From 5119a4c78e7451e386ee1f1aa07b972a0dad788d Mon Sep 17 00:00:00 2001 From: Alex Fedoseev Date: Thu, 6 Feb 2020 16:05:11 +0000 Subject: [PATCH] Refactor --- .gitignore | 4 +- .../bsconfig.json | 2 +- .../package.json | 0 .../src/Api.re | 0 .../src/App.re | 0 .../src/Form.re | 0 .../src/FormsWithFieldId.re | 0 .../src/LoginForm.re | 0 .../src/SignupForm.re | 0 .../src/index.css | 0 .../src/index.html | 0 .../src/index.re | 0 lib/bin/Bin.re | 1 + {re-formality => lib}/bin/dune | 0 {re-formality => lib}/bsconfig.json | 0 {re-formality => lib}/dune-project | 0 {re-formality => lib}/esy.json | 0 {re-formality => lib}/esy.lock/.gitattributes | 2 +- {re-formality => lib}/esy.lock/.gitignore | 0 {re-formality => lib}/esy.lock/index.json | 293 +-- .../esy.lock/opam/atd.2.0.0/opam | 0 .../esy.lock/opam/atdgen-runtime.2.0.0/opam | 0 .../esy.lock/opam/atdgen.2.0.0/opam | 0 .../esy.lock/opam/base-threads.base/opam | 0 .../esy.lock/opam/base-unix.base/opam | 0 .../esy.lock/opam/base.v0.13.0/opam | 0 .../esy.lock/opam/biniou.1.2.1/opam | 0 .../esy.lock/opam/conf-m4.1/opam | 0 .../esy.lock/opam/cppo.1.6.6/opam | 0 .../opam/dune-configurator.2.1.3/opam | 43 + .../opam/dune-private-libs.2.0.1/opam | 42 + .../esy.lock/opam/dune.2.0.1}/opam | 24 +- .../esy.lock/opam/easy-format.1.3.2/opam | 0 lib/esy.lock/opam/jbuilder.1.0+beta20.2/opam | 39 + lib/esy.lock/opam/menhir.20200123/opam | 27 + lib/esy.lock/opam/menhirLib.20200123/opam | 25 + lib/esy.lock/opam/menhirSdk.20200123/opam | 25 + .../esy.lock/opam/merlin-extend.0.5/opam | 0 .../esy.lock/opam/merlin.3.3.3/opam | 0 .../opam/ocaml-compiler-libs.v0.12.1/opam | 0 .../opam/ocaml-migrate-parsetree.1.5.0/opam | 0 .../opam/ocamlfind.1.8.1/files/ocaml-stub | 0 .../ocamlfind.1.8.1/files/ocamlfind.install | 0 .../esy.lock/opam/ocamlfind.1.8.1/opam | 0 .../esy.lock/opam/ppx_derivers.1.2.1/opam | 0 .../esy.lock/opam/ppxlib.0.12.0/opam | 0 .../esy.lock/opam/re.1.9.0/opam | 0 .../esy.lock/opam/result.1.4/opam | 0 .../esy.lock/opam/seq.0.2.2/opam | 0 .../esy.lock/opam/sexplib0.v0.13.0/opam | 0 .../esy.lock/opam/stdio.v0.13.0/opam | 0 .../esy.lock/opam/yojson.1.7.0/opam | 0 .../files/findlib-1.8.1.patch | 0 .../package.json | 0 {re-formality => lib}/package.json | 0 lib/ppx/Ast.re | 17 + lib/ppx/AstHelpers.re | 103 + lib/ppx/Form.re | 1100 ++++++++++ lib/ppx/Meta.re | 593 ++++++ lib/ppx/Ppx.re | 9 + {re-formality => lib}/ppx/dune | 2 +- {re-formality => lib}/re-formality-ppx.opam | 0 lib/src/Formality.re | 168 ++ {re-formality => lib}/src/FormalityCompat.re | 0 {re-formality => lib}/src/FormalityCompat.rei | 0 .../src/FormalityCompat__Form.re | 0 .../src/FormalityCompat__FormAsyncOnBlur.re | 0 .../FormalityCompat__FormAsyncOnBlurWithId.re | 0 .../src/FormalityCompat__FormAsyncOnChange.re | 0 ...ormalityCompat__FormAsyncOnChangeWithId.re | 0 .../src/FormalityCompat__FormStatus.re | 0 .../src/FormalityCompat__FormWithId.re | 0 .../src/FormalityCompat__PublicHelpers.re | 0 .../src/FormalityCompat__PublicHelpers.rei | 0 .../src/FormalityCompat__ReactUpdate.re | 0 .../src/FormalityCompat__Strategy.re | 0 .../src/FormalityCompat__Validation.re | 0 .../src/Formality__ReactUpdate.re | 0 package.json | 4 +- re-formality/bin/Bin.re | 3 - .../opam/dune-configurator.1.0.0/opam | 9 - .../esy.lock/opam/jbuilder.transition/opam | 18 - .../esy.lock/opam/menhir.20190924/opam | 29 - .../esy.lock/opam/ocamlbuild.0.14.0/opam | 36 - .../files/ocamlbuild-0.14.0.patch | 463 ---- .../package.json | 27 - re-formality/ppx/FormalityPpx.re | 1865 ----------------- re-formality/src/Formality.re | 3 - re-formality/src/Formality__Form.re | 107 - re-formality/src/Formality__FormStatus.re | 9 - re-formality/src/Formality__Strategy.re | 6 - re-formality/src/Formality__Validation.re | 87 - 92 files changed, 2386 insertions(+), 2799 deletions(-) rename {re-formality-examples => examples}/bsconfig.json (85%) rename {re-formality-examples => examples}/package.json (100%) rename {re-formality-examples => examples}/src/Api.re (100%) rename {re-formality-examples => examples}/src/App.re (100%) rename {re-formality-examples => examples}/src/Form.re (100%) rename {re-formality-examples => examples}/src/FormsWithFieldId.re (100%) rename {re-formality-examples => examples}/src/LoginForm.re (100%) rename {re-formality-examples => examples}/src/SignupForm.re (100%) rename {re-formality-examples => examples}/src/index.css (100%) rename {re-formality-examples => examples}/src/index.html (100%) rename {re-formality-examples => examples}/src/index.re (100%) create mode 100644 lib/bin/Bin.re rename {re-formality => lib}/bin/dune (100%) rename {re-formality => lib}/bsconfig.json (100%) rename {re-formality => lib}/dune-project (100%) rename {re-formality => lib}/esy.json (100%) rename {re-formality => lib}/esy.lock/.gitattributes (67%) rename {re-formality => lib}/esy.lock/.gitignore (100%) rename {re-formality => lib}/esy.lock/index.json (74%) rename {re-formality => lib}/esy.lock/opam/atd.2.0.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/atdgen-runtime.2.0.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/atdgen.2.0.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/base-threads.base/opam (100%) rename {re-formality => lib}/esy.lock/opam/base-unix.base/opam (100%) rename {re-formality => lib}/esy.lock/opam/base.v0.13.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/biniou.1.2.1/opam (100%) rename {re-formality => lib}/esy.lock/opam/conf-m4.1/opam (100%) rename {re-formality => lib}/esy.lock/opam/cppo.1.6.6/opam (100%) create mode 100644 lib/esy.lock/opam/dune-configurator.2.1.3/opam create mode 100644 lib/esy.lock/opam/dune-private-libs.2.0.1/opam rename {re-formality/esy.lock/opam/dune.1.11.4 => lib/esy.lock/opam/dune.2.0.1}/opam (61%) rename {re-formality => lib}/esy.lock/opam/easy-format.1.3.2/opam (100%) create mode 100644 lib/esy.lock/opam/jbuilder.1.0+beta20.2/opam create mode 100644 lib/esy.lock/opam/menhir.20200123/opam create mode 100644 lib/esy.lock/opam/menhirLib.20200123/opam create mode 100644 lib/esy.lock/opam/menhirSdk.20200123/opam rename {re-formality => lib}/esy.lock/opam/merlin-extend.0.5/opam (100%) rename {re-formality => lib}/esy.lock/opam/merlin.3.3.3/opam (100%) rename {re-formality => lib}/esy.lock/opam/ocaml-compiler-libs.v0.12.1/opam (100%) rename {re-formality => lib}/esy.lock/opam/ocaml-migrate-parsetree.1.5.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub (100%) rename {re-formality => lib}/esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install (100%) rename {re-formality => lib}/esy.lock/opam/ocamlfind.1.8.1/opam (100%) rename {re-formality => lib}/esy.lock/opam/ppx_derivers.1.2.1/opam (100%) rename {re-formality => lib}/esy.lock/opam/ppxlib.0.12.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/re.1.9.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/result.1.4/opam (100%) rename {re-formality => lib}/esy.lock/opam/seq.0.2.2/opam (100%) rename {re-formality => lib}/esy.lock/opam/sexplib0.v0.13.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/stdio.v0.13.0/opam (100%) rename {re-formality => lib}/esy.lock/opam/yojson.1.7.0/opam (100%) rename {re-formality => lib}/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch (100%) rename {re-formality => lib}/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json (100%) rename {re-formality => lib}/package.json (100%) create mode 100644 lib/ppx/Ast.re create mode 100644 lib/ppx/AstHelpers.re create mode 100644 lib/ppx/Form.re create mode 100644 lib/ppx/Meta.re create mode 100644 lib/ppx/Ppx.re rename {re-formality => lib}/ppx/dune (86%) rename {re-formality => lib}/re-formality-ppx.opam (100%) create mode 100644 lib/src/Formality.re rename {re-formality => lib}/src/FormalityCompat.re (100%) rename {re-formality => lib}/src/FormalityCompat.rei (100%) rename {re-formality => lib}/src/FormalityCompat__Form.re (100%) rename {re-formality => lib}/src/FormalityCompat__FormAsyncOnBlur.re (100%) rename {re-formality => lib}/src/FormalityCompat__FormAsyncOnBlurWithId.re (100%) rename {re-formality => lib}/src/FormalityCompat__FormAsyncOnChange.re (100%) rename {re-formality => lib}/src/FormalityCompat__FormAsyncOnChangeWithId.re (100%) rename {re-formality => lib}/src/FormalityCompat__FormStatus.re (100%) rename {re-formality => lib}/src/FormalityCompat__FormWithId.re (100%) rename {re-formality => lib}/src/FormalityCompat__PublicHelpers.re (100%) rename {re-formality => lib}/src/FormalityCompat__PublicHelpers.rei (100%) rename {re-formality => lib}/src/FormalityCompat__ReactUpdate.re (100%) rename {re-formality => lib}/src/FormalityCompat__Strategy.re (100%) rename {re-formality => lib}/src/FormalityCompat__Validation.re (100%) rename {re-formality => lib}/src/Formality__ReactUpdate.re (100%) delete mode 100644 re-formality/bin/Bin.re delete mode 100644 re-formality/esy.lock/opam/dune-configurator.1.0.0/opam delete mode 100644 re-formality/esy.lock/opam/jbuilder.transition/opam delete mode 100644 re-formality/esy.lock/opam/menhir.20190924/opam delete mode 100644 re-formality/esy.lock/opam/ocamlbuild.0.14.0/opam delete mode 100644 re-formality/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/files/ocamlbuild-0.14.0.patch delete mode 100644 re-formality/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/package.json delete mode 100644 re-formality/ppx/FormalityPpx.re delete mode 100644 re-formality/src/Formality.re delete mode 100644 re-formality/src/Formality__Form.re delete mode 100644 re-formality/src/Formality__FormStatus.re delete mode 100644 re-formality/src/Formality__Strategy.re delete mode 100644 re-formality/src/Formality__Validation.re diff --git a/.gitignore b/.gitignore index 27b2a923..66df0b6e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,6 @@ node_modules/ -lib/ -dist/ +*/lib/ +*/dist/ .merlin .bsb.lock *.bs.js diff --git a/re-formality-examples/bsconfig.json b/examples/bsconfig.json similarity index 85% rename from re-formality-examples/bsconfig.json rename to examples/bsconfig.json index b0a15970..0e28ef98 100644 --- a/re-formality-examples/bsconfig.json +++ b/examples/bsconfig.json @@ -11,7 +11,7 @@ }, "refmt": 3, "bsc-flags": ["-open Belt"], - "ppx-flags": ["../re-formality/_build/default/bin/bin.exe"], + "ppx-flags": ["../lib/_build/default/bin/bin.exe"], "package-specs": { "module": "es6", "in-source": true diff --git a/re-formality-examples/package.json b/examples/package.json similarity index 100% rename from re-formality-examples/package.json rename to examples/package.json diff --git a/re-formality-examples/src/Api.re b/examples/src/Api.re similarity index 100% rename from re-formality-examples/src/Api.re rename to examples/src/Api.re diff --git a/re-formality-examples/src/App.re b/examples/src/App.re similarity index 100% rename from re-formality-examples/src/App.re rename to examples/src/App.re diff --git a/re-formality-examples/src/Form.re b/examples/src/Form.re similarity index 100% rename from re-formality-examples/src/Form.re rename to examples/src/Form.re diff --git a/re-formality-examples/src/FormsWithFieldId.re b/examples/src/FormsWithFieldId.re similarity index 100% rename from re-formality-examples/src/FormsWithFieldId.re rename to examples/src/FormsWithFieldId.re diff --git a/re-formality-examples/src/LoginForm.re b/examples/src/LoginForm.re similarity index 100% rename from re-formality-examples/src/LoginForm.re rename to examples/src/LoginForm.re diff --git a/re-formality-examples/src/SignupForm.re b/examples/src/SignupForm.re similarity index 100% rename from re-formality-examples/src/SignupForm.re rename to examples/src/SignupForm.re diff --git a/re-formality-examples/src/index.css b/examples/src/index.css similarity index 100% rename from re-formality-examples/src/index.css rename to examples/src/index.css diff --git a/re-formality-examples/src/index.html b/examples/src/index.html similarity index 100% rename from re-formality-examples/src/index.html rename to examples/src/index.html diff --git a/re-formality-examples/src/index.re b/examples/src/index.re similarity index 100% rename from re-formality-examples/src/index.re rename to examples/src/index.re diff --git a/lib/bin/Bin.re b/lib/bin/Bin.re new file mode 100644 index 00000000..25d3caf0 --- /dev/null +++ b/lib/bin/Bin.re @@ -0,0 +1 @@ +Ppxlib.Driver.run_as_ppx_rewriter(); diff --git a/re-formality/bin/dune b/lib/bin/dune similarity index 100% rename from re-formality/bin/dune rename to lib/bin/dune diff --git a/re-formality/bsconfig.json b/lib/bsconfig.json similarity index 100% rename from re-formality/bsconfig.json rename to lib/bsconfig.json diff --git a/re-formality/dune-project b/lib/dune-project similarity index 100% rename from re-formality/dune-project rename to lib/dune-project diff --git a/re-formality/esy.json b/lib/esy.json similarity index 100% rename from re-formality/esy.json rename to lib/esy.json diff --git a/re-formality/esy.lock/.gitattributes b/lib/esy.lock/.gitattributes similarity index 67% rename from re-formality/esy.lock/.gitattributes rename to lib/esy.lock/.gitattributes index 25366aee..e0b4e26c 100644 --- a/re-formality/esy.lock/.gitattributes +++ b/lib/esy.lock/.gitattributes @@ -1,3 +1,3 @@ # Set eol to LF so files aren't converted to CRLF-eol on Windows. -* text eol=lf +* text eol=lf linguist-generated diff --git a/re-formality/esy.lock/.gitignore b/lib/esy.lock/.gitignore similarity index 100% rename from re-formality/esy.lock/.gitignore rename to lib/esy.lock/.gitignore diff --git a/re-formality/esy.lock/index.json b/lib/esy.lock/index.json similarity index 74% rename from re-formality/esy.lock/index.json rename to lib/esy.lock/index.json index cef5b690..d3bd06e4 100644 --- a/re-formality/esy.lock/index.json +++ b/lib/esy.lock/index.json @@ -14,9 +14,9 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@reason-native/pastel@0.2.3@d41d8cd9", + "ocaml@4.6.1000@d41d8cd9", "@reason-native/pastel@0.3.0@d41d8cd9", "@reason-native/console@0.1.0@d41d8cd9", - "@opam/re@opam:1.9.0@d4d5e13d", "@opam/dune@opam:1.11.4@a7ccb7ae", + "@opam/re@opam:1.9.0@d4d5e13d", "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/atdgen@opam:2.0.0@46af0360", "@esy-ocaml/reason@3.5.2@d41d8cd9" ], @@ -31,7 +31,7 @@ "dependencies": [ "refmterr@3.3.0@d41d8cd9", "ocaml@4.6.1000@d41d8cd9", "@opam/ppxlib@opam:0.12.0@fcf5cabc", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@esy-ocaml/reason@3.5.2@d41d8cd9" + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/reason@3.5.2@d41d8cd9" ], "devDependencies": [ "@opam/merlin@opam:3.3.3@d653b06a" ] }, @@ -49,20 +49,20 @@ "dependencies": [], "devDependencies": [] }, - "@reason-native/pastel@0.2.3@d41d8cd9": { - "id": "@reason-native/pastel@0.2.3@d41d8cd9", + "@reason-native/pastel@0.3.0@d41d8cd9": { + "id": "@reason-native/pastel@0.3.0@d41d8cd9", "name": "@reason-native/pastel", - "version": "0.2.3", + "version": "0.3.0", "source": { "type": "install", "source": [ - "archive:https://registry.npmjs.org/@reason-native/pastel/-/pastel-0.2.3.tgz#sha1:5c5d420c09874584ce15a38695c5dfd0f0ff5dfa" + "archive:https://registry.npmjs.org/@reason-native/pastel/-/pastel-0.3.0.tgz#sha1:07da3c5a0933e61bc3b353bc85aa71ac7c0f311c" ] }, "overrides": [], "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/re@opam:1.9.0@d4d5e13d", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@esy-ocaml/reason@3.5.2@d41d8cd9" + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/reason@3.5.2@d41d8cd9" ], "devDependencies": [] }, @@ -78,7 +78,7 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/reason@3.5.2@d41d8cd9" ], "devDependencies": [] @@ -102,13 +102,13 @@ "overrides": [], "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@opam/cppo@opam:1.6.6@f4f83858", + "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/cppo@opam:1.6.6@f4f83858", "@opam/biniou@opam:1.2.1@d7570399", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@opam/biniou@opam:1.2.1@d7570399" + "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/biniou@opam:1.2.1@d7570399" ] }, "@opam/stdio@opam:v0.13.0@eb59d879": { @@ -129,12 +129,12 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/base@opam:v0.13.0@93f21415", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/base@opam:v0.13.0@93f21415" ] }, @@ -156,11 +156,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae" + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/seq@opam:0.2.2@e9144e45": { @@ -181,11 +181,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae" + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/result@opam:1.4@dc720aef": { @@ -206,11 +206,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae" + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/re@opam:1.9.0@d4d5e13d": { @@ -232,11 +232,11 @@ "overrides": [], "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/seq@opam:0.2.2@e9144e45", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/seq@opam:0.2.2@e9144e45", - "@opam/dune@opam:1.11.4@a7ccb7ae" + "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/ppxlib@opam:0.12.0@fcf5cabc": { @@ -261,8 +261,7 @@ "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", "@opam/ocaml-migrate-parsetree@opam:1.5.0@3e319dbc", "@opam/ocaml-compiler-libs@opam:v0.12.1@5c34eb0d", - "@opam/dune@opam:1.11.4@a7ccb7ae", - "@opam/base@opam:v0.13.0@93f21415", + "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/base@opam:v0.13.0@93f21415", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ @@ -270,7 +269,7 @@ "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", "@opam/ocaml-migrate-parsetree@opam:1.5.0@3e319dbc", "@opam/ocaml-compiler-libs@opam:v0.12.1@5c34eb0d", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@opam/base@opam:v0.13.0@93f21415" + "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/base@opam:v0.13.0@93f21415" ] }, "@opam/ppx_derivers@opam:1.2.1@ecf0aa45": { @@ -291,11 +290,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae" + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/ocamlfind@opam:1.8.1@ff07b0f9": { @@ -327,33 +326,6 @@ ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9" ] }, - "@opam/ocamlbuild@opam:0.14.0@6ac75d03": { - "id": "@opam/ocamlbuild@opam:0.14.0@6ac75d03", - "name": "@opam/ocamlbuild", - "version": "opam:0.14.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/87/87b29ce96958096c0a1a8eeafeb6268077b2d11e1bf2b3de0f5ebc9cf8d42e78#sha256:87b29ce96958096c0a1a8eeafeb6268077b2d11e1bf2b3de0f5ebc9cf8d42e78", - "archive:https://github.com/ocaml/ocamlbuild/archive/0.14.0.tar.gz#sha256:87b29ce96958096c0a1a8eeafeb6268077b2d11e1bf2b3de0f5ebc9cf8d42e78" - ], - "opam": { - "name": "ocamlbuild", - "version": "0.14.0", - "path": "esy.lock/opam/ocamlbuild.0.14.0" - } - }, - "overrides": [ - { - "opamoverride": - "esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override" - } - ], - "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.6.1000@d41d8cd9" ] - }, "@opam/ocaml-migrate-parsetree@opam:1.5.0@3e319dbc": { "id": "@opam/ocaml-migrate-parsetree@opam:1.5.0@3e319dbc", "name": "@opam/ocaml-migrate-parsetree", @@ -374,12 +346,12 @@ "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/result@opam:1.4@dc720aef", "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/result@opam:1.4@dc720aef", "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", - "@opam/dune@opam:1.11.4@a7ccb7ae" + "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/ocaml-compiler-libs@opam:v0.12.1@5c34eb0d": { @@ -400,11 +372,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae" + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/merlin-extend@opam:0.5@a5dd7d4b": { @@ -425,11 +397,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/cppo@opam:1.6.6@f4f83858", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae" + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/merlin@opam:3.3.3@d653b06a": { @@ -452,60 +424,114 @@ "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/dune@opam:1.11.4@a7ccb7ae" + "@opam/dune@opam:2.0.1@5dc56bd0" ] }, - "@opam/menhir@opam:20190924@004407ff": { - "id": "@opam/menhir@opam:20190924@004407ff", - "name": "@opam/menhir", - "version": "opam:20190924", + "@opam/menhirSdk@opam:20200123@b2300eb1": { + "id": "@opam/menhirSdk@opam:20200123@b2300eb1", + "name": "@opam/menhirSdk", + "version": "opam:20200123", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/67/677f1997fb73177d5a00fa1b8d61c3ef#md5:677f1997fb73177d5a00fa1b8d61c3ef", - "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20190924/archive.tar.gz#md5:677f1997fb73177d5a00fa1b8d61c3ef" + "archive:https://opam.ocaml.org/cache/md5/91/91aeae45fbf781e82ec3fe636be6ad49#md5:91aeae45fbf781e82ec3fe636be6ad49", + "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20200123/archive.tar.gz#md5:91aeae45fbf781e82ec3fe636be6ad49" ], "opam": { - "name": "menhir", - "version": "20190924", - "path": "esy.lock/opam/menhir.20190924" + "name": "menhirSdk", + "version": "20200123", + "path": "esy.lock/opam/menhirSdk.20200123" } }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/ocamlbuild@opam:0.14.0@6ac75d03", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.6.1000@d41d8cd9" ] + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" + ] }, - "@opam/jbuilder@opam:transition@20522f05": { - "id": "@opam/jbuilder@opam:transition@20522f05", - "name": "@opam/jbuilder", - "version": "opam:transition", + "@opam/menhirLib@opam:20200123@aac9ddb2": { + "id": "@opam/menhirLib@opam:20200123@aac9ddb2", + "name": "@opam/menhirLib", + "version": "opam:20200123", "source": { "type": "install", - "source": [ "no-source:" ], + "source": [ + "archive:https://opam.ocaml.org/cache/md5/91/91aeae45fbf781e82ec3fe636be6ad49#md5:91aeae45fbf781e82ec3fe636be6ad49", + "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20200123/archive.tar.gz#md5:91aeae45fbf781e82ec3fe636be6ad49" + ], "opam": { - "name": "jbuilder", - "version": "transition", - "path": "esy.lock/opam/jbuilder.transition" + "name": "menhirLib", + "version": "20200123", + "path": "esy.lock/opam/menhirLib.20200123" } }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae" + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" ] }, + "@opam/menhir@opam:20200123@fdbafd0c": { + "id": "@opam/menhir@opam:20200123@fdbafd0c", + "name": "@opam/menhir", + "version": "opam:20200123", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/91/91aeae45fbf781e82ec3fe636be6ad49#md5:91aeae45fbf781e82ec3fe636be6ad49", + "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20200123/archive.tar.gz#md5:91aeae45fbf781e82ec3fe636be6ad49" + ], + "opam": { + "name": "menhir", + "version": "20200123", + "path": "esy.lock/opam/menhir.20200123" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/menhirSdk@opam:20200123@b2300eb1", + "@opam/menhirLib@opam:20200123@aac9ddb2", + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/menhirSdk@opam:20200123@b2300eb1", + "@opam/menhirLib@opam:20200123@aac9ddb2", + "@opam/dune@opam:2.0.1@5dc56bd0" + ] + }, + "@opam/jbuilder@opam:1.0+beta20.2@053ddcf2": { + "id": "@opam/jbuilder@opam:1.0+beta20.2@053ddcf2", + "name": "@opam/jbuilder", + "version": "opam:1.0+beta20.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/fb/fbe8c3b1facb206cac3fb8932b5dd5d9#md5:fbe8c3b1facb206cac3fb8932b5dd5d9", + "archive:https://github.com/ocaml/dune/releases/download/1.0%2Bbeta20.2/jbuilder-1.0+beta20.2.tbz#md5:fbe8c3b1facb206cac3fb8932b5dd5d9" + ], + "opam": { + "name": "jbuilder", + "version": "1.0+beta20.2", + "path": "esy.lock/opam/jbuilder.1.0+beta20.2" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@4.6.1000@d41d8cd9" ] + }, "@opam/easy-format@opam:1.3.2@0484b3c4": { "id": "@opam/easy-format@opam:1.3.2@0484b3c4", "name": "@opam/easy-format", @@ -524,46 +550,78 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae" + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" ] }, - "@opam/dune-configurator@opam:1.0.0@4873acd8": { - "id": "@opam/dune-configurator@opam:1.0.0@4873acd8", + "@opam/dune-private-libs@opam:2.0.1@d5d5e717": { + "id": "@opam/dune-private-libs@opam:2.0.1@d5d5e717", + "name": "@opam/dune-private-libs", + "version": "opam:2.0.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/e0/e04090c846f005f1cc02c390e963a7efe74c653ce2c5c7fd2e7e30a06ceadcb7#sha256:e04090c846f005f1cc02c390e963a7efe74c653ce2c5c7fd2e7e30a06ceadcb7", + "archive:https://github.com/ocaml/dune/releases/download/2.0.1/dune-2.0.1.tbz#sha256:e04090c846f005f1cc02c390e963a7efe74c653ce2c5c7fd2e7e30a06ceadcb7" + ], + "opam": { + "name": "dune-private-libs", + "version": "2.0.1", + "path": "esy.lock/opam/dune-private-libs.2.0.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0" + ] + }, + "@opam/dune-configurator@opam:2.1.3@25ad9b47": { + "id": "@opam/dune-configurator@opam:2.1.3@25ad9b47", "name": "@opam/dune-configurator", - "version": "opam:1.0.0", + "version": "opam:2.1.3", "source": { "type": "install", - "source": [ "no-source:" ], + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/1e/1e8e3b55a9fae02c4b8137e2134a6cc163df5cddcd1d52cdacf2343ac53baeb3#sha256:1e8e3b55a9fae02c4b8137e2134a6cc163df5cddcd1d52cdacf2343ac53baeb3", + "archive:https://github.com/ocaml/dune/releases/download/2.1.3/dune-2.1.3.tbz#sha256:1e8e3b55a9fae02c4b8137e2134a6cc163df5cddcd1d52cdacf2343ac53baeb3" + ], "opam": { "name": "dune-configurator", - "version": "1.0.0", - "path": "esy.lock/opam/dune-configurator.1.0.0" + "version": "2.1.3", + "path": "esy.lock/opam/dune-configurator.2.1.3" } }, "overrides": [], "dependencies": [ - "@opam/dune@opam:1.11.4@a7ccb7ae", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune-private-libs@opam:2.0.1@d5d5e717", + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "@opam/dune@opam:1.11.4@a7ccb7ae" ] + "devDependencies": [ + "@opam/dune-private-libs@opam:2.0.1@d5d5e717", + "@opam/dune@opam:2.0.1@5dc56bd0" + ] }, - "@opam/dune@opam:1.11.4@a7ccb7ae": { - "id": "@opam/dune@opam:1.11.4@a7ccb7ae", + "@opam/dune@opam:2.0.1@5dc56bd0": { + "id": "@opam/dune@opam:2.0.1@5dc56bd0", "name": "@opam/dune", - "version": "opam:1.11.4", + "version": "opam:2.0.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/77/77cb5f483221b266ded2b85fc84173ae0089a25134a086be922e82c131456ce6#sha256:77cb5f483221b266ded2b85fc84173ae0089a25134a086be922e82c131456ce6", - "archive:https://github.com/ocaml/dune/releases/download/1.11.4/dune-build-info-1.11.4.tbz#sha256:77cb5f483221b266ded2b85fc84173ae0089a25134a086be922e82c131456ce6" + "archive:https://opam.ocaml.org/cache/sha256/e0/e04090c846f005f1cc02c390e963a7efe74c653ce2c5c7fd2e7e30a06ceadcb7#sha256:e04090c846f005f1cc02c390e963a7efe74c653ce2c5c7fd2e7e30a06ceadcb7", + "archive:https://github.com/ocaml/dune/releases/download/2.0.1/dune-2.0.1.tbz#sha256:e04090c846f005f1cc02c390e963a7efe74c653ce2c5c7fd2e7e30a06ceadcb7" ], "opam": { "name": "dune", - "version": "1.11.4", - "path": "esy.lock/opam/dune.1.11.4" + "version": "2.0.1", + "path": "esy.lock/opam/dune.2.0.1" } }, "overrides": [], @@ -595,12 +653,12 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:1.11.4@a7ccb7ae", + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.0.1@5dc56bd0", "@opam/base-unix@opam:base@87d0b2eb" ] }, @@ -640,11 +698,11 @@ "overrides": [], "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", - "@opam/dune@opam:1.11.4@a7ccb7ae" + "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/base-unix@opam:base@87d0b2eb": { @@ -700,13 +758,13 @@ "overrides": [], "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/sexplib0@opam:v0.13.0@3f54c2be", - "@opam/dune-configurator@opam:1.0.0@4873acd8", - "@opam/dune@opam:1.11.4@a7ccb7ae", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune-configurator@opam:2.1.3@25ad9b47", + "@opam/dune@opam:2.0.1@5dc56bd0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/sexplib0@opam:v0.13.0@3f54c2be", - "@opam/dune-configurator@opam:1.0.0@4873acd8", - "@opam/dune@opam:1.11.4@a7ccb7ae" + "@opam/dune-configurator@opam:2.1.3@25ad9b47", + "@opam/dune@opam:2.0.1@5dc56bd0" ] }, "@opam/atdgen-runtime@opam:2.0.0@60f6faab": { @@ -728,13 +786,13 @@ "overrides": [], "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/jbuilder@opam:transition@20522f05", + "@opam/jbuilder@opam:1.0+beta20.2@053ddcf2", "@opam/biniou@opam:1.2.1@d7570399", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/jbuilder@opam:transition@20522f05", + "@opam/jbuilder@opam:1.0+beta20.2@053ddcf2", "@opam/biniou@opam:1.2.1@d7570399" ] }, @@ -757,14 +815,14 @@ "overrides": [], "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/jbuilder@opam:transition@20522f05", + "@opam/jbuilder@opam:1.0+beta20.2@053ddcf2", "@opam/biniou@opam:1.2.1@d7570399", "@opam/atdgen-runtime@opam:2.0.0@60f6faab", "@opam/atd@opam:2.0.0@e0ddd12f", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/jbuilder@opam:transition@20522f05", + "@opam/jbuilder@opam:1.0+beta20.2@053ddcf2", "@opam/biniou@opam:1.2.1@d7570399", "@opam/atdgen-runtime@opam:2.0.0@60f6faab", "@opam/atd@opam:2.0.0@e0ddd12f" @@ -788,13 +846,14 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/menhir@opam:20190924@004407ff", - "@opam/jbuilder@opam:transition@20522f05", + "ocaml@4.6.1000@d41d8cd9", "@opam/menhir@opam:20200123@fdbafd0c", + "@opam/jbuilder@opam:1.0+beta20.2@053ddcf2", "@opam/easy-format@opam:1.3.2@0484b3c4", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/jbuilder@opam:transition@20522f05", + "ocaml@4.6.1000@d41d8cd9", + "@opam/jbuilder@opam:1.0+beta20.2@053ddcf2", "@opam/easy-format@opam:1.3.2@0484b3c4" ] }, @@ -828,8 +887,8 @@ "@opam/ocamlfind@opam:1.8.1@ff07b0f9", "@opam/ocaml-migrate-parsetree@opam:1.5.0@3e319dbc", "@opam/merlin-extend@opam:0.5@a5dd7d4b", - "@opam/menhir@opam:20190924@004407ff", - "@opam/dune@opam:1.11.4@a7ccb7ae" + "@opam/menhir@opam:20200123@fdbafd0c", + "@opam/dune@opam:2.0.1@5dc56bd0" ], "devDependencies": [] } diff --git a/re-formality/esy.lock/opam/atd.2.0.0/opam b/lib/esy.lock/opam/atd.2.0.0/opam similarity index 100% rename from re-formality/esy.lock/opam/atd.2.0.0/opam rename to lib/esy.lock/opam/atd.2.0.0/opam diff --git a/re-formality/esy.lock/opam/atdgen-runtime.2.0.0/opam b/lib/esy.lock/opam/atdgen-runtime.2.0.0/opam similarity index 100% rename from re-formality/esy.lock/opam/atdgen-runtime.2.0.0/opam rename to lib/esy.lock/opam/atdgen-runtime.2.0.0/opam diff --git a/re-formality/esy.lock/opam/atdgen.2.0.0/opam b/lib/esy.lock/opam/atdgen.2.0.0/opam similarity index 100% rename from re-formality/esy.lock/opam/atdgen.2.0.0/opam rename to lib/esy.lock/opam/atdgen.2.0.0/opam diff --git a/re-formality/esy.lock/opam/base-threads.base/opam b/lib/esy.lock/opam/base-threads.base/opam similarity index 100% rename from re-formality/esy.lock/opam/base-threads.base/opam rename to lib/esy.lock/opam/base-threads.base/opam diff --git a/re-formality/esy.lock/opam/base-unix.base/opam b/lib/esy.lock/opam/base-unix.base/opam similarity index 100% rename from re-formality/esy.lock/opam/base-unix.base/opam rename to lib/esy.lock/opam/base-unix.base/opam diff --git a/re-formality/esy.lock/opam/base.v0.13.0/opam b/lib/esy.lock/opam/base.v0.13.0/opam similarity index 100% rename from re-formality/esy.lock/opam/base.v0.13.0/opam rename to lib/esy.lock/opam/base.v0.13.0/opam diff --git a/re-formality/esy.lock/opam/biniou.1.2.1/opam b/lib/esy.lock/opam/biniou.1.2.1/opam similarity index 100% rename from re-formality/esy.lock/opam/biniou.1.2.1/opam rename to lib/esy.lock/opam/biniou.1.2.1/opam diff --git a/re-formality/esy.lock/opam/conf-m4.1/opam b/lib/esy.lock/opam/conf-m4.1/opam similarity index 100% rename from re-formality/esy.lock/opam/conf-m4.1/opam rename to lib/esy.lock/opam/conf-m4.1/opam diff --git a/re-formality/esy.lock/opam/cppo.1.6.6/opam b/lib/esy.lock/opam/cppo.1.6.6/opam similarity index 100% rename from re-formality/esy.lock/opam/cppo.1.6.6/opam rename to lib/esy.lock/opam/cppo.1.6.6/opam diff --git a/lib/esy.lock/opam/dune-configurator.2.1.3/opam b/lib/esy.lock/opam/dune-configurator.2.1.3/opam new file mode 100644 index 00000000..84bc0588 --- /dev/null +++ b/lib/esy.lock/opam/dune-configurator.2.1.3/opam @@ -0,0 +1,43 @@ +opam-version: "2.0" +synopsis: "Helper library for gathering system configuration" +description: """ +dune-configurator is a small library that helps writing OCaml scripts that +test features available on the system, in order to generate config.h +files for instance. +Among other things, dune-configurator allows one to: +- test if a C program compiles +- query pkg-config +- import #define from OCaml header files +- generate config.h file +""" +maintainer: ["Jane Street Group, LLC "] +authors: ["Jane Street Group, LLC "] +license: "MIT" +homepage: "https://github.com/ocaml/dune" +doc: "https://dune.readthedocs.io/" +bug-reports: "https://github.com/ocaml/dune/issues" +depends: [ + "dune" {>= "2.0"} + "dune-private-libs" {= version} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@doc" {with-doc} + ] +] +url { + src: "https://github.com/ocaml/dune/releases/download/2.1.3/dune-2.1.3.tbz" + checksum: [ + "sha256=1e8e3b55a9fae02c4b8137e2134a6cc163df5cddcd1d52cdacf2343ac53baeb3" + "sha512=31e179bc4aaf6cd84f3a0ce42870f44f7d86c1016600f053767e68779a9a074bdae718237bd9ec63ace088c11967311bf990c17e2db4c1bee02dfd23cafaeecd" + ] +} diff --git a/lib/esy.lock/opam/dune-private-libs.2.0.1/opam b/lib/esy.lock/opam/dune-private-libs.2.0.1/opam new file mode 100644 index 00000000..2cd658ab --- /dev/null +++ b/lib/esy.lock/opam/dune-private-libs.2.0.1/opam @@ -0,0 +1,42 @@ +opam-version: "2.0" +synopsis: "Private libraries of Dune" +description: """ +!!!!!!!!!!!!!!!!!!!!!! +!!!!! DO NOT USE !!!!! +!!!!!!!!!!!!!!!!!!!!!! + +This package contains code that is shared between various dune-xxx +packages. However, it is not meant for public consumption and provides +no stability guarantee. +""" +maintainer: ["Jane Street Group, LLC "] +authors: ["Jane Street Group, LLC "] +license: "MIT" +homepage: "https://github.com/ocaml/dune" +doc: "https://dune.readthedocs.io/" +bug-reports: "https://github.com/ocaml/dune/issues" +depends: [ + "dune" {>= "2.0"} + "ocaml" {>= "4.06"} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@doc" {with-doc} + ] +] +url { + src: "https://github.com/ocaml/dune/releases/download/2.0.1/dune-2.0.1.tbz" + checksum: [ + "sha256=e04090c846f005f1cc02c390e963a7efe74c653ce2c5c7fd2e7e30a06ceadcb7" + "sha512=8c973ccfa1de0ff7173e17dac74ea850446a057866d47c7a100b271c7e440d5e607f1bfaa8fa5b756e0439492276e8c6615fac30cbff9ea900dc8e891f7ba4d3" + ] +} diff --git a/re-formality/esy.lock/opam/dune.1.11.4/opam b/lib/esy.lock/opam/dune.2.0.1/opam similarity index 61% rename from re-formality/esy.lock/opam/dune.1.11.4/opam rename to lib/esy.lock/opam/dune.2.0.1/opam index 19e25117..2bea38af 100644 --- a/re-formality/esy.lock/opam/dune.1.11.4/opam +++ b/lib/esy.lock/opam/dune.2.0.1/opam @@ -1,14 +1,14 @@ opam-version: "2.0" -synopsis: "Fast, portable and opinionated build system" +synopsis: "Fast, portable, and opinionated build system" description: """ dune is a build system that was designed to simplify the release of Jane Street packages. It reads metadata from "dune" files following a very simple s-expression syntax. -dune is fast, it has very low-overhead and support parallel builds on -all platforms. It has no system dependencies, all you need to build -dune and packages using dune is OCaml. You don't need or make or bash +dune is fast, has very low-overhead, and supports parallel builds on +all platforms. It has no system dependencies; all you need to build +dune or packages using dune is OCaml. You don't need make or bash as long as the packages themselves don't use bash explicitly. dune supports multi-package development by simply dropping multiple @@ -26,28 +26,26 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "ocaml" {>= "4.02"} + ("ocaml" {>= "4.06"} | ("ocaml" {< "4.06~~"} & "ocamlfind-secondary")) "base-unix" "base-threads" ] conflicts: [ - "jbuilder" {!= "transition"} "odoc" {< "1.3.0"} "dune-release" {< "1.3.0"} + "jbuilder" {= "transition"} ] dev-repo: "git+https://github.com/ocaml/dune.git" build: [ # opam 2 sets OPAM_SWITCH_PREFIX, so we don't need a hardcoded path ["ocaml" "configure.ml" "--libdir" lib] {opam-version < "2"} - ["ocaml" "bootstrap.ml"] - ["./boot.exe" "--release" "--subst"] {pinned} - ["./boot.exe" "--release" "-j" jobs] + ["ocaml" "bootstrap.ml" "-j" jobs] + ["./dune.exe" "build" "-p" name "--profile" "dune-bootstrap" "-j" jobs] ] url { - src: - "https://github.com/ocaml/dune/releases/download/1.11.4/dune-build-info-1.11.4.tbz" + src: "https://github.com/ocaml/dune/releases/download/2.0.1/dune-2.0.1.tbz" checksum: [ - "sha256=77cb5f483221b266ded2b85fc84173ae0089a25134a086be922e82c131456ce6" - "sha512=02f00fd872aa49b832fc8c1e928409f23c79ddf84a53009a58875f222cca36fbb92c905e12c539caec9cbad723f195a8aa24218382dca35a903b3f52b11f06f2" + "sha256=e04090c846f005f1cc02c390e963a7efe74c653ce2c5c7fd2e7e30a06ceadcb7" + "sha512=8c973ccfa1de0ff7173e17dac74ea850446a057866d47c7a100b271c7e440d5e607f1bfaa8fa5b756e0439492276e8c6615fac30cbff9ea900dc8e891f7ba4d3" ] } diff --git a/re-formality/esy.lock/opam/easy-format.1.3.2/opam b/lib/esy.lock/opam/easy-format.1.3.2/opam similarity index 100% rename from re-formality/esy.lock/opam/easy-format.1.3.2/opam rename to lib/esy.lock/opam/easy-format.1.3.2/opam diff --git a/lib/esy.lock/opam/jbuilder.1.0+beta20.2/opam b/lib/esy.lock/opam/jbuilder.1.0+beta20.2/opam new file mode 100644 index 00000000..2e411c9e --- /dev/null +++ b/lib/esy.lock/opam/jbuilder.1.0+beta20.2/opam @@ -0,0 +1,39 @@ +opam-version: "2.0" +maintainer: "opensource@janestreet.com" +authors: ["Jane Street Group, LLC "] +homepage: "https://github.com/ocaml/dune" +bug-reports: "https://github.com/ocaml/dune/issues" +dev-repo: "git+https://github.com/ocaml/dune.git" +license: "Apache-2.0" +build: [ + ["ocaml" "configure.ml" "--libdir" lib] + ["ocaml" "bootstrap.ml"] + ["./boot.exe" "--subst"] {pinned} + ["./boot.exe" "-j" jobs] +] +synopsis: "Fast, portable and opinionated build system" +description: """ +jbuilder is a build system that was designed to simplify the release +of Jane Street packages. It reads metadata from "jbuild" files +following a very simple s-expression syntax. + +jbuilder is fast, it has very low-overhead and support parallel builds +on all platforms. It has no system dependencies, all you need to build +jbuilder and packages using jbuilder is OCaml. You don't need or make +or bash as long as the packages themselves don't use bash explicitely. + +jbuilder supports multi-package development by simply dropping multiple +repositories into the same directory. + +It also supports multi-context builds, such as building against +several opam roots/switches simultaneously. This helps maintaining +packages across several versions of OCaml and gives cross-compilation +for free.""" +depends: [ + "ocaml" {>= "4.02.3"} +] +url { + src: + "https://github.com/ocaml/dune/releases/download/1.0%2Bbeta20.2/jbuilder-1.0+beta20.2.tbz" + checksum: "md5=fbe8c3b1facb206cac3fb8932b5dd5d9" +} diff --git a/lib/esy.lock/opam/menhir.20200123/opam b/lib/esy.lock/opam/menhir.20200123/opam new file mode 100644 index 00000000..356699e4 --- /dev/null +++ b/lib/esy.lock/opam/menhir.20200123/opam @@ -0,0 +1,27 @@ +opam-version: "2.0" +maintainer: "francois.pottier@inria.fr" +authors: [ + "François Pottier " + "Yann Régis-Gianas " +] +homepage: "http://gitlab.inria.fr/fpottier/menhir" +dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" +bug-reports: "menhir@inria.fr" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.02.3"} + "dune" {>= "2.0.0"} + "menhirLib" {= version} + "menhirSdk" {= version} +] +synopsis: "An LR(1) parser generator" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/repository/20200123/archive.tar.gz" + checksum: [ + "md5=91aeae45fbf781e82ec3fe636be6ad49" + "sha512=4a7c4a72d4437940a0f62d402f783efcf357dde6f0a9e9f164c315148776e4642a822b6472f1e6e641164d110bc1ee05a6c1ad4a733f5defe4603b6072c1a34f" + ] +} diff --git a/lib/esy.lock/opam/menhirLib.20200123/opam b/lib/esy.lock/opam/menhirLib.20200123/opam new file mode 100644 index 00000000..8df35795 --- /dev/null +++ b/lib/esy.lock/opam/menhirLib.20200123/opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +maintainer: "francois.pottier@inria.fr" +authors: [ + "François Pottier " + "Yann Régis-Gianas " +] +homepage: "http://gitlab.inria.fr/fpottier/menhir" +dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" +bug-reports: "menhir@inria.fr" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.02.3"} + "dune" {>= "2.0.0"} +] +synopsis: "Runtime support library for parsers generated by Menhir" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/repository/20200123/archive.tar.gz" + checksum: [ + "md5=91aeae45fbf781e82ec3fe636be6ad49" + "sha512=4a7c4a72d4437940a0f62d402f783efcf357dde6f0a9e9f164c315148776e4642a822b6472f1e6e641164d110bc1ee05a6c1ad4a733f5defe4603b6072c1a34f" + ] +} diff --git a/lib/esy.lock/opam/menhirSdk.20200123/opam b/lib/esy.lock/opam/menhirSdk.20200123/opam new file mode 100644 index 00000000..1d46a24d --- /dev/null +++ b/lib/esy.lock/opam/menhirSdk.20200123/opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +maintainer: "francois.pottier@inria.fr" +authors: [ + "François Pottier " + "Yann Régis-Gianas " +] +homepage: "http://gitlab.inria.fr/fpottier/menhir" +dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" +bug-reports: "menhir@inria.fr" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.02.3"} + "dune" {>= "2.0.0"} +] +synopsis: "Compile-time library for auxiliary tools related to Menhir" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/repository/20200123/archive.tar.gz" + checksum: [ + "md5=91aeae45fbf781e82ec3fe636be6ad49" + "sha512=4a7c4a72d4437940a0f62d402f783efcf357dde6f0a9e9f164c315148776e4642a822b6472f1e6e641164d110bc1ee05a6c1ad4a733f5defe4603b6072c1a34f" + ] +} diff --git a/re-formality/esy.lock/opam/merlin-extend.0.5/opam b/lib/esy.lock/opam/merlin-extend.0.5/opam similarity index 100% rename from re-formality/esy.lock/opam/merlin-extend.0.5/opam rename to lib/esy.lock/opam/merlin-extend.0.5/opam diff --git a/re-formality/esy.lock/opam/merlin.3.3.3/opam b/lib/esy.lock/opam/merlin.3.3.3/opam similarity index 100% rename from re-formality/esy.lock/opam/merlin.3.3.3/opam rename to lib/esy.lock/opam/merlin.3.3.3/opam diff --git a/re-formality/esy.lock/opam/ocaml-compiler-libs.v0.12.1/opam b/lib/esy.lock/opam/ocaml-compiler-libs.v0.12.1/opam similarity index 100% rename from re-formality/esy.lock/opam/ocaml-compiler-libs.v0.12.1/opam rename to lib/esy.lock/opam/ocaml-compiler-libs.v0.12.1/opam diff --git a/re-formality/esy.lock/opam/ocaml-migrate-parsetree.1.5.0/opam b/lib/esy.lock/opam/ocaml-migrate-parsetree.1.5.0/opam similarity index 100% rename from re-formality/esy.lock/opam/ocaml-migrate-parsetree.1.5.0/opam rename to lib/esy.lock/opam/ocaml-migrate-parsetree.1.5.0/opam diff --git a/re-formality/esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub b/lib/esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub similarity index 100% rename from re-formality/esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub rename to lib/esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub diff --git a/re-formality/esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install b/lib/esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install similarity index 100% rename from re-formality/esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install rename to lib/esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install diff --git a/re-formality/esy.lock/opam/ocamlfind.1.8.1/opam b/lib/esy.lock/opam/ocamlfind.1.8.1/opam similarity index 100% rename from re-formality/esy.lock/opam/ocamlfind.1.8.1/opam rename to lib/esy.lock/opam/ocamlfind.1.8.1/opam diff --git a/re-formality/esy.lock/opam/ppx_derivers.1.2.1/opam b/lib/esy.lock/opam/ppx_derivers.1.2.1/opam similarity index 100% rename from re-formality/esy.lock/opam/ppx_derivers.1.2.1/opam rename to lib/esy.lock/opam/ppx_derivers.1.2.1/opam diff --git a/re-formality/esy.lock/opam/ppxlib.0.12.0/opam b/lib/esy.lock/opam/ppxlib.0.12.0/opam similarity index 100% rename from re-formality/esy.lock/opam/ppxlib.0.12.0/opam rename to lib/esy.lock/opam/ppxlib.0.12.0/opam diff --git a/re-formality/esy.lock/opam/re.1.9.0/opam b/lib/esy.lock/opam/re.1.9.0/opam similarity index 100% rename from re-formality/esy.lock/opam/re.1.9.0/opam rename to lib/esy.lock/opam/re.1.9.0/opam diff --git a/re-formality/esy.lock/opam/result.1.4/opam b/lib/esy.lock/opam/result.1.4/opam similarity index 100% rename from re-formality/esy.lock/opam/result.1.4/opam rename to lib/esy.lock/opam/result.1.4/opam diff --git a/re-formality/esy.lock/opam/seq.0.2.2/opam b/lib/esy.lock/opam/seq.0.2.2/opam similarity index 100% rename from re-formality/esy.lock/opam/seq.0.2.2/opam rename to lib/esy.lock/opam/seq.0.2.2/opam diff --git a/re-formality/esy.lock/opam/sexplib0.v0.13.0/opam b/lib/esy.lock/opam/sexplib0.v0.13.0/opam similarity index 100% rename from re-formality/esy.lock/opam/sexplib0.v0.13.0/opam rename to lib/esy.lock/opam/sexplib0.v0.13.0/opam diff --git a/re-formality/esy.lock/opam/stdio.v0.13.0/opam b/lib/esy.lock/opam/stdio.v0.13.0/opam similarity index 100% rename from re-formality/esy.lock/opam/stdio.v0.13.0/opam rename to lib/esy.lock/opam/stdio.v0.13.0/opam diff --git a/re-formality/esy.lock/opam/yojson.1.7.0/opam b/lib/esy.lock/opam/yojson.1.7.0/opam similarity index 100% rename from re-formality/esy.lock/opam/yojson.1.7.0/opam rename to lib/esy.lock/opam/yojson.1.7.0/opam diff --git a/re-formality/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch b/lib/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch similarity index 100% rename from re-formality/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch rename to lib/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch diff --git a/re-formality/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json b/lib/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json similarity index 100% rename from re-formality/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json rename to lib/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json diff --git a/re-formality/package.json b/lib/package.json similarity index 100% rename from re-formality/package.json rename to lib/package.json diff --git a/lib/ppx/Ast.re b/lib/ppx/Ast.re new file mode 100644 index 00000000..f629333b --- /dev/null +++ b/lib/ppx/Ast.re @@ -0,0 +1,17 @@ +open Ppxlib; +open Ast_helper; + +let lid = (~loc, x: Longident.t) => {txt: x, loc}; +let str = (~loc, x: string) => {txt: x, loc}; + +let explicit_arity = (~loc) => { + attr_name: "explicit_arity" |> str(~loc), + attr_payload: PStr([]), + attr_loc: Location.none, +}; + +module StructureItem = { + let from_type_declaration = + (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => + Str.type_(~loc, rec_flag, [decl]); +}; diff --git a/lib/ppx/AstHelpers.re b/lib/ppx/AstHelpers.re new file mode 100644 index 00000000..05d01081 --- /dev/null +++ b/lib/ppx/AstHelpers.re @@ -0,0 +1,103 @@ +open Ast; +open Meta; + +open Ppxlib; +open Ast_helper; + +module T = { + let constructor = (~loc, ~args: option(list(core_type))=?, x) => + Type.constructor( + ~args=? + switch (args) { + | Some(args) => Some(Pcstr_tuple(args)) + | None => None + }, + x |> str(~loc), + ); + + let record_of_fields = + ( + ~name, + ~loc, + ~typ: FieldSpec.t => core_type, + fields: list(FieldSpec.t), + ) => + name + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_record( + fields + |> List.map((field: FieldSpec.t) => + Type.field( + field.id |> Field.to_string |> str(~loc), + field |> typ, + ) + ), + ), + ) + |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); +}; + +module E = { + let some = (~loc, x) => + Exp.construct( + ~attrs=[explicit_arity(~loc)], + Lident("Some") |> lid(~loc), + Some(Exp.tuple([x])), + ); + + let ref_ = (~loc, x) => + Exp.apply( + Exp.ident(Lident("!") |> lid(~loc)), + [(Nolabel, Exp.ident(Lident(x) |> lid(~loc)))], + ); + + let rec seq = (~exp, ~make, list) => + switch (list) { + | [] => exp + | [x] => x |> make |> Exp.sequence(exp) + | [x, ...rest] => + rest |> seq(~exp=x |> make |> Exp.sequence(exp), ~make) + }; + + let field = (~of_ as record, ~loc, field: Field.t) => + Exp.field( + Exp.ident(Lident(record) |> lid(~loc)), + Lident(field |> Field.to_string) |> lid(~loc), + ); + + let field2 = (~of_ as (record1, record2), ~loc, field: Field.t) => + Exp.field( + Exp.field( + Exp.ident(Lident(record1) |> lid(~loc)), + Lident(record2) |> lid(~loc), + ), + Lident(field |> Field.to_string) |> lid(~loc), + ); + + let ref_field = (~of_ as record, ~loc, field: Field.t) => + Exp.field( + record |> ref_(~loc), + Lident(field |> Field.to_string) |> lid(~loc), + ); + + let update_field = (~of_ as record, ~with_ as value, ~loc, field: Field.t) => + Exp.record( + [(Lident(field |> Field.to_string) |> lid(~loc), value)], + Some(Exp.ident(Lident(record) |> lid(~loc))), + ); + + let update_ref_field = + (~of_ as record, ~with_ as value, ~loc, field: Field.t) => + Exp.record( + [(Lident(field |> Field.to_string) |> lid(~loc), value)], + Some(record |> ref_(~loc)), + ); + + let record = (~loc, xs: list((string, expression))) => + Exp.record( + xs |> List.map(((name, expr)) => (Lident(name) |> lid(~loc), expr)), + None, + ); +}; diff --git a/lib/ppx/Form.re b/lib/ppx/Form.re new file mode 100644 index 00000000..e429ec66 --- /dev/null +++ b/lib/ppx/Form.re @@ -0,0 +1,1100 @@ +open Meta; +open Ast; +open AstHelpers; + +open Ppxlib; +open Ast_helper; + +let open_formality = (~loc) => [%stri open Formality]; + +let input_type = (input_type: InputType.t) => { + input_type |> InputType.structure_item; +}; + +let output_type = (output_type: OutputType.t) => { + output_type |> OutputType.structure_item; +}; + +let message_type = (message_type: MessageType.t) => + message_type |> MessageType.structure_item; + +let submission_error_type = (submission_error_type: SubmissionErrorType.t) => + submission_error_type |> SubmissionErrorType.structure_item; + +let validators_type = (~loc, fields: list(FieldSpec.t)) => { + fields + |> T.record_of_fields( + ~name="validators", + ~loc, + ~typ=field => { + let typ = + Typ.constr( + Lident("singleValueValidator") |> lid(~loc), + [ + Typ.constr(Lident("input") |> lid(~loc), []), + field.output_type |> FieldType.unpack, + Typ.constr(Lident("message") |> lid(~loc), []), + ], + ); + switch (field.validator) { + | `Required => typ + | `Optional => Typ.constr(Lident("option") |> lid(~loc), [typ]) + }; + }, + ); +}; + +let fields_statuses_type = (~loc, fields: list(FieldSpec.t)) => { + fields + |> T.record_of_fields(~name="fieldsStatuses", ~loc, ~typ=field => + Typ.constr( + Lident("fieldStatus") |> lid(~loc), + [ + field.output_type |> FieldType.unpack, + Typ.constr(Lident("message") |> lid(~loc), []), + ], + ) + ); +}; + +let state_type = (~loc) => [%stri + type state = { + input, + fieldsStatuses, + formStatus: formStatus(submissionError), + submissionStatus, + } +]; + +let action_type = (~loc, fields: list(FieldSpec.t)) => { + let update_actions = + fields + |> List.map((field: FieldSpec.t) => + field.id + |> Field.update_action + |> T.constructor(~args=[[%type: input]], ~loc) + ); + let blur_actions = + fields + |> List.map((field: FieldSpec.t) => + field.id |> Field.blur_action |> T.constructor(~loc) + ); + let rest_actions = [ + "Submit" |> T.constructor(~loc), + "SetSubmittedStatus" + |> T.constructor(~args=[[%type: option(input)]], ~loc), + "SetSubmissionFailedStatus" + |> T.constructor(~args=[[%type: submissionError]], ~loc), + "MapSubmissionError" + |> T.constructor( + ~args=[[%type: submissionError => submissionError]], + ~loc, + ), + "DismissSubmissionError" |> T.constructor(~loc), + "DismissSubmissionResult" |> T.constructor(~loc), + "Reset" |> T.constructor(~loc), + ]; + + "action" + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_variant( + rest_actions + |> List.append(blur_actions) + |> List.append(update_actions), + ), + ) + |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); +}; + +let interface_type = (~loc, fields: list(FieldSpec.t)) => { + let f = (x, t) => t |> Type.field(x |> str(~loc)); + + let base = [ + f("input", [%type: input]), + f("status", [%type: formStatus(submissionError)]), + f("dirty", [%type: unit => bool]), + f("valid", [%type: unit => bool]), + f("submitting", [%type: bool]), + f("submit", [%type: unit => unit]), + f("dismissSubmissionError", [%type: unit => unit]), + f("dismissSubmissionResult", [%type: unit => unit]), + f( + "mapSubmissionError", + [%type: (submissionError => submissionError) => unit], + ), + f("reset", [%type: unit => unit]), + ]; + + let update_fns = + fields + |> List.map((field: FieldSpec.t) => { + f(field.id |> Field.update_fn, [%type: input => unit]) + }); + + let blur_fns = + fields + |> List.map((field: FieldSpec.t) => { + f(field.id |> Field.blur_fn, [%type: unit => unit]) + }); + + let result_fns = + fields + |> List.map((field: FieldSpec.t) => { + f( + field.id |> Field.result_fn, + [%type: + unit => + option( + result([%t field.output_type |> FieldType.unpack], message), + ) + ], + ) + }); + + "interface" + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_record( + base + |> List.append(result_fns) + |> List.append(blur_fns) + |> List.append(update_fns), + ), + ) + |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); +}; + +let initial_fields_statuses_fn = (~loc, fields: list(FieldSpec.t)) => { + [%stri + let initialFieldsStatuses = (_input: input) => [%e + Exp.record( + fields + |> List.map((field: FieldSpec.t) => + ( + Lident(field.id |> Field.to_string) |> lid(~loc), + [%expr Pristine], + ) + ), + None, + ) + ] + ]; +}; + +let initial_state_fn = (~loc) => [%stri + let initialState = input => { + input, + fieldsStatuses: input->initialFieldsStatuses, + formStatus: Editing, + submissionStatus: NeverSubmitted, + } +]; + +let validate_form_fn = (~loc, fields: list(FieldSpec.t)) => { + let field_result = x => (x |> Field.to_string) ++ "Result"; + let field_result_visibility = x => + (x |> Field.to_string) ++ "ResultVisibility"; + + [%stri + let validateForm = + (input: input, ~validators: validators) + : formValidationResult(output, fieldsStatuses) => [%e + Exp.match( + Exp.tuple( + fields + |> List.map((field: FieldSpec.t) => + switch (field.validator) { + | `Required => + %expr + { + let validator = [%e + field.id |> E.field(~of_="validators", ~loc) + ]; + (validator.validate(input), Shown); + } + | `Optional => + switch%expr ( + [%e field.id |> E.field(~of_="validators", ~loc)] + ) { + | Some(validator) => (validator.validate(input), Shown) + | None => ( + Ok([%e field.id |> E.field(~of_="input", ~loc)]), + Hidden, + ) + } + } + ), + ), + [ + // ((Ok(value), visibility), ...) => Ok(...) + Exp.case( + Pat.tuple( + fields + |> List.map((field: FieldSpec.t) => + Pat.tuple([ + Pat.alias( + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident("Ok") |> lid(~loc), + Some( + Pat.tuple([ + Pat.var( + field.id |> Field.to_string |> str(~loc), + ), + ]), + ), + ), + field.id |> field_result |> str(~loc), + ), + Pat.var( + field.id |> field_result_visibility |> str(~loc), + ), + ]) + ), + ), + [%expr + Ok({ + output: [%e + Exp.record( + fields + |> List.map((field: FieldSpec.t) => + ( + Lident(field.id |> Field.to_string) |> lid(~loc), + Exp.ident( + Lident(field.id |> Field.to_string) |> lid(~loc), + ), + ) + ), + None, + ) + ], + fieldsStatuses: [%e + Exp.record( + fields + |> List.map((field: FieldSpec.t) => + ( + Lident(field.id |> Field.to_string) |> lid(~loc), + [%expr + Dirty( + [%e + Exp.ident( + Lident(field.id |> field_result) + |> lid(~loc), + ) + ], + [%e + Exp.ident( + Lident(field.id |> field_result_visibility) + |> lid(~loc), + ) + ], + ) + ], + ) + ), + None, + ) + ], + }) + ], + ), + // ((_, visibility), ...) => Error(...) + Exp.case( + Pat.tuple( + fields + |> List.map((field: FieldSpec.t) => + Pat.tuple([ + Pat.var(field.id |> field_result |> str(~loc)), + Pat.var( + field.id |> field_result_visibility |> str(~loc), + ), + ]) + ), + ), + [%expr + Error({ + fieldsStatuses: [%e + Exp.record( + fields + |> List.map((field: FieldSpec.t) => + ( + Lident(field.id |> Field.to_string) |> lid(~loc), + [%expr + Dirty( + [%e + Exp.ident( + Lident(field.id |> field_result) + |> lid(~loc), + ) + ], + [%e + Exp.ident( + Lident(field.id |> field_result_visibility) + |> lid(~loc), + ) + ], + ) + ], + ) + ), + None, + ) + ], + }) + ], + ), + ], + ) + ] + ]; +}; + +let use_form_fn = (~loc, fields: list(FieldSpec.t)) => [%stri + let useForm = + ( + ~initialInput: input, + ~validators: validators, + ~onSubmit: + (output, submissionCallbacks(input, submissionError)) => unit, + ) => { + // Reducer + let memoizedInitialState = + React.useMemo1(() => initialInput->initialState, [|initialInput|]); + + let (state, dispatch) = + memoizedInitialState->ReactUpdate.useReducer((state, action) => { + %e + { + let update_actions = + fields + |> List.map((field: FieldSpec.t) => + Exp.case( + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident(field.id |> Field.update_action) |> lid(~loc), + Some(Pat.tuple([Pat.var("input" |> str(~loc))])), + ), + switch (field.deps) { + | [] => + %expr + { + let {fieldsStatuses, submissionStatus} = state; + Update({ + ...state, + input, + fieldsStatuses: + switch%e (field.validator) { + | `Required => + %expr + { + validateFieldOnChangeWithValidator( + ~input, + ~fieldStatus=[%e + field.id + |> E.field(~of_="fieldsStatuses", ~loc) + ], + ~submissionStatus, + ~validator=[%e + field.id + |> E.field(~of_="validators", ~loc) + ], + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ); + } + | `Optional => + switch%expr ( + [%e + field.id |> E.field(~of_="validators", ~loc) + ] + ) { + | Some(validator) => + validateFieldOnChangeWithValidator( + ~input, + ~fieldStatus=[%e + field.id + |> E.field(~of_="fieldsStatuses", ~loc) + ], + ~submissionStatus, + ~validator, + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + | None => + validateFieldOnChangeWithoutValidator( + ~fieldInput=[%e + field.id |> E.field(~of_="input", ~loc) + ], + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + } + }, + }); + } + | [dep, ...deps] => + %expr + { + let fieldsStatuses = ref(state.fieldsStatuses); + let {submissionStatus} = state; + + %e + { + let validate_dep = dep => { + let field = + fields + |> List.find((field: FieldSpec.t) => + field.id |> Field.eq(dep) + ); + switch (field.validator) { + | `Required => + switch%expr ( + validateFieldDependencyOnChange( + ~input, + ~fieldStatus=[%e + field.id + |> E.ref_field(~of_="fieldsStatuses", ~loc) + ], + ~validator=[%e + field.id + |> E.field(~of_="validators", ~loc) + ], + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_ref_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + ) { + | Some(result) => fieldsStatuses := result + | None => () + } + | `Optional => + switch%expr ( + [%e + field.id |> E.field(~of_="validators", ~loc) + ] + ) { + | None => () + | Some(validator) => + switch ( + validateFieldDependencyOnChange( + ~input, + ~fieldStatus=[%e + field.id + |> E.ref_field( + ~of_="fieldsStatuses", + ~loc, + ) + ], + ~validator, + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_ref_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + ) { + | Some(result) => fieldsStatuses := result + | None => () + } + } + }; + }; + deps + |> E.seq( + ~exp=dep |> validate_dep, + ~make=validate_dep, + ); + }; + + Update({ + ...state, + input, + fieldsStatuses: + switch%e (field.validator) { + | `Required => + %expr + { + validateFieldOnChangeWithValidator( + ~input, + ~fieldStatus=[%e + field.id + |> E.ref_field(~of_="fieldsStatuses", ~loc) + ], + ~submissionStatus, + ~validator=[%e + field.id + |> E.field(~of_="validators", ~loc) + ], + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_ref_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ); + } + | `Optional => + switch%expr ( + [%e + field.id |> E.field(~of_="validators", ~loc) + ] + ) { + | Some(validator) => + validateFieldOnChangeWithValidator( + ~input, + ~fieldStatus=[%e + field.id + |> E.ref_field(~of_="fieldsStatuses", ~loc) + ], + ~submissionStatus, + ~validator, + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_ref_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + | None => + validateFieldOnChangeWithoutValidator( + ~fieldInput=[%e + field.id |> E.field(~of_="input", ~loc) + ], + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_ref_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + } + }, + }); + } + }, + ) + ); + + let blur_actions = + fields + |> List.map((field: FieldSpec.t) => + Exp.case( + Pat.construct( + Lident(field.id |> Field.blur_action) |> lid(~loc), + None, + ), + { + %expr + { + let {input, fieldsStatuses} = state; + let result = + switch%e (field.validator) { + | `Required => + %expr + validateFieldOnBlurWithValidator( + ~input, + ~fieldStatus=[%e + field.id + |> E.field(~of_="fieldsStatuses", ~loc) + ], + ~validator=[%e + field.id |> E.field(~of_="validators", ~loc) + ], + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + | `Optional => + switch%expr ( + [%e field.id |> E.field(~of_="validators", ~loc)] + ) { + | Some(validator) => + validateFieldOnBlurWithValidator( + ~input, + ~fieldStatus=[%e + field.id + |> E.field(~of_="fieldsStatuses", ~loc) + ], + ~validator, + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + | None => + validateFieldOnBlurWithoutValidator( + ~fieldInput=[%e + field.id |> E.field(~of_="input", ~loc) + ], + ~fieldStatus=[%e + field.id + |> E.field(~of_="fieldsStatuses", ~loc) + ], + ~setStatus=[%e + [%expr + status => [%e + field.id + |> E.update_field( + ~of_="fieldsStatuses", + ~with_=[%expr status], + ~loc, + ) + ] + ] + ], + ) + } + }; + switch (result) { + | Some(fieldsStatuses) => + Update({...state, fieldsStatuses}) + | None => NoUpdate + }; + }; + }, + ) + ); + let rest_actions = [ + Exp.case( + [%pat? Submit], + switch%expr (state.formStatus) { + | Submitting(_) => NoUpdate + | Editing + | Submitted + | SubmissionFailed(_) => + switch (state.input->validateForm(~validators)) { + | Ok({output, fieldsStatuses}) => + UpdateWithSideEffects( + { + ...state, + fieldsStatuses, + formStatus: + Submitting( + switch (state.formStatus) { + | SubmissionFailed(error) => Some(error) + | Editing + | Submitted + | Submitting(_) => None + }, + ), + submissionStatus: AttemptedToSubmit, + }, + ({dispatch}) => + output->onSubmit({ + notifyOnSuccess: input => + SetSubmittedStatus(input)->dispatch, + notifyOnFailure: error => + SetSubmissionFailedStatus(error)->dispatch, + reset: () => Reset->dispatch, + dismissSubmissionResult: () => + DismissSubmissionResult->dispatch, + }), + ) + | Error({fieldsStatuses}) => + Update({ + ...state, + fieldsStatuses, + formStatus: Editing, + submissionStatus: AttemptedToSubmit, + }) + } + }, + ), + Exp.case( + [%pat? SetSubmittedStatus(input)], + switch%expr (input) { + | Some(input) => + Update({ + ...state, + input, + formStatus: Submitted, + fieldsStatuses: input->initialFieldsStatuses, + }) + | None => + Update({ + ...state, + formStatus: Submitted, + fieldsStatuses: state.input->initialFieldsStatuses, + }) + }, + ), + Exp.case( + [%pat? SetSubmissionFailedStatus(error)], + [%expr + Update({...state, formStatus: SubmissionFailed(error)}) + ], + ), + Exp.case( + [%pat? MapSubmissionError(map)], + switch%expr (state.formStatus) { + | Submitting(Some(error)) => + Update({...state, formStatus: Submitting(Some(error->map))}) + | SubmissionFailed(error) => + Update({...state, formStatus: SubmissionFailed(error->map)}) + | Editing + | Submitting(None) + | Submitted => NoUpdate + }, + ), + Exp.case( + [%pat? DismissSubmissionError], + switch%expr (state.formStatus) { + | Editing + | Submitting(_) + | Submitted => NoUpdate + | SubmissionFailed(_) => Update({...state, formStatus: Editing}) + }, + ), + Exp.case( + [%pat? DismissSubmissionResult], + switch%expr (state.formStatus) { + | Editing + | Submitting(_) => NoUpdate + | Submitted + | SubmissionFailed(_) => Update({...state, formStatus: Editing}) + }, + ), + Exp.case( + [%pat? Reset], + [%expr Update(initialInput->initialState)], + ), + ]; + Exp.match( + [%expr action], + rest_actions + |> List.append(blur_actions) + |> List.append(update_actions), + ); + } + }); + + // Interface + %e + { + let base = [ + ("input", [%expr state.input]), + ("status", [%expr state.formStatus]), + ( + "dirty", + [%expr + () => [%e + Exp.match( + [%expr state.fieldsStatuses], + [ + Exp.case( + Pat.record( + fields + |> List.map((field: FieldSpec.t) => + ( + Lident(field.id |> Field.to_string) |> lid(~loc), + [%pat? Pristine], + ) + ), + Closed, + ), + [%expr false], + ), + Exp.case([%pat? _], [%expr true]), + ], + ) + ] + ], + ), + ( + "valid", + [%expr + () => + switch (state.input->validateForm(~validators)) { + | Ok(_) => true + | Error(_) => false + } + ], + ), + ( + "submitting", + switch%expr (state.formStatus) { + | Submitting(_) => true + | Editing + | Submitted + | SubmissionFailed(_) => false + }, + ), + ("submit", [%expr () => Submit->dispatch]), + ( + "mapSubmissionError", + [%expr map => MapSubmissionError(map)->dispatch], + ), + ( + "dismissSubmissionError", + [%expr () => DismissSubmissionError->dispatch], + ), + ( + "dismissSubmissionResult", + [%expr () => DismissSubmissionResult->dispatch], + ), + ("reset", [%expr () => Reset->dispatch]), + ]; + let update_fns = + fields + |> List.map((field: FieldSpec.t) => { + ( + field.id |> Field.update_fn, + [%expr + input => + [%e + Exp.construct( + Lident(field.id |> Field.update_action) |> lid(~loc), + Some([%expr input]), + ) + ] + ->dispatch + ], + ) + }); + let blur_fns = + fields + |> List.map((field: FieldSpec.t) => { + ( + field.id |> Field.blur_fn, + [%expr + () => + [%e + Exp.construct( + Lident(field.id |> Field.blur_action) |> lid(~loc), + None, + ) + ] + ->dispatch + ], + ) + }); + let result_fns = + fields + |> List.map((field: FieldSpec.t) => { + ( + field.id |> Field.result_fn, + [%expr + () => { + exposeFieldResult( + [%e + field.id + |> E.field2(~of_=("state", "fieldsStatuses"), ~loc) + ], + ); + } + ], + ) + }); + + E.record( + ~loc, + result_fns + |> List.append(blur_fns) + |> List.append(update_fns) + |> List.append(base), + ); + }; + } +]; + +let ext = + Extension.declare( + "form", + Extension.Context.module_expr, + Ast_pattern.__, + (~loc, ~path as _, expr) => { + switch (expr) { + | PStr(structure) => + switch (structure |> Data.make) { + | Ok(data) => + Mod.mk( + Pmod_structure([ + open_formality(~loc), + input_type(data.input_type), + output_type(data.output_type), + message_type(data.message_type), + submission_error_type(data.submission_error_type), + validators_type(~loc, data.fields), + fields_statuses_type(~loc, data.fields), + state_type(~loc), + action_type(~loc, data.fields), + interface_type(~loc, data.fields), + initial_fields_statuses_fn(~loc, data.fields), + initial_state_fn(~loc), + validate_form_fn(~loc, data.fields), + use_form_fn(~loc, data.fields), + ]), + ) + | Error(InputTypeParseError(NotFound)) => + Location.raise_errorf(~loc, "`input` type not found") + | Error(InputTypeParseError(NotRecord(loc))) => + Location.raise_errorf(~loc, "`input` must be of record type") + | Error(InputTypeParseError(InvalidFieldDeps(DepsParseError(loc)))) => + Location.raise_errorf( + ~loc, + "[@field.deps] attribute must contain field or tuple of fields", + ) + | Error( + InputTypeParseError( + InvalidFieldDeps(DepNotFound(`Field(dep, loc))), + ), + ) => + Location.raise_errorf(~loc, "Field %s doesn't exist in input", dep) + | Error( + InputTypeParseError( + InvalidFieldDeps(DepOfItself(`Field(dep, loc))), + ), + ) => + Location.raise_errorf(~loc, "Field can't depend on itself") + | Error( + InputTypeParseError( + InvalidFieldDeps(DepDuplicate(`Field(dep, loc))), + ), + ) => + Location.raise_errorf( + ~loc, + "Field %s is already declared as a dependency for this field", + dep, + ) + | Error(OutputTypeParseError(NotFound)) => + Location.raise_errorf(~loc, "`output` type not found") + | Error(OutputTypeParseError(NotRecord(loc))) => + Location.raise_errorf( + ~loc, + "`output` must be of record type or an alias of `input`", + ) + | Error(OutputTypeParseError(BadTypeAlias({alias, loc}))) => + Location.raise_errorf( + ~loc, + "`output` can only be an alias of `input` type or a record", + ) + | Error(IOMismatch(OutputFieldsNotInInput({fields}))) => + switch (fields) { + | [] => + failwith( + "Empty list of non-matched fields in IOMatchError(OutputFieldsNotInInput)", + ) + | [(field, loc)] + | [(field, loc), ..._] => + Location.raise_errorf( + ~loc, + "`output` field `%s` doesn't exist in `input` type", + field |> Field.to_string, + ) + } + | Error(IOMismatch(InputFieldsNotInOutput({fields, loc}))) + | Error( + IOMismatch( + Both({ + input_fields_not_in_output: fields, + output_fields_not_in_input: _, + loc, + }), + ), + ) => + switch (fields) { + | [] => + failwith( + "Empty list of non-matched fields in IOMatchError(Both)", + ) + | [field] => + Location.raise_errorf( + ~loc, + "`input` field `%s` doesn't exist in `output` type", + field |> Field.to_string, + ) + | fields => + Location.raise_errorf( + ~loc, + "Some `input` fields don't exist in `output` type: %s", + fields |> List.map(Field.to_string) |> String.concat(", "), + ) + } + } + | _ => Location.raise_errorf(~loc, "Must be a structure") + } + }); diff --git a/lib/ppx/Meta.re b/lib/ppx/Meta.re new file mode 100644 index 00000000..5fdd028f --- /dev/null +++ b/lib/ppx/Meta.re @@ -0,0 +1,593 @@ +open Ast; + +open Ppxlib; + +module Field = { + module T: {type t;} = { + type t = string; + }; + + type t = T.t; + external to_string: t => string = "%identity"; + external from_string: string => t = "%identity"; + + let make = (label: label_declaration) => label.pld_name.txt |> from_string; + + let to_capitalized_string = (field: t) => + field |> to_string |> String.capitalize_ascii; + + let eq = (x1, x2) => to_string(x1) == to_string(x2); + let cmp = (x1, x2) => compare(x1 |> to_string, x2 |> to_string); + + let update_action = x => "Update" ++ (x |> to_capitalized_string) ++ "Field"; + let blur_action = x => "Blur" ++ (x |> to_capitalized_string) ++ "Field"; + + let update_fn = x => "update" ++ (x |> to_capitalized_string); + let blur_fn = x => "blur" ++ (x |> to_capitalized_string); + let result_fn = x => (x |> to_string) ++ "Result"; +}; + +module FieldType = { + module T: {type t;} = { + type t = core_type; + }; + + type t = T.t; + + external make: core_type => t = "%identity"; + let make = (core_type: core_type) => core_type |> make; + + external unpack: t => core_type = "%identity"; + + let rec eq = (t1: core_type, t2: core_type) => + switch (t1.ptyp_desc, t2.ptyp_desc) { + | (Ptyp_constr({txt: lid1}, list1), Ptyp_constr({txt: lid2}, list2)) => + eq_lid(lid1, lid2) && eq_list(list1, list2) + | (Ptyp_var(x1), Ptyp_var(x2)) => x1 == x2 + | (Ptyp_tuple(l1), Ptyp_tuple(l2)) => eq_list(l1, l2) + | _ => false + } + and eq_lid = (l1: Longident.t, l2: Longident.t) => + switch (l1, l2) { + | (Lident(x1), Lident(x2)) => x1 == x2 + | (Ldot(l1, x1), Ldot(l2, x2)) => x1 == x2 && eq_lid(l1, l2) + | (Lapply(l1, l1'), Lapply(l2, l2')) => + eq_lid(l1, l2) && eq_lid(l1', l2') + | _ => false + } + and eq_list = (l1: list(core_type), l2: list(core_type)) => + if (List.length(l1) == List.length(l2)) { + List.for_all2((t1, t2) => eq(t1, t2), l1, l2); + } else { + false; + }; + let eq = (x1: t, x2: t) => eq(x1 |> unpack, x2 |> unpack); +}; + +module FieldDeps = { + type unvalidated_dep = [ | `Field(string, Location.t)]; + + type error = + | DepsParseError(Location.t) + | DepNotFound(unvalidated_dep) + | DepOfItself(unvalidated_dep) + | DepDuplicate(unvalidated_dep); + + let from_attributes = (attributes: list(attribute)) => { + let deps_attr = + attributes + |> List.find_opt(attr => + switch (attr) { + | {attr_name: {txt: "field.deps"}} => true + | _ => false + } + ); + switch (deps_attr) { + | None => Ok([]) + | Some({ + attr_payload: PStr([{pstr_desc: Pstr_eval(exp, _)}]), + attr_loc, + }) => + switch (exp) { + | {pexp_desc: Pexp_ident({txt: Lident(dep), loc})} => + Ok([`Field((dep, loc))]) + | {pexp_desc: Pexp_tuple(exps)} => + exps + |> List.fold_left( + (res, exp) => + switch (res, exp) { + | (Error(loc), _) => Error(loc) + | ( + Ok(deps), + {pexp_desc: Pexp_ident({txt: Lident(dep), loc})}, + ) => + Ok([`Field((dep, loc)), ...deps]) + | (Ok(_), {pexp_loc}) => Error(DepsParseError(pexp_loc)) + }, + Ok([]), + ) + | {pexp_loc} => Error(DepsParseError(pexp_loc)) + } + | Some({attr_loc}) => Error(DepsParseError(attr_loc)) + }; + }; +}; + +module FieldSpec = { + type t = { + id: Field.t, + input_type: FieldType.t, + output_type: FieldType.t, + validator: [ | `Required | `Optional], + deps: list(Field.t), + }; +}; + +module InputType = { + module T: {type t;} = { + type t = structure_item; + }; + + type t = T.t; + external pack: structure_item => t = "%identity"; + external structure_item: t => structure_item = "%identity"; + + let make = (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => + decl |> StructureItem.from_type_declaration(~loc, ~rec_flag) |> pack; +}; + +module OutputType = { + module T: {type t;} = { + type t = structure_item; + }; + + type t = T.t; + external pack: structure_item => t = "%identity"; + external structure_item: t => structure_item = "%identity"; + + let make = (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => + decl |> StructureItem.from_type_declaration(~loc, ~rec_flag) |> pack; +}; + +module MessageType = { + module T: {type t;} = { + type t = structure_item; + }; + + type t = T.t; + external pack: structure_item => t = "%identity"; + external structure_item: t => structure_item = "%identity"; + + let make = (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => + decl |> StructureItem.from_type_declaration(~loc, ~rec_flag) |> pack; + + let default = (~loc) => [%stri type message = string] |> pack; +}; + +module SubmissionErrorType = { + module T: {type t;} = { + type t = structure_item; + }; + + type t = T.t; + external pack: structure_item => t = "%identity"; + external structure_item: t => structure_item = "%identity"; + + let make = (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => + decl |> StructureItem.from_type_declaration(~loc, ~rec_flag) |> pack; + + let default = (~loc) => [%stri type submissionError = unit] |> pack; +}; + +module InputTypeParser = { + type result = Pervasives.result(ok, error) + and ok = { + fields: list((Field.t, FieldType.t, list(FieldDeps.unvalidated_dep))), + structure_item: InputType.t, + } + and error = + | NotFound + | NotRecord(Location.t) + | InvalidFieldDeps(FieldDeps.error); +}; + +module OutputTypeParser = { + type result = Pervasives.result(ok, error) + and ok = + | AliasOfInput(OutputType.t) + | Record({ + fields: list((Field.t, FieldType.t, Location.t)), + structure_item: OutputType.t, + loc: Location.t, + }) + and error = + | NotFound + | NotRecord(Location.t) + | BadTypeAlias({ + alias: string, + loc: Location.t, + }); +}; + +module Data = { + type t = { + fields: list(FieldSpec.t), + input_type: InputType.t, + output_type: OutputType.t, + message_type: MessageType.t, + submission_error_type: SubmissionErrorType.t, + }; + + type error = + | InputTypeParseError(InputTypeParser.error) + | OutputTypeParseError(OutputTypeParser.error) + | IOMismatch(io_mismatch) + and io_mismatch = + | InputFieldsNotInOutput({ + fields: list(Field.t), + loc: Location.t, + }) + | OutputFieldsNotInInput({fields: list((Field.t, Location.t))}) + | Both({ + input_fields_not_in_output: list(Field.t), + output_fields_not_in_input: list((Field.t, Location.t)), + loc: Location.t, + }); + + let make = (structure: structure) => { + let input_parsing_result: ref(option(InputTypeParser.result)) = + ref(None); + let output_parsing_result: ref(option(OutputTypeParser.result)) = + ref(None); + let message_type: ref(option(MessageType.t)) = ref(None); + let submission_error_type: ref(option(SubmissionErrorType.t)) = + ref(None); + + structure + |> List.iter( + fun + | {pstr_desc: Pstr_type(rec_flag, decls)} => { + decls + |> List.iter( + fun + // Input type + | { + ptype_name: {txt: "input"}, + ptype_kind: Ptype_record(fields), + ptype_loc, + } as decl => + input_parsing_result := + Some( + { + let fields = + List.fold_right( + (field, res) => + switch ( + res, + field.pld_type.ptyp_attributes + |> FieldDeps.from_attributes, + ) { + | (Ok(fields), Ok(deps)) => + Ok([ + ( + field |> Field.make, + field.pld_type |> FieldType.make, + deps, + ), + ...fields, + ]) + | (Error(error), _) + | (_, Error(error)) => Error(error) + }, + fields, + Ok([]), + ); + switch (fields) { + | Error(error) => Error(InvalidFieldDeps(error)) + | Ok(fields) => + Ok({ + fields, + structure_item: + decl + |> InputType.make(~loc=ptype_loc, ~rec_flag), + }) + }; + }, + ) + | {ptype_name: {txt: "input"}, ptype_loc} => + input_parsing_result := + Some(Error(InputTypeParser.NotRecord(ptype_loc))) + + // Output type + | { + ptype_name: {txt: "output"}, + ptype_kind: Ptype_record(fields), + ptype_loc, + } as decl => + output_parsing_result := + Some( + Ok( + Record({ + fields: + List.fold_right( + (field, acc) => + [ + ( + field |> Field.make, + field.pld_type |> FieldType.make, + field.pld_loc, + ), + ...acc, + ], + fields, + [], + ), + loc: ptype_loc, + structure_item: + decl + |> OutputType.make(~loc=ptype_loc, ~rec_flag), + }), + ), + ) + | { + ptype_name: {txt: "output"}, + ptype_kind: Ptype_abstract, + ptype_loc, + ptype_manifest: + Some({ + ptyp_desc: + Ptyp_constr({txt: Lident("input")}, []), + }), + } as decl => + output_parsing_result := + Some( + Ok( + AliasOfInput( + decl |> OutputType.make(~loc=ptype_loc, ~rec_flag), + ), + ), + ) + | { + ptype_name: {txt: "output"}, + ptype_kind: Ptype_abstract, + ptype_manifest: + Some({ + ptyp_desc: + Ptyp_constr({txt: Lident(alias), loc}, []), + }), + } => + output_parsing_result := + Some( + Error(OutputTypeParser.BadTypeAlias({alias, loc})), + ) + | {ptype_name: {txt: "output"}, ptype_loc} => + output_parsing_result := + Some(Error(OutputTypeParser.NotRecord(ptype_loc))) + + // Message type + | { + ptype_name: {txt: "message"}, + ptype_loc, + ptype_manifest: Some(_), + } as decl => + message_type := + Some( + decl |> MessageType.make(~rec_flag, ~loc=ptype_loc), + ) + + // Submission error type + | { + ptype_name: {txt: "submissionError"}, + ptype_loc, + ptype_manifest: Some(_), + } as decl => + submission_error_type := + Some( + decl + |> SubmissionErrorType.make(~rec_flag, ~loc=ptype_loc), + ) + + // Rest + | _ => (), + ); + } + | _ => (), + ); + + switch (input_parsing_result^, output_parsing_result^) { + | (Some(Error(error)), _) => Error(InputTypeParseError(error)) + | (None, _) => Error(InputTypeParseError(NotFound)) + | (_, Some(Error(error))) => Error(OutputTypeParseError(error)) + | (_, None) => Error(OutputTypeParseError(NotFound)) + | (Some(Ok(input_data)), Some(Ok(output_result))) => + let deps_validity = + input_data.fields + |> List.fold_left( + (res, (field, _, deps)) => + switch (res) { + | Error(error) => Error(error) + | Ok(_) => + deps + |> List.fold_left( + (res, dep) => + switch (res, dep) { + | (Error(error), _) => Error(error) + | (Ok (), `Field(dep_name, loc)) => + switch ( + deps + |> List.find_all(dep' => + switch (dep') { + | `Field(dep', _) => dep' == dep_name + } + ) + |> List.length + ) { + | 0 + | 1 => + switch ( + input_data.fields + |> List.find_opt(((field, _, _)) => + field |> Field.to_string == dep_name + ) + ) { + | None => Error(FieldDeps.DepNotFound(dep)) + | Some(_) + when dep_name == (field |> Field.to_string) => + Error(FieldDeps.DepOfItself(dep)) + | Some(_) => Ok() + } + | _ => Error(FieldDeps.DepDuplicate(dep)) + } + }, + Ok(), + ) + }, + Ok(), + ); + switch (deps_validity) { + | Error(error) => Error(InputTypeParseError(InvalidFieldDeps(error))) + | Ok () => + let fields = + switch (output_result) { + | AliasOfInput(_) => + Ok( + input_data.fields + |> List.map(((field, input_type, deps)) => + FieldSpec.{ + id: field, + input_type, + output_type: input_type, + validator: `Optional, + deps: + deps + |> List.map( + fun + | `Field(dep, _) => dep |> Field.from_string, + ), + } + ), + ) + | Record({fields: output_fields, loc: output_loc}) => + let ( + matched_fields, + input_fields_not_in_output, + output_fields_not_in_input, + ) = + List.fold_right( + ( + (input_field, input_field_type, input_field_deps), + ( + matched_fields, + input_fields_not_in_output, + output_fields_not_in_input, + ), + ) => { + let output_field = + output_fields + |> List.find_opt(((output_field, _, _)) => + input_field |> Field.eq(output_field) + ); + switch (output_field) { + | None => ( + matched_fields, + [input_field, ...input_fields_not_in_output], + output_fields_not_in_input, + ) + | Some((output_field, output_field_type, _)) => ( + [ + FieldSpec.{ + id: input_field, + input_type: input_field_type, + output_type: output_field_type, + validator: + if (FieldType.eq( + input_field_type, + output_field_type, + )) { + `Optional; + } else { + `Required; + }, + deps: + input_field_deps + |> List.map( + fun + | `Field(dep, _) => dep |> Field.from_string, + ), + }, + ...matched_fields, + ], + input_fields_not_in_output, + output_fields_not_in_input + |> List.filter(((output_field, _, _)) => + !(input_field |> Field.eq(output_field)) + ), + ) + }; + }, + input_data.fields, + ([], [], output_fields), + ); + switch (input_fields_not_in_output, output_fields_not_in_input) { + | ([], []) => Ok(matched_fields) + | (input_fields_not_in_output, []) => + Error( + IOMismatch( + InputFieldsNotInOutput({ + fields: input_fields_not_in_output, + loc: output_loc, + }), + ), + ) + | ([], output_fields_not_in_input) => + Error( + IOMismatch( + OutputFieldsNotInInput({ + fields: + output_fields_not_in_input + |> List.map(((field, _, loc)) => (field, loc)), + }), + ), + ) + | (input_fields_not_in_output, output_fields_not_in_input) => + Error( + IOMismatch( + Both({ + input_fields_not_in_output, + output_fields_not_in_input: + output_fields_not_in_input + |> List.map(((field, _, loc)) => (field, loc)), + loc: output_loc, + }), + ), + ) + }; + }; + + switch (fields) { + | Ok(fields) => + Ok({ + fields, + input_type: input_data.structure_item, + output_type: + switch (output_result) { + | AliasOfInput(structure_item) + | Record({structure_item}) => structure_item + }, + message_type: + switch (message_type^) { + | Some(x) => x + | None => MessageType.default(~loc=Location.none) + }, + submission_error_type: + switch (submission_error_type^) { + | Some(x) => x + | None => SubmissionErrorType.default(~loc=Location.none) + }, + }) + | Error(error) => Error(error) + }; + }; + }; + }; +}; diff --git a/lib/ppx/Ppx.re b/lib/ppx/Ppx.re new file mode 100644 index 00000000..584039ac --- /dev/null +++ b/lib/ppx/Ppx.re @@ -0,0 +1,9 @@ +// TODO: Async validation: `item: [@field.async] string` +// TODO: Collections: `items: [@field.collection] array(item)` +// TODO: Whole collection validation +// TODO: Field with deps validation +// TODO: Add/remove items from collections +// TODO: Reorder items in collections +// TODO: Strip attributes from input types + +"formality" |> Ppxlib.Driver.register_transformation(~extensions=[Form.ext]); diff --git a/re-formality/ppx/dune b/lib/ppx/dune similarity index 86% rename from re-formality/ppx/dune rename to lib/ppx/dune index d806f0d1..35b4a0f0 100644 --- a/re-formality/ppx/dune +++ b/lib/ppx/dune @@ -1,5 +1,5 @@ (library - (name FormalityPpx) + (name Ppx) (public_name re-formality-ppx.lib) (kind ppx_rewriter) (libraries ppxlib) diff --git a/re-formality/re-formality-ppx.opam b/lib/re-formality-ppx.opam similarity index 100% rename from re-formality/re-formality-ppx.opam rename to lib/re-formality-ppx.opam diff --git a/lib/src/Formality.re b/lib/src/Formality.re new file mode 100644 index 00000000..a1d6a51c --- /dev/null +++ b/lib/src/Formality.re @@ -0,0 +1,168 @@ +module ReactUpdate = Formality__ReactUpdate; + +type strategy = + | OnFirstBlur + | OnFirstChange + | OnFirstSuccess + | OnFirstSuccessOrFirstBlur + | OnSubmit; + +type visibility = + | Shown + | Hidden; + +type fieldStatus('outputValue, 'message) = + | Pristine + | Dirty(result('outputValue, 'message), visibility); + +type asyncFieldStatus('outputValue, 'message) = + | Pristine + | Dirty(result('outputValue, 'message), visibility) + | Validating; + +type formStatus('submissionError) = + | Editing + | Submitting(option('submissionError)) + | Submitted + | SubmissionFailed('submissionError); + +type submissionStatus = + | NeverSubmitted + | AttemptedToSubmit; + +type index = int; + +type singleValueValidator('input, 'outputValue, 'message) = { + strategy, + validate: 'input => result('outputValue, 'message), +}; + +type singleValueAsyncValidator('input, 'outputValue, 'message) = { + strategy, + validate: 'input => result('outputValue, 'message), + validateAsync: 'input => Js.Promise.t(result('outputValue, 'message)), +}; + +type collectionValidator('input, 'message, 'fieldsValidators) = { + collection: option('input => result(unit, 'message)), + fields: 'fieldsValidators, +}; + +type valueOfCollectionValidator('input, 'outputValue, 'message) = { + strategy, + validate: ('input, ~at: index) => result('outputValue, 'message), +}; + +type valueOfCollectionAsyncValidator('input, 'outputValue, 'message) = { + strategy, + validate: ('input, ~at: index) => result('outputValue, 'message), + validateAsync: + ('input, ~at: index) => Js.Promise.t(result('outputValue, 'message)), +}; + +type formValidationResult('output, 'fieldsStatuses) = + | Ok({ + output: 'output, + fieldsStatuses: 'fieldsStatuses, + }) + | Error({fieldsStatuses: 'fieldsStatuses}); + +type submissionCallbacks('input, 'submissionError) = { + notifyOnSuccess: option('input) => unit, + notifyOnFailure: 'submissionError => unit, + reset: unit => unit, + dismissSubmissionResult: unit => unit, +}; + +let validateFieldOnChangeWithValidator = + ( + ~input: 'input, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator('input, 'outputValue, 'message), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + Dirty(validator.validate(input), Shown)->setStatus + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input)) { + | Ok(_) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + }; +}; + +let validateFieldOnChangeWithoutValidator = + ( + ~fieldInput: 'outputValue, + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : 'statuses => { + Dirty(Ok(fieldInput), Hidden)->setStatus; +}; + +let validateFieldDependencyOnChange = + ( + ~input: 'input, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~validator: singleValueValidator('input, 'outputValue, 'message), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Pristine + | Dirty(_, Hidden) => None + | Dirty(_, Shown) => + Some(Dirty(validator.validate(input), Shown)->setStatus) + }; +}; + +let validateFieldOnBlurWithValidator = + ( + ~input: 'input, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~validator: singleValueValidator('input, 'outputValue, 'message), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch (validator.strategy) { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => Some(Dirty(validator.validate(input), Hidden)->setStatus) + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + Some(Dirty(validator.validate(input), Shown)->setStatus) + } + }; +}; + +let validateFieldOnBlurWithoutValidator = + ( + ~fieldInput: 'outputValue, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : option('statuses) => + switch (fieldStatus) { + | Dirty(_, Shown | Hidden) => None + | Pristine => Some(Dirty(Ok(fieldInput), Hidden)->setStatus) + }; + +let exposeFieldResult = + (fieldStatus: fieldStatus('outputValue, 'message)) + : option(result('outputValue, 'message)) => + switch (fieldStatus) { + | Pristine + | Dirty(_, Hidden) => None + | Dirty(result, Shown) => Some(result) + }; diff --git a/re-formality/src/FormalityCompat.re b/lib/src/FormalityCompat.re similarity index 100% rename from re-formality/src/FormalityCompat.re rename to lib/src/FormalityCompat.re diff --git a/re-formality/src/FormalityCompat.rei b/lib/src/FormalityCompat.rei similarity index 100% rename from re-formality/src/FormalityCompat.rei rename to lib/src/FormalityCompat.rei diff --git a/re-formality/src/FormalityCompat__Form.re b/lib/src/FormalityCompat__Form.re similarity index 100% rename from re-formality/src/FormalityCompat__Form.re rename to lib/src/FormalityCompat__Form.re diff --git a/re-formality/src/FormalityCompat__FormAsyncOnBlur.re b/lib/src/FormalityCompat__FormAsyncOnBlur.re similarity index 100% rename from re-formality/src/FormalityCompat__FormAsyncOnBlur.re rename to lib/src/FormalityCompat__FormAsyncOnBlur.re diff --git a/re-formality/src/FormalityCompat__FormAsyncOnBlurWithId.re b/lib/src/FormalityCompat__FormAsyncOnBlurWithId.re similarity index 100% rename from re-formality/src/FormalityCompat__FormAsyncOnBlurWithId.re rename to lib/src/FormalityCompat__FormAsyncOnBlurWithId.re diff --git a/re-formality/src/FormalityCompat__FormAsyncOnChange.re b/lib/src/FormalityCompat__FormAsyncOnChange.re similarity index 100% rename from re-formality/src/FormalityCompat__FormAsyncOnChange.re rename to lib/src/FormalityCompat__FormAsyncOnChange.re diff --git a/re-formality/src/FormalityCompat__FormAsyncOnChangeWithId.re b/lib/src/FormalityCompat__FormAsyncOnChangeWithId.re similarity index 100% rename from re-formality/src/FormalityCompat__FormAsyncOnChangeWithId.re rename to lib/src/FormalityCompat__FormAsyncOnChangeWithId.re diff --git a/re-formality/src/FormalityCompat__FormStatus.re b/lib/src/FormalityCompat__FormStatus.re similarity index 100% rename from re-formality/src/FormalityCompat__FormStatus.re rename to lib/src/FormalityCompat__FormStatus.re diff --git a/re-formality/src/FormalityCompat__FormWithId.re b/lib/src/FormalityCompat__FormWithId.re similarity index 100% rename from re-formality/src/FormalityCompat__FormWithId.re rename to lib/src/FormalityCompat__FormWithId.re diff --git a/re-formality/src/FormalityCompat__PublicHelpers.re b/lib/src/FormalityCompat__PublicHelpers.re similarity index 100% rename from re-formality/src/FormalityCompat__PublicHelpers.re rename to lib/src/FormalityCompat__PublicHelpers.re diff --git a/re-formality/src/FormalityCompat__PublicHelpers.rei b/lib/src/FormalityCompat__PublicHelpers.rei similarity index 100% rename from re-formality/src/FormalityCompat__PublicHelpers.rei rename to lib/src/FormalityCompat__PublicHelpers.rei diff --git a/re-formality/src/FormalityCompat__ReactUpdate.re b/lib/src/FormalityCompat__ReactUpdate.re similarity index 100% rename from re-formality/src/FormalityCompat__ReactUpdate.re rename to lib/src/FormalityCompat__ReactUpdate.re diff --git a/re-formality/src/FormalityCompat__Strategy.re b/lib/src/FormalityCompat__Strategy.re similarity index 100% rename from re-formality/src/FormalityCompat__Strategy.re rename to lib/src/FormalityCompat__Strategy.re diff --git a/re-formality/src/FormalityCompat__Validation.re b/lib/src/FormalityCompat__Validation.re similarity index 100% rename from re-formality/src/FormalityCompat__Validation.re rename to lib/src/FormalityCompat__Validation.re diff --git a/re-formality/src/Formality__ReactUpdate.re b/lib/src/Formality__ReactUpdate.re similarity index 100% rename from re-formality/src/Formality__ReactUpdate.re rename to lib/src/Formality__ReactUpdate.re diff --git a/package.json b/package.json index b310327b..c80b18f8 100644 --- a/package.json +++ b/package.json @@ -1,7 +1,7 @@ { "workspaces": [ - "re-formality", - "re-formality-examples" + "lib", + "examples" ], "private": true } diff --git a/re-formality/bin/Bin.re b/re-formality/bin/Bin.re deleted file mode 100644 index 850fadd9..00000000 --- a/re-formality/bin/Bin.re +++ /dev/null @@ -1,3 +0,0 @@ -open Ppxlib; - -Driver.run_as_ppx_rewriter(); diff --git a/re-formality/esy.lock/opam/dune-configurator.1.0.0/opam b/re-formality/esy.lock/opam/dune-configurator.1.0.0/opam deleted file mode 100644 index 6e2b712e..00000000 --- a/re-formality/esy.lock/opam/dune-configurator.1.0.0/opam +++ /dev/null @@ -1,9 +0,0 @@ -opam-version: "2.0" -authors: ["Jérémie Dimino"] -homepage: "https://github.com/ocaml/dune" -bug-reports: "https://github.com/ocaml/dune/issues" -maintainer: "Jérémie Dimino" -description: """ -dune.configurator library distributed with Dune 1.x -""" -depends: ["dune" {<"2.0.0"}] diff --git a/re-formality/esy.lock/opam/jbuilder.transition/opam b/re-formality/esy.lock/opam/jbuilder.transition/opam deleted file mode 100644 index 9280c3ff..00000000 --- a/re-formality/esy.lock/opam/jbuilder.transition/opam +++ /dev/null @@ -1,18 +0,0 @@ -opam-version: "2.0" -maintainer: "opensource@janestreet.com" -authors: ["Jane Street Group, LLC "] -homepage: "https://github.com/ocaml/dune" -bug-reports: "https://github.com/ocaml/dune/issues" -dev-repo: "git+https://github.com/ocaml/dune.git" -license: "MIT" -depends: [ - "ocaml" - "dune" {< "2.0"} -] -post-messages: [ - "Jbuilder has been renamed and the jbuilder package is now a transition \ - package. Use the dune package instead." -] -synopsis: - "This is a transition package, jbuilder is now named dune. Use the dune" -description: "package instead." diff --git a/re-formality/esy.lock/opam/menhir.20190924/opam b/re-formality/esy.lock/opam/menhir.20190924/opam deleted file mode 100644 index 348967a7..00000000 --- a/re-formality/esy.lock/opam/menhir.20190924/opam +++ /dev/null @@ -1,29 +0,0 @@ -opam-version: "2.0" -maintainer: "francois.pottier@inria.fr" -authors: [ - "François Pottier " - "Yann Régis-Gianas " -] -homepage: "http://gitlab.inria.fr/fpottier/menhir" -dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" -bug-reports: "menhir@inria.fr" -build: [ - [make "-f" "Makefile" "PREFIX=%{prefix}%" "USE_OCAMLFIND=true" "docdir=%{doc}%/menhir" "libdir=%{lib}%/menhir" "mandir=%{man}%/man1"] -] -install: [ - [make "-f" "Makefile" "install" "PREFIX=%{prefix}%" "docdir=%{doc}%/menhir" "libdir=%{lib}%/menhir" "mandir=%{man}%/man1"] -] -depends: [ - "ocaml" {>= "4.02"} - "ocamlfind" {build} - "ocamlbuild" {build} -] -synopsis: "An LR(1) parser generator" -url { - src: - "https://gitlab.inria.fr/fpottier/menhir/repository/20190924/archive.tar.gz" - checksum: [ - "md5=677f1997fb73177d5a00fa1b8d61c3ef" - "sha512=ea8a9a6d773529cf6ac05e4c6c4532770fbb8e574c9b646efcefe90d9f24544741e3e8cfd94c8afea0447e34059a8c79c2829b46764ce3a3d6dcb3e7f75980fc" - ] -} diff --git a/re-formality/esy.lock/opam/ocamlbuild.0.14.0/opam b/re-formality/esy.lock/opam/ocamlbuild.0.14.0/opam deleted file mode 100644 index 8deabeed..00000000 --- a/re-formality/esy.lock/opam/ocamlbuild.0.14.0/opam +++ /dev/null @@ -1,36 +0,0 @@ -opam-version: "2.0" -maintainer: "Gabriel Scherer " -authors: ["Nicolas Pouillard" "Berke Durak"] -homepage: "https://github.com/ocaml/ocamlbuild/" -bug-reports: "https://github.com/ocaml/ocamlbuild/issues" -license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" -doc: "https://github.com/ocaml/ocamlbuild/blob/master/manual/manual.adoc" -dev-repo: "git+https://github.com/ocaml/ocamlbuild.git" -build: [ - [ - make - "-f" - "configure.make" - "all" - "OCAMLBUILD_PREFIX=%{prefix}%" - "OCAMLBUILD_BINDIR=%{bin}%" - "OCAMLBUILD_LIBDIR=%{lib}%" - "OCAMLBUILD_MANDIR=%{man}%" - "OCAML_NATIVE=%{ocaml:native}%" - "OCAML_NATIVE_TOOLS=%{ocaml:native}%" - ] - [make "check-if-preinstalled" "all" "opam-install"] -] -conflicts: [ - "base-ocamlbuild" - "ocamlfind" {< "1.6.2"} -] -synopsis: - "OCamlbuild is a build system with builtin rules to easily build most OCaml projects." -depends: [ - "ocaml" {>= "4.03"} -] -url { - src: "https://github.com/ocaml/ocamlbuild/archive/0.14.0.tar.gz" - checksum: "sha256=87b29ce96958096c0a1a8eeafeb6268077b2d11e1bf2b3de0f5ebc9cf8d42e78" -} diff --git a/re-formality/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/files/ocamlbuild-0.14.0.patch b/re-formality/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/files/ocamlbuild-0.14.0.patch deleted file mode 100644 index 4d5bea0e..00000000 --- a/re-formality/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/files/ocamlbuild-0.14.0.patch +++ /dev/null @@ -1,463 +0,0 @@ ---- ./Makefile -+++ ./Makefile -@@ -213,7 +213,7 @@ - rm -f man/ocamlbuild.1 - - man/options_man.byte: src/ocamlbuild_pack.cmo -- $(OCAMLC) $^ -I src man/options_man.ml -o man/options_man.byte -+ $(OCAMLC) -I +unix unix.cma $^ -I src man/options_man.ml -o man/options_man.byte - - clean:: - rm -f man/options_man.cm* ---- ./src/command.ml -+++ ./src/command.ml -@@ -148,9 +148,10 @@ - let self = string_of_command_spec_with_calls call_with_tags call_with_target resolve_virtuals in - let b = Buffer.create 256 in - (* The best way to prevent bash from switching to its windows-style -- * quote-handling is to prepend an empty string before the command name. *) -+ * quote-handling is to prepend an empty string before the command name. -+ * space seems to work, too - and the ouput is nicer *) - if Sys.os_type = "Win32" then -- Buffer.add_string b "''"; -+ Buffer.add_char b ' '; - let first = ref true in - let put_space () = - if !first then -@@ -260,7 +261,7 @@ - - let execute_many ?(quiet=false) ?(pretend=false) cmds = - add_parallel_stat (List.length cmds); -- let degraded = !*My_unix.is_degraded || Sys.os_type = "Win32" in -+ let degraded = !*My_unix.is_degraded in - let jobs = !jobs in - if jobs < 0 then invalid_arg "jobs < 0"; - let max_jobs = if jobs = 0 then None else Some jobs in ---- ./src/findlib.ml -+++ ./src/findlib.ml -@@ -66,9 +66,6 @@ - (fun command -> lexer & Lexing.from_string & run_and_read command) - command - --let run_and_read command = -- Printf.ksprintf run_and_read command -- - let rec query name = - try - Hashtbl.find packages name -@@ -135,7 +132,8 @@ - with Not_found -> s - - let list () = -- List.map before_space (split_nl & run_and_read "%s list" ocamlfind) -+ let cmd = Shell.quote_filename_if_needed ocamlfind ^ " list" in -+ List.map before_space (split_nl & run_and_read cmd) - - (* The closure algorithm is easy because the dependencies are already closed - and sorted for each package. We only have to make the union. We could also ---- ./src/main.ml -+++ ./src/main.ml -@@ -162,6 +162,9 @@ - Tags.mem "traverse" tags - || List.exists (Pathname.is_prefix path_name) !Options.include_dirs - || List.exists (Pathname.is_prefix path_name) target_dirs) -+ && ((* beware: !Options.build_dir is an absolute directory *) -+ Pathname.normalize !Options.build_dir -+ <> Pathname.normalize (Pathname.pwd/path_name)) - end - end - end ---- ./src/my_std.ml -+++ ./src/my_std.ml -@@ -271,13 +271,107 @@ - try Array.iter (fun x -> if x = basename then raise Exit) a; false - with Exit -> true - -+let command_plain = function -+| [| |] -> 0 -+| margv -> -+ let rec waitpid a b = -+ match Unix.waitpid a b with -+ | exception (Unix.Unix_error(Unix.EINTR,_,_)) -> waitpid a b -+ | x -> x -+ in -+ let pid = Unix.(create_process margv.(0) margv stdin stdout stderr) in -+ let pid', process_status = waitpid [] pid in -+ assert (pid = pid'); -+ match process_status with -+ | Unix.WEXITED n -> n -+ | Unix.WSIGNALED _ -> 2 (* like OCaml's uncaught exceptions *) -+ | Unix.WSTOPPED _ -> 127 -+ -+(* can't use Lexers because of circular dependency *) -+let split_path_win str = -+ let rec aux pos = -+ try -+ let i = String.index_from str pos ';' in -+ let len = i - pos in -+ if len = 0 then -+ aux (succ i) -+ else -+ String.sub str pos (i - pos) :: aux (succ i) -+ with Not_found | Invalid_argument _ -> -+ let len = String.length str - pos in -+ if len = 0 then [] else [String.sub str pos len] -+ in -+ aux 0 -+ -+let windows_shell = lazy begin -+ let rec iter = function -+ | [] -> [| "bash.exe" ; "--norc" ; "--noprofile" |] -+ | hd::tl -> -+ let dash = Filename.concat hd "dash.exe" in -+ if Sys.file_exists dash then [|dash|] else -+ let bash = Filename.concat hd "bash.exe" in -+ if Sys.file_exists bash = false then iter tl else -+ (* if sh.exe and bash.exe exist in the same dir, choose sh.exe *) -+ let sh = Filename.concat hd "sh.exe" in -+ if Sys.file_exists sh then [|sh|] else [|bash ; "--norc" ; "--noprofile"|] -+ in -+ split_path_win (try Sys.getenv "PATH" with Not_found -> "") |> iter -+end -+ -+let prep_windows_cmd cmd = -+ (* workaround known ocaml bug, remove later *) -+ if String.contains cmd '\t' && String.contains cmd ' ' = false then -+ " " ^ cmd -+ else -+ cmd -+ -+let run_with_shell = function -+| "" -> 0 -+| cmd -> -+ let cmd = prep_windows_cmd cmd in -+ let shell = Lazy.force windows_shell in -+ let qlen = Filename.quote cmd |> String.length in -+ (* old versions of dash had problems with bs *) -+ try -+ if qlen < 7_900 then -+ command_plain (Array.append shell [| "-ec" ; cmd |]) -+ else begin -+ (* it can still work, if the called command is a cygwin tool *) -+ let ch_closed = ref false in -+ let file_deleted = ref false in -+ let fln,ch = -+ Filename.open_temp_file -+ ~mode:[Open_binary] -+ "ocamlbuildtmp" -+ ".sh" -+ in -+ try -+ let f_slash = String.map ( fun x -> if x = '\\' then '/' else x ) fln in -+ output_string ch cmd; -+ ch_closed:= true; -+ close_out ch; -+ let ret = command_plain (Array.append shell [| "-e" ; f_slash |]) in -+ file_deleted:= true; -+ Sys.remove fln; -+ ret -+ with -+ | x -> -+ if !ch_closed = false then -+ close_out_noerr ch; -+ if !file_deleted = false then -+ (try Sys.remove fln with _ -> ()); -+ raise x -+ end -+ with -+ | (Unix.Unix_error _) as x -> -+ (* Sys.command doesn't raise an exception, so run_with_shell also won't -+ raise *) -+ Printexc.to_string x ^ ":" ^ cmd |> prerr_endline; -+ 1 -+ - let sys_command = -- match Sys.os_type with -- | "Win32" -> fun cmd -> -- if cmd = "" then 0 else -- let cmd = "bash --norc -c " ^ Filename.quote cmd in -- Sys.command cmd -- | _ -> fun cmd -> if cmd = "" then 0 else Sys.command cmd -+ if Sys.win32 then run_with_shell -+ else fun cmd -> if cmd = "" then 0 else Sys.command cmd - - (* FIXME warning fix and use Filename.concat *) - let filename_concat x y = ---- ./src/my_std.mli -+++ ./src/my_std.mli -@@ -69,3 +69,6 @@ - - val split_ocaml_version : (int * int * int * string) option - (** (major, minor, patchlevel, rest) *) -+ -+val windows_shell : string array Lazy.t -+val prep_windows_cmd : string -> string ---- ./src/ocamlbuild_executor.ml -+++ ./src/ocamlbuild_executor.ml -@@ -34,6 +34,8 @@ - job_stdin : out_channel; - job_stderr : in_channel; - job_buffer : Buffer.t; -+ job_pid : int; -+ job_tmp_file: string option; - mutable job_dying : bool; - };; - -@@ -76,6 +78,61 @@ - in - loop 0 - ;; -+ -+let open_process_full_win cmd env = -+ let (in_read, in_write) = Unix.pipe () in -+ let (out_read, out_write) = Unix.pipe () in -+ let (err_read, err_write) = Unix.pipe () in -+ Unix.set_close_on_exec in_read; -+ Unix.set_close_on_exec out_write; -+ Unix.set_close_on_exec err_read; -+ let inchan = Unix.in_channel_of_descr in_read in -+ let outchan = Unix.out_channel_of_descr out_write in -+ let errchan = Unix.in_channel_of_descr err_read in -+ let shell = Lazy.force Ocamlbuild_pack.My_std.windows_shell in -+ let test_cmd = -+ String.concat " " (List.map Filename.quote (Array.to_list shell)) ^ -+ "-ec " ^ -+ Filename.quote (Ocamlbuild_pack.My_std.prep_windows_cmd cmd) in -+ let argv,tmp_file = -+ if String.length test_cmd < 7_900 then -+ Array.append -+ shell -+ [| "-ec" ; Ocamlbuild_pack.My_std.prep_windows_cmd cmd |],None -+ else -+ let fln,ch = Filename.open_temp_file ~mode:[Open_binary] "ocamlbuild" ".sh" in -+ output_string ch (Ocamlbuild_pack.My_std.prep_windows_cmd cmd); -+ close_out ch; -+ let fln' = String.map (function '\\' -> '/' | c -> c) fln in -+ Array.append -+ shell -+ [| "-c" ; fln' |], Some fln in -+ let pid = -+ Unix.create_process_env argv.(0) argv env out_read in_write err_write in -+ Unix.close out_read; -+ Unix.close in_write; -+ Unix.close err_write; -+ (pid, inchan, outchan, errchan,tmp_file) -+ -+let close_process_full_win (pid,inchan, outchan, errchan, tmp_file) = -+ let delete tmp_file = -+ match tmp_file with -+ | None -> () -+ | Some x -> try Sys.remove x with Sys_error _ -> () in -+ let tmp_file_deleted = ref false in -+ try -+ close_in inchan; -+ close_out outchan; -+ close_in errchan; -+ let res = snd(Unix.waitpid [] pid) in -+ tmp_file_deleted := true; -+ delete tmp_file; -+ res -+ with -+ | x when tmp_file <> None && !tmp_file_deleted = false -> -+ delete tmp_file; -+ raise x -+ - (* ***) - (*** execute *) - (* XXX: Add test for non reentrancy *) -@@ -130,10 +187,16 @@ - (*** add_job *) - let add_job cmd rest result id = - (*display begin fun oc -> fp oc "Job %a is %s\n%!" print_job_id id cmd; end;*) -- let (stdout', stdin', stderr') = open_process_full cmd env in -+ let (pid,stdout', stdin', stderr', tmp_file) = -+ if Sys.win32 then open_process_full_win cmd env else -+ let a,b,c = open_process_full cmd env in -+ -1,a,b,c,None -+ in - incr jobs_active; -- set_nonblock (doi stdout'); -- set_nonblock (doi stderr'); -+ if not Sys.win32 then ( -+ set_nonblock (doi stdout'); -+ set_nonblock (doi stderr'); -+ ); - let job = - { job_id = id; - job_command = cmd; -@@ -143,7 +206,9 @@ - job_stdin = stdin'; - job_stderr = stderr'; - job_buffer = Buffer.create 1024; -- job_dying = false } -+ job_dying = false; -+ job_tmp_file = tmp_file; -+ job_pid = pid } - in - outputs := FDM.add (doi stdout') job (FDM.add (doi stderr') job !outputs); - jobs := JS.add job !jobs; -@@ -199,6 +264,7 @@ - try - read fd u 0 (Bytes.length u) - with -+ | Unix.Unix_error(Unix.EPIPE,_,_) when Sys.win32 -> 0 - | Unix.Unix_error(e,_,_) -> - let msg = error_message e in - display (fun oc -> fp oc -@@ -241,14 +307,19 @@ - decr jobs_active; - - (* PR#5371: we would get EAGAIN below otherwise *) -- clear_nonblock (doi job.job_stdout); -- clear_nonblock (doi job.job_stderr); -- -+ if not Sys.win32 then ( -+ clear_nonblock (doi job.job_stdout); -+ clear_nonblock (doi job.job_stderr); -+ ); - do_read ~loop:true (doi job.job_stdout) job; - do_read ~loop:true (doi job.job_stderr) job; - outputs := FDM.remove (doi job.job_stdout) (FDM.remove (doi job.job_stderr) !outputs); - jobs := JS.remove job !jobs; -- let status = close_process_full (job.job_stdout, job.job_stdin, job.job_stderr) in -+ let status = -+ if Sys.win32 then -+ close_process_full_win (job.job_pid, job.job_stdout, job.job_stdin, job.job_stderr, job.job_tmp_file) -+ else -+ close_process_full (job.job_stdout, job.job_stdin, job.job_stderr) in - - let shown = ref false in - ---- ./src/ocamlbuild_unix_plugin.ml -+++ ./src/ocamlbuild_unix_plugin.ml -@@ -48,12 +48,22 @@ - end - - let run_and_open s kont = -+ let s_orig = s in -+ let s = -+ (* Be consistent! My_unix.run_and_open uses My_std.sys_command and -+ sys_command uses bash. *) -+ if Sys.win32 = false then s else -+ let l = match Lazy.force My_std.windows_shell |> Array.to_list with -+ | hd::tl -> (Filename.quote hd)::tl -+ | _ -> assert false in -+ "\"" ^ (String.concat " " l) ^ " -ec " ^ Filename.quote (" " ^ s) ^ "\"" -+ in - let ic = Unix.open_process_in s in - let close () = - match Unix.close_process_in ic with - | Unix.WEXITED 0 -> () - | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> -- failwith (Printf.sprintf "Error while running: %s" s) in -+ failwith (Printf.sprintf "Error while running: %s" s_orig) in - let res = try - kont ic - with e -> (close (); raise e) ---- ./src/options.ml -+++ ./src/options.ml -@@ -174,11 +174,24 @@ - build_dir := Filename.concat (Sys.getcwd ()) s - else - build_dir := s -+ -+let slashify = -+ if Sys.win32 then fun p -> String.map (function '\\' -> '/' | x -> x) p -+ else fun p ->p -+ -+let sb () = -+ match Sys.os_type with -+ | "Win32" -> -+ (try set_binary_mode_out stdout true with _ -> ()); -+ | _ -> () -+ -+ - let spec = ref ( - let print_version () = -+ sb (); - Printf.printf "ocamlbuild %s\n%!" Ocamlbuild_config.version; raise Exit_OK - in -- let print_vnum () = print_endline Ocamlbuild_config.version; raise Exit_OK in -+ let print_vnum () = sb (); print_endline Ocamlbuild_config.version; raise Exit_OK in - Arg.align - [ - "-version", Unit print_version , " Display the version"; -@@ -257,8 +270,8 @@ - "-build-dir", String set_build_dir, " Set build directory (implies no-links)"; - "-install-lib-dir", Set_string Ocamlbuild_where.libdir, " Set the install library directory"; - "-install-bin-dir", Set_string Ocamlbuild_where.bindir, " Set the install binary directory"; -- "-where", Unit (fun () -> print_endline !Ocamlbuild_where.libdir; raise Exit_OK), " Display the install library directory"; -- "-which", String (fun cmd -> print_endline (find_tool cmd); raise Exit_OK), " Display path to the tool command"; -+ "-where", Unit (fun () -> sb (); print_endline (slashify !Ocamlbuild_where.libdir); raise Exit_OK), " Display the install library directory"; -+ "-which", String (fun cmd -> sb (); print_endline (slashify (find_tool cmd)); raise Exit_OK), " Display path to the tool command"; - "-ocamlc", set_cmd ocamlc, " Set the OCaml bytecode compiler"; - "-plugin-ocamlc", set_cmd plugin_ocamlc, " Set the OCaml bytecode compiler \ - used when building myocamlbuild.ml (only)"; ---- ./src/pathname.ml -+++ ./src/pathname.ml -@@ -84,6 +84,26 @@ - | x :: xs -> x :: normalize_list xs - - let normalize x = -+ let x = -+ if Sys.win32 = false then -+ x -+ else -+ let len = String.length x in -+ let b = Bytes.create len in -+ for i = 0 to pred len do -+ match x.[i] with -+ | '\\' -> Bytes.set b i '/' -+ | c -> Bytes.set b i c -+ done; -+ if len > 1 then ( -+ let c1 = Bytes.get b 0 in -+ let c2 = Bytes.get b 1 in -+ if c2 = ':' && c1 >= 'a' && c1 <= 'z' && -+ ( len = 2 || Bytes.get b 2 = '/') then -+ Bytes.set b 0 (Char.uppercase_ascii c1) -+ ); -+ Bytes.unsafe_to_string b -+ in - if Glob.eval not_normal_form_re x then - let root, paths = split x in - join root (normalize_list paths) ---- ./src/shell.ml -+++ ./src/shell.ml -@@ -24,12 +24,26 @@ - | 'a'..'z' | 'A'..'Z' | '0'..'9' | '.' | '-' | '/' | '_' | ':' | '@' | '+' | ',' -> loop (pos + 1) - | _ -> false in - loop 0 -+ -+let generic_quote quotequote s = -+ let l = String.length s in -+ let b = Buffer.create (l + 20) in -+ Buffer.add_char b '\''; -+ for i = 0 to l - 1 do -+ if s.[i] = '\'' -+ then Buffer.add_string b quotequote -+ else Buffer.add_char b s.[i] -+ done; -+ Buffer.add_char b '\''; -+ Buffer.contents b -+let unix_quote = generic_quote "'\\''" -+ - let quote_filename_if_needed s = - if is_simple_filename s then s - (* We should probably be using [Filename.unix_quote] except that function - * isn't exported. Users on Windows will have to live with not being able to - * install OCaml into c:\o'caml. Too bad. *) -- else if Sys.os_type = "Win32" then Printf.sprintf "'%s'" s -+ else if Sys.os_type = "Win32" then unix_quote s - else Filename.quote s - let chdir dir = - reset_filesys_cache (); -@@ -37,7 +51,7 @@ - let run args target = - reset_readdir_cache (); - let cmd = String.concat " " (List.map quote_filename_if_needed args) in -- if !*My_unix.is_degraded || Sys.os_type = "Win32" then -+ if !*My_unix.is_degraded then - begin - Log.event cmd target Tags.empty; - let st = sys_command cmd in diff --git a/re-formality/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/package.json b/re-formality/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/package.json deleted file mode 100644 index b24be7b5..00000000 --- a/re-formality/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/package.json +++ /dev/null @@ -1,27 +0,0 @@ -{ - "build": [ - [ - "bash", - "-c", - "#{os == 'windows' ? 'patch -p1 < ocamlbuild-0.14.0.patch' : 'true'}" - ], - [ - "make", - "-f", - "configure.make", - "all", - "OCAMLBUILD_PREFIX=#{self.install}", - "OCAMLBUILD_BINDIR=#{self.bin}", - "OCAMLBUILD_LIBDIR=#{self.lib}", - "OCAMLBUILD_MANDIR=#{self.man}", - "OCAMLBUILD_NATIVE=true", - "OCAMLBUILD_NATIVE_TOOLS=true" - ], - [ - "make", - "check-if-preinstalled", - "all", - "#{os == 'windows' ? 'install' : 'opam-install'}" - ] - ] -} diff --git a/re-formality/ppx/FormalityPpx.re b/re-formality/ppx/FormalityPpx.re deleted file mode 100644 index b2e0c74f..00000000 --- a/re-formality/ppx/FormalityPpx.re +++ /dev/null @@ -1,1865 +0,0 @@ -// TODO: PPX collections: `items: [@form.collection] array(item)` -// TODO: PPX deps: `deps: [@form.deps (title, item.name)] string` -// TODO: Whole collection validation -// TODO: Field with deps validation -// TODO: Add/remove items from collections -// TODO: Reorder items in collections - -open Ppxlib; -open Ast_helper; - -module Error = { - let report = (~loc, message) => Location.raise_errorf(~loc, message); -}; - -module Structure = { - let from_expr = (~loc, expr) => - switch (expr) { - | PStr(structure) => structure - | _ => Error.report(~loc, "Must be a structure") - }; -}; - -module StructureItem = { - let from_type_declaration = - (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => - Str.type_(~loc, rec_flag, [decl]); -}; - -module Field = { - module T: {type t;} = { - type t = string; - }; - - type t = T.t; - external to_string: t => string = "%identity"; - external from_string: string => t = "%identity"; - - let make = (label: label_declaration) => label.pld_name.txt |> from_string; - - let to_capitalized_string = (field: t) => - field |> to_string |> String.capitalize_ascii; - - let eq = (x1, x2) => to_string(x1) == to_string(x2); - let cmp = (x1, x2) => compare(x1 |> to_string, x2 |> to_string); - - let update_action = x => "Update" ++ (x |> to_capitalized_string) ++ "Field"; - let blur_action = x => "Blur" ++ (x |> to_capitalized_string) ++ "Field"; - - let update_fn = x => "update" ++ (x |> to_capitalized_string); - let blur_fn = x => "blur" ++ (x |> to_capitalized_string); - let result_fn = x => (x |> to_string) ++ "Result"; -}; - -module FieldType = { - module T: {type t;} = { - type t = core_type; - }; - - type t = T.t; - - external make: core_type => t = "%identity"; - let make = (core_type: core_type) => core_type |> make; - - external unpack: t => core_type = "%identity"; - - let rec eq = (t1: core_type, t2: core_type) => - switch (t1.ptyp_desc, t2.ptyp_desc) { - | (Ptyp_constr({txt: lid1}, list1), Ptyp_constr({txt: lid2}, list2)) => - eq_lid(lid1, lid2) && eq_list(list1, list2) - | (Ptyp_var(x1), Ptyp_var(x2)) => x1 == x2 - | (Ptyp_tuple(l1), Ptyp_tuple(l2)) => eq_list(l1, l2) - | _ => false - } - and eq_lid = (l1: Longident.t, l2: Longident.t) => - switch (l1, l2) { - | (Lident(x1), Lident(x2)) => x1 == x2 - | (Ldot(l1, x1), Ldot(l2, x2)) => x1 == x2 && eq_lid(l1, l2) - | (Lapply(l1, l1'), Lapply(l2, l2')) => - eq_lid(l1, l2) && eq_lid(l1', l2') - | _ => false - } - and eq_list = (l1: list(core_type), l2: list(core_type)) => - if (List.length(l1) == List.length(l2)) { - List.for_all2((t1, t2) => eq(t1, t2), l1, l2); - } else { - false; - }; - let eq = (x1: t, x2: t) => eq(x1 |> unpack, x2 |> unpack); -}; - -module FieldDeps = { - type unvalidated_dep = [ | `Field(string, Location.t)]; - - let report_error = (~loc) => - Error.report( - ~loc, - "[@field.deps] attribute must contain field or tuple of fields", - ); - - let from_attributes = (attributes: list(attribute)) => { - let deps_attr = - attributes - |> List.find_opt(attr => - switch (attr) { - | {attr_name: {txt: "field.deps"}} => true - | _ => false - } - ); - switch (deps_attr) { - | None => [] - | Some({ - attr_payload: PStr([{pstr_desc: Pstr_eval(exp, _)}]), - attr_loc, - }) => - let deps: result(list(unvalidated_dep), Location.t) = - switch (exp) { - | {pexp_desc: Pexp_ident({txt: Lident(dep), loc})} => - Ok([`Field((dep, loc))]) - | {pexp_desc: Pexp_tuple(exps)} => - exps - |> List.fold_left( - (res, exp) => - switch (res, exp) { - | (Error(loc), _) => Error(loc) - | ( - Ok(deps), - {pexp_desc: Pexp_ident({txt: Lident(dep), loc})}, - ) => - Ok([`Field((dep, loc)), ...deps]) - | (Ok(_), {pexp_loc}) => Error(pexp_loc) - }, - Ok([]), - ) - | {pexp_loc} => Error(pexp_loc) - }; - switch (deps) { - | Ok(deps) => deps - | Error(loc) => report_error(~loc) - }; - | Some({attr_loc}) => report_error(~loc=attr_loc) - }; - }; -}; - -module FieldSpec = { - type t = { - id: Field.t, - input_type: FieldType.t, - output_type: FieldType.t, - validator: [ | `Required | `Optional], - deps: list(Field.t), - }; -}; - -module InputType = { - module T: {type t;} = { - type t = structure_item; - }; - - type t = T.t; - external pack: structure_item => t = "%identity"; - external structure_item: t => structure_item = "%identity"; - - let make = (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => - decl |> StructureItem.from_type_declaration(~loc, ~rec_flag) |> pack; -}; - -module OutputType = { - module T: {type t;} = { - type t = structure_item; - }; - - type t = T.t; - external pack: structure_item => t = "%identity"; - external structure_item: t => structure_item = "%identity"; - - let make = (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => - decl |> StructureItem.from_type_declaration(~loc, ~rec_flag) |> pack; -}; - -module MessageType = { - module T: {type t;} = { - type t = structure_item; - }; - - type t = T.t; - external pack: structure_item => t = "%identity"; - external structure_item: t => structure_item = "%identity"; - - let make = (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => - decl |> StructureItem.from_type_declaration(~loc, ~rec_flag) |> pack; - - let default = (~loc) => [%stri type message = string] |> pack; -}; - -module SubmissionErrorType = { - module T: {type t;} = { - type t = structure_item; - }; - - type t = T.t; - external pack: structure_item => t = "%identity"; - external structure_item: t => structure_item = "%identity"; - - let make = (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => - decl |> StructureItem.from_type_declaration(~loc, ~rec_flag) |> pack; - - let default = (~loc) => [%stri type submissionError = unit] |> pack; -}; - -module InputTypeParser = { - type result = Pervasives.result(ok, error) - and ok = { - fields: list((Field.t, FieldType.t, list(FieldDeps.unvalidated_dep))), - structure_item: InputType.t, - } - and error = - | NotFound - | NotRecord(Location.t); -}; - -module OutputTypeParser = { - type result = Pervasives.result(ok, error) - and ok = - | AliasOfInput(OutputType.t) - | Record({ - fields: list((Field.t, FieldType.t, Location.t)), - structure_item: OutputType.t, - loc: Location.t, - }) - and error = - | NotFound - | NotRecord(Location.t) - | BadTypeAlias({ - alias: string, - loc: Location.t, - }); -}; - -module Config = { - type data = { - fields: list(FieldSpec.t), - input_type: InputType.t, - output_type: OutputType.t, - message_type: MessageType.t, - submission_error_type: SubmissionErrorType.t, - }; - - type error = - | InputTypeParseError(InputTypeParser.error) - | OutputTypeParseError(OutputTypeParser.error) - | IOMismatch(mismatch) - and mismatch = - | InputFieldsNotInOutput({ - fields: list(Field.t), - loc: Location.t, - }) - | OutputFieldsNotInInput({fields: list((Field.t, Location.t))}) - | Both({ - input_fields_not_in_output: list(Field.t), - output_fields_not_in_input: list((Field.t, Location.t)), - loc: Location.t, - }); - - let make = (structure: structure) => { - let input_parsing_result: ref(option(InputTypeParser.result)) = - ref(None); - let output_parsing_result: ref(option(OutputTypeParser.result)) = - ref(None); - let message_type: ref(option(MessageType.t)) = ref(None); - let submission_error_type: ref(option(SubmissionErrorType.t)) = - ref(None); - - structure - |> List.iter( - fun - | {pstr_desc: Pstr_type(rec_flag, decls)} => { - decls - |> List.iter( - fun - // Input type - | { - ptype_name: {txt: "input"}, - ptype_kind: Ptype_record(fields), - ptype_loc, - } as decl => - input_parsing_result := - Some( - Ok({ - fields: - List.fold_right( - (field, acc) => - [ - ( - field |> Field.make, - field.pld_type |> FieldType.make, - field.pld_type.ptyp_attributes - |> FieldDeps.from_attributes, - ), - ...acc, - ], - fields, - [], - ), - structure_item: - decl |> InputType.make(~loc=ptype_loc, ~rec_flag), - }), - ) - | {ptype_name: {txt: "input"}, ptype_loc} => - input_parsing_result := - Some(Error(InputTypeParser.NotRecord(ptype_loc))) - - // Output type - | { - ptype_name: {txt: "output"}, - ptype_kind: Ptype_record(fields), - ptype_loc, - } as decl => - output_parsing_result := - Some( - Ok( - Record({ - fields: - List.fold_right( - (field, acc) => - [ - ( - field |> Field.make, - field.pld_type |> FieldType.make, - field.pld_loc, - ), - ...acc, - ], - fields, - [], - ), - loc: ptype_loc, - structure_item: - decl - |> OutputType.make(~loc=ptype_loc, ~rec_flag), - }), - ), - ) - | { - ptype_name: {txt: "output"}, - ptype_kind: Ptype_abstract, - ptype_loc, - ptype_manifest: - Some({ - ptyp_desc: - Ptyp_constr({txt: Lident("input")}, []), - }), - } as decl => - output_parsing_result := - Some( - Ok( - AliasOfInput( - decl |> OutputType.make(~loc=ptype_loc, ~rec_flag), - ), - ), - ) - | { - ptype_name: {txt: "output"}, - ptype_kind: Ptype_abstract, - ptype_manifest: - Some({ - ptyp_desc: - Ptyp_constr({txt: Lident(alias), loc}, []), - }), - } => - output_parsing_result := - Some( - Error(OutputTypeParser.BadTypeAlias({alias, loc})), - ) - | {ptype_name: {txt: "output"}, ptype_loc} => - output_parsing_result := - Some(Error(OutputTypeParser.NotRecord(ptype_loc))) - - // Message type - | { - ptype_name: {txt: "message"}, - ptype_loc, - ptype_manifest: Some(_), - } as decl => - message_type := - Some( - decl |> MessageType.make(~rec_flag, ~loc=ptype_loc), - ) - - // Submission error type - | { - ptype_name: {txt: "submissionError"}, - ptype_loc, - ptype_manifest: Some(_), - } as decl => - submission_error_type := - Some( - decl - |> SubmissionErrorType.make(~rec_flag, ~loc=ptype_loc), - ) - - // Rest - | _ => (), - ); - } - | _ => (), - ); - - switch (input_parsing_result^, output_parsing_result^) { - | (Some(Error(error)), _) => Error(InputTypeParseError(error)) - | (None, _) => Error(InputTypeParseError(NotFound)) - | (_, Some(Error(error))) => Error(OutputTypeParseError(error)) - | (_, None) => Error(OutputTypeParseError(NotFound)) - | (Some(Ok(input_data)), Some(Ok(output_result))) => - let deps_validity = - input_data.fields - |> List.fold_left( - (res, (field, _, deps)) => - switch (res) { - | Error(error) => Error(error) - | Ok(_) => - deps - |> List.fold_left( - (res, dep) => - switch (res, dep) { - | (Error(error), _) => Error(error) - | (Ok (), `Field(dep, loc)) => - switch ( - deps - |> List.find_all(dep' => - switch (dep') { - | `Field(dep', _) => dep' == dep - } - ) - |> List.length - ) { - | 0 - | 1 => - switch ( - input_data.fields - |> List.find_opt(((field, _, _)) => - field |> Field.to_string == dep - ) - ) { - | None => Error(`DepNotFound((dep, loc))) - | Some(_) when dep == (field |> Field.to_string) => - Error(`DepOfItself((dep, loc))) - | Some(_) => Ok() - } - | _ => Error(`DuplicateDep((dep, loc))) - } - }, - Ok(), - ) - }, - Ok(), - ); - switch (deps_validity) { - | Error(`DepNotFound(dep, loc)) => - Error.report(~loc, "Field %s doesn't exist in input", dep) - | Error(`DepOfItself(dep, loc)) => - Error.report(~loc, "Field can't depend on itself") - | Error(`DuplicateDep(dep, loc)) => - Error.report( - ~loc, - "Field %s is already declared as a dependency for this field", - dep, - ) - | Ok () => - let fields = - switch (output_result) { - | AliasOfInput(_) => - Ok( - input_data.fields - |> List.map(((field, input_type, deps)) => - FieldSpec.{ - id: field, - input_type, - output_type: input_type, - validator: `Optional, - deps: - deps - |> List.map( - fun - | `Field(dep, _) => dep |> Field.from_string, - ), - } - ), - ) - | Record({fields: output_fields, loc: output_loc}) => - let ( - matched_fields, - input_fields_not_in_output, - output_fields_not_in_input, - ) = - List.fold_right( - ( - (input_field, input_field_type, input_field_deps), - ( - matched_fields, - input_fields_not_in_output, - output_fields_not_in_input, - ), - ) => { - let output_field = - output_fields - |> List.find_opt(((output_field, _, _)) => - input_field |> Field.eq(output_field) - ); - switch (output_field) { - | None => ( - matched_fields, - [input_field, ...input_fields_not_in_output], - output_fields_not_in_input, - ) - | Some((output_field, output_field_type, _)) => ( - [ - FieldSpec.{ - id: input_field, - input_type: input_field_type, - output_type: output_field_type, - validator: - if (FieldType.eq( - input_field_type, - output_field_type, - )) { - `Optional; - } else { - `Required; - }, - deps: - input_field_deps - |> List.map( - fun - | `Field(dep, _) => dep |> Field.from_string, - ), - }, - ...matched_fields, - ], - input_fields_not_in_output, - output_fields_not_in_input - |> List.filter(((output_field, _, _)) => - !(input_field |> Field.eq(output_field)) - ), - ) - }; - }, - input_data.fields, - ([], [], output_fields), - ); - switch (input_fields_not_in_output, output_fields_not_in_input) { - | ([], []) => Ok(matched_fields) - | (input_fields_not_in_output, []) => - Error( - IOMismatch( - InputFieldsNotInOutput({ - fields: input_fields_not_in_output, - loc: output_loc, - }), - ), - ) - | ([], output_fields_not_in_input) => - Error( - IOMismatch( - OutputFieldsNotInInput({ - fields: - output_fields_not_in_input - |> List.map(((field, _, loc)) => (field, loc)), - }), - ), - ) - | (input_fields_not_in_output, output_fields_not_in_input) => - Error( - IOMismatch( - Both({ - input_fields_not_in_output, - output_fields_not_in_input: - output_fields_not_in_input - |> List.map(((field, _, loc)) => (field, loc)), - loc: output_loc, - }), - ), - ) - }; - }; - - switch (fields) { - | Ok(fields) => - Ok({ - fields, - input_type: input_data.structure_item, - output_type: - switch (output_result) { - | AliasOfInput(structure_item) - | Record({structure_item}) => structure_item - }, - message_type: - switch (message_type^) { - | Some(x) => x - | None => MessageType.default(~loc=Location.none) - }, - submission_error_type: - switch (submission_error_type^) { - | Some(x) => x - | None => SubmissionErrorType.default(~loc=Location.none) - }, - }) - | Error(error) => Error(error) - }; - }; - }; - }; - - let unwrap = (result, ~loc): data => - switch (result) { - | Ok(data) => data - | Error(InputTypeParseError(NotFound)) => - Error.report(~loc, "`input` type not found") - | Error(InputTypeParseError(NotRecord(loc))) => - Error.report(~loc, "`input` must be of record type") - | Error(OutputTypeParseError(NotFound)) => - Error.report(~loc, "`output` type not found") - | Error(OutputTypeParseError(NotRecord(loc))) => - Error.report( - ~loc, - "`output` must be of record type or an alias of `input`", - ) - | Error(OutputTypeParseError(BadTypeAlias({alias, loc}))) => - Error.report( - ~loc, - "`output` can only be an alias of `input` type or a record", - ) - | Error(IOMismatch(OutputFieldsNotInInput({fields}))) => - switch (fields) { - | [] => - failwith( - "Empty list of non-matched fields in IOMatchError(OutputFieldsNotInInput)", - ) - | [(field, loc)] - | [(field, loc), ..._] => - Error.report( - ~loc, - "`output` field `%s` doesn't exist in `input` type", - field |> Field.to_string, - ) - } - | Error(IOMismatch(InputFieldsNotInOutput({fields, loc}))) - | Error( - IOMismatch( - Both({ - input_fields_not_in_output: fields, - output_fields_not_in_input: _, - loc, - }), - ), - ) => - switch (fields) { - | [] => - failwith( - "Empty list of non-matched fields in IOMatchError(TotalMess)", - ) - | [field] => - Error.report( - ~loc, - "`input` field `%s` doesn't exist in `output` type", - field |> Field.to_string, - ) - | fields => - Error.report( - ~loc, - "Some `input` fields don't exist in `output` type: %s", - fields |> List.map(Field.to_string) |> String.concat(", "), - ) - } - }; -}; - -module AstHelpers = { - let lid = (~loc, x: Longident.t) => {txt: x, loc}; - let str = (~loc, x: string) => {txt: x, loc}; - - let explicit_arity = (~loc) => { - attr_name: "explicit_arity" |> str(~loc), - attr_payload: PStr([]), - attr_loc: Location.none, - }; - - module T = { - let constructor = (~loc, ~args: option(list(core_type))=?, x) => - Type.constructor( - ~args=? - switch (args) { - | Some(args) => Some(Pcstr_tuple(args)) - | None => None - }, - x |> str(~loc), - ); - - let record_of_fields = - ( - ~name, - ~loc, - ~typ: FieldSpec.t => core_type, - fields: list(FieldSpec.t), - ) => - name - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - fields - |> List.map((field: FieldSpec.t) => - Type.field( - field.id |> Field.to_string |> str(~loc), - field |> typ, - ) - ), - ), - ) - |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); - }; - - module E = { - let some = (~loc, x) => - Exp.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Some") |> lid(~loc), - Some(Exp.tuple([x])), - ); - - let ref_ = (~loc, x) => - Exp.apply( - Exp.ident(Lident("!") |> lid(~loc)), - [(Nolabel, Exp.ident(Lident(x) |> lid(~loc)))], - ); - - let rec seq = (~exp, ~make, list) => - switch (list) { - | [] => exp - | [x] => x |> make |> Exp.sequence(exp) - | [x, ...rest] => - rest |> seq(~exp=x |> make |> Exp.sequence(exp), ~make) - }; - - let field = (~of_ as record, ~loc, field: Field.t) => - Exp.field( - Exp.ident(Lident(record) |> lid(~loc)), - Lident(field |> Field.to_string) |> lid(~loc), - ); - - let field2 = (~of_ as (record1, record2), ~loc, field: Field.t) => - Exp.field( - Exp.field( - Exp.ident(Lident(record1) |> lid(~loc)), - Lident(record2) |> lid(~loc), - ), - Lident(field |> Field.to_string) |> lid(~loc), - ); - - let ref_field = (~of_ as record, ~loc, field: Field.t) => - Exp.field( - record |> ref_(~loc), - Lident(field |> Field.to_string) |> lid(~loc), - ); - - let update_field = (~of_ as record, ~with_ as value, ~loc, field: Field.t) => - Exp.record( - [(Lident(field |> Field.to_string) |> lid(~loc), value)], - Some(Exp.ident(Lident(record) |> lid(~loc))), - ); - - let update_ref_field = - (~of_ as record, ~with_ as value, ~loc, field: Field.t) => - Exp.record( - [(Lident(field |> Field.to_string) |> lid(~loc), value)], - Some(record |> ref_(~loc)), - ); - - let record = (~loc, xs: list((string, expression))) => - Exp.record( - xs - |> List.map(((name, expr)) => (Lident(name) |> lid(~loc), expr)), - None, - ); - }; -}; - -module Render = { - open AstHelpers; - - let module_form = (~loc) => { - [%stri module Form = Formality__Form]; - }; - - let module_validation = (~loc) => { - [%stri module Validation = Formality__Validation]; - }; - - let module_strategy = (~loc) => { - [%stri module Strategy = Formality__Strategy]; - }; - - let module_form_status = (~loc) => { - [%stri module FormStatus = Formality__FormStatus]; - }; - - let module_react_update = (~loc) => { - [%stri module ReactUpdate = Formality__ReactUpdate]; - }; - - let input_type = (input_type: InputType.t) => { - input_type |> InputType.structure_item; - }; - - let output_type = (output_type: OutputType.t) => { - output_type |> OutputType.structure_item; - }; - - let message_type = (message_type: MessageType.t) => - message_type |> MessageType.structure_item; - - let submission_error_type = (submission_error_type: SubmissionErrorType.t) => - submission_error_type |> SubmissionErrorType.structure_item; - - let validators_type = (~loc, fields: list(FieldSpec.t)) => { - fields - |> T.record_of_fields( - ~name="validators", - ~loc, - ~typ=field => { - let typ = - Typ.constr( - Ldot(Ldot(Lident("Validation"), "SingleValue"), "validator") - |> lid(~loc), - [ - Typ.constr(Lident("input") |> lid(~loc), []), - field.output_type |> FieldType.unpack, - Typ.constr(Lident("message") |> lid(~loc), []), - ], - ); - switch (field.validator) { - | `Required => typ - | `Optional => Typ.constr(Lident("option") |> lid(~loc), [typ]) - }; - }, - ); - }; - - let fields_statuses_type = (~loc, fields: list(FieldSpec.t)) => { - fields - |> T.record_of_fields(~name="fieldsStatuses", ~loc, ~typ=field => - Typ.constr( - Ldot(Lident("Validation"), "status") |> lid(~loc), - [ - field.output_type |> FieldType.unpack, - Typ.constr(Lident("message") |> lid(~loc), []), - ], - ) - ); - }; - - let state_type = (~loc) => [%stri - type state = { - input, - fieldsStatuses, - formStatus: FormStatus.t(submissionError), - formSubmissions: FormStatus.submission, - } - ]; - - let action_type = (~loc, fields: list(FieldSpec.t)) => { - let update_actions = - fields - |> List.map((field: FieldSpec.t) => - field.id - |> Field.update_action - |> T.constructor(~args=[[%type: input]], ~loc) - ); - let blur_actions = - fields - |> List.map((field: FieldSpec.t) => - field.id |> Field.blur_action |> T.constructor(~loc) - ); - let rest_actions = [ - "Submit" |> T.constructor(~loc), - "SetSubmittedStatus" - |> T.constructor(~args=[[%type: option(input)]], ~loc), - "SetSubmissionFailedStatus" - |> T.constructor(~args=[[%type: submissionError]], ~loc), - "MapSubmissionError" - |> T.constructor( - ~args=[[%type: submissionError => submissionError]], - ~loc, - ), - "DismissSubmissionError" |> T.constructor(~loc), - "DismissSubmissionResult" |> T.constructor(~loc), - "Reset" |> T.constructor(~loc), - ]; - - "action" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_variant( - rest_actions - |> List.append(blur_actions) - |> List.append(update_actions), - ), - ) - |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); - }; - - let interface_type = (~loc, fields: list(FieldSpec.t)) => { - let f = (x, t) => t |> Type.field(x |> str(~loc)); - - let base = [ - f("input", [%type: input]), - f("status", [%type: FormStatus.t(submissionError)]), - f("dirty", [%type: unit => bool]), - f("valid", [%type: unit => bool]), - f("submitting", [%type: bool]), - f("submit", [%type: unit => unit]), - f("dismissSubmissionError", [%type: unit => unit]), - f("dismissSubmissionResult", [%type: unit => unit]), - f( - "mapSubmissionError", - [%type: (submissionError => submissionError) => unit], - ), - f("reset", [%type: unit => unit]), - ]; - - let update_fns = - fields - |> List.map((field: FieldSpec.t) => { - f(field.id |> Field.update_fn, [%type: input => unit]) - }); - - let blur_fns = - fields - |> List.map((field: FieldSpec.t) => { - f(field.id |> Field.blur_fn, [%type: unit => unit]) - }); - - let result_fns = - fields - |> List.map((field: FieldSpec.t) => { - f( - field.id |> Field.result_fn, - [%type: - unit => - option( - result([%t field.output_type |> FieldType.unpack], message), - ) - ], - ) - }); - - "interface" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - base - |> List.append(result_fns) - |> List.append(blur_fns) - |> List.append(update_fns), - ), - ) - |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); - }; - - let initial_fields_statuses_fn = (~loc, fields: list(FieldSpec.t)) => { - [%stri - let initialFieldsStatuses = (_input: input) => [%e - Exp.record( - fields - |> List.map((field: FieldSpec.t) => - ( - Lident(field.id |> Field.to_string) |> lid(~loc), - [%expr Pristine], - ) - ), - None, - ) - ] - ]; - }; - - let initial_state_fn = (~loc) => [%stri - let initialState = input => { - input, - fieldsStatuses: input->initialFieldsStatuses, - formStatus: Editing, - formSubmissions: NeverSubmitted, - } - ]; - - let validate_form_fn = (~loc, fields: list(FieldSpec.t)) => { - let field_result = x => (x |> Field.to_string) ++ "Result"; - let field_result_visibility = x => - (x |> Field.to_string) ++ "ResultVisibility"; - - [%stri - let validateForm = - (input: input, ~validators: validators) - : Validation.result(output, fieldsStatuses) => [%e - Exp.match( - Exp.tuple( - fields - |> List.map((field: FieldSpec.t) => - switch (field.validator) { - | `Required => - %expr - { - let Validation.SingleValue.{validate} = [%e - field.id |> E.field(~of_="validators", ~loc) - ]; - (input->validate, Validation.Visibility.Shown); - } - | `Optional => - switch%expr ( - [%e field.id |> E.field(~of_="validators", ~loc)] - ) { - | Some({validate}) => ( - input->validate, - Validation.Visibility.Shown, - ) - | None => ( - Ok([%e field.id |> E.field(~of_="input", ~loc)]), - Validation.Visibility.Hidden, - ) - } - } - ), - ), - [ - // ((Ok(value), visibility), ...) => Ok(...) - Exp.case( - Pat.tuple( - fields - |> List.map((field: FieldSpec.t) => - Pat.tuple([ - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some( - Pat.tuple([ - Pat.var( - field.id |> Field.to_string |> str(~loc), - ), - ]), - ), - ), - field.id |> field_result |> str(~loc), - ), - Pat.var( - field.id |> field_result_visibility |> str(~loc), - ), - ]) - ), - ), - [%expr - Ok({ - output: [%e - Exp.record( - fields - |> List.map((field: FieldSpec.t) => - ( - Lident(field.id |> Field.to_string) |> lid(~loc), - Exp.ident( - Lident(field.id |> Field.to_string) - |> lid(~loc), - ), - ) - ), - None, - ) - ], - fieldsStatuses: [%e - Exp.record( - fields - |> List.map((field: FieldSpec.t) => - ( - Lident(field.id |> Field.to_string) |> lid(~loc), - [%expr - Dirty( - [%e - Exp.ident( - Lident(field.id |> field_result) - |> lid(~loc), - ) - ], - [%e - Exp.ident( - Lident( - field.id |> field_result_visibility, - ) - |> lid(~loc), - ) - ], - ) - ], - ) - ), - None, - ) - ], - }) - ], - ), - // ((_, visibility), ...) => Error(...) - Exp.case( - Pat.tuple( - fields - |> List.map((field: FieldSpec.t) => - Pat.tuple([ - Pat.var(field.id |> field_result |> str(~loc)), - Pat.var( - field.id |> field_result_visibility |> str(~loc), - ), - ]) - ), - ), - [%expr - Error({ - fieldsStatuses: [%e - Exp.record( - fields - |> List.map((field: FieldSpec.t) => - ( - Lident(field.id |> Field.to_string) |> lid(~loc), - [%expr - Dirty( - [%e - Exp.ident( - Lident(field.id |> field_result) - |> lid(~loc), - ) - ], - [%e - Exp.ident( - Lident( - field.id |> field_result_visibility, - ) - |> lid(~loc), - ) - ], - ) - ], - ) - ), - None, - ) - ], - }) - ], - ), - ], - ) - ] - ]; - }; - - let use_form_fn = (~loc, fields: list(FieldSpec.t)) => [%stri - let useForm = - ( - ~initialInput: input, - ~validators: validators, - ~onSubmit: - ( - output, - Validation.submissionCallbacks(input, submissionError) - ) => - unit, - ) => { - // Reducer - let memoizedInitialState = - React.useMemo1(() => initialInput->initialState, [|initialInput|]); - - let (state, dispatch) = - memoizedInitialState->ReactUpdate.useReducer((state, action) => { - %e - { - let update_actions = - fields - |> List.map((field: FieldSpec.t) => - Exp.case( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident(field.id |> Field.update_action) |> lid(~loc), - Some(Pat.tuple([Pat.var("input" |> str(~loc))])), - ), - switch (field.deps) { - | [] => - %expr - { - let {fieldsStatuses, formSubmissions} = state; - Update({ - ...state, - input, - fieldsStatuses: - switch%e (field.validator) { - | `Required => - %expr - { - Form.validateFieldOnChangeWithValidator( - ~input, - ~status=[%e - field.id - |> E.field(~of_="fieldsStatuses", ~loc) - ], - ~submission=formSubmissions, - ~validator=[%e - field.id - |> E.field(~of_="validators", ~loc) - ], - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ); - } - | `Optional => - switch%expr ( - [%e - field.id - |> E.field(~of_="validators", ~loc) - ] - ) { - | Some(validator) => - Form.validateFieldOnChangeWithValidator( - ~input, - ~status=[%e - field.id - |> E.field(~of_="fieldsStatuses", ~loc) - ], - ~submission=formSubmissions, - ~validator, - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - | None => - Form.validateFieldOnChangeWithoutValidator( - ~fieldInput=[%e - field.id |> E.field(~of_="input", ~loc) - ], - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - } - }, - }); - } - | [dep, ...deps] => - %expr - { - let fieldsStatuses = ref(state.fieldsStatuses); - let {formSubmissions} = state; - - %e - { - let validate_dep = dep => { - let field = - fields - |> List.find((field: FieldSpec.t) => - field.id |> Field.eq(dep) - ); - switch (field.validator) { - | `Required => - switch%expr ( - Form.validateFieldDependencyOnChange( - ~input, - ~status=[%e - field.id - |> E.ref_field( - ~of_="fieldsStatuses", - ~loc, - ) - ], - ~validator=[%e - field.id - |> E.field(~of_="validators", ~loc) - ], - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_ref_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - ) { - | Some(result) => fieldsStatuses := result - | None => () - } - | `Optional => - switch%expr ( - [%e - field.id - |> E.field(~of_="validators", ~loc) - ] - ) { - | None => () - | Some(validator) => - switch ( - Form.validateFieldDependencyOnChange( - ~input, - ~status=[%e - field.id - |> E.ref_field( - ~of_="fieldsStatuses", - ~loc, - ) - ], - ~validator, - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_ref_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - ) { - | Some(result) => fieldsStatuses := result - | None => () - } - } - }; - }; - deps - |> E.seq( - ~exp=dep |> validate_dep, - ~make=validate_dep, - ); - }; - - Update({ - ...state, - input, - fieldsStatuses: - switch%e (field.validator) { - | `Required => - %expr - { - Form.validateFieldOnChangeWithValidator( - ~input, - ~status=[%e - field.id - |> E.ref_field( - ~of_="fieldsStatuses", - ~loc, - ) - ], - ~submission=formSubmissions, - ~validator=[%e - field.id - |> E.field(~of_="validators", ~loc) - ], - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_ref_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ); - } - | `Optional => - switch%expr ( - [%e - field.id - |> E.field(~of_="validators", ~loc) - ] - ) { - | Some(validator) => - Form.validateFieldOnChangeWithValidator( - ~input, - ~status=[%e - field.id - |> E.ref_field( - ~of_="fieldsStatuses", - ~loc, - ) - ], - ~submission=formSubmissions, - ~validator, - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_ref_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - | None => - Form.validateFieldOnChangeWithoutValidator( - ~fieldInput=[%e - field.id |> E.field(~of_="input", ~loc) - ], - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_ref_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - } - }, - }); - } - }, - ) - ); - - let blur_actions = - fields - |> List.map((field: FieldSpec.t) => - Exp.case( - Pat.construct( - Lident(field.id |> Field.blur_action) |> lid(~loc), - None, - ), - { - %expr - { - let {input, fieldsStatuses} = state; - let result = - switch%e (field.validator) { - | `Required => - %expr - Form.validateFieldOnBlurWithValidator( - ~input, - ~status=[%e - field.id - |> E.field(~of_="fieldsStatuses", ~loc) - ], - ~validator=[%e - field.id |> E.field(~of_="validators", ~loc) - ], - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - | `Optional => - switch%expr ( - [%e - field.id |> E.field(~of_="validators", ~loc) - ] - ) { - | Some(validator) => - Form.validateFieldOnBlurWithValidator( - ~input, - ~status=[%e - field.id - |> E.field(~of_="fieldsStatuses", ~loc) - ], - ~validator, - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - | None => - Form.validateFieldOnBlurWithoutValidator( - ~fieldInput=[%e - field.id |> E.field(~of_="input", ~loc) - ], - ~status=[%e - field.id - |> E.field(~of_="fieldsStatuses", ~loc) - ], - ~setStatus=[%e - [%expr - status => [%e - field.id - |> E.update_field( - ~of_="fieldsStatuses", - ~with_=[%expr status], - ~loc, - ) - ] - ] - ], - ) - } - }; - switch (result) { - | Some(fieldsStatuses) => - Update({...state, fieldsStatuses}) - | None => NoUpdate - }; - }; - }, - ) - ); - let rest_actions = [ - Exp.case( - [%pat? Submit], - switch%expr (state.formStatus) { - | Submitting(_) => NoUpdate - | Editing - | Submitted - | SubmissionFailed(_) => - switch (state.input->validateForm(~validators)) { - | Ok({output, fieldsStatuses}) => - UpdateWithSideEffects( - { - ...state, - fieldsStatuses, - formStatus: - FormStatus.Submitting( - switch (state.formStatus) { - | SubmissionFailed(error) => Some(error) - | Editing - | Submitted - | Submitting(_) => None - }, - ), - formSubmissions: AttemptedToSubmit, - }, - ({dispatch}) => - output->onSubmit({ - notifyOnSuccess: input => - SetSubmittedStatus(input)->dispatch, - notifyOnFailure: error => - SetSubmissionFailedStatus(error)->dispatch, - reset: () => Reset->dispatch, - dismissSubmissionResult: () => - DismissSubmissionResult->dispatch, - }), - ) - | Error({fieldsStatuses}) => - Update({ - ...state, - fieldsStatuses, - formStatus: Editing, - formSubmissions: AttemptedToSubmit, - }) - } - }, - ), - Exp.case( - [%pat? SetSubmittedStatus(input)], - switch%expr (input) { - | Some(input) => - Update({ - ...state, - input, - formStatus: Submitted, - fieldsStatuses: input->initialFieldsStatuses, - }) - | None => - Update({ - ...state, - formStatus: Submitted, - fieldsStatuses: state.input->initialFieldsStatuses, - }) - }, - ), - Exp.case( - [%pat? SetSubmissionFailedStatus(error)], - [%expr - Update({...state, formStatus: SubmissionFailed(error)}) - ], - ), - Exp.case( - [%pat? MapSubmissionError(map)], - switch%expr (state.formStatus) { - | Submitting(Some(error)) => - Update({ - ...state, - formStatus: Submitting(Some(error->map)), - }) - | SubmissionFailed(error) => - Update({ - ...state, - formStatus: SubmissionFailed(error->map), - }) - | Editing - | Submitting(None) - | Submitted => NoUpdate - }, - ), - Exp.case( - [%pat? DismissSubmissionError], - switch%expr (state.formStatus) { - | Editing - | Submitting(_) - | Submitted => NoUpdate - | SubmissionFailed(_) => - Update({...state, formStatus: Editing}) - }, - ), - Exp.case( - [%pat? DismissSubmissionResult], - switch%expr (state.formStatus) { - | Editing - | Submitting(_) => NoUpdate - | Submitted - | SubmissionFailed(_) => - Update({...state, formStatus: Editing}) - }, - ), - Exp.case( - [%pat? Reset], - [%expr Update(initialInput->initialState)], - ), - ]; - Exp.match( - [%expr action], - rest_actions - |> List.append(blur_actions) - |> List.append(update_actions), - ); - } - }); - - // Interface - %e - { - let base = [ - ("input", [%expr state.input]), - ("status", [%expr state.formStatus]), - ( - "dirty", - [%expr - () => [%e - Exp.match( - [%expr state.fieldsStatuses], - [ - Exp.case( - Pat.record( - fields - |> List.map((field: FieldSpec.t) => - ( - Lident(field.id |> Field.to_string) - |> lid(~loc), - [%pat? Pristine], - ) - ), - Closed, - ), - [%expr false], - ), - Exp.case([%pat? _], [%expr true]), - ], - ) - ] - ], - ), - ( - "valid", - [%expr - () => - switch (state.input->validateForm(~validators)) { - | Ok(_) => true - | Error(_) => false - } - ], - ), - ( - "submitting", - switch%expr (state.formStatus) { - | Submitting(_) => true - | Editing - | Submitted - | SubmissionFailed(_) => false - }, - ), - ("submit", [%expr () => Submit->dispatch]), - ( - "mapSubmissionError", - [%expr map => MapSubmissionError(map)->dispatch], - ), - ( - "dismissSubmissionError", - [%expr () => DismissSubmissionError->dispatch], - ), - ( - "dismissSubmissionResult", - [%expr () => DismissSubmissionResult->dispatch], - ), - ("reset", [%expr () => Reset->dispatch]), - ]; - let update_fns = - fields - |> List.map((field: FieldSpec.t) => { - ( - field.id |> Field.update_fn, - [%expr - input => - [%e - Exp.construct( - Lident(field.id |> Field.update_action) |> lid(~loc), - Some([%expr input]), - ) - ] - ->dispatch - ], - ) - }); - let blur_fns = - fields - |> List.map((field: FieldSpec.t) => { - ( - field.id |> Field.blur_fn, - [%expr - () => - [%e - Exp.construct( - Lident(field.id |> Field.blur_action) |> lid(~loc), - None, - ) - ] - ->dispatch - ], - ) - }); - let result_fns = - fields - |> List.map((field: FieldSpec.t) => { - ( - field.id |> Field.result_fn, - [%expr - () => { - Form.exposeFieldResult( - [%e - field.id - |> E.field2(~of_=("state", "fieldsStatuses"), ~loc) - ], - ); - } - ], - ) - }); - - E.record( - ~loc, - result_fns - |> List.append(blur_fns) - |> List.append(update_fns) - |> List.append(base), - ); - }; - } - ]; -}; - -let ext = - Extension.declare( - "form", - Extension.Context.module_expr, - Ast_pattern.__, - (~loc, ~path as _, expr) => { - let Config.{ - fields, - input_type, - output_type, - message_type, - submission_error_type, - } = - expr - |> Structure.from_expr(~loc) - |> Config.make - |> Config.unwrap(~loc); - - Mod.mk( - Pmod_structure([ - Render.module_form(~loc), - Render.module_validation(~loc), - Render.module_strategy(~loc), - Render.module_form_status(~loc), - Render.module_react_update(~loc), - Render.input_type(input_type), - Render.output_type(output_type), - Render.message_type(message_type), - Render.submission_error_type(submission_error_type), - Render.validators_type(~loc, fields), - Render.fields_statuses_type(~loc, fields), - Render.state_type(~loc), - Render.action_type(~loc, fields), - Render.interface_type(~loc, fields), - Render.initial_fields_statuses_fn(~loc, fields), - Render.initial_state_fn(~loc), - Render.validate_form_fn(~loc, fields), - Render.use_form_fn(~loc, fields), - ]), - ); - }, - ); - -"formality" |> Driver.register_transformation(~extensions=[ext]); diff --git a/re-formality/src/Formality.re b/re-formality/src/Formality.re deleted file mode 100644 index 331d5090..00000000 --- a/re-formality/src/Formality.re +++ /dev/null @@ -1,3 +0,0 @@ -module Strategy = Formality__Strategy; -module FormStatus = Formality__FormStatus; -module Validation = Formality__Validation; diff --git a/re-formality/src/Formality__Form.re b/re-formality/src/Formality__Form.re deleted file mode 100644 index c1d163c8..00000000 --- a/re-formality/src/Formality__Form.re +++ /dev/null @@ -1,107 +0,0 @@ -module FormStatus = Formality__FormStatus; -module Validation = Formality__Validation; - -let validateFieldOnChangeWithValidator: - type o. - ( - ~input: 'input, - ~status: Validation.status(o, 'message), - ~submission: FormStatus.submission, - ~validator: Validation.SingleValue.validator('input, o, 'message), - ~setStatus: Validation.status(o, 'message) => 'statuses - ) => - 'statuses = - (~input, ~status, ~submission, ~validator, ~setStatus) => { - let Validation.SingleValue.{strategy, validate} = validator; - switch (strategy, status, submission) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - Dirty(input->validate, Shown)->setStatus - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (input->validate) { - | Ok(_) as result => Dirty(result, Shown)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(input->validate, Hidden)->setStatus - }; - }; - -let validateFieldOnChangeWithoutValidator: - type o. - ( - ~fieldInput: o, - ~setStatus: Validation.status(o, 'message) => 'statuses - ) => - 'statuses = - (~fieldInput, ~setStatus) => { - Dirty(Ok(fieldInput), Hidden)->setStatus; - }; - -let validateFieldDependencyOnChange: - type o. - ( - ~input: 'input, - ~status: Validation.status(o, 'message), - ~validator: Validation.SingleValue.validator('input, o, 'message), - ~setStatus: Validation.status(o, 'message) => 'statuses - ) => - option('statuses) = - (~input, ~status, ~validator, ~setStatus) => { - let Validation.SingleValue.{validate} = validator; - switch (status) { - | Pristine - | Dirty(_, Hidden) => None - | Dirty(_, Shown) => Some(Dirty(input->validate, Shown)->setStatus) - }; - }; - -let validateFieldOnBlurWithValidator: - type o. - ( - ~input: 'input, - ~status: Validation.status(o, 'message), - ~validator: Validation.SingleValue.validator('input, o, 'message), - ~setStatus: Validation.status(o, 'message) => 'statuses - ) => - option('statuses) = - (~input, ~status, ~validator, ~setStatus) => { - switch (status) { - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - let Validation.SingleValue.{strategy, validate} = validator; - switch (strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => Some(Dirty(input->validate, Hidden)->setStatus) - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - Some(Dirty(input->validate, Shown)->setStatus) - }; - }; - }; - -let validateFieldOnBlurWithoutValidator: - type o. - ( - ~fieldInput: o, - ~status: Validation.status(o, 'message), - ~setStatus: Validation.status(o, 'message) => 'statuses - ) => - option('statuses) = - (~fieldInput, ~status, ~setStatus) => - switch (status) { - | Dirty(_, Shown | Hidden) => None - | Pristine => Some(Dirty(Ok(fieldInput), Hidden)->setStatus) - }; - -let exposeFieldResult: - type o. Validation.status(o, 'message) => option(result(o, 'message)) = - status => - switch (status) { - | Pristine - | Dirty(_, Hidden) => None - | Dirty(result, Shown) => Some(result) - }; diff --git a/re-formality/src/Formality__FormStatus.re b/re-formality/src/Formality__FormStatus.re deleted file mode 100644 index ed3090a5..00000000 --- a/re-formality/src/Formality__FormStatus.re +++ /dev/null @@ -1,9 +0,0 @@ -type t('submissionError) = - | Editing - | Submitting(option('submissionError)) - | Submitted - | SubmissionFailed('submissionError); - -type submission = - | NeverSubmitted - | AttemptedToSubmit; diff --git a/re-formality/src/Formality__Strategy.re b/re-formality/src/Formality__Strategy.re deleted file mode 100644 index b8b72632..00000000 --- a/re-formality/src/Formality__Strategy.re +++ /dev/null @@ -1,6 +0,0 @@ -type t = - | OnFirstBlur - | OnFirstChange - | OnFirstSuccess - | OnFirstSuccessOrFirstBlur - | OnSubmit; diff --git a/re-formality/src/Formality__Validation.re b/re-formality/src/Formality__Validation.re deleted file mode 100644 index fc73d511..00000000 --- a/re-formality/src/Formality__Validation.re +++ /dev/null @@ -1,87 +0,0 @@ -module Strategy = Formality__Strategy; - -module Index = { - type t = int; -}; - -module Visibility = { - type t = - | Shown - | Hidden; -}; - -module Sync = { - type status('output, 'message) = - | Pristine - | Dirty(Result.t('output, 'message), Visibility.t); - - type result('output, 'fieldsStatuses) = - | Ok({ - output: 'output, - fieldsStatuses: 'fieldsStatuses, - }) - | Error({fieldsStatuses: 'fieldsStatuses}); - - module SingleValue = { - type validator('input, 'output, 'message) = { - strategy: Strategy.t, - validate: 'input => Result.t('output, 'message), - }; - }; - - module Collection = { - type collectionValidator('input, 'message, 'fieldsValidators) = { - collection: option('input => Result.t(unit, 'message)), - fields: 'fieldsValidators, - }; - - type valueValidator('input, 'output, 'message) = { - strategy: Strategy.t, - validate: ('input, ~at: Index.t) => Result.t('output, 'message), - }; - }; -}; - -module Async = { - module Result = { - type t('message) = Belt.Result.t(ok, 'message) - and ok = - | Valid - | NoValue; - }; - - type status('message) = - | Pristine - | Dirty(Result.t('message), Visibility.t) - | Validating; - - type singleValueValidatorFn('input, 'message) = - 'input => Result.t('message); - type valueOfCollectionValidatorFn('input, 'message) = - ('input, ~at: Index.t) => Result.t('message); - - type validate('state, 'message) = - 'state => Js.Promise.t(Result.t('message)); - - type equalityChecker('state) = ('state, 'state) => bool; - - type validator('field, 'state, 'message) = { - field: 'field, - strategy: Formality__Strategy.t, - dependents: option(list('field)), - validate: singleValueValidatorFn('state, 'message), - validateAsync: - option((validate('state, 'message), equalityChecker('state))), - }; -}; - -include Sync; - -type visibility = Visibility.t; - -type submissionCallbacks('state, 'submissionError) = { - notifyOnSuccess: option('state) => unit, - notifyOnFailure: 'submissionError => unit, - reset: unit => unit, - dismissSubmissionResult: unit => unit, -};