diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7cc753bd..78bc9afd 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -4,70 +4,124 @@ on: pull_request: branches: - master + push: + tags: + - 'v*' jobs: - build: - name: Build on ${{ matrix.os }} - runs-on: ${{ matrix.os }} + validate: + name: Validate + runs-on: ubuntu-latest strategy: matrix: - node-version: [ 16.x ] - os: [ macOS-latest, windows-latest ] + os: [ubuntu-latest] + ocaml-version: [4.14.1] + node-version: [16.x] steps: - name: Checkout repo - uses: actions/checkout@v2 + uses: actions/checkout@v4 - name: Setup Node ${{ matrix.node-version }} - uses: actions/setup-node@v1 + uses: actions/setup-node@v4 with: node-version: ${{ matrix.node-version }} - name: Print Yarn cache id: print-yarn-cache - run: echo "::set-output name=yarn-cache::$(yarn cache dir)" + run: echo "yarn-cache=$(yarn cache dir)" >> $GITHUB_OUTPUT - name: Restore Yarn cache id: yarn-cache - uses: actions/cache@v1 + uses: actions/cache@v4 with: path: ${{ steps.print-yarn-cache.outputs.yarn-cache }} - key: ${{ matrix.os }}-yarn-${{ hashFiles('**/yarn.lock') }} + key: ${{ matrix.os }}-yarn-${{ hashFiles('yarn.lock', '*/yarn.lock') }} - name: Install Yarn deps run: yarn install - - name: Install Esy - run: npm install -g esy@0.6.12 + - name: Setup OCaml ${{ matrix.ocaml-version }} + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: ${{ matrix.ocaml-version }} + + - name: Install Opam deps + run: opam install . --deps-only --with-test + + - name: Build PPX + run: opam exec -- dune build + + - name: Build ReScript lib + run: | + cd lib + yarn run build + cd ../examples + yarn run build + + - name: Run PPX tests + run: opam exec -- dune exec test.exe - - name: Install Esy deps - run: esy install + - name: Run integration tests + run: | + cd specs + yarn run test - - name: Print Esy cache - id: print-esy-cache - run: node .github/workflows/scripts/print-esy-cache.js + build_macos: + name: Build on ${{ matrix.os }} + runs-on: ${{ matrix.os }} + if: startsWith(github.ref, 'refs/tags/v') + needs: + - validate + strategy: + matrix: + os: [macos-13, macos-14] + ocaml-version: [4.14.1] + node-version: [16.x] - - name: Restore Esy cache - id: esy-cache - uses: actions/cache@v1 + steps: + - name: Checkout repo + uses: actions/checkout@v4 + + - name: Setup Node ${{ matrix.node-version }} + uses: actions/setup-node@v4 with: - path: ${{ steps.print-esy-cache.outputs.esy-cache }} - key: ${{ matrix.os }}-esy-${{ hashFiles('**/index.json') }} + node-version: ${{ matrix.node-version }} + + - name: Print Yarn cache + id: print-yarn-cache + run: echo "yarn-cache=$(yarn cache dir)" >> $GITHUB_OUTPUT - - name: Build ppx - run: esy build + - name: Restore Yarn cache + id: yarn-cache + uses: actions/cache@v4 + with: + path: ${{ steps.print-yarn-cache.outputs.yarn-cache }} + key: ${{ matrix.os }}-yarn-${{ hashFiles('yarn.lock', '*/yarn.lock') }} + + - name: Install Yarn deps + run: yarn install + + - name: Setup OCaml ${{ matrix.ocaml-version }} + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: ${{ matrix.ocaml-version }} + + - name: Install Opam deps + run: opam install . --deps-only --with-test + + - name: Build PPX + run: opam exec -- dune build - name: Build ReScript lib run: | cd lib yarn run build - cd ../ppx/sandbox + cd ../examples yarn run build - - name: Run ppx tests - # FIXME: Snapshot tests are broken on Win - if: matrix.os != 'windows-latest' - run: esy x test.exe + - name: Run PPX tests + run: opam exec -- dune exec test.exe - name: Run integration tests run: | @@ -75,111 +129,179 @@ jobs: yarn run test - name: Upload artifacts - uses: actions/upload-artifact@v1 + uses: actions/upload-artifact@v4 with: name: ${{ matrix.os }} path: _build/default/ppx/bin/bin.exe build_linux: + name: Build on ${{ matrix.container-os }} + runs-on: ${{ matrix.host-os }} + if: startsWith(github.ref, 'refs/tags/v') + needs: + - validate + strategy: + matrix: + host-os: [ubuntu-latest] + container-os: [linux-alpine-3] + ocaml-version: [4.14.1] + node-version: [16.x] + container: + image: alex35mil/alpine-ocaml-opam-node-yarn:alpine-3.19-ocaml-4.14-node-16.20-yarn-1.22-o5gm + + steps: + - name: Checkout repo + uses: actions/checkout@v4 + + - name: Print Yarn cache + id: print-yarn-cache + run: echo "yarn-cache=$(yarn cache dir)" >> $GITHUB_OUTPUT + + - name: Restore Yarn cache + id: yarn-cache + uses: actions/cache@v4 + with: + path: ${{ steps.print-yarn-cache.outputs.yarn-cache }} + key: ${{ matrix.container-os }}-yarn-${{ hashFiles('yarn.lock', '*/yarn.lock') }} + + - name: Install Yarn deps + run: yarn install + + - name: Setup OCaml ${{ matrix.ocaml-version }} + run: opam init -a --disable-sandboxing --compiler=${{ matrix.ocaml-version }} + + - name: Install Opam deps + run: opam install . --deps-only --with-test + + - name: Build PPX + run: opam exec -- dune build --profile static + + - name: Build ReScript lib + run: | + cd lib + yarn run build + cd ../examples + yarn run build + + - name: Upload artifacts + uses: actions/upload-artifact@v4 + with: + name: ${{ matrix.container-os }} + path: _build/default/ppx/bin/bin.exe + + build_windows: name: Build on ${{ matrix.os }} runs-on: ${{ matrix.os }} + if: startsWith(github.ref, 'refs/tags/v') + needs: + - validate strategy: matrix: - os: [ ubuntu-latest ] - - container: - image: alexfedoseev/alpine-node-yarn-esy:0.0.10 + os: [windows-latest] + ocaml-version: [4.14.1] + node-version: [16.x] steps: - name: Checkout repo - uses: actions/checkout@v2 + uses: actions/checkout@v4 - - name: Apply static linking patch - run: git apply linux.patch + - name: Setup Node ${{ matrix.node-version }} + uses: actions/setup-node@v4 + with: + node-version: ${{ matrix.node-version }} - name: Print Yarn cache id: print-yarn-cache - run: echo "::set-output name=yarn-cache::$(yarn cache dir)" + run: echo "::set-output name=yarn-cache::$(yarn cache dir)" # Using the old way as the new way doesn't work on windows - name: Restore Yarn cache id: yarn-cache - uses: actions/cache@v1 + uses: actions/cache@v4 with: path: ${{ steps.print-yarn-cache.outputs.yarn-cache }} - key: ${{ matrix.os }}-yarn-${{ hashFiles('yarn.lock') }}-v1 + key: ${{ matrix.os }}-yarn-${{ hashFiles('yarn.lock', '*/yarn.lock') }} - name: Install Yarn deps run: yarn install - - name: Install Esy deps - run: esy install + - name: Apply Opam deps patch + run: | + $lastCommitterName = git log -1 --pretty=format:'%an' + $lastCommitterEmail = git log -1 --pretty=format:'%ae' + git config user.name "$lastCommitterName" + git config user.email "$lastCommitterEmail" + git apply windows.patch + git add . + git commit -m "Patch opam deps" + + - name: Setup OCaml ${{ matrix.ocaml-version }} + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: ${{ matrix.ocaml-version }} - - name: Print Esy cache - id: print-esy-cache - run: node .github/workflows/scripts/print-esy-cache.js + - name: Pin Opam deps + run: | + opam pin add dune https://github.com/ocaml/dune.git#7cbb0e7 # 3.11.1 + opam pin add ppxlib https://github.com/ocaml-ppx/ppxlib.git#f0496c9 # 0.30.0 + opam pin add alcotest https://github.com/mirage/alcotest.git#927088f # 1.7.0 - - name: Restore Esy cache - id: esy-cache - uses: actions/cache@v1 - with: - path: ${{ steps.print-esy-cache.outputs.esy-cache }} - key: ${{ matrix.os }}-esy-${{ hashFiles('esy.lock/index.json') }} + - name: Install Opam deps + run: opam install . --deps-only --with-test - - name: Build ppx - run: esy build + - name: Build PPX + run: opam exec -- dune build - name: Build ReScript lib run: | cd lib yarn run build - cd ../ppx/sandbox + cd ../examples yarn run build - - name: Run ppx tests - run: esy x test.exe - - # FIXME: Integration tests are broken on Linux - # - name: Run integration tests - # run: | - # cd specs - # yarn run test - - name: Upload artifacts - uses: actions/upload-artifact@v1 + uses: actions/upload-artifact@v4 with: name: ${{ matrix.os }} path: _build/default/ppx/bin/bin.exe - rc: + prepare_release: needs: - - build + - build_macos - build_linux - name: Prepare RC + - build_windows + name: Prepare release runs-on: ubuntu-latest + if: startsWith(github.ref, 'refs/tags/v') steps: - name: Checkout repo - uses: actions/checkout@v2 + uses: actions/checkout@v4 - name: Setup Node ${{ matrix.node-version }} - uses: actions/setup-node@v1 + uses: actions/setup-node@v4 with: node-version: 16.x - - name: Download Linux artifacts - uses: actions/download-artifact@v1 + - name: Download macOS x86 artifacts + uses: actions/download-artifact@v4 with: - name: ubuntu-latest - path: _bin/linux + name: macos-13 + path: _bin/darwin/intel - - name: Download macOS artifacts - uses: actions/download-artifact@v1 + - name: Download macOS ARM artifacts + uses: actions/download-artifact@v4 with: - name: macOS-latest - path: _bin/darwin + name: macos-14 + path: _bin/darwin/arm + + - name: Download Linux artifacts + uses: actions/download-artifact@v4 + with: + name: linux-alpine-3 + path: _bin/linux - name: Download Windows artifacts - uses: actions/download-artifact@v1 + uses: actions/download-artifact@v4 with: name: windows-latest path: _bin/windows @@ -187,22 +309,23 @@ jobs: - name: Move artifacts run: | mkdir -p _release/bin - mv _bin/darwin/bin.exe _release/bin/re-formality-ppx-darwin-x64.exe - mv _bin/windows/bin.exe _release/bin/re-formality-ppx-win-x64.exe + mv _bin/darwin/intel/bin.exe _release/bin/re-formality-ppx-darwin-x64.exe + mv _bin/darwin/arm/bin.exe _release/bin/re-formality-ppx-darwin-arm64.exe mv _bin/linux/bin.exe _release/bin/re-formality-ppx-linux-x64.exe + mv _bin/windows/bin.exe _release/bin/re-formality-ppx-win-x64.exe rm -rf _bin - name: Move lib files run: | mkdir -p _release/src cp README.md _release/README.md - cp lib/bsconfig.json _release/bsconfig.json + cp lib/rescript.json _release/rescript.json cp -a lib/src/. _release/src/ cp .github/workflows/scripts/postinstall.js _release/postinstall.js node .github/workflows/scripts/write-package-json.js - name: Upload release - uses: actions/upload-artifact@v1 + uses: actions/upload-artifact@v4 with: name: release path: _release diff --git a/.github/workflows/scripts/postinstall.js b/.github/workflows/scripts/postinstall.js index 10ea9fc3..c86ddcfc 100644 --- a/.github/workflows/scripts/postinstall.js +++ b/.github/workflows/scripts/postinstall.js @@ -8,11 +8,11 @@ let arch = process.arch; let platform = process.platform; if (arch === "ia32") { - arch = "x86"; + arch = "x86"; } if (platform === "win32") { - platform = "win"; + platform = "win"; } const filename = `bin/${PPX}-${platform}-${arch}.exe`; @@ -20,32 +20,31 @@ const filename = `bin/${PPX}-${platform}-${arch}.exe`; const supported = fs.existsSync(filename); if (!supported) { - console.error(`${PPX} does not support this platform :(`); - console.error(""); - console.error(`${PPX} comes prepacked as built binaries to avoid large`); - console.error("dependencies at build-time."); - console.error(""); - console.error(`If you want ${PPX} to support this platform natively,`); - console.error("please open an issue at our repository, linked above. Please"); - console.error(`specify that you are on the ${platform} platform,`); - console.error(`on the ${arch} architecture.`); - + console.error(`${PPX} does not support this platform :(`); + console.error(""); + console.error(`${PPX} comes prepacked as built binaries to avoid large`); + console.error("dependencies at build-time."); + console.error(""); + console.error(`If you want ${PPX} to support this platform natively,`); + console.error("please open an issue at our repository, linked above. Please"); + console.error(`specify that you are on the ${platform} platform,`); + console.error(`on the ${arch} architecture.`); } if (!fs.existsSync("ppx.exe")) { - copyFileSync(filename, "ppx.exe"); - fs.chmodSync("ppx.exe", 0755); + copyFileSync(filename, "ppx.exe"); + fs.chmodSync("ppx.exe", 0755); } if (!fs.existsSync("ppx")) { - copyFileSync(filename, "ppx"); - fs.chmodSync("ppx", 0755); + copyFileSync(filename, "ppx"); + fs.chmodSync("ppx", 0755); } function copyFileSync(source, dest) { - if (typeof fs.copyFileSync === "function") { - fs.copyFileSync(source, dest); - } else { - fs.writeFileSync(dest, fs.readFileSync(source)); - } + if (typeof fs.copyFileSync === "function") { + fs.copyFileSync(source, dest); + } else { + fs.writeFileSync(dest, fs.readFileSync(source)); + } } diff --git a/.github/workflows/scripts/print-esy-cache.js b/.github/workflows/scripts/print-esy-cache.js deleted file mode 100644 index 4d417a38..00000000 --- a/.github/workflows/scripts/print-esy-cache.js +++ /dev/null @@ -1,15 +0,0 @@ -const fs = require("fs"); -const os = require("os"); -const path = require("path"); - -const ESY_FOLDER = process.env.ESY__PREFIX - ? process.env.ESY__PREFIX - : path.join(os.homedir(), ".esy"); - -const esy3 = fs - .readdirSync(ESY_FOLDER) - .filter(name => name.length > 0 && name[0] === "3") - .sort() - .pop(); - -console.log(`::set-output name=esy-cache::${path.join(ESY_FOLDER, esy3, "i")}`); diff --git a/.github/workflows/scripts/write-package-json.js b/.github/workflows/scripts/write-package-json.js index e2b017b3..e7ad3323 100644 --- a/.github/workflows/scripts/write-package-json.js +++ b/.github/workflows/scripts/write-package-json.js @@ -1,43 +1,26 @@ const fs = require("fs"); const path = require("path"); -const { - name, - version, - description, - author, - license, - repository, - keywords -} = require("../../../package.json"); +const { name, version, description, author, license, repository, keywords } = require("../../../package.json"); const { dependencies } = require("../../../lib/package.json"); const packageJson = JSON.stringify( - { - name, - version, - description, - author, - license, - repository, - keywords, - dependencies, - files: [ - "src", - "bin", - "bsconfig.json", - "postinstall.js", - ], - scripts: { - postinstall: "node ./postinstall.js" - } - }, - null, - 2 + { + name, + version, + description, + author, + license, + repository, + keywords, + dependencies, + files: ["src", "bin", "rescript.json", "postinstall.js"], + scripts: { + postinstall: "node ./postinstall.js", + }, + }, + null, + 2, ); -fs.writeFileSync( - path.join(__dirname, "..", "..", "..", "_release", "package.json"), - packageJson, - { encoding: "utf8" } -); +fs.writeFileSync(path.join(__dirname, "..", "..", "..", "_release", "package.json"), packageJson, { encoding: "utf8" }); diff --git a/.gitignore b/.gitignore index 5ed9c4b4..2115d99c 100644 --- a/.gitignore +++ b/.gitignore @@ -6,17 +6,14 @@ node_modules/ .merlin .bsb.lock .parcel-cache -*.bs.js +*.res.js yarn-error.log .DS_Store */dist/ -/_esy /_build /_release /examples/lib/ /lib/lib/ /specs/lib/ -/scripts/aws.env -/scripts/aws.pem /ppx/test/**/*.cm[itj] re-formality-ppx.install diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 00000000..0619e802 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1 @@ +profile = janestreet diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index e5bbac35..b7da2e17 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -31,13 +31,12 @@ It would be great if you could reduce your test case to minimal size. I.e. inste - ppx/ # PPX - bin/ # PPX binary - lib/ # PPX implementation - - sandbox/ # PPX sandbox for debugging - test/ # PPX tests - specs/ # Integration tests ``` ### Setup -This repo uses `yarn` workspaces to manage frontend related dependencies and `esy` to manage PPX related dependencies (optionally, you can use `nix` shell instead of `esy` for development). +This repo uses `yarn` workspaces to manage frontend related dependencies and `opam` to manage PPX related dependencies (optionally, you can use `nix` shell instead of `opam` for development). Install Yarn dependencies: @@ -58,25 +57,26 @@ Build public interface of the ReScript lib: # Apparently `rescript` doesn't have `bsb -install` counterpart # So you need to build any app in this workspace that relies on `re-formality` -# E.g. in ppx/sandbox folder +# E.g. in ./examples folder yarn rescript build -with-deps ``` -**Esy flow** +**Opam flow** Install Esy dependencies: ```shell -esy install +opam init -a --disable-sandboxing --compiler=4.14.1 +opam install . --deps-only --with-test ``` Build PPX: ```shell -esy build +opam exec -- dune build ``` **Nix/Devbox flow** -Build PPX: +Considering you are already in Devbox shell, build PPX: ```shell dune build diff --git a/HISTORY.md b/HISTORY.md index 6a26e955..1be97e77 100644 --- a/HISTORY.md +++ b/HISTORY.md @@ -1,5 +1,15 @@ # History +## 4.0.0-beta.21 +** This is the last release before library rename: `re-formality → rescript-formality` (unless there are bugs)** + +* **[ BREAKING ]** Update to ReScript v11. All the functions are now uncurried. We don't offer curried option, sorry. +* **[ BREAKING ]** Remove Linux `arm64` binary. + +Internal changes: +* PPX source code is converted from Reason to OCaml. +* ReScript library source code is converted from Reason to ReScript. + ## 4.0.0-beta.20 * Fix Linux `arm64` binary name. diff --git a/devbox.json b/devbox.json index 7ec981d8..018ac8a9 100644 --- a/devbox.json +++ b/devbox.json @@ -1,17 +1,15 @@ { "packages": [ - "path:./nix/ocaml#ocaml", - "path:./nix/ocaml#dune", - "path:./nix/ocaml#reason", - "path:./nix/ocaml#result", - "path:./nix/ocaml#findlib", - "path:./nix/ocaml#ppxlib", - "path:./nix/ocaml#alcotest", - "path:./nix/ocaml#merlin", - "path:./nix/ocaml#lsp", + "ocamlPackages.ocaml", + "ocamlPackages.dune_3", + "ocamlPackages.findlib", + "ocamlPackages.ppxlib", + "ocamlPackages.alcotest", + "ocamlPackages.ocaml-lsp", + "ocamlPackages.ocamlformat", + "ocamlPackages.ocamlformat-rpc-lib", "nodejs", - "yarn", - "awscli2" + "yarn" ], "shell": { "init_hook": [ diff --git a/devbox.lock b/devbox.lock index 2c004e62..6f2a5df6 100644 --- a/devbox.lock +++ b/devbox.lock @@ -1,23 +1,42 @@ { "lockfile_version": "1", "packages": { - "awscli2": { - "resolved": "github:NixOS/nixpkgs/f80ac848e3d6f0c12c52758c0f25c10c97ca3b62#awscli2", - "source": "nixpkg" - }, "nodejs": { "resolved": "github:NixOS/nixpkgs/f80ac848e3d6f0c12c52758c0f25c10c97ca3b62#nodejs", "source": "nixpkg" }, - "path:./nix/ocaml#alcotest": {}, - "path:./nix/ocaml#dune": {}, - "path:./nix/ocaml#findlib": {}, - "path:./nix/ocaml#lsp": {}, - "path:./nix/ocaml#merlin": {}, - "path:./nix/ocaml#ocaml": {}, - "path:./nix/ocaml#ppxlib": {}, - "path:./nix/ocaml#reason": {}, - "path:./nix/ocaml#result": {}, + "ocamlPackages.alcotest": { + "resolved": "github:NixOS/nixpkgs/75a52265bda7fd25e06e3a67dee3f0354e73243c#ocamlPackages.alcotest", + "source": "nixpkg" + }, + "ocamlPackages.dune_3": { + "resolved": "github:NixOS/nixpkgs/75a52265bda7fd25e06e3a67dee3f0354e73243c#ocamlPackages.dune_3", + "source": "nixpkg" + }, + "ocamlPackages.findlib": { + "resolved": "github:NixOS/nixpkgs/75a52265bda7fd25e06e3a67dee3f0354e73243c#ocamlPackages.findlib", + "source": "nixpkg" + }, + "ocamlPackages.ocaml": { + "resolved": "github:NixOS/nixpkgs/75a52265bda7fd25e06e3a67dee3f0354e73243c#ocamlPackages.ocaml", + "source": "nixpkg" + }, + "ocamlPackages.ocaml-lsp": { + "resolved": "github:NixOS/nixpkgs/75a52265bda7fd25e06e3a67dee3f0354e73243c#ocamlPackages.ocaml-lsp", + "source": "nixpkg" + }, + "ocamlPackages.ocamlformat": { + "resolved": "github:NixOS/nixpkgs/75a52265bda7fd25e06e3a67dee3f0354e73243c#ocamlPackages.ocamlformat", + "source": "nixpkg" + }, + "ocamlPackages.ocamlformat-rpc-lib": { + "resolved": "github:NixOS/nixpkgs/75a52265bda7fd25e06e3a67dee3f0354e73243c#ocamlPackages.ocamlformat-rpc-lib", + "source": "nixpkg" + }, + "ocamlPackages.ppxlib": { + "resolved": "github:NixOS/nixpkgs/75a52265bda7fd25e06e3a67dee3f0354e73243c#ocamlPackages.ppxlib", + "source": "nixpkg" + }, "yarn": { "resolved": "github:NixOS/nixpkgs/f80ac848e3d6f0c12c52758c0f25c10c97ca3b62#yarn", "source": "nixpkg" diff --git a/dune-project b/dune-project index ad918f3f..63fc91b5 100644 --- a/dune-project +++ b/dune-project @@ -1,2 +1,2 @@ (lang dune 2.6) - (name re-formality-ppx) +(name re-formality-ppx) diff --git a/dune-workspace b/dune-workspace new file mode 100644 index 00000000..e8b83749 --- /dev/null +++ b/dune-workspace @@ -0,0 +1 @@ +(lang dune 2.6) diff --git a/esy.json b/esy.json deleted file mode 100644 index 7b7cdffb..00000000 --- a/esy.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "name": "re-formality-ppx", - "version": "0.0.0", - "description": "Form validation tool for @rescript/react", - "author": "Alex Fedoseev ", - "license": "MIT", - "esy": { - "build": "dune build -p #{self.name}", - "buildsInSource": "_build" - }, - "dependencies": { - "ocaml": "4.12.0", - "@opam/reason": "3.8.2", - "@opam/dune": "3.7.0", - "@opam/ppxlib": "0.28.0", - "@opam/ocamlfind": "1.9.6" - }, - "devDependencies": { - "@opam/merlin": "*", - "@opam/alcotest": "1.4.0" - } -} diff --git a/esy.lock/.gitattributes b/esy.lock/.gitattributes deleted file mode 100644 index e0b4e26c..00000000 --- a/esy.lock/.gitattributes +++ /dev/null @@ -1,3 +0,0 @@ - -# Set eol to LF so files aren't converted to CRLF-eol on Windows. -* text eol=lf linguist-generated diff --git a/esy.lock/.gitignore b/esy.lock/.gitignore deleted file mode 100644 index a221be22..00000000 --- a/esy.lock/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ - -# Reset any possible .gitignore, we want all esy.lock to be un-ignored. -!* diff --git a/esy.lock/index.json b/esy.lock/index.json deleted file mode 100644 index d2efd8f6..00000000 --- a/esy.lock/index.json +++ /dev/null @@ -1,954 +0,0 @@ -{ - "checksum": "319075a6eb659f641dda92e4b0840492", - "root": "re-formality-ppx@link-dev:./esy.json", - "node": { - "re-formality-ppx@link-dev:./esy.json": { - "id": "re-formality-ppx@link-dev:./esy.json", - "name": "re-formality-ppx", - "version": "link-dev:./esy.json", - "source": { "type": "link-dev", "path": ".", "manifest": "esy.json" }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/reason@opam:3.7.0@5ea7a0b2", - "@opam/ppxlib@opam:0.24.0@4c00d6db", - "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/dune@opam:2.9.2@f48e8212" - ], - "devDependencies": [ - "@opam/merlin@opam:4.4-412@c7695ce2", - "@opam/alcotest@opam:1.4.0@f5f94b2a" - ] - }, - "ocaml@4.12.0@d41d8cd9": { - "id": "ocaml@4.12.0@d41d8cd9", - "name": "ocaml", - "version": "4.12.0", - "source": { - "type": "install", - "source": [ - "archive:https://registry.npmjs.org/ocaml/-/ocaml-4.12.0.tgz#sha1:2a979f37535faaded8aa3fdf82b6f16f2c71e284" - ] - }, - "overrides": [], - "dependencies": [], - "devDependencies": [] - }, - "esy-m4@github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7@d41d8cd9": { - "id": - "esy-m4@github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7@d41d8cd9", - "name": "esy-m4", - "version": - "github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7", - "source": { - "type": "install", - "source": [ - "github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7" - ] - }, - "overrides": [], - "dependencies": [], - "devDependencies": [] - }, - "@opam/yojson@opam:1.7.0@69d87312": { - "id": "@opam/yojson@opam:1.7.0@69d87312", - "name": "@opam/yojson", - "version": "opam:1.7.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/b8/b89d39ca3f8c532abe5f547ad3b8f84d#md5:b89d39ca3f8c532abe5f547ad3b8f84d", - "archive:https://github.com/ocaml-community/yojson/releases/download/1.7.0/yojson-1.7.0.tbz#md5:b89d39ca3f8c532abe5f547ad3b8f84d" - ], - "opam": { - "name": "yojson", - "version": "1.7.0", - "path": "esy.lock/opam/yojson.1.7.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/easy-format@opam:1.3.2@1ea9f987", - "@opam/dune@opam:2.9.2@f48e8212", "@opam/cppo@opam:1.6.8@7e48217d", - "@opam/biniou@opam:1.2.1@420bda02", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/easy-format@opam:1.3.2@1ea9f987", - "@opam/dune@opam:2.9.2@f48e8212", "@opam/biniou@opam:1.2.1@420bda02" - ] - }, - "@opam/uutf@opam:1.0.3@47c95a18": { - "id": "@opam/uutf@opam:1.0.3@47c95a18", - "name": "@opam/uutf", - "version": "opam:1.0.3", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha512/50/50cc4486021da46fb08156e9daec0d57b4ca469b07309c508d5a9a41e9dbcf1f32dec2ed7be027326544453dcaf9c2534919395fd826dc7768efc6cc4bfcc9f8#sha512:50cc4486021da46fb08156e9daec0d57b4ca469b07309c508d5a9a41e9dbcf1f32dec2ed7be027326544453dcaf9c2534919395fd826dc7768efc6cc4bfcc9f8", - "archive:https://erratique.ch/software/uutf/releases/uutf-1.0.3.tbz#sha512:50cc4486021da46fb08156e9daec0d57b4ca469b07309c508d5a9a41e9dbcf1f32dec2ed7be027326544453dcaf9c2534919395fd826dc7768efc6cc4bfcc9f8" - ], - "opam": { - "name": "uutf", - "version": "1.0.3", - "path": "esy.lock/opam/uutf.1.0.3" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/topkg@opam:1.0.5@0aa59f51", - "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/ocamlbuild@opam:0.14.1@ead10f40", - "@opam/cmdliner@opam:1.1.0@643a0e00", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.12.0@d41d8cd9" ] - }, - "@opam/uuidm@opam:0.9.8@f287a426": { - "id": "@opam/uuidm@opam:0.9.8@f287a426", - "name": "@opam/uuidm", - "version": "opam:0.9.8", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha512/d5/d5073ae49c402ab3ea6dc8f86bc5b8cc14129437e23e47da4d91431648fcb31c4dce6308f9c936c58df9a2c6afda61d77105a3022e369cca4e4c140320e803b5#sha512:d5073ae49c402ab3ea6dc8f86bc5b8cc14129437e23e47da4d91431648fcb31c4dce6308f9c936c58df9a2c6afda61d77105a3022e369cca4e4c140320e803b5", - "archive:https://erratique.ch/software/uuidm/releases/uuidm-0.9.8.tbz#sha512:d5073ae49c402ab3ea6dc8f86bc5b8cc14129437e23e47da4d91431648fcb31c4dce6308f9c936c58df9a2c6afda61d77105a3022e369cca4e4c140320e803b5" - ], - "opam": { - "name": "uuidm", - "version": "0.9.8", - "path": "esy.lock/opam/uuidm.0.9.8" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/topkg@opam:1.0.5@0aa59f51", - "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/ocamlbuild@opam:0.14.1@ead10f40", - "@opam/cmdliner@opam:1.1.0@643a0e00", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.12.0@d41d8cd9" ] - }, - "@opam/topkg@opam:1.0.5@0aa59f51": { - "id": "@opam/topkg@opam:1.0.5@0aa59f51", - "name": "@opam/topkg", - "version": "opam:1.0.5", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha512/94/9450e9139209aacd8ddb4ba18e4225770837e526a52a56d94fd5c9c4c9941e83e0e7102e2292b440104f4c338fabab47cdd6bb51d69b41cc92cc7a551e6fefab#sha512:9450e9139209aacd8ddb4ba18e4225770837e526a52a56d94fd5c9c4c9941e83e0e7102e2292b440104f4c338fabab47cdd6bb51d69b41cc92cc7a551e6fefab", - "archive:https://erratique.ch/software/topkg/releases/topkg-1.0.5.tbz#sha512:9450e9139209aacd8ddb4ba18e4225770837e526a52a56d94fd5c9c4c9941e83e0e7102e2292b440104f4c338fabab47cdd6bb51d69b41cc92cc7a551e6fefab" - ], - "opam": { - "name": "topkg", - "version": "1.0.5", - "path": "esy.lock/opam/topkg.1.0.5" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/ocamlbuild@opam:0.14.1@ead10f40", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/ocamlbuild@opam:0.14.1@ead10f40" - ] - }, - "@opam/stdlib-shims@opam:0.3.0@72c7bc98": { - "id": "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "name": "@opam/stdlib-shims", - "version": "opam:0.3.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/ba/babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a#sha256:babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a", - "archive:https://github.com/ocaml/stdlib-shims/releases/download/0.3.0/stdlib-shims-0.3.0.tbz#sha256:babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a" - ], - "opam": { - "name": "stdlib-shims", - "version": "0.3.0", - "path": "esy.lock/opam/stdlib-shims.0.3.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/sexplib0@opam:v0.14.0@155c136c": { - "id": "@opam/sexplib0@opam:v0.14.0@155c136c", - "name": "@opam/sexplib0", - "version": "opam:v0.14.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/37/37aff0af8f8f6f759249475684aebdc4#md5:37aff0af8f8f6f759249475684aebdc4", - "archive:https://ocaml.janestreet.com/ocaml-core/v0.14/files/sexplib0-v0.14.0.tar.gz#md5:37aff0af8f8f6f759249475684aebdc4" - ], - "opam": { - "name": "sexplib0", - "version": "v0.14.0", - "path": "esy.lock/opam/sexplib0.v0.14.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/seq@opam:base@d8d7de1d": { - "id": "@opam/seq@opam:base@d8d7de1d", - "name": "@opam/seq", - "version": "opam:base", - "source": { - "type": "install", - "source": [ "no-source:" ], - "opam": { - "name": "seq", - "version": "base", - "path": "esy.lock/opam/seq.base" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.12.0@d41d8cd9" ] - }, - "@opam/result@opam:1.5@1c6a6533": { - "id": "@opam/result@opam:1.5@1c6a6533", - "name": "@opam/result", - "version": "opam:1.5", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/1b/1b82dec78849680b49ae9a8a365b831b#md5:1b82dec78849680b49ae9a8a365b831b", - "archive:https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz#md5:1b82dec78849680b49ae9a8a365b831b" - ], - "opam": { - "name": "result", - "version": "1.5", - "path": "esy.lock/opam/result.1.5" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/reason@opam:3.7.0@5ea7a0b2": { - "id": "@opam/reason@opam:3.7.0@5ea7a0b2", - "name": "@opam/reason", - "version": "opam:3.7.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/7e/7eb8cbbff8565b93ebfabf4eca7254d4#md5:7eb8cbbff8565b93ebfabf4eca7254d4", - "archive:https://registry.npmjs.org/@esy-ocaml/reason/-/reason-3.7.0.tgz#md5:7eb8cbbff8565b93ebfabf4eca7254d4" - ], - "opam": { - "name": "reason", - "version": "3.7.0", - "path": "esy.lock/opam/reason.3.7.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/result@opam:1.5@1c6a6533", - "@opam/ppx_derivers@opam:1.2.1@e2cbad12", - "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/merlin-extend@opam:0.6@88755c91", - "@opam/menhir@opam:20220210@ff87a93b", - "@opam/fix@opam:20220121@17b9a1a4", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/result@opam:1.5@1c6a6533", - "@opam/ppx_derivers@opam:1.2.1@e2cbad12", - "@opam/merlin-extend@opam:0.6@88755c91", - "@opam/menhir@opam:20220210@ff87a93b", - "@opam/fix@opam:20220121@17b9a1a4", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/re@opam:1.10.3@0585c65d": { - "id": "@opam/re@opam:1.10.3@0585c65d", - "name": "@opam/re", - "version": "opam:1.10.3", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/84/846546967f3fe31765935dd40a6460a9424337ecce7b12727fcba49480790ebb#sha256:846546967f3fe31765935dd40a6460a9424337ecce7b12727fcba49480790ebb", - "archive:https://github.com/ocaml/ocaml-re/releases/download/1.10.3/re-1.10.3.tbz#sha256:846546967f3fe31765935dd40a6460a9424337ecce7b12727fcba49480790ebb" - ], - "opam": { - "name": "re", - "version": "1.10.3", - "path": "esy.lock/opam/re.1.10.3" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:2.9.2@f48e8212", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/ppxlib@opam:0.24.0@4c00d6db": { - "id": "@opam/ppxlib@opam:0.24.0@4c00d6db", - "name": "@opam/ppxlib", - "version": "opam:0.24.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/77/7766027c2ecd0f5b3b460e9212a70709c6744278113eb91f317c56c41e7a90c8#sha256:7766027c2ecd0f5b3b460e9212a70709c6744278113eb91f317c56c41e7a90c8", - "archive:https://github.com/ocaml-ppx/ppxlib/releases/download/0.24.0/ppxlib-0.24.0.tbz#sha256:7766027c2ecd0f5b3b460e9212a70709c6744278113eb91f317c56c41e7a90c8" - ], - "opam": { - "name": "ppxlib", - "version": "0.24.0", - "path": "esy.lock/opam/ppxlib.0.24.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "@opam/sexplib0@opam:v0.14.0@155c136c", - "@opam/ppx_derivers@opam:1.2.1@e2cbad12", - "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", - "@opam/dune@opam:2.9.2@f48e8212", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "@opam/sexplib0@opam:v0.14.0@155c136c", - "@opam/ppx_derivers@opam:1.2.1@e2cbad12", - "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", - "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/ppx_derivers@opam:1.2.1@e2cbad12": { - "id": "@opam/ppx_derivers@opam:1.2.1@e2cbad12", - "name": "@opam/ppx_derivers", - "version": "opam:1.2.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/5d/5dc2bf130c1db3c731fe0fffc5648b41#md5:5dc2bf130c1db3c731fe0fffc5648b41", - "archive:https://github.com/ocaml-ppx/ppx_derivers/archive/1.2.1.tar.gz#md5:5dc2bf130c1db3c731fe0fffc5648b41" - ], - "opam": { - "name": "ppx_derivers", - "version": "1.2.1", - "path": "esy.lock/opam/ppx_derivers.1.2.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/ocamlfind@opam:1.8.1@b7dc3072": { - "id": "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "name": "@opam/ocamlfind", - "version": "opam:1.8.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/18/18ca650982c15536616dea0e422cbd8c#md5:18ca650982c15536616dea0e422cbd8c", - "archive:http://download2.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c", - "archive:http://download.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c" - ], - "opam": { - "name": "ocamlfind", - "version": "1.8.1", - "path": "esy.lock/opam/ocamlfind.1.8.1" - } - }, - "overrides": [ - { - "opamoverride": - "esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override" - } - ], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/conf-m4@opam:1@196bf219", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.12.0@d41d8cd9" ] - }, - "@opam/ocamlbuild@opam:0.14.1@ead10f40": { - "id": "@opam/ocamlbuild@opam:0.14.1@ead10f40", - "name": "@opam/ocamlbuild", - "version": "opam:0.14.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/70/7027e507ed85f290923ad198f3d2cd1c#md5:7027e507ed85f290923ad198f3d2cd1c", - "archive:https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.1.tar.gz#md5:7027e507ed85f290923ad198f3d2cd1c" - ], - "opam": { - "name": "ocamlbuild", - "version": "0.14.1", - "path": "esy.lock/opam/ocamlbuild.0.14.1" - } - }, - "overrides": [ - { - "opamoverride": - "esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.1_opam_override" - } - ], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.12.0@d41d8cd9" ] - }, - "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882": { - "id": "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", - "name": "@opam/ocaml-compiler-libs", - "version": "opam:v0.12.4", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/4e/4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760#sha256:4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760", - "archive:https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.4/ocaml-compiler-libs-v0.12.4.tbz#sha256:4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760" - ], - "opam": { - "name": "ocaml-compiler-libs", - "version": "v0.12.4", - "path": "esy.lock/opam/ocaml-compiler-libs.v0.12.4" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/merlin-extend@opam:0.6@88755c91": { - "id": "@opam/merlin-extend@opam:0.6@88755c91", - "name": "@opam/merlin-extend", - "version": "opam:0.6", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/c2/c2f236ae97feb6ba0bc90f33beb7b7343e42f9871b66de9ba07974917e256c43#sha256:c2f236ae97feb6ba0bc90f33beb7b7343e42f9871b66de9ba07974917e256c43", - "archive:https://github.com/let-def/merlin-extend/releases/download/v0.6/merlin-extend-v0.6.tbz#sha256:c2f236ae97feb6ba0bc90f33beb7b7343e42f9871b66de9ba07974917e256c43" - ], - "opam": { - "name": "merlin-extend", - "version": "0.6", - "path": "esy.lock/opam/merlin-extend.0.6" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@opam/cppo@opam:1.6.8@7e48217d", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/merlin@opam:4.4-412@c7695ce2": { - "id": "@opam/merlin@opam:4.4-412@c7695ce2", - "name": "@opam/merlin", - "version": "opam:4.4-412", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/16/16d879496882d44ee0a5392e20b3824240e70f1585b9ae6d936ff5f3a3beb2a3#sha256:16d879496882d44ee0a5392e20b3824240e70f1585b9ae6d936ff5f3a3beb2a3", - "archive:https://github.com/ocaml/merlin/releases/download/v4.4-412/merlin-4.4-412.tbz#sha256:16d879496882d44ee0a5392e20b3824240e70f1585b9ae6d936ff5f3a3beb2a3" - ], - "opam": { - "name": "merlin", - "version": "4.4-412", - "path": "esy.lock/opam/merlin.4.4-412" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/yojson@opam:1.7.0@69d87312", - "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:2.9.2@f48e8212", - "@opam/dot-merlin-reader@opam:4.1@84436e1c", - "@opam/csexp@opam:1.5.1@8a8fb3a7", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/yojson@opam:1.7.0@69d87312", - "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:2.9.2@f48e8212", - "@opam/dot-merlin-reader@opam:4.1@84436e1c", - "@opam/csexp@opam:1.5.1@8a8fb3a7" - ] - }, - "@opam/menhirSdk@opam:20220210@b8921e41": { - "id": "@opam/menhirSdk@opam:20220210@b8921e41", - "name": "@opam/menhirSdk", - "version": "opam:20220210", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/e3/e3cef220f676c4b1c16cbccb174cefe3#md5:e3cef220f676c4b1c16cbccb174cefe3", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz#md5:e3cef220f676c4b1c16cbccb174cefe3" - ], - "opam": { - "name": "menhirSdk", - "version": "20220210", - "path": "esy.lock/opam/menhirSdk.20220210" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/menhirLib@opam:20220210@e6562f4f": { - "id": "@opam/menhirLib@opam:20220210@e6562f4f", - "name": "@opam/menhirLib", - "version": "opam:20220210", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/e3/e3cef220f676c4b1c16cbccb174cefe3#md5:e3cef220f676c4b1c16cbccb174cefe3", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz#md5:e3cef220f676c4b1c16cbccb174cefe3" - ], - "opam": { - "name": "menhirLib", - "version": "20220210", - "path": "esy.lock/opam/menhirLib.20220210" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/menhir@opam:20220210@ff87a93b": { - "id": "@opam/menhir@opam:20220210@ff87a93b", - "name": "@opam/menhir", - "version": "opam:20220210", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/e3/e3cef220f676c4b1c16cbccb174cefe3#md5:e3cef220f676c4b1c16cbccb174cefe3", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz#md5:e3cef220f676c4b1c16cbccb174cefe3" - ], - "opam": { - "name": "menhir", - "version": "20220210", - "path": "esy.lock/opam/menhir.20220210" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/menhirSdk@opam:20220210@b8921e41", - "@opam/menhirLib@opam:20220210@e6562f4f", - "@opam/dune@opam:2.9.2@f48e8212", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/menhirSdk@opam:20220210@b8921e41", - "@opam/menhirLib@opam:20220210@e6562f4f", - "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/fmt@opam:0.9.0@87213963": { - "id": "@opam/fmt@opam:0.9.0@87213963", - "name": "@opam/fmt", - "version": "opam:0.9.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha512/66/66cf4b8bb92232a091dfda5e94d1c178486a358cdc34b1eec516d48ea5acb6209c0dfcb416f0c516c50ddbddb3c94549a45e4a6d5c5fd1c81d3374dec823a83b#sha512:66cf4b8bb92232a091dfda5e94d1c178486a358cdc34b1eec516d48ea5acb6209c0dfcb416f0c516c50ddbddb3c94549a45e4a6d5c5fd1c81d3374dec823a83b", - "archive:https://erratique.ch/software/fmt/releases/fmt-0.9.0.tbz#sha512:66cf4b8bb92232a091dfda5e94d1c178486a358cdc34b1eec516d48ea5acb6209c0dfcb416f0c516c50ddbddb3c94549a45e4a6d5c5fd1c81d3374dec823a83b" - ], - "opam": { - "name": "fmt", - "version": "0.9.0", - "path": "esy.lock/opam/fmt.0.9.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/topkg@opam:1.0.5@0aa59f51", - "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/ocamlbuild@opam:0.14.1@ead10f40", - "@opam/cmdliner@opam:1.1.0@643a0e00", - "@opam/base-unix@opam:base@87d0b2eb", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.12.0@d41d8cd9" ] - }, - "@opam/fix@opam:20220121@17b9a1a4": { - "id": "@opam/fix@opam:20220121@17b9a1a4", - "name": "@opam/fix", - "version": "opam:20220121", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/48/48d8a5bdff23cf7fbf9288877df2b6aa#md5:48d8a5bdff23cf7fbf9288877df2b6aa", - "archive:https://gitlab.inria.fr/fpottier/fix/-/archive/20220121/archive.tar.gz#md5:48d8a5bdff23cf7fbf9288877df2b6aa" - ], - "opam": { - "name": "fix", - "version": "20220121", - "path": "esy.lock/opam/fix.20220121" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/easy-format@opam:1.3.2@1ea9f987": { - "id": "@opam/easy-format@opam:1.3.2@1ea9f987", - "name": "@opam/easy-format", - "version": "opam:1.3.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/34/3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926#sha256:3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926", - "archive:https://github.com/mjambon/easy-format/releases/download/1.3.2/easy-format-1.3.2.tbz#sha256:3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926" - ], - "opam": { - "name": "easy-format", - "version": "1.3.2", - "path": "esy.lock/opam/easy-format.1.3.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/dune@opam:2.9.2@f48e8212": { - "id": "@opam/dune@opam:2.9.2@f48e8212", - "name": "@opam/dune", - "version": "opam:2.9.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/b8/b8e7cc507fb978b45f6fdc839f2b3201d2c1e611e4a8e972c8c8cfd8522e7447#sha256:b8e7cc507fb978b45f6fdc839f2b3201d2c1e611e4a8e972c8c8cfd8522e7447", - "archive:https://github.com/ocaml/dune/releases/download/2.9.2/dune-site-2.9.2.tbz#sha256:b8e7cc507fb978b45f6fdc839f2b3201d2c1e611e4a8e972c8c8cfd8522e7447" - ], - "opam": { - "name": "dune", - "version": "2.9.2", - "path": "esy.lock/opam/dune.2.9.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", - "@opam/base-threads@opam:base@36803084", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", - "@opam/base-threads@opam:base@36803084" - ] - }, - "@opam/dot-merlin-reader@opam:4.1@84436e1c": { - "id": "@opam/dot-merlin-reader@opam:4.1@84436e1c", - "name": "@opam/dot-merlin-reader", - "version": "opam:4.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/14/14a36d6fb8646a5df4530420a7861722f1a4ee04753717947305e3676031e7cd#sha256:14a36d6fb8646a5df4530420a7861722f1a4ee04753717947305e3676031e7cd", - "archive:https://github.com/ocaml/merlin/releases/download/v4.1/dot-merlin-reader-v4.1.tbz#sha256:14a36d6fb8646a5df4530420a7861722f1a4ee04753717947305e3676031e7cd" - ], - "opam": { - "name": "dot-merlin-reader", - "version": "4.1", - "path": "esy.lock/opam/dot-merlin-reader.4.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/yojson@opam:1.7.0@69d87312", - "@opam/result@opam:1.5@1c6a6533", - "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/dune@opam:2.9.2@f48e8212", "@opam/csexp@opam:1.5.1@8a8fb3a7", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/yojson@opam:1.7.0@69d87312", - "@opam/result@opam:1.5@1c6a6533", - "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/dune@opam:2.9.2@f48e8212", "@opam/csexp@opam:1.5.1@8a8fb3a7" - ] - }, - "@opam/csexp@opam:1.5.1@8a8fb3a7": { - "id": "@opam/csexp@opam:1.5.1@8a8fb3a7", - "name": "@opam/csexp", - "version": "opam:1.5.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/d6/d605e4065fa90a58800440ef2f33a2d931398bf2c22061a8acb7df845c0aac02#sha256:d605e4065fa90a58800440ef2f33a2d931398bf2c22061a8acb7df845c0aac02", - "archive:https://github.com/ocaml-dune/csexp/releases/download/1.5.1/csexp-1.5.1.tbz#sha256:d605e4065fa90a58800440ef2f33a2d931398bf2c22061a8acb7df845c0aac02" - ], - "opam": { - "name": "csexp", - "version": "1.5.1", - "path": "esy.lock/opam/csexp.1.5.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/cppo@opam:1.6.8@7e48217d": { - "id": "@opam/cppo@opam:1.6.8@7e48217d", - "name": "@opam/cppo", - "version": "opam:1.6.8", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/fe/fed401197d86f9089e89f6cbdf1d660d#md5:fed401197d86f9089e89f6cbdf1d660d", - "archive:https://github.com/ocaml-community/cppo/archive/v1.6.8.tar.gz#md5:fed401197d86f9089e89f6cbdf1d660d" - ], - "opam": { - "name": "cppo", - "version": "1.6.8", - "path": "esy.lock/opam/cppo.1.6.8" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@opam/base-unix@opam:base@87d0b2eb", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/dune@opam:2.9.2@f48e8212", - "@opam/base-unix@opam:base@87d0b2eb" - ] - }, - "@opam/conf-m4@opam:1@196bf219": { - "id": "@opam/conf-m4@opam:1@196bf219", - "name": "@opam/conf-m4", - "version": "opam:1", - "source": { - "type": "install", - "source": [ "no-source:" ], - "opam": { - "name": "conf-m4", - "version": "1", - "path": "esy.lock/opam/conf-m4.1" - } - }, - "overrides": [ - { - "opamoverride": - "esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override" - } - ], - "dependencies": [ - "esy-m4@github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7@d41d8cd9", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [] - }, - "@opam/cmdliner@opam:1.1.0@643a0e00": { - "id": "@opam/cmdliner@opam:1.1.0@643a0e00", - "name": "@opam/cmdliner", - "version": "opam:1.1.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha512/e2/e2fad706829e7b8b50d1a510b59b87e44294252d8e8bdd9d6cb07f435d7c1c123f82353eedf29e9a4b7768da485516b89b62bf956234e90d7eae1bbaae2c9263#sha512:e2fad706829e7b8b50d1a510b59b87e44294252d8e8bdd9d6cb07f435d7c1c123f82353eedf29e9a4b7768da485516b89b62bf956234e90d7eae1bbaae2c9263", - "archive:https://erratique.ch/software/cmdliner/releases/cmdliner-1.1.0.tbz#sha512:e2fad706829e7b8b50d1a510b59b87e44294252d8e8bdd9d6cb07f435d7c1c123f82353eedf29e9a4b7768da485516b89b62bf956234e90d7eae1bbaae2c9263" - ], - "opam": { - "name": "cmdliner", - "version": "1.1.0", - "path": "esy.lock/opam/cmdliner.1.1.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.12.0@d41d8cd9" ] - }, - "@opam/biniou@opam:1.2.1@420bda02": { - "id": "@opam/biniou@opam:1.2.1@420bda02", - "name": "@opam/biniou", - "version": "opam:1.2.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/35/35546c68b1929a8e6d27a3b39ecd17b38303a0d47e65eb9d1480c2061ea84335#sha256:35546c68b1929a8e6d27a3b39ecd17b38303a0d47e65eb9d1480c2061ea84335", - "archive:https://github.com/mjambon/biniou/releases/download/1.2.1/biniou-1.2.1.tbz#sha256:35546c68b1929a8e6d27a3b39ecd17b38303a0d47e65eb9d1480c2061ea84335" - ], - "opam": { - "name": "biniou", - "version": "1.2.1", - "path": "esy.lock/opam/biniou.1.2.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/easy-format@opam:1.3.2@1ea9f987", - "@opam/dune@opam:2.9.2@f48e8212", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/easy-format@opam:1.3.2@1ea9f987", - "@opam/dune@opam:2.9.2@f48e8212" - ] - }, - "@opam/base-unix@opam:base@87d0b2eb": { - "id": "@opam/base-unix@opam:base@87d0b2eb", - "name": "@opam/base-unix", - "version": "opam:base", - "source": { - "type": "install", - "source": [ "no-source:" ], - "opam": { - "name": "base-unix", - "version": "base", - "path": "esy.lock/opam/base-unix.base" - } - }, - "overrides": [], - "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [] - }, - "@opam/base-threads@opam:base@36803084": { - "id": "@opam/base-threads@opam:base@36803084", - "name": "@opam/base-threads", - "version": "opam:base", - "source": { - "type": "install", - "source": [ "no-source:" ], - "opam": { - "name": "base-threads", - "version": "base", - "path": "esy.lock/opam/base-threads.base" - } - }, - "overrides": [], - "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [] - }, - "@opam/astring@opam:0.8.5@1300cee8": { - "id": "@opam/astring@opam:0.8.5@1300cee8", - "name": "@opam/astring", - "version": "opam:0.8.5", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/e1/e148907c24157d1df43bec89b58b3ec8#md5:e148907c24157d1df43bec89b58b3ec8", - "archive:https://erratique.ch/software/astring/releases/astring-0.8.5.tbz#md5:e148907c24157d1df43bec89b58b3ec8" - ], - "opam": { - "name": "astring", - "version": "0.8.5", - "path": "esy.lock/opam/astring.0.8.5" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/topkg@opam:1.0.5@0aa59f51", - "@opam/ocamlfind@opam:1.8.1@b7dc3072", - "@opam/ocamlbuild@opam:0.14.1@ead10f40", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.12.0@d41d8cd9" ] - }, - "@opam/alcotest@opam:1.4.0@f5f94b2a": { - "id": "@opam/alcotest@opam:1.4.0@f5f94b2a", - "name": "@opam/alcotest", - "version": "opam:1.4.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/b1/b1aaccfb2d651c902592c04953e2619169c91f797cf4f04a7dda2cab09b93ec1#sha256:b1aaccfb2d651c902592c04953e2619169c91f797cf4f04a7dda2cab09b93ec1", - "archive:https://github.com/mirage/alcotest/releases/download/1.4.0/alcotest-mirage-1.4.0.tbz#sha256:b1aaccfb2d651c902592c04953e2619169c91f797cf4f04a7dda2cab09b93ec1" - ], - "opam": { - "name": "alcotest", - "version": "1.4.0", - "path": "esy.lock/opam/alcotest.1.4.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", - "@opam/uuidm@opam:0.9.8@f287a426", - "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "@opam/re@opam:1.10.3@0585c65d", "@opam/fmt@opam:0.9.0@87213963", - "@opam/dune@opam:2.9.2@f48e8212", - "@opam/cmdliner@opam:1.1.0@643a0e00", - "@opam/astring@opam:0.8.5@1300cee8", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.12.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", - "@opam/uuidm@opam:0.9.8@f287a426", - "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "@opam/re@opam:1.10.3@0585c65d", "@opam/fmt@opam:0.9.0@87213963", - "@opam/dune@opam:2.9.2@f48e8212", - "@opam/cmdliner@opam:1.1.0@643a0e00", - "@opam/astring@opam:0.8.5@1300cee8" - ] - }, - "@esy-ocaml/substs@0.0.1@d41d8cd9": { - "id": "@esy-ocaml/substs@0.0.1@d41d8cd9", - "name": "@esy-ocaml/substs", - "version": "0.0.1", - "source": { - "type": "install", - "source": [ - "archive:https://registry.npmjs.org/@esy-ocaml/substs/-/substs-0.0.1.tgz#sha1:59ebdbbaedcda123fc7ed8fb2b302b7d819e9a46" - ] - }, - "overrides": [], - "dependencies": [], - "devDependencies": [] - } - } -} \ No newline at end of file diff --git a/esy.lock/opam/alcotest.1.4.0/opam b/esy.lock/opam/alcotest.1.4.0/opam deleted file mode 100644 index 918ce132..00000000 --- a/esy.lock/opam/alcotest.1.4.0/opam +++ /dev/null @@ -1,55 +0,0 @@ -opam-version: "2.0" -synopsis: "Alcotest is a lightweight and colourful test framework" -description: """ -Alcotest exposes simple interface to perform unit tests. It exposes -a simple TESTABLE module type, a check function to assert test -predicates and a run function to perform a list of unit -> unit -test callbacks. - -Alcotest provides a quiet and colorful output where only faulty runs -are fully displayed at the end of the run (with the full logs ready to -inspect), with a simple (yet expressive) query language to select the -tests to run. -""" -maintainer: ["thomas@gazagnaire.org"] -authors: ["Thomas Gazagnaire"] -license: "ISC" -homepage: "https://github.com/mirage/alcotest" -doc: "https://mirage.github.io/alcotest" -bug-reports: "https://github.com/mirage/alcotest/issues" -depends: [ - "dune" {>= "2.2"} - "ocaml" {>= "4.03.0"} - "fmt" {>= "0.8.7"} - "astring" - "cmdliner" {>= "1.0.3"} # required because of (implicit_transitive_deps false) and cmdliner < 1.0.3 uses result - "cmdliner" {with-test & < "1.1.0"} - "uuidm" - "re" {>= "1.7.2"} - "stdlib-shims" - "uutf" {>= "1.0.0"} -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/mirage/alcotest.git" -x-commit-hash: "93940ea6da1d4ce8718ddd6c528eeb6d991b29ff" -url { - src: - "https://github.com/mirage/alcotest/releases/download/1.4.0/alcotest-mirage-1.4.0.tbz" - checksum: [ - "sha256=b1aaccfb2d651c902592c04953e2619169c91f797cf4f04a7dda2cab09b93ec1" - "sha512=8a13d5d4c8c77f115903e6b8e58160c6e6ec27870440bd38a674e9406f57f1eff299e65f006fd77728015d1a8f0ae30a714fe47e035824950a71ebfdff2cf3c9" - ] -} diff --git a/esy.lock/opam/astring.0.8.5/opam b/esy.lock/opam/astring.0.8.5/opam deleted file mode 100644 index 338a06a3..00000000 --- a/esy.lock/opam/astring.0.8.5/opam +++ /dev/null @@ -1,37 +0,0 @@ -opam-version: "2.0" -maintainer: "Daniel Bünzli " -authors: ["The astring programmers"] -homepage: "https://erratique.ch/software/astring" -doc: "https://erratique.ch/software/astring/doc" -dev-repo: "git+http://erratique.ch/repos/astring.git" -bug-reports: "https://github.com/dbuenzli/astring/issues" -tags: [ "string" "org:erratique" ] -license: "ISC" -depends: [ - "ocaml" {>= "4.05.0"} - "ocamlfind" {build} - "ocamlbuild" {build} - "topkg" {build} ] -build: [[ "ocaml" "pkg/pkg.ml" "build" "--pinned" "%{pinned}%" ]] - -synopsis: """Alternative String module for OCaml""" -description: """\ - -Astring exposes an alternative `String` module for OCaml. This module -tries to balance minimality and expressiveness for basic, index-free, -string processing and provides types and functions for substrings, -string sets and string maps. - -Remaining compatible with the OCaml `String` module is a non-goal. The -`String` module exposed by Astring has exception safe functions, -removes deprecated and rarely used functions, alters some signatures -and names, adds a few missing functions and fully exploits OCaml's -newfound string immutability. - -Astring depends only on the OCaml standard library. It is distributed -under the ISC license. -""" -url { -archive: "https://erratique.ch/software/astring/releases/astring-0.8.5.tbz" -checksum: "e148907c24157d1df43bec89b58b3ec8" -} diff --git a/esy.lock/opam/base-threads.base/opam b/esy.lock/opam/base-threads.base/opam deleted file mode 100644 index 914ff50c..00000000 --- a/esy.lock/opam/base-threads.base/opam +++ /dev/null @@ -1,6 +0,0 @@ -opam-version: "2.0" -maintainer: "https://github.com/ocaml/opam-repository/issues" -description: """ -Threads library distributed with the OCaml compiler -""" - diff --git a/esy.lock/opam/base-unix.base/opam b/esy.lock/opam/base-unix.base/opam deleted file mode 100644 index b973540b..00000000 --- a/esy.lock/opam/base-unix.base/opam +++ /dev/null @@ -1,6 +0,0 @@ -opam-version: "2.0" -maintainer: "https://github.com/ocaml/opam-repository/issues" -description: """ -Unix library distributed with the OCaml compiler -""" - diff --git a/esy.lock/opam/biniou.1.2.1/opam b/esy.lock/opam/biniou.1.2.1/opam deleted file mode 100644 index ec7028f2..00000000 --- a/esy.lock/opam/biniou.1.2.1/opam +++ /dev/null @@ -1,45 +0,0 @@ -opam-version: "2.0" -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} - ["dune" "build" "-p" name "@doc"] {with-doc} -] -maintainer: ["martin@mjambon.com"] -authors: ["Martin Jambon"] -bug-reports: "https://github.com/mjambon/biniou/issues" -homepage: "https://github.com/mjambon/biniou" -doc: "https://mjambon.github.io/biniou/" -license: "BSD-3-Clause" -dev-repo: "git+https://github.com/mjambon/biniou.git" -synopsis: - "Binary data format designed for speed, safety, ease of use and backward compatibility as protocols evolve" -description: """ - -Biniou (pronounced "be new") is a binary data format designed for speed, safety, -ease of use and backward compatibility as protocols evolve. Biniou is vastly -equivalent to JSON in terms of functionality but allows implementations several -times faster (4 times faster than yojson), with 25-35% space savings. - -Biniou data can be decoded into human-readable form without knowledge of type -definitions except for field and variant names which are represented by 31-bit -hashes. A program named bdump is provided for routine visualization of biniou -data files. - -The program atdgen is used to derive OCaml-Biniou serializers and deserializers -from type definitions. - -Biniou format specification: mjambon.github.io/atdgen-doc/biniou-format.txt""" -depends: [ - "easy-format" - "dune" {>= "1.10"} - "ocaml" {>= "4.02.3"} -] -url { - src: - "https://github.com/mjambon/biniou/releases/download/1.2.1/biniou-1.2.1.tbz" - checksum: [ - "sha256=35546c68b1929a8e6d27a3b39ecd17b38303a0d47e65eb9d1480c2061ea84335" - "sha512=82670cc77bf3e869ee26e5fbe5a5affa45a22bc8b6c4bd7e85473912780e0111baca59b34a2c14feae3543ce6e239d7fddaeab24b686a65bfe642cdb91d27ebf" - ] -} diff --git a/esy.lock/opam/cmdliner.1.1.0/opam b/esy.lock/opam/cmdliner.1.1.0/opam deleted file mode 100644 index f8fd5923..00000000 --- a/esy.lock/opam/cmdliner.1.1.0/opam +++ /dev/null @@ -1,33 +0,0 @@ -opam-version: "2.0" -synopsis: """Declarative definition of command line interfaces for OCaml""" -maintainer: ["Daniel Bünzli "] -authors: ["The cmdliner programmers"] -homepage: "https://erratique.ch/software/cmdliner" -doc: "https://erratique.ch/software/cmdliner/doc" -dev-repo: "git+https://erratique.ch/repos/cmdliner.git" -bug-reports: "https://github.com/dbuenzli/cmdliner/issues" -license: ["ISC"] -tags: ["cli" "system" "declarative" "org:erratique"] -depends: ["ocaml" {>= "4.08.0"}] -build: [[ make "all" "PREFIX=%{prefix}%" ]] -install: [[make "install" "LIBDIR=%{_:lib}%" "DOCDIR=%{_:doc}%"] - [make "install-doc" "LIBDIR=%{_:lib}%" "DOCDIR=%{_:doc}%"]] -url { - src: "https://erratique.ch/software/cmdliner/releases/cmdliner-1.1.0.tbz" - checksum: "sha512=e2fad706829e7b8b50d1a510b59b87e44294252d8e8bdd9d6cb07f435d7c1c123f82353eedf29e9a4b7768da485516b89b62bf956234e90d7eae1bbaae2c9263"} -description: """ -Cmdliner allows the declarative definition of command line interfaces -for OCaml. - -It provides a simple and compositional mechanism to convert command -line arguments to OCaml values and pass them to your functions. The -module automatically handles syntax errors, help messages and UNIX man -page generation. It supports programs with single or multiple commands -and respects most of the [POSIX][1] and [GNU][2] conventions. - -Cmdliner has no dependencies and is distributed under the ISC license. - -[1]: http://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html -[2]: http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html - -Home page: http://erratique.ch/software/cmdliner""" \ No newline at end of file diff --git a/esy.lock/opam/conf-m4.1/opam b/esy.lock/opam/conf-m4.1/opam deleted file mode 100644 index c6feb2a7..00000000 --- a/esy.lock/opam/conf-m4.1/opam +++ /dev/null @@ -1,22 +0,0 @@ -opam-version: "2.0" -maintainer: "tim@gfxmonk.net" -homepage: "http://www.gnu.org/software/m4/m4.html" -bug-reports: "https://github.com/ocaml/opam-repository/issues" -authors: "GNU Project" -license: "GPL-3.0-only" -build: [["sh" "-exc" "echo | m4"]] -depexts: [ - ["m4"] {os-family = "debian"} - ["m4"] {os-distribution = "fedora"} - ["m4"] {os-distribution = "rhel"} - ["m4"] {os-distribution = "centos"} - ["m4"] {os-distribution = "alpine"} - ["m4"] {os-distribution = "nixos"} - ["m4"] {os-family = "suse"} - ["m4"] {os-distribution = "ol"} - ["m4"] {os-distribution = "arch"} -] -synopsis: "Virtual package relying on m4" -description: - "This package can only install if the m4 binary is installed on the system." -flags: conf diff --git a/esy.lock/opam/cppo.1.6.8/opam b/esy.lock/opam/cppo.1.6.8/opam deleted file mode 100644 index c9d7f68f..00000000 --- a/esy.lock/opam/cppo.1.6.8/opam +++ /dev/null @@ -1,37 +0,0 @@ -opam-version: "2.0" -maintainer: "martin@mjambon.com" -authors: "Martin Jambon" -license: "BSD-3-Clause" -homepage: "https://github.com/ocaml-community/cppo" -doc: "https://ocaml-community.github.io/cppo/" -bug-reports: "https://github.com/ocaml-community/cppo/issues" -depends: [ - "ocaml" {>= "4.02.3"} - "dune" {>= "1.0"} - "base-unix" -] -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -dev-repo: "git+https://github.com/ocaml-community/cppo.git" -synopsis: "Code preprocessor like cpp for OCaml" -description: """ -Cppo is an equivalent of the C preprocessor for OCaml programs. -It allows the definition of simple macros and file inclusion. - -Cppo is: - -* more OCaml-friendly than cpp -* easy to learn without consulting a manual -* reasonably fast -* simple to install and to maintain -""" -url { - src: "https://github.com/ocaml-community/cppo/archive/v1.6.8.tar.gz" - checksum: [ - "md5=fed401197d86f9089e89f6cbdf1d660d" - "sha512=069bbe0ef09c03b0dc4b5795f909c3ef872fe99c6f1e6704a0fa97594b1570b3579226ec67fe11d696ccc349a4585055bbaf07c65eff423aa45af28abf38c858" - ] -} diff --git a/esy.lock/opam/csexp.1.5.1/opam b/esy.lock/opam/csexp.1.5.1/opam deleted file mode 100644 index 59324f9e..00000000 --- a/esy.lock/opam/csexp.1.5.1/opam +++ /dev/null @@ -1,60 +0,0 @@ -opam-version: "2.0" -synopsis: "Parsing and printing of S-expressions in Canonical form" -description: """ - -This library provides minimal support for Canonical S-expressions -[1]. Canonical S-expressions are a binary encoding of S-expressions -that is super simple and well suited for communication between -programs. - -This library only provides a few helpers for simple applications. If -you need more advanced support, such as parsing from more fancy input -sources, you should consider copying the code of this library given -how simple parsing S-expressions in canonical form is. - -To avoid a dependency on a particular S-expression library, the only -module of this library is parameterised by the type of S-expressions. - -[1] https://en.wikipedia.org/wiki/Canonical_S-expressions -""" -maintainer: ["Jeremie Dimino "] -authors: [ - "Quentin Hocquet " - "Jane Street Group, LLC" - "Jeremie Dimino " -] -license: "MIT" -homepage: "https://github.com/ocaml-dune/csexp" -doc: "https://ocaml-dune.github.io/csexp/" -bug-reports: "https://github.com/ocaml-dune/csexp/issues" -depends: [ - "dune" {>= "1.11"} - "ocaml" {>= "4.03.0"} -# "ppx_expect" {with-test & >= "v0.14"} - "odoc" {with-doc} -] -dev-repo: "git+https://github.com/ocaml-dune/csexp.git" -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" -# Tests disabled because of a cyclic dependency with csexp, dune-configurator and ppx_expect -# "@runtest" {with-test} - "@doc" {with-doc} - ] -] -x-commit-hash: "7eeb86206819d2b1782d6cde1be9d6cf8b5fc851" -url { - src: - "https://github.com/ocaml-dune/csexp/releases/download/1.5.1/csexp-1.5.1.tbz" - checksum: [ - "sha256=d605e4065fa90a58800440ef2f33a2d931398bf2c22061a8acb7df845c0aac02" - "sha512=d785bbabaff9f6bf601399149ef0a42e5e99647b54e27f97ef1625907793dda22a45bf83e0e8a1eba2c63634c5484b54739ff0904ef556f5fc592efa38af7505" - ] -} diff --git a/esy.lock/opam/dot-merlin-reader.4.1/opam b/esy.lock/opam/dot-merlin-reader.4.1/opam deleted file mode 100644 index f860cab4..00000000 --- a/esy.lock/opam/dot-merlin-reader.4.1/opam +++ /dev/null @@ -1,30 +0,0 @@ -opam-version: "2.0" -maintainer: "defree@gmail.com" -authors: "The Merlin team" -synopsis: "Reads config files for merlin" -homepage: "https://github.com/ocaml/merlin" -bug-reports: "https://github.com/ocaml/merlin/issues" -dev-repo: "git+https://github.com/ocaml/merlin.git" -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.06.1" } - "dune" {>= "2.7.0"} - "yojson" {>= "1.6.0"} - "ocamlfind" {>= "1.6.0"} - "csexp" {>= "1.2.3"} - "result" {>= "1.5"} -] -description: - "Helper process: reads .merlin files and gives the normalized content to merlin" -x-commit-hash: "ab02f60994c81166820791b5f465f467d752b8dc" -url { - src: - "https://github.com/ocaml/merlin/releases/download/v4.1/dot-merlin-reader-v4.1.tbz" - checksum: [ - "sha256=14a36d6fb8646a5df4530420a7861722f1a4ee04753717947305e3676031e7cd" - "sha512=65fd4ab08904c05651a7ef8971802ffaa428daa920765dbcf162e3c56e8047e4c9e4356daa45efccce7c73a586635c8f6cf8118fd3059789de9aff68579bd436" - ] -} diff --git a/esy.lock/opam/dune.2.9.2/opam b/esy.lock/opam/dune.2.9.2/opam deleted file mode 100644 index a775c562..00000000 --- a/esy.lock/opam/dune.2.9.2/opam +++ /dev/null @@ -1,59 +0,0 @@ -opam-version: "2.0" -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, 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 -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. -""" -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" -conflicts: [ - "merlin" {< "3.4.0"} - "ocaml-lsp-server" {< "1.3.0"} - "dune-configurator" {< "2.3.0"} - "odoc" {< "1.3.0"} - "dune-release" {< "1.3.0"} - "js_of_ocaml-compiler" {< "3.6.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" "-j" jobs] - ["./dune.exe" "build" "-p" name "--profile" "dune-bootstrap" "-j" jobs] -] -depends: [ - # Please keep the lower bound in sync with .github/workflows/workflow.yml, - # dune-project and min_ocaml_version in bootstrap.ml - ("ocaml" {>= "4.08"} | ("ocaml" {>= "4.03" & < "4.08~~"} & "ocamlfind-secondary")) - "base-unix" - "base-threads" -] -url { - src: - "https://github.com/ocaml/dune/releases/download/2.9.2/dune-site-2.9.2.tbz" - checksum: [ - "sha256=b8e7cc507fb978b45f6fdc839f2b3201d2c1e611e4a8e972c8c8cfd8522e7447" - "sha512=e45986afdce4a1a19671206bf9818463b398ee2658ca7203a00546b9b1079cde018bc435b4846c82281960fa3ca1cdca8aab670b15a1b7cac6cafac369de7b67" - ] -} -x-commit-hash: "ee27573858f9ff7fe8e0b8bb1d785be8cabd3b23" diff --git a/esy.lock/opam/easy-format.1.3.2/opam b/esy.lock/opam/easy-format.1.3.2/opam deleted file mode 100644 index f55c2c8d..00000000 --- a/esy.lock/opam/easy-format.1.3.2/opam +++ /dev/null @@ -1,46 +0,0 @@ -opam-version: "2.0" -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} - ["dune" "build" "-p" name "@doc"] {with-doc} -] -maintainer: ["martin@mjambon.com" "rudi.grinberg@gmail.com"] -authors: ["Martin Jambon"] -bug-reports: "https://github.com/mjambon/easy-format/issues" -homepage: "https://github.com/mjambon/easy-format" -doc: "https://mjambon.github.io/easy-format/" -license: "BSD-3-Clause" -dev-repo: "git+https://github.com/mjambon/easy-format.git" -synopsis: - "High-level and functional interface to the Format module of the OCaml standard library" -description: """ - -This module offers a high-level and functional interface to the Format module of -the OCaml standard library. It is a pretty-printing facility, i.e. it takes as -input some code represented as a tree and formats this code into the most -visually satisfying result, breaking and indenting lines of code where -appropriate. - -Input data must be first modelled and converted into a tree using 3 kinds of -nodes: - -* atoms -* lists -* labelled nodes - -Atoms represent any text that is guaranteed to be printed as-is. Lists can model -any sequence of items such as arrays of data or lists of definitions that are -labelled with something like "int main", "let x =" or "x:".""" -depends: [ - "dune" {>= "1.10"} - "ocaml" {>= "4.02.3"} -] -url { - src: - "https://github.com/mjambon/easy-format/releases/download/1.3.2/easy-format-1.3.2.tbz" - checksum: [ - "sha256=3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926" - "sha512=e39377a2ff020ceb9ac29e8515a89d9bdbc91dfcfa871c4e3baafa56753fac2896768e5d9822a050dc1e2ade43c8967afb69391a386c0a8ecd4e1f774e236135" - ] -} diff --git a/esy.lock/opam/fix.20220121/opam b/esy.lock/opam/fix.20220121/opam deleted file mode 100644 index 877b44e6..00000000 --- a/esy.lock/opam/fix.20220121/opam +++ /dev/null @@ -1,26 +0,0 @@ - -opam-version: "2.0" -maintainer: "francois.pottier@inria.fr" -authors: [ - "François Pottier " -] -homepage: "https://gitlab.inria.fr/fpottier/fix" -dev-repo: "git+https://gitlab.inria.fr/fpottier/fix.git" -bug-reports: "francois.pottier@inria.fr" -license: "LGPL-2.0-only" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" { >= "4.03" } - "dune" { >= "1.3" } -] -synopsis: "Algorithmic building blocks for memoization, recursion, and more" -url { - src: - "https://gitlab.inria.fr/fpottier/fix/-/archive/20220121/archive.tar.gz" - checksum: [ - "md5=48d8a5bdff23cf7fbf9288877df2b6aa" - "sha512=a851d8783c0c519c6e55359a5c471af433058872409c29a1a7bdfd0076813341ad2c0ebd1ce9e28bff4d4c729dfbc808c41c084fe12a42b45a2b5e391e77ccd2" - ] -} diff --git a/esy.lock/opam/fmt.0.9.0/opam b/esy.lock/opam/fmt.0.9.0/opam deleted file mode 100644 index 6424cf8a..00000000 --- a/esy.lock/opam/fmt.0.9.0/opam +++ /dev/null @@ -1,36 +0,0 @@ -opam-version: "2.0" -synopsis: """OCaml Format pretty-printer combinators""" -maintainer: ["Daniel Bünzli "] -authors: ["The fmt programmers"] -homepage: "https://erratique.ch/software/fmt" -doc: "https://erratique.ch/software/fmt/doc/" -dev-repo: "git+https://erratique.ch/repos/fmt.git" -bug-reports: "https://github.com/dbuenzli/fmt/issues" -license: ["ISC"] -tags: ["string" "format" "pretty-print" "org:erratique"] -depends: ["ocaml" {>= "4.08.0"} - "ocamlfind" {build} - "ocamlbuild" {build} - "topkg" {build & >= "1.0.3"}] -depopts: ["base-unix" - "cmdliner"] -conflicts: ["cmdliner" {< "0.9.8"}] -build: [["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%" - "--with-base-unix" "%{base-unix:installed}%" - "--with-cmdliner" "%{cmdliner:installed}%"]] -url { - src: "https://erratique.ch/software/fmt/releases/fmt-0.9.0.tbz" - checksum: "sha512=66cf4b8bb92232a091dfda5e94d1c178486a358cdc34b1eec516d48ea5acb6209c0dfcb416f0c516c50ddbddb3c94549a45e4a6d5c5fd1c81d3374dec823a83b"} -description: """ -Fmt exposes combinators to devise `Format` pretty-printing functions. - -Fmt depends only on the OCaml standard library. The optional `Fmt_tty` -library that allows to setup formatters for terminal color output -depends on the Unix library. The optional `Fmt_cli` library that -provides command line support for Fmt depends on [`Cmdliner`][cmdliner]. - -Fmt is distributed under the ISC license. - -[cmdliner]: http://erratique.ch/software/cmdliner - -Home page: http://erratique.ch/software/fmt""" \ No newline at end of file diff --git a/esy.lock/opam/menhir.20220210/opam b/esy.lock/opam/menhir.20220210/opam deleted file mode 100644 index 3cd79886..00000000 --- a/esy.lock/opam/menhir.20220210/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: "https://gitlab.inria.fr/fpottier/menhir/-/issues" -license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.03.0"} - "dune" {>= "2.8.0"} - "menhirLib" {= version} - "menhirSdk" {= version} -] -synopsis: "An LR(1) parser generator" -url { - src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz" - checksum: [ - "md5=e3cef220f676c4b1c16cbccb174cefe3" - "sha512=3063fec1d8b9fe092c8461b0689d426c7fe381a2bf3fd258dc42ceecca1719d32efbb8a18d94ada5555c38175ea352da3adbb239fdbcbcf52c3a5c85a4d9586f" - ] -} diff --git a/esy.lock/opam/menhirLib.20220210/opam b/esy.lock/opam/menhirLib.20220210/opam deleted file mode 100644 index 895b5427..00000000 --- a/esy.lock/opam/menhirLib.20220210/opam +++ /dev/null @@ -1,30 +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: "https://gitlab.inria.fr/fpottier/menhir/-/issues" -license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" { >= "4.03.0" } - "dune" { >= "2.8.0" } -] -conflicts: [ - "menhir" { != version } -] -synopsis: "Runtime support library for parsers generated by Menhir" -url { - src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz" - checksum: [ - "md5=e3cef220f676c4b1c16cbccb174cefe3" - "sha512=3063fec1d8b9fe092c8461b0689d426c7fe381a2bf3fd258dc42ceecca1719d32efbb8a18d94ada5555c38175ea352da3adbb239fdbcbcf52c3a5c85a4d9586f" - ] -} diff --git a/esy.lock/opam/menhirSdk.20220210/opam b/esy.lock/opam/menhirSdk.20220210/opam deleted file mode 100644 index d95c170d..00000000 --- a/esy.lock/opam/menhirSdk.20220210/opam +++ /dev/null @@ -1,30 +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: "https://gitlab.inria.fr/fpottier/menhir/-/issues" -license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" { >= "4.03.0" } - "dune" { >= "2.8.0" } -] -conflicts: [ - "menhir" { != version } -] -synopsis: "Compile-time library for auxiliary tools related to Menhir" -url { - src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz" - checksum: [ - "md5=e3cef220f676c4b1c16cbccb174cefe3" - "sha512=3063fec1d8b9fe092c8461b0689d426c7fe381a2bf3fd258dc42ceecca1719d32efbb8a18d94ada5555c38175ea352da3adbb239fdbcbcf52c3a5c85a4d9586f" - ] -} diff --git a/esy.lock/opam/merlin-extend.0.6/opam b/esy.lock/opam/merlin-extend.0.6/opam deleted file mode 100644 index 8394e1ac..00000000 --- a/esy.lock/opam/merlin-extend.0.6/opam +++ /dev/null @@ -1,30 +0,0 @@ -opam-version: "2.0" -maintainer: "Frederic Bour " -authors: "Frederic Bour " -homepage: "https://github.com/let-def/merlin-extend" -bug-reports: "https://github.com/let-def/merlin-extend" -license: "MIT" -dev-repo: "git+https://github.com/let-def/merlin-extend.git" -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "dune" {>= "1.0"} - "cppo" {build & >= "1.1.0"} - "ocaml" {>= "4.02.3"} -] -synopsis: "A protocol to provide custom frontend to Merlin" -description: """ -This protocol allows to replace the OCaml frontend of Merlin. -It extends what used to be done with the `-pp' flag to handle a few more cases.""" -doc: "https://let-def.github.io/merlin-extend" -x-commit-hash: "640620568a5f5c7798239ecf7c707c813e3df3cf" -url { - src: - "https://github.com/let-def/merlin-extend/releases/download/v0.6/merlin-extend-v0.6.tbz" - checksum: [ - "sha256=c2f236ae97feb6ba0bc90f33beb7b7343e42f9871b66de9ba07974917e256c43" - "sha512=4c64a490e2ece04fc89aef679c1d9202175df4fe045b5fdc7a37cd7cebe861226fddd9648c1bf4f06175ecfcd2ed7686c96bd6a8cae003a5096f6134c240f857" - ] -} diff --git a/esy.lock/opam/merlin.4.4-412/opam b/esy.lock/opam/merlin.4.4-412/opam deleted file mode 100644 index e8d65e15..00000000 --- a/esy.lock/opam/merlin.4.4-412/opam +++ /dev/null @@ -1,77 +0,0 @@ -opam-version: "2.0" -maintainer: "defree@gmail.com" -authors: "The Merlin team" -homepage: "https://github.com/ocaml/merlin" -bug-reports: "https://github.com/ocaml/merlin/issues" -dev-repo: "git+https://github.com/ocaml/merlin.git" -license: "MIT" -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" "merlin,dot-merlin-reader" "-j" "1"] {with-test} -] -depends: [ - "ocaml" {>= "4.12" & < "4.13"} - "dune" {>= "2.9.0"} - "dot-merlin-reader" {>= "4.0"} - "yojson" {>= "1.6.0"} - "conf-jq" {with-test} - "csexp" {>= "1.2.3"} - "result" {>= "1.5"} - "menhir" {dev} - "menhirLib" {dev} - "menhirSdk" {dev} -] -synopsis: - "Editor helper, provides completion, typing and source browsing in Vim and Emacs" -description: - "Merlin is an assistant for editing OCaml code. It aims to provide the features available in modern IDEs: error reporting, auto completion, source browsing and much more." -post-messages: [ - "merlin installed. - -Quick setup for VIM -------------------- -Append this to your .vimrc to add merlin to vim's runtime-path: - let g:opamshare = substitute(system('opam var share'),'\\n$','','''') - execute \"set rtp+=\" . g:opamshare . \"/merlin/vim\" - -Also run the following line in vim to index the documentation: - :execute \"helptags \" . g:opamshare . \"/merlin/vim/doc\" - -Quick setup for EMACS -------------------- -Add opam emacs directory to your load-path by appending this to your .emacs: - (let ((opam-share (ignore-errors (car (process-lines \"opam\" \"var\" \"share\"))))) - (when (and opam-share (file-directory-p opam-share)) - ;; Register Merlin - (add-to-list 'load-path (expand-file-name \"emacs/site-lisp\" opam-share)) - (autoload 'merlin-mode \"merlin\" nil t nil) - ;; Automatically start it in OCaml buffers - (add-hook 'tuareg-mode-hook 'merlin-mode t) - (add-hook 'caml-mode-hook 'merlin-mode t) - ;; Use opam switch to lookup ocamlmerlin binary - (setq merlin-command 'opam))) - -Take a look at https://github.com/ocaml/merlin for more information - -Quick setup with opam-user-setup --------------------------------- - -Opam-user-setup support Merlin. - - $ opam user-setup install - -should take care of basic setup. -See https://github.com/OCamlPro/opam-user-setup -" - {success & !user-setup:installed} -] -url { - src: - "https://github.com/ocaml/merlin/releases/download/v4.4-412/merlin-4.4-412.tbz" - checksum: [ - "sha256=16d879496882d44ee0a5392e20b3824240e70f1585b9ae6d936ff5f3a3beb2a3" - "sha512=f51b2875b75215d0be378de86b9dca0957b5e62241ce625a46c6341c219582510d37af94dedf67e1d3db61ebacfef8fa764e4719fac16c0b4b99bb85d0b991d4" - ] -} -x-commit-hash: "5497c563b06f868d72d4f74bd8026c1c1aeb6595" diff --git a/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam b/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam deleted file mode 100644 index 14c9f753..00000000 --- a/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam +++ /dev/null @@ -1,39 +0,0 @@ -opam-version: "2.0" -synopsis: "OCaml compiler libraries repackaged" -description: """ -This packages exposes the OCaml compiler libraries repackages under -the toplevel names Ocaml_common, Ocaml_bytecomp, Ocaml_optcomp, ...""" -maintainer: ["Jane Street developers"] -authors: ["Jane Street Group, LLC"] -license: "MIT" -homepage: "https://github.com/janestreet/ocaml-compiler-libs" -bug-reports: "https://github.com/janestreet/ocaml-compiler-libs/issues" -depends: [ - "dune" {>= "2.8"} - "ocaml" {>= "4.04.1"} - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/janestreet/ocaml-compiler-libs.git" -url { - src: - "https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.4/ocaml-compiler-libs-v0.12.4.tbz" - checksum: [ - "sha256=4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760" - "sha512=978dba8dfa61f98fa24fda7a9c26c2e837081f37d1685fe636dc19cfc3278a940cf01a10293504b185c406706bc1008bc54313d50f023bcdea6d5ac6c0788b35" - ] -} -x-commit-hash: "8cd12f18bb7171c2b67d661868c4271fae528d93" diff --git a/esy.lock/opam/ocamlbuild.0.14.1/opam b/esy.lock/opam/ocamlbuild.0.14.1/opam deleted file mode 100644 index d7413780..00000000 --- a/esy.lock/opam/ocamlbuild.0.14.1/opam +++ /dev/null @@ -1,39 +0,0 @@ -opam-version: "2.0" -synopsis: - "OCamlbuild is a build system with builtin rules to easily build most OCaml projects" -maintainer: "Gabriel Scherer " -authors: ["Nicolas Pouillard" "Berke Durak"] -license: "LGPL-2.0-or-later WITH OCaml-LGPL-linking-exception" -homepage: "https://github.com/ocaml/ocamlbuild/" -doc: "https://github.com/ocaml/ocamlbuild/blob/master/manual/manual.adoc" -bug-reports: "https://github.com/ocaml/ocamlbuild/issues" -depends: [ - "ocaml" {>= "4.03"} -] -conflicts: [ - "base-ocamlbuild" - "ocamlfind" {< "1.6.2"} -] -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"] -] -dev-repo: "git+https://github.com/ocaml/ocamlbuild.git" -url { - src: "https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.1.tar.gz" - checksum: [ - "md5=7027e507ed85f290923ad198f3d2cd1c" - "sha512=1f5b43215b1d3dc427b9c64e005add9d423ed4bca9686d52c55912df8955647cb2d7d86622d44b41b14c4f0d657b770c27967c541c868eeb7c78e3bd35b827ad" - ] -} \ No newline at end of file diff --git a/esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub b/esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub deleted file mode 100644 index e5ad9907..00000000 --- a/esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh - -BINDIR=$(dirname "$(command -v ocamlc)") -"$BINDIR/ocaml" -I "$OCAML_TOPLEVEL_PATH" "$@" diff --git a/esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install b/esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install deleted file mode 100644 index 295c6254..00000000 --- a/esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install +++ /dev/null @@ -1,6 +0,0 @@ -bin: [ - "src/findlib/ocamlfind" {"ocamlfind"} - "?src/findlib/ocamlfind_opt" {"ocamlfind"} - "?tools/safe_camlp4" -] -toplevel: ["src/findlib/topfind"] diff --git a/esy.lock/opam/ocamlfind.1.8.1/opam b/esy.lock/opam/ocamlfind.1.8.1/opam deleted file mode 100644 index 04cbc6cc..00000000 --- a/esy.lock/opam/ocamlfind.1.8.1/opam +++ /dev/null @@ -1,64 +0,0 @@ -opam-version: "2.0" -synopsis: "A library manager for OCaml" -maintainer: "Thomas Gazagnaire " -authors: "Gerd Stolpmann " -homepage: "http://projects.camlcity.org/projects/findlib.html" -bug-reports: "https://gitlab.camlcity.org/gerd/lib-findlib/issues" -dev-repo: "git+https://gitlab.camlcity.org/gerd/lib-findlib.git" -description: """ -Findlib is a library manager for OCaml. It provides a convention how -to store libraries, and a file format ("META") to describe the -properties of libraries. There is also a tool (ocamlfind) for -interpreting the META files, so that it is very easy to use libraries -in programs and scripts. -""" -build: [ - [ - "./configure" - "-bindir" - bin - "-sitelib" - lib - "-mandir" - man - "-config" - "%{lib}%/findlib.conf" - "-no-custom" - "-no-camlp4" {!ocaml:preinstalled & ocaml:version >= "4.02.0"} - "-no-topfind" {ocaml:preinstalled} - ] - [make "all"] - [make "opt"] {ocaml:native} -] -install: [ - [ - "./configure" - "-bindir" - bin - "-sitelib" - lib - "-mandir" - man - "-config" - "%{lib}%/findlib.conf" - "-no-custom" - "-no-camlp4" {!ocaml:preinstalled & ocaml:version >= "4.02.0"} - "-no-topfind" {ocaml:preinstalled} - ] - [make "install"] - ["install" "-m" "0755" "ocaml-stub" "%{bin}%/ocaml"] {ocaml:preinstalled} -] -depends: [ - "ocaml" {>= "4.00.0" & < "4.13"} - "conf-m4" {build} -] -extra-files: [ - ["ocamlfind.install" "md5=06f2c282ab52d93aa6adeeadd82a2543"] - ["ocaml-stub" "md5=181f259c9e0bad9ef523e7d4abfdf87a"] -] -url { - src: "http://download.camlcity.org/download/findlib-1.8.1.tar.gz" - checksum: "md5=18ca650982c15536616dea0e422cbd8c" - mirrors: "http://download2.camlcity.org/download/findlib-1.8.1.tar.gz" -} -depopts: ["graphics"] diff --git a/esy.lock/opam/ppx_derivers.1.2.1/opam b/esy.lock/opam/ppx_derivers.1.2.1/opam deleted file mode 100644 index 484b2654..00000000 --- a/esy.lock/opam/ppx_derivers.1.2.1/opam +++ /dev/null @@ -1,23 +0,0 @@ -opam-version: "2.0" -maintainer: "jeremie@dimino.org" -authors: ["Jérémie Dimino"] -license: "BSD-3-Clause" -homepage: "https://github.com/ocaml-ppx/ppx_derivers" -bug-reports: "https://github.com/ocaml-ppx/ppx_derivers/issues" -dev-repo: "git+https://github.com/ocaml-ppx/ppx_derivers.git" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" - "dune" -] -synopsis: "Shared [@@deriving] plugin registry" -description: """ -Ppx_derivers is a tiny package whose sole purpose is to allow -ppx_deriving and ppx_type_conv to inter-operate gracefully when linked -as part of the same ocaml-migrate-parsetree driver.""" -url { - src: "https://github.com/ocaml-ppx/ppx_derivers/archive/1.2.1.tar.gz" - checksum: "md5=5dc2bf130c1db3c731fe0fffc5648b41" -} diff --git a/esy.lock/opam/ppxlib.0.24.0/opam b/esy.lock/opam/ppxlib.0.24.0/opam deleted file mode 100644 index d4b4b0fc..00000000 --- a/esy.lock/opam/ppxlib.0.24.0/opam +++ /dev/null @@ -1,62 +0,0 @@ -opam-version: "2.0" -synopsis: "Standard library for ppx rewriters" -description: """ -Ppxlib is the standard library for ppx rewriters and other programs -that manipulate the in-memory reprensation of OCaml programs, a.k.a -the "Parsetree". - -It also comes bundled with two ppx rewriters that are commonly used to -write tools that manipulate and/or generate Parsetree values; -`ppxlib.metaquot` which allows to construct Parsetree values using the -OCaml syntax directly and `ppxlib.traverse` which provides various -ways of automatically traversing values of a given type, in particular -allowing to inject a complex structured value into generated code. -""" -maintainer: ["opensource@janestreet.com"] -authors: ["Jane Street Group, LLC "] -license: "MIT" -homepage: "https://github.com/ocaml-ppx/ppxlib" -doc: "https://ocaml-ppx.github.io/ppxlib/" -bug-reports: "https://github.com/ocaml-ppx/ppxlib/issues" -depends: [ - "dune" {>= "2.7"} - "ocaml" {>= "4.04.1" & < "4.15"} - "ocaml-compiler-libs" {>= "v0.11.0"} - "ppx_derivers" {>= "1.0"} - "sexplib0" {>= "v0.12"} - "stdlib-shims" - "ocamlfind" {with-test} - "re" {with-test & >= "1.9.0"} - "cinaps" {with-test & >= "v0.12.1"} - "base" {with-test} - "stdio" {with-test} - "odoc" {with-doc} -] -conflicts: [ - "ocaml-migrate-parsetree" {< "2.0.0"} - "base-effects" -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/ocaml-ppx/ppxlib.git" -url { - src: - "https://github.com/ocaml-ppx/ppxlib/releases/download/0.24.0/ppxlib-0.24.0.tbz" - checksum: [ - "sha256=7766027c2ecd0f5b3b460e9212a70709c6744278113eb91f317c56c41e7a90c8" - "sha512=726e48899c43f8bee1935618827e68b2953753a62868e424a2dadf2e156cc60794abacea658686a8a160eccde0f75b95b98daacf2b9242b4f86a92798d47b597" - ] -} -x-commit-hash: "3d858b04613833fec7e2b5f5be25d45bfd354649" diff --git a/esy.lock/opam/re.1.10.3/opam b/esy.lock/opam/re.1.10.3/opam deleted file mode 100644 index c65d450f..00000000 --- a/esy.lock/opam/re.1.10.3/opam +++ /dev/null @@ -1,46 +0,0 @@ -opam-version: "2.0" - -maintainer: "rudi.grinberg@gmail.com" -authors: [ - "Jerome Vouillon" - "Thomas Gazagnaire" - "Anil Madhavapeddy" - "Rudi Grinberg" - "Gabriel Radanne" -] -license: "LGPL-2.0 with OCaml linking exception" -homepage: "https://github.com/ocaml/ocaml-re" -bug-reports: "https://github.com/ocaml/ocaml-re/issues" -dev-repo: "git+https://github.com/ocaml/ocaml-re.git" - -build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] - -depends: [ - "ocaml" {>= "4.02"} - "dune" {>= "2.0"} - "ounit" {with-test} - "seq" -] - -synopsis: "RE is a regular expression library for OCaml" -description: """ -Pure OCaml regular expressions with: -* Perl-style regular expressions (module Re.Perl) -* Posix extended regular expressions (module Re.Posix) -* Emacs-style regular expressions (module Re.Emacs) -* Shell-style file globbing (module Re.Glob) -* Compatibility layer for OCaml's built-in Str module (module Re.Str) -""" -url { - src: - "https://github.com/ocaml/ocaml-re/releases/download/1.10.3/re-1.10.3.tbz" - checksum: [ - "sha256=846546967f3fe31765935dd40a6460a9424337ecce7b12727fcba49480790ebb" - "sha512=d02103b7b8b8d8bc797341dcc933554745427f3c1b51b54b4ac9ff81badfd68c94726c57548b08e00ca99f3e09741b54b6500e97c19fc0e8fcefd6dfbe71da7f" - ] -} -x-commit-hash: "c5d5df80e128c3d7646b7d8b1322012c5fcc35f3" diff --git a/esy.lock/opam/reason.3.7.0/opam b/esy.lock/opam/reason.3.7.0/opam deleted file mode 100644 index 8c77ab75..00000000 --- a/esy.lock/opam/reason.3.7.0/opam +++ /dev/null @@ -1,31 +0,0 @@ -opam-version: "2.0" -maintainer: "Jordan Walke " -authors: [ "Jordan Walke " ] -license: "MIT" -homepage: "https://github.com/facebook/reason" -doc: "http://reasonml.github.io/" -bug-reports: "https://github.com/facebook/reason/issues" -dev-repo: "git+https://github.com/facebook/reason.git" -tags: [ "syntax" ] -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.03" & < "4.13"} - "dune" {>= "1.4"} - "ocamlfind" {build} - "menhir" {>= "20180523"} - "merlin-extend" {>= "0.6"} - "ppx_derivers" {< "2.0"} - "fix" - "result" -] -synopsis: "Reason: Syntax & Toolchain for OCaml" -description: """ -Reason gives OCaml a new syntax that is remniscient of languages like -JavaScript. It's also the umbrella project for a set of tools for the OCaml & -JavaScript ecosystem.""" -url { - src: "https://registry.npmjs.org/@esy-ocaml/reason/-/reason-3.7.0.tgz" - checksum: "md5=7eb8cbbff8565b93ebfabf4eca7254d4" -} diff --git a/esy.lock/opam/result.1.5/opam b/esy.lock/opam/result.1.5/opam deleted file mode 100644 index 6b7b68d7..00000000 --- a/esy.lock/opam/result.1.5/opam +++ /dev/null @@ -1,22 +0,0 @@ -opam-version: "2.0" -maintainer: "Jane Street developers" -authors: ["Jane Street Group, LLC"] -homepage: "https://github.com/janestreet/result" -dev-repo: "git+https://github.com/janestreet/result.git" -bug-reports: "https://github.com/janestreet/result/issues" -license: "BSD-3-Clause" -build: [["dune" "build" "-p" name "-j" jobs]] -depends: [ - "ocaml" - "dune" {>= "1.0"} -] -synopsis: "Compatibility Result module" -description: """ -Projects that want to use the new result type defined in OCaml >= 4.03 -while staying compatible with older version of OCaml should use the -Result module defined in this library.""" -url { - src: - "https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz" - checksum: "md5=1b82dec78849680b49ae9a8a365b831b" -} diff --git a/esy.lock/opam/seq.base/files/META.seq b/esy.lock/opam/seq.base/files/META.seq deleted file mode 100644 index 06b95eff..00000000 --- a/esy.lock/opam/seq.base/files/META.seq +++ /dev/null @@ -1,4 +0,0 @@ -name="seq" -version="[distributed with OCaml 4.07 or above]" -description="dummy backward-compatibility package for iterators" -requires="" diff --git a/esy.lock/opam/seq.base/files/seq.install b/esy.lock/opam/seq.base/files/seq.install deleted file mode 100644 index c4d70206..00000000 --- a/esy.lock/opam/seq.base/files/seq.install +++ /dev/null @@ -1,3 +0,0 @@ -lib:[ - "META.seq" {"META"} -] diff --git a/esy.lock/opam/seq.base/opam b/esy.lock/opam/seq.base/opam deleted file mode 100644 index b33d8c7d..00000000 --- a/esy.lock/opam/seq.base/opam +++ /dev/null @@ -1,15 +0,0 @@ -opam-version: "2.0" -maintainer: " " -authors: " " -homepage: " " -depends: [ - "ocaml" {>= "4.07.0"} -] -dev-repo: "git+https://github.com/ocaml/ocaml.git" -bug-reports: "https://caml.inria.fr/mantis/main_page.php" -synopsis: - "Compatibility package for OCaml's standard iterator type starting from 4.07." -extra-files: [ - ["seq.install" "md5=026b31e1df290373198373d5aaa26e42"] - ["META.seq" "md5=b33c8a1a6c7ed797816ce27df4855107"] -] diff --git a/esy.lock/opam/sexplib0.v0.14.0/opam b/esy.lock/opam/sexplib0.v0.14.0/opam deleted file mode 100644 index a618b826..00000000 --- a/esy.lock/opam/sexplib0.v0.14.0/opam +++ /dev/null @@ -1,26 +0,0 @@ -opam-version: "2.0" -maintainer: "Jane Street developers" -authors: ["Jane Street Group, LLC"] -homepage: "https://github.com/janestreet/sexplib0" -bug-reports: "https://github.com/janestreet/sexplib0/issues" -dev-repo: "git+https://github.com/janestreet/sexplib0.git" -doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/sexplib0/index.html" -license: "MIT" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.04.2"} - "dune" {>= "2.0.0"} -] -synopsis: "Library containing the definition of S-expressions and some base converters" -description: " -Part of Jane Street's Core library -The Core suite of libraries is an industrial strength alternative to -OCaml's standard library that was developed by Jane Street, the -largest industrial user of OCaml. -" -url { - src: "https://ocaml.janestreet.com/ocaml-core/v0.14/files/sexplib0-v0.14.0.tar.gz" - checksum: "md5=37aff0af8f8f6f759249475684aebdc4" -} diff --git a/esy.lock/opam/stdlib-shims.0.3.0/opam b/esy.lock/opam/stdlib-shims.0.3.0/opam deleted file mode 100644 index 8c969571..00000000 --- a/esy.lock/opam/stdlib-shims.0.3.0/opam +++ /dev/null @@ -1,31 +0,0 @@ -opam-version: "2.0" -maintainer: "The stdlib-shims programmers" -authors: "The stdlib-shims programmers" -homepage: "https://github.com/ocaml/stdlib-shims" -doc: "https://ocaml.github.io/stdlib-shims/" -dev-repo: "git+https://github.com/ocaml/stdlib-shims.git" -bug-reports: "https://github.com/ocaml/stdlib-shims/issues" -tags: ["stdlib" "compatibility" "org:ocaml"] -license: ["LGPL-2.1-only WITH OCaml-LGPL-linking-exception"] -depends: [ - "dune" - "ocaml" {>= "4.02.3"} -] -build: [ "dune" "build" "-p" name "-j" jobs ] -synopsis: "Backport some of the new stdlib features to older compiler" -description: """ -Backport some of the new stdlib features to older compiler, -such as the Stdlib module. - -This allows projects that require compatibility with older compiler to -use these new features in their code. -""" -x-commit-hash: "fb6815e5d745f07fd567c11671149de6ef2e74c8" -url { - src: - "https://github.com/ocaml/stdlib-shims/releases/download/0.3.0/stdlib-shims-0.3.0.tbz" - checksum: [ - "sha256=babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a" - "sha512=1151d7edc8923516e9a36995a3f8938d323aaade759ad349ed15d6d8501db61ffbe63277e97c4d86149cf371306ac23df0f581ec7e02611f58335126e1870980" - ] -} diff --git a/esy.lock/opam/topkg.1.0.5/opam b/esy.lock/opam/topkg.1.0.5/opam deleted file mode 100644 index 3b2f63a0..00000000 --- a/esy.lock/opam/topkg.1.0.5/opam +++ /dev/null @@ -1,44 +0,0 @@ -opam-version: "2.0" -synopsis: """The transitory OCaml software packager""" -maintainer: ["Daniel Bünzli "] -authors: ["The topkg programmers"] -homepage: "https://erratique.ch/software/topkg" -doc: "https://erratique.ch/software/topkg/doc" -dev-repo: "git+https://erratique.ch/repos/topkg.git" -bug-reports: "https://github.com/dbuenzli/topkg/issues" -license: ["ISC"] -tags: ["packaging" "ocamlbuild" "org:erratique"] -depends: ["ocaml" {>= "4.05.0"} - "ocamlfind" {build & >= "1.6.1"} - "ocamlbuild"] -build: [["ocaml" "pkg/pkg.ml" "build" "--pkg-name" name - "--dev-pkg" "%{dev}%"]] -url { - src: "https://erratique.ch/software/topkg/releases/topkg-1.0.5.tbz" - checksum: "sha512=9450e9139209aacd8ddb4ba18e4225770837e526a52a56d94fd5c9c4c9941e83e0e7102e2292b440104f4c338fabab47cdd6bb51d69b41cc92cc7a551e6fefab"} -description: """ -Topkg is a packager for distributing OCaml software. It provides an -API to describe the files a package installs in a given build -configuration and to specify information about the package's -distribution, creation and publication procedures. - -The optional topkg-care package provides the `topkg` command line tool -which helps with various aspects of a package's life cycle: creating -and linting a distribution, releasing it on the WWW, publish its -documentation, add it to the OCaml opam repository, etc. - -Topkg is distributed under the ISC license and has **no** -dependencies. This is what your packages will need as a *build* -dependency. - -Topkg-care is distributed under the ISC license it depends on -[fmt][fmt], [logs][logs], [bos][bos], [cmdliner][cmdliner], -[webbrowser][webbrowser] and `opam-format`. - -[fmt]: http://erratique.ch/software/fmt -[logs]: http://erratique.ch/software/logs -[bos]: http://erratique.ch/software/bos -[cmdliner]: http://erratique.ch/software/cmdliner -[webbrowser]: http://erratique.ch/software/webbrowser - -Home page: http://erratique.ch/software/topkg""" \ No newline at end of file diff --git a/esy.lock/opam/uuidm.0.9.8/opam b/esy.lock/opam/uuidm.0.9.8/opam deleted file mode 100644 index ca18d902..00000000 --- a/esy.lock/opam/uuidm.0.9.8/opam +++ /dev/null @@ -1,44 +0,0 @@ -opam-version: "2.0" -synopsis: "Universally unique identifiers (UUIDs) for OCaml" -description: """\ -Uuidm is an OCaml module implementing 128 bits universally unique -identifiers version 3, 5 (named based with MD5, SHA-1 hashing) and 4 -(random based) according to [RFC 4122][rfc4122]. - -Uuidm has no dependency and is distributed under the ISC license. - -[rfc4122]: http://tools.ietf.org/html/rfc4122 - -Homepage: """ -maintainer: "Daniel Bünzli " -authors: "The uuidm programmers" -license: "ISC" -tags: ["uuid" "codec" "org:erratique"] -homepage: "https://erratique.ch/software/uuidm" -doc: "https://erratique.ch/software/uuidm/doc/" -bug-reports: "https://github.com/dbuenzli/uuidm/issues" -depends: [ - "ocaml" {>= "4.08.0"} - "ocamlfind" {build} - "ocamlbuild" {build} - "topkg" {build & >= "1.0.3"} -] -depopts: ["cmdliner"] -conflicts: [ - "cmdliner" {< "1.1.0"} -] -build: [ - "ocaml" - "pkg/pkg.ml" - "build" - "--dev-pkg" - "%{dev}%" - "--with-cmdliner" - "%{cmdliner:installed}%" -] -dev-repo: "git+https://erratique.ch/repos/uuidm.git" -url { - src: "https://erratique.ch/software/uuidm/releases/uuidm-0.9.8.tbz" - checksum: - "sha512=d5073ae49c402ab3ea6dc8f86bc5b8cc14129437e23e47da4d91431648fcb31c4dce6308f9c936c58df9a2c6afda61d77105a3022e369cca4e4c140320e803b5" -} \ No newline at end of file diff --git a/esy.lock/opam/uutf.1.0.3/opam b/esy.lock/opam/uutf.1.0.3/opam deleted file mode 100644 index e96cc4a4..00000000 --- a/esy.lock/opam/uutf.1.0.3/opam +++ /dev/null @@ -1,36 +0,0 @@ -opam-version: "2.0" -synopsis: """Non-blocking streaming Unicode codec for OCaml""" -maintainer: ["Daniel Bünzli "] -authors: ["The uutf programmers"] -homepage: "https://erratique.ch/software/uutf" -doc: "https://erratique.ch/software/uutf/doc/" -dev-repo: "git+https://erratique.ch/repos/uutf.git" -bug-reports: "https://github.com/dbuenzli/uutf/issues" -license: ["ISC"] -tags: ["unicode" "text" "utf-8" "utf-16" "codec" "org:erratique"] -depends: ["ocaml" {>= "4.03.0"} - "ocamlfind" {build} - "ocamlbuild" {build} - "topkg" {build & >= "1.0.3"}] -depopts: ["cmdliner"] -conflicts: ["cmdliner" {< "0.9.8"}] -build: [["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%" - "--with-cmdliner" "%{cmdliner:installed}%"]] -url { - src: "https://erratique.ch/software/uutf/releases/uutf-1.0.3.tbz" - checksum: "sha512=50cc4486021da46fb08156e9daec0d57b4ca469b07309c508d5a9a41e9dbcf1f32dec2ed7be027326544453dcaf9c2534919395fd826dc7768efc6cc4bfcc9f8"} -description: """ -Uutf is a non-blocking streaming codec to decode and encode the UTF-8, -UTF-16, UTF-16LE and UTF-16BE encoding schemes. It can efficiently -work character by character without blocking on IO. Decoders perform -character position tracking and support newline normalization. - -Functions are also provided to fold over the characters of UTF encoded -OCaml string values and to directly encode characters in OCaml -Buffer.t values. **Note** that since OCaml 4.14, that functionality -can be found in the Stdlib and you are encouraged to migrate to it. - -Uutf has no dependency and is distributed under the ISC license. - -Home page: http://erratique.ch/software/uutf -Contact: Daniel Bünzli ``""" \ No newline at end of file diff --git a/esy.lock/opam/yojson.1.7.0/opam b/esy.lock/opam/yojson.1.7.0/opam deleted file mode 100644 index f5438059..00000000 --- a/esy.lock/opam/yojson.1.7.0/opam +++ /dev/null @@ -1,38 +0,0 @@ -opam-version: "2.0" -maintainer: "martin@mjambon.com" -authors: ["Martin Jambon"] -homepage: "https://github.com/ocaml-community/yojson" -bug-reports: "https://github.com/ocaml-community/yojson/issues" -dev-repo: "git+https://github.com/ocaml-community/yojson.git" -doc: "https://ocaml-community.github.io/yojson/" -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] -] -run-test: [["dune" "runtest" "-p" name "-j" jobs]] -depends: [ - "ocaml" {>= "4.02.3"} - "dune" - "cppo" {build} - "easy-format" - "biniou" {>= "1.2.0"} - "alcotest" {with-test & >= "0.8.5"} -] -synopsis: - "Yojson is an optimized parsing and printing library for the JSON format" -description: """ -Yojson is an optimized parsing and printing library for the JSON format. - -It addresses a few shortcomings of json-wheel including 2x speedup, -polymorphic variants and optional syntax for tuples and variants. - -ydump is a pretty-printing command-line program provided with the -yojson package. - -The program atdgen can be used to derive OCaml-JSON serializers and -deserializers from type definitions.""" -url { - src: - "https://github.com/ocaml-community/yojson/releases/download/1.7.0/yojson-1.7.0.tbz" - checksum: "md5=b89d39ca3f8c532abe5f547ad3b8f84d" -} diff --git a/esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override/package.json b/esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override/package.json deleted file mode 100644 index ca6a373d..00000000 --- a/esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override/package.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "build": "true", - "dependencies": { - "esy-m4": "esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7" - } -} diff --git a/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.1_opam_override/files/winpatch.patch b/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.1_opam_override/files/winpatch.patch deleted file mode 100644 index bba9929f..00000000 --- a/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.1_opam_override/files/winpatch.patch +++ /dev/null @@ -1,11 +0,0 @@ ---- ./Makefile -+++ ./Makefile -@@ -271,7 +271,7 @@ - echo ' "ocamlbuild.byte" {"ocamlbuild.byte"}' >> ocamlbuild.install - ifeq ($(OCAML_NATIVE), true) - echo ' "ocamlbuild.native" {"ocamlbuild.native"}' >> ocamlbuild.install -- echo ' "ocamlbuild.native" {"ocamlbuild"}' >> ocamlbuild.install -+ echo " \"ocamlbuild.native\" {\"ocamlbuild${EXE}\"}" >> ocamlbuild.install - else - echo ' "ocamlbuild.byte" {"ocamlbuild"}' >> ocamlbuild.install - endif diff --git a/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.1_opam_override/package.json b/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.1_opam_override/package.json deleted file mode 100644 index b57a42cc..00000000 --- a/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.1_opam_override/package.json +++ /dev/null @@ -1,29 +0,0 @@ -{ - "build": [ - [ - "bash", - "-c", - "#{os == 'windows' ? 'patch -p1 < winpatch.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", - "EXE=#{os == 'windows' ? '.exe': ''}" - ], - [ - "make", - "check-if-preinstalled", - "all", - "EXE=#{os == 'windows' ? '.exe': ''}", - "opam-install" - ] - ] -} diff --git a/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch b/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch deleted file mode 100644 index 3e3ee5a2..00000000 --- a/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch +++ /dev/null @@ -1,471 +0,0 @@ ---- ./Makefile -+++ ./Makefile -@@ -57,16 +57,16 @@ - cat findlib.conf.in | \ - $(SH) tools/patch '@SITELIB@' '$(OCAML_SITELIB)' >findlib.conf - if ./tools/cmd_from_same_dir ocamlc; then \ -- echo 'ocamlc="ocamlc.opt"' >>findlib.conf; \ -+ echo 'ocamlc="ocamlc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ - fi - if ./tools/cmd_from_same_dir ocamlopt; then \ -- echo 'ocamlopt="ocamlopt.opt"' >>findlib.conf; \ -+ echo 'ocamlopt="ocamlopt.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ - fi - if ./tools/cmd_from_same_dir ocamldep; then \ -- echo 'ocamldep="ocamldep.opt"' >>findlib.conf; \ -+ echo 'ocamldep="ocamldep.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ - fi - if ./tools/cmd_from_same_dir ocamldoc; then \ -- echo 'ocamldoc="ocamldoc.opt"' >>findlib.conf; \ -+ echo 'ocamldoc="ocamldoc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ - fi - - .PHONY: install-doc ---- ./src/findlib/findlib_config.mlp -+++ ./src/findlib/findlib_config.mlp -@@ -24,3 +24,5 @@ - | "MacOS" -> "" (* don't know *) - | _ -> failwith "Unknown Sys.os_type" - ;; -+ -+let exec_suffix = "@EXEC_SUFFIX@";; ---- ./src/findlib/findlib.ml -+++ ./src/findlib/findlib.ml -@@ -28,15 +28,20 @@ - let conf_ldconf = ref "";; - let conf_ignore_dups_in = ref ([] : string list);; - --let ocamlc_default = "ocamlc";; --let ocamlopt_default = "ocamlopt";; --let ocamlcp_default = "ocamlcp";; --let ocamloptp_default = "ocamloptp";; --let ocamlmklib_default = "ocamlmklib";; --let ocamlmktop_default = "ocamlmktop";; --let ocamldep_default = "ocamldep";; --let ocamlbrowser_default = "ocamlbrowser";; --let ocamldoc_default = "ocamldoc";; -+let add_exec str = -+ match Findlib_config.exec_suffix with -+ | "" -> str -+ | a -> str ^ a ;; -+let ocamlc_default = add_exec "ocamlc";; -+let ocamlopt_default = add_exec "ocamlopt";; -+let ocamlcp_default = add_exec "ocamlcp";; -+let ocamloptp_default = add_exec "ocamloptp";; -+let ocamlmklib_default = add_exec "ocamlmklib";; -+let ocamlmktop_default = add_exec "ocamlmktop";; -+let ocamldep_default = add_exec "ocamldep";; -+let ocamlbrowser_default = add_exec "ocamlbrowser";; -+let ocamldoc_default = add_exec "ocamldoc";; -+ - - - let init_manually ---- ./src/findlib/fl_package_base.ml -+++ ./src/findlib/fl_package_base.ml -@@ -133,7 +133,15 @@ - List.find (fun def -> def.def_var = "exists_if") p.package_defs in - let files = Fl_split.in_words def.def_value in - List.exists -- (fun file -> Sys.file_exists (Filename.concat d' file)) -+ (fun file -> -+ let fln = Filename.concat d' file in -+ let e = Sys.file_exists fln in -+ (* necessary for ppx executables *) -+ if e || Sys.os_type <> "Win32" || Filename.check_suffix fln ".exe" then -+ e -+ else -+ Sys.file_exists (fln ^ ".exe") -+ ) - files - with Not_found -> true in - ---- ./src/findlib/fl_split.ml -+++ ./src/findlib/fl_split.ml -@@ -126,10 +126,17 @@ - | '/' | '\\' -> true - | _ -> false in - let norm_dir_win() = -- if l >= 1 && s.[0] = '/' then -- Buffer.add_char b '\\' else Buffer.add_char b s.[0]; -- if l >= 2 && s.[1] = '/' then -- Buffer.add_char b '\\' else Buffer.add_char b s.[1]; -+ if l >= 1 then ( -+ if s.[0] = '/' then -+ Buffer.add_char b '\\' -+ else -+ Buffer.add_char b s.[0] ; -+ if l >= 2 then -+ if s.[1] = '/' then -+ Buffer.add_char b '\\' -+ else -+ Buffer.add_char b s.[1]; -+ ); - for k = 2 to l - 1 do - let c = s.[k] in - if is_slash c then ( ---- ./src/findlib/frontend.ml -+++ ./src/findlib/frontend.ml -@@ -31,10 +31,18 @@ - else - Sys_error (arg ^ ": " ^ Unix.error_message code) - -+let is_win = Sys.os_type = "Win32" -+ -+let () = -+ match Findlib_config.system with -+ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> -+ (try set_binary_mode_out stdout true with _ -> ()); -+ (try set_binary_mode_out stderr true with _ -> ()); -+ | _ -> () - - let slashify s = - match Findlib_config.system with -- | "mingw" | "mingw64" | "cygwin" -> -+ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> - let b = Buffer.create 80 in - String.iter - (function -@@ -49,7 +57,7 @@ - - let out_path ?(prefix="") s = - match Findlib_config.system with -- | "mingw" | "mingw64" | "cygwin" -> -+ | "win32" | "win64" | "mingw" | "mingw64" | "cygwin" -> - let u = slashify s in - prefix ^ - (if String.contains u ' ' then -@@ -273,11 +281,9 @@ - - - let identify_dir d = -- match Sys.os_type with -- | "Win32" -> -- failwith "identify_dir" (* not available *) -- | _ -> -- let s = Unix.stat d in -+ if is_win then -+ failwith "identify_dir"; (* not available *) -+ let s = Unix.stat d in - (s.Unix.st_dev, s.Unix.st_ino) - ;; - -@@ -459,6 +465,96 @@ - ) - packages - -+let rewrite_cmd s = -+ if s = "" || not is_win then -+ s -+ else -+ let s = -+ let l = String.length s in -+ let b = Buffer.create l in -+ for i = 0 to pred l do -+ match s.[i] with -+ | '/' -> Buffer.add_char b '\\' -+ | x -> Buffer.add_char b x -+ done; -+ Buffer.contents b -+ in -+ if (Filename.is_implicit s && String.contains s '\\' = false) || -+ Filename.check_suffix (String.lowercase s) ".exe" then -+ s -+ else -+ let s' = s ^ ".exe" in -+ if Sys.file_exists s' then -+ s' -+ else -+ s -+ -+let rewrite_cmd s = -+ if s = "" || not is_win then s else -+ let s = -+ let l = String.length s in -+ let b = Buffer.create l in -+ for i = 0 to pred l do -+ match s.[i] with -+ | '/' -> Buffer.add_char b '\\' -+ | x -> Buffer.add_char b x -+ done; -+ Buffer.contents b -+ in -+ if (Filename.is_implicit s && String.contains s '\\' = false) || -+ Filename.check_suffix (String.lowercase s) ".exe" then -+ s -+ else -+ let s' = s ^ ".exe" in -+ if Sys.file_exists s' then -+ s' -+ else -+ s -+ -+let rewrite_pp cmd = -+ if not is_win then cmd else -+ let module T = struct exception Keep end in -+ let is_whitespace = function -+ | ' ' | '\011' | '\012' | '\n' | '\r' | '\t' -> true -+ | _ -> false in -+ (* characters that triggers special behaviour (cmd.exe, not unix shell) *) -+ let is_unsafe_char = function -+ | '(' | ')' | '%' | '!' | '^' | '<' | '>' | '&' -> true -+ | _ -> false in -+ let len = String.length cmd in -+ let buf = Buffer.create (len + 4) in -+ let buf_cmd = Buffer.create len in -+ let rec iter_ws i = -+ if i >= len then () else -+ let cur = cmd.[i] in -+ if is_whitespace cur then ( -+ Buffer.add_char buf cur; -+ iter_ws (succ i) -+ ) -+ else -+ iter_cmd i -+ and iter_cmd i = -+ if i >= len then add_buf_cmd () else -+ let cur = cmd.[i] in -+ if is_unsafe_char cur || cur = '"' || cur = '\'' then -+ raise T.Keep; -+ if is_whitespace cur then ( -+ add_buf_cmd (); -+ Buffer.add_substring buf cmd i (len - i) -+ ) -+ else ( -+ Buffer.add_char buf_cmd cur; -+ iter_cmd (succ i) -+ ) -+ and add_buf_cmd () = -+ if Buffer.length buf_cmd > 0 then -+ Buffer.add_string buf (rewrite_cmd (Buffer.contents buf_cmd)) -+ in -+ try -+ iter_ws 0; -+ Buffer.contents buf -+ with -+ | T.Keep -> cmd - - let process_pp_spec syntax_preds packages pp_opts = - (* Returns: pp_command *) -@@ -549,7 +645,7 @@ - None -> [] - | Some cmd -> - ["-pp"; -- cmd ^ " " ^ -+ (rewrite_cmd cmd) ^ " " ^ - String.concat " " (List.map Filename.quote pp_i_options) ^ " " ^ - String.concat " " (List.map Filename.quote pp_archives) ^ " " ^ - String.concat " " (List.map Filename.quote pp_opts)] -@@ -625,9 +721,11 @@ - in - try - let preprocessor = -+ rewrite_cmd ( - resolve_path - ~base ~explicit:true -- (package_property predicates pname "ppx") in -+ (package_property predicates pname "ppx") ) -+ in - ["-ppx"; String.concat " " (preprocessor :: options)] - with Not_found -> [] - ) -@@ -895,6 +993,14 @@ - switch (e.g. -L instead of -L ) - *) - -+(* We may need to remove files on which we do not have complete control. -+ On Windows, removing a read-only file fails so try to change the -+ mode of the file first. *) -+let remove_file fname = -+ try Sys.remove fname -+ with Sys_error _ when is_win -> -+ (try Unix.chmod fname 0o666 with Unix.Unix_error _ -> ()); -+ Sys.remove fname - - let ocamlc which () = - -@@ -1022,9 +1128,12 @@ - - "-intf", - Arg.String (fun s -> pass_files := !pass_files @ [ Intf(slashify s) ]); -- -+ - "-pp", -- Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" s); -+ Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" (rewrite_pp s)); -+ -+ "-ppx", -+ Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); - - "-thread", - Arg.Unit (fun _ -> threads := threads_default); -@@ -1237,7 +1346,7 @@ - with - any -> - close_out initl; -- Sys.remove initl_file_name; -+ remove_file initl_file_name; - raise any - end; - -@@ -1245,9 +1354,9 @@ - at_exit - (fun () -> - let tr f x = try f x with _ -> () in -- tr Sys.remove initl_file_name; -- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmi"); -- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmo"); -+ tr remove_file initl_file_name; -+ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmi"); -+ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmo"); - ); - - let exclude_list = [ stdlibdir; threads_dir; vmthreads_dir ] in -@@ -1493,7 +1602,9 @@ - [ "-v", Arg.Unit (fun () -> verbose := Verbose); - "-pp", Arg.String (fun s -> - pp_specified := true; -- options := !options @ ["-pp"; s]); -+ options := !options @ ["-pp"; rewrite_pp s]); -+ "-ppx", Arg.String (fun s -> -+ options := !options @ ["-ppx"; rewrite_pp s]); - ] - ) - ) -@@ -1672,7 +1783,9 @@ - Arg.String (fun s -> add_spec_fn "-I" (slashify (resolve_path s))); - - "-pp", Arg.String (fun s -> pp_specified := true; -- add_spec_fn "-pp" s); -+ add_spec_fn "-pp" (rewrite_pp s)); -+ "-ppx", Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); -+ - ] - ) - ) -@@ -1830,7 +1943,10 @@ - output_string ch_out append; - close_out ch_out; - close_in ch_in; -- Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime; -+ (try Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime -+ with Unix.Unix_error(e,_,_) -> -+ prerr_endline("Warning: setting utimes for " ^ outpath -+ ^ ": " ^ Unix.error_message e)); - - prerr_endline("Installed " ^ outpath); - with -@@ -1882,6 +1998,8 @@ - Unix.openfile (Filename.concat dir owner_file) [Unix.O_RDONLY] 0 in - let f = - Unix.in_channel_of_descr fd in -+ if is_win then -+ set_binary_mode_in f false; - try - let line = input_line f in - let is_my_file = (line = pkg) in -@@ -2208,7 +2326,7 @@ - let lines = read_ldconf !ldconf in - let dlldir_norm = Fl_split.norm_dir dlldir in - let dlldir_norm_lc = string_lowercase_ascii dlldir_norm in -- let ci_filesys = (Sys.os_type = "Win32") in -+ let ci_filesys = is_win in - let check_dir d = - let d' = Fl_split.norm_dir d in - (d' = dlldir_norm) || -@@ -2356,7 +2474,7 @@ - List.iter - (fun file -> - let absfile = Filename.concat dlldir file in -- Sys.remove absfile; -+ remove_file absfile; - prerr_endline ("Removed " ^ absfile) - ) - dll_files -@@ -2365,7 +2483,7 @@ - (* Remove the files from the package directory: *) - if Sys.file_exists pkgdir then begin - let files = Sys.readdir pkgdir in -- Array.iter (fun f -> Sys.remove (Filename.concat pkgdir f)) files; -+ Array.iter (fun f -> remove_file (Filename.concat pkgdir f)) files; - Unix.rmdir pkgdir; - prerr_endline ("Removed " ^ pkgdir) - end -@@ -2415,7 +2533,9 @@ - - - let print_configuration() = -+ let sl = slashify in - let dir s = -+ let s = sl s in - if Sys.file_exists s then - s - else -@@ -2453,27 +2573,27 @@ - if md = "" then "the corresponding package directories" else dir md - ); - Printf.printf "The standard library is assumed to reside in:\n %s\n" -- (Findlib.ocaml_stdlib()); -+ (sl (Findlib.ocaml_stdlib())); - Printf.printf "The ld.conf file can be found here:\n %s\n" -- (Findlib.ocaml_ldconf()); -+ (sl (Findlib.ocaml_ldconf())); - flush stdout - | Some "conf" -> -- print_endline (Findlib.config_file()) -+ print_endline (sl (Findlib.config_file())) - | Some "path" -> -- List.iter print_endline (Findlib.search_path()) -+ List.iter ( fun x -> print_endline (sl x)) (Findlib.search_path()) - | Some "destdir" -> -- print_endline (Findlib.default_location()) -+ print_endline ( sl (Findlib.default_location())) - | Some "metadir" -> -- print_endline (Findlib.meta_directory()) -+ print_endline ( sl (Findlib.meta_directory())) - | Some "metapath" -> - let mdir = Findlib.meta_directory() in - let ddir = Findlib.default_location() in -- print_endline -- (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META") -+ print_endline ( sl -+ (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META")) - | Some "stdlib" -> -- print_endline (Findlib.ocaml_stdlib()) -+ print_endline ( sl (Findlib.ocaml_stdlib())) - | Some "ldconf" -> -- print_endline (Findlib.ocaml_ldconf()) -+ print_endline ( sl (Findlib.ocaml_ldconf())) - | _ -> - assert false - ;; -@@ -2481,7 +2601,7 @@ - - let ocamlcall pkg cmd = - let dir = package_directory pkg in -- let path = Filename.concat dir cmd in -+ let path = rewrite_cmd (Filename.concat dir cmd) in - begin - try Unix.access path [ Unix.X_OK ] - with -@@ -2647,6 +2767,10 @@ - | Sys_error f -> - prerr_endline ("ocamlfind: " ^ f); - exit 2 -+ | Unix.Unix_error (e, fn, f) -> -+ prerr_endline ("ocamlfind: " ^ fn ^ " " ^ f -+ ^ ": " ^ Unix.error_message e); -+ exit 2 - | Findlib.No_such_package(pkg,info) -> - prerr_endline ("ocamlfind: Package `" ^ pkg ^ "' not found" ^ - (if info <> "" then " - " ^ info else "")); ---- ./src/findlib/Makefile -+++ ./src/findlib/Makefile -@@ -90,6 +90,7 @@ - cat findlib_config.mlp | \ - $(SH) $(TOP)/tools/patch '@CONFIGFILE@' '$(OCAMLFIND_CONF)' | \ - $(SH) $(TOP)/tools/patch '@STDLIB@' '$(OCAML_CORE_STDLIB)' | \ -+ $(SH) $(TOP)/tools/patch '@EXEC_SUFFIX@' '$(EXEC_SUFFIX)' | \ - sed -e 's;@AUTOLINK@;$(OCAML_AUTOLINK);g' \ - -e 's;@SYSTEM@;$(SYSTEM);g' \ - >findlib_config.ml diff --git a/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json b/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json deleted file mode 100644 index 9314f870..00000000 --- a/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json +++ /dev/null @@ -1,61 +0,0 @@ -{ - "build": [ - [ - "bash", - "-c", - "#{os == 'windows' ? 'patch -p1 < findlib-1.8.1.patch' : 'true'}" - ], - [ - "./configure", - "-bindir", - "#{self.bin}", - "-sitelib", - "#{self.lib}", - "-mandir", - "#{self.man}", - "-config", - "#{self.lib}/findlib.conf", - "-no-custom", - "-no-topfind" - ], - [ - "make", - "all" - ], - [ - "make", - "opt" - ] - ], - "install": [ - [ - "make", - "install" - ], - [ - "install", - "-m", - "0755", - "ocaml-stub", - "#{self.bin}/ocaml" - ], - [ - "mkdir", - "-p", - "#{self.toplevel}" - ], - [ - "install", - "-m", - "0644", - "src/findlib/topfind", - "#{self.toplevel}/topfind" - ] - ], - "exportedEnv": { - "OCAML_TOPLEVEL_PATH": { - "val": "#{self.toplevel}", - "scope": "global" - } - } -} diff --git a/examples/bsconfig.json b/examples/bsconfig.json deleted file mode 100644 index 7985fd9e..00000000 --- a/examples/bsconfig.json +++ /dev/null @@ -1,23 +0,0 @@ -{ - "name": "re-formality-examples", - "sources": ["src"], - "bs-dependencies": [ - "@rescript/react", - "re-formality", - "rescript-classnames" - ], - "reason": { - "react-jsx": 3 - }, - "refmt": 3, - "bsc-flags": [ - "-open Belt", - "-open Cx" - ], - "ppx-flags": ["../_build/default/ppx/bin/bin.exe"], - "package-specs": { - "module": "es6", - "in-source": true - }, - "suffix": ".bs.js" -} diff --git a/examples/package.json b/examples/package.json index 26fe51d4..acb3b940 100644 --- a/examples/package.json +++ b/examples/package.json @@ -1,32 +1,32 @@ { - "name": "re-formality-examples", - "version": "0.0.0", - "private": true, - "scripts": { - "start": "parcel src/index.html", - "prestart": "yarn run clean && yarn run res:build", - "build": "parcel build src/index.html", - "prebuild": "yarn run clean && yarn run res:build", - "clean": "yarn run dist:clean && yarn run res:clean", - "res:build": "rescript build -with-deps", - "res:watch": "rescript build -with-deps -w", - "res:clean": "rescript clean", - "dist:clean": "rm -rf dist", - "format": "rescript format -all", - "test": "exit 0", - "deploy": "now deploy dist --prod --name re-formality", - "predeploy": "yarn run build" - }, - "dependencies": { - "@rescript/react": "0.11.0", - "re-formality": "*", - "react": "18.2.0", - "react-dom": "18.2.0", - "rescript-classnames": "6.0.0" - }, - "devDependencies": { - "parcel": "2.8.3", - "process": "0.11.10", - "rescript": "10.1.3" - } + "name": "re-formality-examples", + "version": "0.0.0", + "private": true, + "scripts": { + "start": "parcel src/index.html", + "prestart": "yarn run clean && yarn run res:build", + "build": "parcel build src/index.html", + "prebuild": "yarn run clean && yarn run res:build", + "clean": "yarn run dist:clean && yarn run res:clean", + "res:build": "rescript build -with-deps", + "res:watch": "rescript build -with-deps -w", + "res:clean": "rescript clean", + "dist:clean": "rm -rf dist", + "format": "rescript format -all", + "test": "exit 0", + "deploy": "now deploy dist --prod --name re-formality", + "predeploy": "yarn run build" + }, + "dependencies": { + "@rescript/react": "0.12.1", + "re-formality": "*", + "react": "18.2.0", + "react-dom": "18.2.0", + "rescript-classnames": "7.0.0" + }, + "devDependencies": { + "parcel": "2.8.3", + "process": "0.11.10", + "rescript": "11.0.1" + } } diff --git a/examples/rescript.json b/examples/rescript.json new file mode 100644 index 00000000..3d6d0446 --- /dev/null +++ b/examples/rescript.json @@ -0,0 +1,26 @@ +{ + "name": "re-formality-examples", + "sources": [ + "src" + ], + "bs-dependencies": [ + "@rescript/react", + "re-formality", + "rescript-classnames" + ], + "jsx": { + "version": 4 + }, + "bsc-flags": [ + "-open Belt", + "-open Cx" + ], + "ppx-flags": [ + "../_build/default/ppx/bin/bin.exe" + ], + "package-specs": { + "module": "es6", + "in-source": true + }, + "suffix": ".res.js" +} diff --git a/examples/src/Api.res b/examples/src/Api.res index f7c7fd4a..794593a7 100644 --- a/examples/src/Api.res +++ b/examples/src/Api.res @@ -7,11 +7,11 @@ let validateEmail = value => value !== takenEmail ? { Js.log("Remote validation succeeded") - resolve(. true) + resolve(true) } : { Js.log("Remote validation failed") - resolve(. false) + resolve(false) } , 1500)->ignore }) diff --git a/examples/src/BlogPostForm.res b/examples/src/BlogPostForm.res index 3a43ceed..8b9a5f18 100644 --- a/examples/src/BlogPostForm.res +++ b/examples/src/BlogPostForm.res @@ -99,7 +99,7 @@ let make = () => { | Some(Ok(_)) =>
- {j`✓`->React.string} + {"✓"->React.string}
| None => React.null }} @@ -135,7 +135,7 @@ let make = () => { | Some(Ok(_)) =>
- {j`✓`->React.string} + {"✓"->React.string}
| None => React.null }} @@ -182,7 +182,7 @@ let make = () => { )} /> {switch form.authorNameResult(~at=index) { | Some(Error(message)) => @@ -193,7 +193,7 @@ let make = () => { | Some(Ok(_)) =>
- {j`✓`->React.string} + {"✓"->React.string}
| None => React.null }} @@ -214,7 +214,7 @@ let make = () => { {switch form.status { | Submitted => -
{j`✓ Posted`->React.string}
+
{"✓ Posted"->React.string}
| _ => React.null }} diff --git a/examples/src/LoginForm.res b/examples/src/LoginForm.res index c539a527..f7a817ac 100644 --- a/examples/src/LoginForm.res +++ b/examples/src/LoginForm.res @@ -69,7 +69,7 @@ let make = () => { | Some(Ok(_)) =>
- {j`✓`->React.string} + {"✓"->React.string}
| None => React.null }} @@ -95,7 +95,7 @@ let make = () => { | Some(Ok(_)) =>
- {j`✓`->React.string} + {"✓"->React.string}
| None => React.null }} @@ -122,7 +122,7 @@ let make = () => { {switch form.status { | Submitted => -
{j`✓ Logged In`->React.string}
+
{"✓ Logged In"->React.string}
| _ => React.null }} diff --git a/examples/src/SignupForm.res b/examples/src/SignupForm.res index ceabebbc..152c5b80 100644 --- a/examples/src/SignupForm.res +++ b/examples/src/SignupForm.res @@ -19,7 +19,7 @@ module SignupForm = %form( open Js.Promise email ->Api.validateEmail - ->then_(valid => valid ? Ok(email)->resolve : Error("Email is already taken")->resolve, _) + ->(then_(valid => valid ? Ok(email)->resolve : Error("Email is already taken")->resolve, _)) }, }, password: { @@ -28,7 +28,8 @@ module SignupForm = %form( let minLength = 4 switch password { | "" => Error("Password is required") - | _ if password->Js.String.length < minLength => Error(j` $(minLength)+ characters, please`) + | _ if password->Js.String.length < minLength => + Error(` ${minLength->Int.toString}+ characters, please`) | _ => Ok(password) } }, @@ -90,7 +91,7 @@ let make = () => { | Some(Result(Ok(_))) =>
- {j`✓`->React.string} + {"✓"->React.string}
| None => React.null }} @@ -119,7 +120,7 @@ let make = () => { | Some(Ok(_)) =>
- {j`✓`->React.string} + {"✓"->React.string}
| None => React.null }} @@ -147,7 +148,7 @@ let make = () => { | Some(Ok(_)) =>
- {j`✓`->React.string} + {"✓"->React.string}
| None => React.null }} @@ -158,7 +159,7 @@ let make = () => { {switch form.status { | Submitted => -
{j`✓ Signed Up`->React.string}
+
{"✓ Signed Up"->React.string}
| _ => React.null }} diff --git a/examples/src/index.html b/examples/src/index.html index 6cc4b829..57ce41d9 100644 --- a/examples/src/index.html +++ b/examples/src/index.html @@ -1,12 +1,15 @@ - + + re-formality - - + + +
- - + + + diff --git a/lib/bsconfig.json b/lib/bsconfig.json deleted file mode 100644 index 8fdb3b5c..00000000 --- a/lib/bsconfig.json +++ /dev/null @@ -1,18 +0,0 @@ -{ - "name": "re-formality", - "sources": ["src"], - "bs-dependencies": [ - "@rescript/react", - "rescript-debounce" - ], - "reason": { - "react-jsx": 3 - }, - "refmt": 3, - "bsc-flags": ["-open Belt"], - "package-specs": { - "module": "es6", - "in-source": true - }, - "suffix": ".bs.js" -} diff --git a/lib/package.json b/lib/package.json index 9a8d9b7a..b442989a 100644 --- a/lib/package.json +++ b/lib/package.json @@ -10,10 +10,10 @@ "format": "rescript format -all" }, "dependencies": { - "rescript-debounce": "1.0.1" + "rescript-debounce": "2.0.0" }, "devDependencies": { - "@rescript/react": "0.11.0", - "rescript": "10.1.3" + "@rescript/react": "0.12.1", + "rescript": "11.0.1" } } diff --git a/lib/rescript.json b/lib/rescript.json new file mode 100644 index 00000000..b1db33ca --- /dev/null +++ b/lib/rescript.json @@ -0,0 +1,18 @@ +{ + "name": "re-formality", + "sources": [ + "src" + ], + "bs-dependencies": [ + "@rescript/react", + "rescript-debounce" + ], + "bsc-flags": [ + "-open Belt" + ], + "package-specs": { + "module": "es6", + "in-source": true + }, + "suffix": ".res.js" +} diff --git a/lib/src/Formality.re b/lib/src/Formality.re deleted file mode 100644 index b5231f2a..00000000 --- a/lib/src/Formality.re +++ /dev/null @@ -1,2330 +0,0 @@ -module Debouncer = Formality__Debouncer; -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 collectionStatus('message) = result(unit, 'message); - -type formStatus('submissionError) = - | Editing - | Submitting(option('submissionError)) - | Submitted - | SubmissionFailed('submissionError); - -type submissionStatus = - | NeverSubmitted - | AttemptedToSubmit; - -let exposeFieldResult = - (fieldStatus: fieldStatus('outputValue, 'message)) - : option(result('outputValue, 'message)) => - switch (fieldStatus) { - | Pristine - | Dirty(_, Hidden) => None - | Dirty(result, Shown) => Some(result) - }; - -type index = int; - -type singleValueValidator('input, 'outputValue, 'message) = { - strategy, - validate: 'input => result('outputValue, 'message), -}; - -type singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, -) = { - strategy, - validate: ('input, 'metadata) => result('outputValue, 'message), -}; - -type collectionValidatorWithWholeCollectionValidator( - 'input, - 'message, - 'fieldsValidators, -) = { - collection: 'input => result(unit, 'message), - fields: 'fieldsValidators, -}; - -type collectionValidatorWithWholeCollectionValidatorAndMetadata( - 'input, - 'message, - 'fieldsValidators, - 'metadata, -) = { - collection: ('input, 'metadata) => result(unit, 'message), - fields: 'fieldsValidators, -}; - -type collectionValidatorWithoutWholeCollectionValidator('fieldsValidators) = { - collection: unit, - fields: 'fieldsValidators, -}; - -type valueOfCollectionValidator('input, 'outputValue, 'message) = { - strategy, - validate: ('input, ~at: index) => result('outputValue, 'message), -}; - -type valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, -) = { - strategy, - validate: - ('input, ~at: index, ~metadata: 'metadata) => - result('outputValue, 'message), -}; - -type formValidationResult('output, 'fieldsStatuses, 'collectionsStatuses) = - | Valid({ - output: 'output, - fieldsStatuses: 'fieldsStatuses, - collectionsStatuses: 'collectionsStatuses, - }) - | Invalid({ - fieldsStatuses: 'fieldsStatuses, - collectionsStatuses: 'collectionsStatuses, - }); - -type submissionCallbacks('input, 'submissionError) = { - notifyOnSuccess: option('input) => unit, - notifyOnFailure: 'submissionError => unit, - reset: unit => unit, - dismissSubmissionResult: unit => unit, -}; - -let validateFieldOnChangeWithoutValidator = - ( - ~fieldInput: 'outputValue, - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - Dirty(Ok(fieldInput), Hidden)->setStatus; -}; - -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 validateFieldOnChangeWithValidatorAndMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Shown)->setStatus - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(_) as result => Dirty(result, Shown)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; -}; - -let validateFieldOfCollectionOnChangeWithValidator = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: valueOfCollectionValidator('input, 'outputValue, 'message), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Shown)->setStatus - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(_) as result => Dirty(result, Shown)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; -}; - -let validateFieldOfCollectionOnChangeWithValidatorAndMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Shown)->setStatus - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(_) as result => Dirty(result, Shown)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus - }; -}; - -let validateDependentFieldOnChange = - ( - ~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) => - Dirty(validator.validate(input), Shown)->setStatus->Some - }; -}; - -let validateDependentFieldOnChangeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Pristine - | Dirty(_, Hidden) => None - | Dirty(_, Shown) => - Dirty(validator.validate(input, metadata), Shown)->setStatus->Some - }; -}; - -let validateDependentFieldOfCollectionOnChange = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: valueOfCollectionValidator('input, 'outputValue, 'message), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Pristine - | Dirty(_, Hidden) => None - | Dirty(_, Shown) => - Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some - }; -}; - -let validateDependentFieldOfCollectionOnChangeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Pristine - | Dirty(_, Hidden) => None - | Dirty(_, Shown) => - Dirty(validator.validate(input, ~at=index, ~metadata), Shown) - ->setStatus - ->Some - }; -}; - -let validateFieldOnBlurWithoutValidator = - ( - ~fieldInput: 'outputValue, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => - switch (fieldStatus) { - | Dirty(_, Shown | Hidden) => None - | Pristine => Dirty(Ok(fieldInput), Hidden)->setStatus->Some - }; - -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 => Dirty(validator.validate(input), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - Dirty(validator.validate(input), Shown)->setStatus->Some - } - }; -}; - -let validateFieldOnBlurWithValidatorAndMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - Dirty(validator.validate(input, metadata), Shown)->setStatus->Some - } - }; -}; - -let validateFieldOfCollectionOnBlurWithValidator = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: valueOfCollectionValidator('input, 'outputValue, 'message), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some - } - }; -}; - -let validateFieldOfCollectionOnBlurWithValidatorAndMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - ->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - Dirty(validator.validate(input, ~at=index, ~metadata), Shown) - ->setStatus - ->Some - } - }; -}; - -module Async = { - type fieldStatus('outputValue, 'message) = - | Pristine - | Dirty(result('outputValue, 'message), visibility) - | Validating('outputValue); - - type exposedFieldStatus('outputValue, 'message) = - | Validating('outputValue) - | Result(result('outputValue, 'message)); - - type singleValueValidator('input, 'outputValue, 'message, 'action) = { - strategy, - validate: 'input => result('outputValue, 'message), - validateAsync: (('outputValue, 'action => unit)) => unit, - eq: ('outputValue, 'outputValue) => bool, - }; - - type singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ) = { - strategy, - validate: ('input, 'metadata) => result('outputValue, 'message), - validateAsync: (('outputValue, 'metadata, 'action => unit)) => unit, - eq: ('outputValue, 'outputValue) => bool, - }; - - type valueOfCollectionValidator('input, 'outputValue, 'message, 'action) = { - strategy, - validate: ('input, ~at: index) => result('outputValue, 'message), - validateAsync: (('outputValue, index, 'action => unit)) => unit, - eq: ('outputValue, 'outputValue) => bool, - }; - - type valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ) = { - strategy, - validate: - ('input, ~at: index, ~metadata: 'metadata) => - result('outputValue, 'message), - validateAsync: - (('outputValue, index, 'metadata, 'action => unit)) => unit, - eq: ('outputValue, 'outputValue) => bool, - }; - - type validateAsyncFn('outputValue, 'message) = - 'outputValue => Js.Promise.t(result('outputValue, 'message)); - - type validateAsyncFnWithMetadata('outputValue, 'message, 'metadata) = - ('outputValue, 'metadata) => Js.Promise.t(result('outputValue, 'message)); - - let validateAsync = - ( - ~value: 'outputValue, - ~validate: validateAsyncFn('outputValue, 'message), - ~andThen: result('outputValue, 'message) => unit, - ) - : unit => - validate(value) - ->Js.Promise.(then_(res => res->andThen->resolve, _)) - ->ignore; - - let validateAsyncWithMetadata = - ( - ~value: 'outputValue, - ~metadata: 'metadata, - ~validate: - validateAsyncFnWithMetadata('outputValue, 'message, 'metadata), - ~andThen: result('outputValue, 'message) => unit, - ) - : unit => - validate(value, metadata) - ->Js.Promise.(then_(res => res->andThen->resolve, _)) - ->ignore; - - type formValidationResult('output, 'fieldsStatuses, 'collectionsStatuses) = - | Valid({ - output: 'output, - fieldsStatuses: 'fieldsStatuses, - collectionsStatuses: 'collectionsStatuses, - }) - | Invalid({ - fieldsStatuses: 'fieldsStatuses, - collectionsStatuses: 'collectionsStatuses, - }) - | Validating({ - fieldsStatuses: 'fieldsStatuses, - collectionsStatuses: 'collectionsStatuses, - }); - - let exposeFieldResult = - (fieldStatus: fieldStatus('outputValue, 'message)) - : option(exposedFieldStatus('outputValue, 'message)) => - switch (fieldStatus) { - | Pristine - | Dirty(_, Hidden) => None - | Validating(x) => Some(Validating(x)) - | Dirty(result, Shown) => Some(Result(result)) - }; - - let validateFieldOnChangeInOnBlurMode = - ( - ~input: 'input, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidator('input, 'outputValue, 'message, 'action), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(_) as result => Dirty(result, Hidden)->setStatus - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | ( - OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, - _, - NeverSubmitted, - ) => - Dirty(validator.validate(input), Hidden)->setStatus - }; - }; - - let validateFieldOnChangeInOnBlurModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(_) as result => Dirty(result, Hidden)->setStatus - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | ( - OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, - _, - NeverSubmitted, - ) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOnChangeInOnBlurMode = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidator( - 'input, - 'outputValue, - 'message, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(_) as result => Dirty(result, Hidden)->setStatus - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | ( - OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, - _, - NeverSubmitted, - ) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOnChangeInOnBlurModeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(_) as result => Dirty(result, Hidden)->setStatus - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | ( - OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, - _, - NeverSubmitted, - ) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - }; - }; - - let validateFieldOfOptionTypeOnChangeInOnBlurMode = - ( - ~input: 'input, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidator('input, 'outputValue, 'message, 'action), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input), Hidden)->setStatus - }; - }; - - let validateFieldOfOptionTypeOnChangeInOnBlurModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurMode = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidator( - 'input, - 'outputValue, - 'message, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - }; - }; - - let validateFieldOfStringTypeOnChangeInOnBlurMode = - ( - ~input: 'input, - ~fieldStatus: fieldStatus(string, 'message), - ~submissionStatus: submissionStatus, - ~validator: singleValueValidator('input, string, 'message, 'action), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok("") as result => Dirty(result, Shown)->setStatus - | Ok(_) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input), Hidden)->setStatus - }; - }; - - let validateFieldOfStringTypeOnChangeInOnBlurModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(string, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - string, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok("") as result => Dirty(result, Shown)->setStatus - | Ok(_) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfStringTypeOnChangeInOnBlurMode = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus(string, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidator('input, string, 'message, 'action), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok("") as result => Dirty(result, Shown)->setStatus - | Ok(_) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfStringTypeOnChangeInOnBlurModeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(string, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - string, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok("") as result => Dirty(result, Shown)->setStatus - | Ok(_) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - }; - }; - - let validateFieldOfOptionStringTypeOnChangeInOnBlurMode = - ( - ~input: 'input, - ~fieldStatus: fieldStatus(option(string), 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidator('input, option(string), 'message, 'action), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(Some("")) as result - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input), Hidden)->setStatus - }; - }; - - let validateFieldOfOptionStringTypeOnChangeInOnBlurModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(option(string), 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - option(string), - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(Some("")) as result - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurMode = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus(option(string), 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidator( - 'input, - option(string), - 'message, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(Some("")) as result - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurModeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(option(string), 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - option(string), - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some("")) as result - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_)) as result - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - }; - }; - - let validateFieldOnChangeInOnChangeMode = - ( - ~input: 'input, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidator('input, 'outputValue, 'message, 'action), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input), Hidden)->setStatus - }; - }; - - let validateFieldOnChangeInOnChangeModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOnChangeInOnChangeMode = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidator( - 'input, - 'outputValue, - 'message, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOnChangeInOnChangeModeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - }; - }; - - let validateFieldOfOptionTypeOnChangeInOnChangeMode = - ( - ~input: 'input, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidator('input, 'outputValue, 'message, 'action), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(Some(_) as x) => Validating(x)->setStatus - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(Some(_) as x) => Validating(x)->setStatus - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input), Hidden)->setStatus - }; - }; - - let validateFieldOfOptionTypeOnChangeInOnChangeModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(Some(_) as x) => Validating(x)->setStatus - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(Some(_) as x) => Validating(x)->setStatus - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeMode = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidator( - 'input, - 'outputValue, - 'message, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(Some(_) as x) => Validating(x)->setStatus - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(Some(_) as x) => Validating(x)->setStatus - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeModeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some(_) as x) => Validating(x)->setStatus - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some(_) as x) => Validating(x)->setStatus - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - }; - }; - - let validateFieldOfStringTypeOnChangeInOnChangeMode = - ( - ~input: 'input, - ~fieldStatus: fieldStatus(string, 'message), - ~submissionStatus: submissionStatus, - ~validator: singleValueValidator('input, string, 'message, 'action), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(x) => Validating(x)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok("") as result => Dirty(result, Shown)->setStatus - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input), Hidden)->setStatus - }; - }; - - let validateFieldOfStringTypeOnChangeInOnChangeModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(string, 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - string, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(x) => Validating(x)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok("") as result => Dirty(result, Shown)->setStatus - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfStringTypeOnChangeInOnChangeMode = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus(string, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidator('input, string, 'message, 'action), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(x) => Validating(x)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok("") as result => Dirty(result, Shown)->setStatus - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfStringTypeOnChangeInOnChangeModeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(string, 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - string, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(x) => Validating(x)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok("") as result => Dirty(result, Shown)->setStatus - | Ok(x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - }; - }; - - let validateFieldOfOptionStringTypeOnChangeInOnChangeMode = - ( - ~input: 'input, - ~fieldStatus: fieldStatus(option(string), 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidator('input, option(string), 'message, 'action), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_) as x) => Validating(x)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input)) { - | Ok(Some("")) as result - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_) as x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input), Hidden)->setStatus - }; - }; - - let validateFieldOfOptionStringTypeOnChangeInOnChangeModeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(option(string), 'message), - ~submissionStatus: submissionStatus, - ~validator: - singleValueValidatorWithMetadata( - 'input, - option(string), - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_) as x) => Validating(x)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, metadata)) { - | Ok(Some("")) as result - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_) as x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, metadata), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeMode = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus(option(string), 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidator( - 'input, - option(string), - 'message, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_) as x) => Validating(x)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index)) { - | Ok(Some("")) as result - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_) as x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus - }; - }; - - let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeModeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(option(string), 'message), - ~submissionStatus: submissionStatus, - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - option(string), - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : 'statuses => { - switch (validator.strategy, fieldStatus, submissionStatus) { - | (_, Dirty(_, Shown), _) - | (_, _, AttemptedToSubmit) - | (OnFirstChange, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_) as x) => Validating(x)->setStatus - } - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some("")) as result - | Ok(None) as result => Dirty(result, Shown)->setStatus - | Ok(Some(_) as x) => Validating(x)->setStatus - | Error(_) as result => Dirty(result, Hidden)->setStatus - } - | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - }; - }; - - let validateDependentFieldOnChange = - ( - ~input: 'input, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - singleValueValidator('input, 'outputValue, 'message, 'action), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Pristine - | Validating(_) - | Dirty(_, Hidden) => None - | Dirty(_, Shown) => - Dirty(validator.validate(input), Shown)->setStatus->Some - }; - }; - - let validateDependentFieldOnChangeWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Pristine - | Validating(_) - | Dirty(_, Hidden) => None - | Dirty(_, Shown) => - Dirty(validator.validate(input, metadata), Shown)->setStatus->Some - }; - }; - - let validateDependentFieldOfCollectionOnChange = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - valueOfCollectionValidator( - 'input, - 'outputValue, - 'message, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Pristine - | Validating(_) - | Dirty(_, Hidden) => None - | Dirty(_, Shown) => - Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some - }; - }; - - let validateDependentFieldOfCollectionOnChangeWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Pristine - | Validating(_) - | Dirty(_, Hidden) => None - | Dirty(_, Shown) => - Dirty(validator.validate(input, ~at=index, ~metadata), Shown) - ->setStatus - ->Some - }; - }; - - let validateFieldOnBlur = - ( - ~input: 'input, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - singleValueValidator('input, 'outputValue, 'message, 'action), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => Dirty(validator.validate(input), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input)) { - | Ok(x) => Validating(x)->setStatus->Some - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - } - } - }; - }; - - let validateFieldOnBlurWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, metadata)) { - | Ok(x) => Validating(x)->setStatus->Some - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - } - } - }; - }; - - let validateFieldOfCollectionOnBlur = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - valueOfCollectionValidator( - 'input, - 'outputValue, - 'message, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, ~at=index)) { - | Ok(x) => Validating(x)->setStatus->Some - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - } - } - }; - }; - - let validateFieldOfCollectionOnBlurWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - ->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(x) => Validating(x)->setStatus->Some - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - } - } - }; - }; - - let validateFieldOfOptionTypeOnBlur = - ( - ~input: 'input, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - singleValueValidator('input, 'outputValue, 'message, 'action), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => Dirty(validator.validate(input), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input)) { - | Ok(Some(_) as x) => Validating(x)->setStatus->Some - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - } - } - }; - }; - - let validateFieldOfOptionTypeOnBlurWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - singleValueValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, metadata)) { - | Ok(Some(_) as x) => Validating(x)->setStatus->Some - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - } - } - }; - }; - - let validateFieldOfCollectionOfOptionTypeOnBlur = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - valueOfCollectionValidator( - 'input, - 'outputValue, - 'message, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, ~at=index)) { - | Ok(Some(_) as x) => Validating(x)->setStatus->Some - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - } - } - }; - }; - - let validateFieldOfCollectionOfOptionTypeOnBlurWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus('outputValue, 'message), - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - 'outputValue, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - ->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some(_) as x) => Validating(x)->setStatus->Some - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - } - } - }; - }; - - let validateFieldOfStringTypeOnBlur = - ( - ~input: 'input, - ~fieldStatus: fieldStatus(string, 'message), - ~validator: singleValueValidator('input, string, 'message, 'action), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => Dirty(validator.validate(input), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - | Ok(x) => Validating(x)->setStatus->Some - } - } - }; - }; - - let validateFieldOfStringTypeOnBlurWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(string, 'message), - ~validator: - singleValueValidatorWithMetadata( - 'input, - string, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, metadata)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - | Ok(x) => Validating(x)->setStatus->Some - } - } - }; - }; - - let validateFieldOfCollectionOfStringTypeOnBlur = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus(string, 'message), - ~validator: - valueOfCollectionValidator('input, string, 'message, 'action), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, ~at=index)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - | Ok(x) => Validating(x)->setStatus->Some - } - } - }; - }; - - let validateFieldOfCollectionOfStringTypeOnBlurWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(string, 'message), - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - string, - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(string, 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - ->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok("") as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - | Ok(x) => Validating(x)->setStatus->Some - } - } - }; - }; - - let validateFieldOfOptionStringTypeOnBlur = - ( - ~input: 'input, - ~fieldStatus: fieldStatus(option(string), 'message), - ~validator: - singleValueValidator('input, option(string), 'message, 'action), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => Dirty(validator.validate(input), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - | Ok(Some(_) as x) => Validating(x)->setStatus->Some - } - } - }; - }; - - let validateFieldOfOptionStringTypeOnBlurWithMetadata = - ( - ~input: 'input, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(option(string), 'message), - ~validator: - singleValueValidatorWithMetadata( - 'input, - option(string), - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, metadata)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - | Ok(Some(_) as x) => Validating(x)->setStatus->Some - } - } - }; - }; - - let validateFieldOfCollectionOfOptionStringTypeOnBlur = - ( - ~input: 'input, - ~index: index, - ~fieldStatus: fieldStatus(option(string), 'message), - ~validator: - valueOfCollectionValidator( - 'input, - option(string), - 'message, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, ~at=index)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - | Ok(Some(_) as x) => Validating(x)->setStatus->Some - } - } - }; - }; - - let validateFieldOfCollectionOfOptionStringTypeOnBlurWithMetadata = - ( - ~input: 'input, - ~index: index, - ~metadata: 'metadata, - ~fieldStatus: fieldStatus(option(string), 'message), - ~validator: - valueOfCollectionValidatorWithMetadata( - 'input, - option(string), - 'message, - 'metadata, - 'action, - ), - ~setStatus: fieldStatus(option(string), 'message) => 'statuses, - ) - : option('statuses) => { - switch (fieldStatus) { - | Validating(_) - | Dirty(_, Shown) => None - | Pristine - | Dirty(_, Hidden) => - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Dirty(validator.validate(input, ~at=index, ~metadata), Hidden) - ->setStatus - ->Some - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (validator.validate(input, ~at=index, ~metadata)) { - | Ok(Some("")) as result - | Ok(None) as result - | Error(_) as result => Dirty(result, Shown)->setStatus->Some - | Ok(Some(_) as x) => Validating(x)->setStatus->Some - } - } - }; - }; -}; diff --git a/lib/src/Formality.res b/lib/src/Formality.res new file mode 100644 index 00000000..26d78393 --- /dev/null +++ b/lib/src/Formality.res @@ -0,0 +1,1990 @@ +module Debouncer = Formality__Debouncer +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 collectionStatus<'message> = result + +type formStatus<'submissionError> = + | Editing + | Submitting(option<'submissionError>) + | Submitted + | SubmissionFailed('submissionError) + +type submissionStatus = + | NeverSubmitted + | AttemptedToSubmit + +let exposeFieldResult = (fieldStatus: fieldStatus<'outputValue, 'message>): option< + result<'outputValue, 'message>, +> => + switch fieldStatus { + | Pristine + | Dirty(_, Hidden) => + None + | Dirty(result, Shown) => Some(result) + } + +type index = int + +type singleValueValidator<'input, 'outputValue, 'message> = { + strategy: strategy, + validate: 'input => result<'outputValue, 'message>, +} + +type singleValueValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata> = { + strategy: strategy, + validate: ('input, 'metadata) => result<'outputValue, 'message>, +} + +type collectionValidatorWithWholeCollectionValidator<'input, 'message, 'fieldsValidators> = { + collection: 'input => result, + fields: 'fieldsValidators, +} + +type collectionValidatorWithWholeCollectionValidatorAndMetadata< + 'input, + 'message, + 'fieldsValidators, + 'metadata, +> = { + collection: ('input, 'metadata) => result, + fields: 'fieldsValidators, +} + +type collectionValidatorWithoutWholeCollectionValidator<'fieldsValidators> = { + collection: unit, + fields: 'fieldsValidators, +} + +type valueOfCollectionValidator<'input, 'outputValue, 'message> = { + strategy: strategy, + validate: ('input, ~at: index) => result<'outputValue, 'message>, +} + +type valueOfCollectionValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata> = { + strategy: strategy, + validate: ('input, ~at: index, ~metadata: 'metadata) => result<'outputValue, 'message>, +} + +type formValidationResult<'output, 'fieldsStatuses, 'collectionsStatuses> = + | Valid({ + output: 'output, + fieldsStatuses: 'fieldsStatuses, + collectionsStatuses: 'collectionsStatuses, + }) + | Invalid({fieldsStatuses: 'fieldsStatuses, collectionsStatuses: 'collectionsStatuses}) + +type submissionCallbacks<'input, 'submissionError> = { + notifyOnSuccess: option<'input> => unit, + notifyOnFailure: 'submissionError => unit, + reset: unit => unit, + dismissSubmissionResult: unit => unit, +} + +let validateFieldOnChangeWithoutValidator = ( + ~fieldInput: 'outputValue, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): 'statuses => Dirty(Ok(fieldInput), Hidden)->setStatus + +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 validateFieldOnChangeWithValidatorAndMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Shown)->setStatus + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(_) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + +let validateFieldOfCollectionOnChangeWithValidator = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Shown)->setStatus + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(_) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + +let validateFieldOfCollectionOnChangeWithValidatorAndMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Shown)->setStatus + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(_) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + +let validateDependentFieldOnChange = ( + ~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) => Dirty(validator.validate(input), Shown)->setStatus->Some + } + +let validateDependentFieldOnChangeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: singleValueValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): option<'statuses> => + switch fieldStatus { + | Pristine + | Dirty(_, Hidden) => + None + | Dirty(_, Shown) => Dirty(validator.validate(input, metadata), Shown)->setStatus->Some + } + +let validateDependentFieldOfCollectionOnChange = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): option<'statuses> => + switch fieldStatus { + | Pristine + | Dirty(_, Hidden) => + None + | Dirty(_, Shown) => Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some + } + +let validateDependentFieldOfCollectionOnChangeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): option<'statuses> => + switch fieldStatus { + | Pristine + | Dirty(_, Hidden) => + None + | Dirty(_, Shown) => + Dirty(validator.validate(input, ~at=index, ~metadata), Shown)->setStatus->Some + } + +let validateFieldOnBlurWithoutValidator = ( + ~fieldInput: 'outputValue, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): option<'statuses> => + switch fieldStatus { + | Dirty(_, Shown | Hidden) => None + | Pristine => Dirty(Ok(fieldInput), Hidden)->setStatus->Some + } + +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 => + Dirty(validator.validate(input), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + Dirty(validator.validate(input), Shown)->setStatus->Some + } + } + +let validateFieldOnBlurWithValidatorAndMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: singleValueValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): option<'statuses> => + switch fieldStatus { + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + Dirty(validator.validate(input, metadata), Shown)->setStatus->Some + } + } + +let validateFieldOfCollectionOnBlurWithValidator = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): option<'statuses> => + switch fieldStatus { + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some + } + } + +let validateFieldOfCollectionOnBlurWithValidatorAndMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, +): option<'statuses> => + switch fieldStatus { + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + Dirty(validator.validate(input, ~at=index, ~metadata), Shown)->setStatus->Some + } + } + +module Async = { + type fieldStatus<'outputValue, 'message> = + | Pristine + | Dirty(result<'outputValue, 'message>, visibility) + | Validating('outputValue) + + type exposedFieldStatus<'outputValue, 'message> = + | Validating('outputValue) + | Result(result<'outputValue, 'message>) + + type singleValueValidator<'input, 'outputValue, 'message, 'action> = { + strategy: strategy, + validate: 'input => result<'outputValue, 'message>, + validateAsync: (('outputValue, 'action => unit)) => unit, + eq: ('outputValue, 'outputValue) => bool, + } + + type singleValueValidatorWithMetadata<'input, 'outputValue, 'message, 'metadata, 'action> = { + strategy: strategy, + validate: ('input, 'metadata) => result<'outputValue, 'message>, + validateAsync: (('outputValue, 'metadata, 'action => unit)) => unit, + eq: ('outputValue, 'outputValue) => bool, + } + + type valueOfCollectionValidator<'input, 'outputValue, 'message, 'action> = { + strategy: strategy, + validate: ('input, ~at: index) => result<'outputValue, 'message>, + validateAsync: (('outputValue, index, 'action => unit)) => unit, + eq: ('outputValue, 'outputValue) => bool, + } + + type valueOfCollectionValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + > = { + strategy: strategy, + validate: ('input, ~at: index, ~metadata: 'metadata) => result<'outputValue, 'message>, + validateAsync: (('outputValue, index, 'metadata, 'action => unit)) => unit, + eq: ('outputValue, 'outputValue) => bool, + } + + type validateAsyncFn<'outputValue, 'message> = 'outputValue => Js.Promise.t< + result<'outputValue, 'message>, + > + + type validateAsyncFnWithMetadata<'outputValue, 'message, 'metadata> = ( + 'outputValue, + 'metadata, + ) => Js.Promise.t> + + let validateAsync = ( + ~value: 'outputValue, + ~validate: validateAsyncFn<'outputValue, 'message>, + ~andThen: result<'outputValue, 'message> => unit, + ): unit => + validate(value) + ->{ + open Js.Promise + then_(res => res->andThen->resolve, _) + } + ->ignore + + let validateAsyncWithMetadata = ( + ~value: 'outputValue, + ~metadata: 'metadata, + ~validate: validateAsyncFnWithMetadata<'outputValue, 'message, 'metadata>, + ~andThen: result<'outputValue, 'message> => unit, + ): unit => + validate(value, metadata) + ->{ + open Js.Promise + then_(res => res->andThen->resolve, _) + } + ->ignore + + type formValidationResult<'output, 'fieldsStatuses, 'collectionsStatuses> = + | Valid({ + output: 'output, + fieldsStatuses: 'fieldsStatuses, + collectionsStatuses: 'collectionsStatuses, + }) + | Invalid({fieldsStatuses: 'fieldsStatuses, collectionsStatuses: 'collectionsStatuses}) + | Validating({fieldsStatuses: 'fieldsStatuses, collectionsStatuses: 'collectionsStatuses}) + + let exposeFieldResult = (fieldStatus: fieldStatus<'outputValue, 'message>): option< + exposedFieldStatus<'outputValue, 'message>, + > => + switch fieldStatus { + | Pristine + | Dirty(_, Hidden) => + None + | Validating(x) => Some(Validating(x)) + | Dirty(result, Shown) => Some(Result(result)) + } + + let validateFieldOnChangeInOnBlurMode = ( + ~input: 'input, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(_) as result => Dirty(result, Hidden)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + } + + let validateFieldOnChangeInOnBlurModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(_) as result => Dirty(result, Hidden)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + + let validateFieldOfCollectionOnChangeInOnBlurMode = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(_) as result => Dirty(result, Hidden)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + + let validateFieldOfCollectionOnChangeInOnBlurModeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(_) as result => Dirty(result, Hidden)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + + let validateFieldOfOptionTypeOnChangeInOnBlurMode = ( + ~input: 'input, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + } + + let validateFieldOfOptionTypeOnChangeInOnBlurModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + + let validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurMode = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + + let validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + + let validateFieldOfStringTypeOnChangeInOnBlurMode = ( + ~input: 'input, + ~fieldStatus: fieldStatus, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator<'input, string, 'message, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(_) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + } + + let validateFieldOfStringTypeOnChangeInOnBlurModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata<'input, string, 'message, 'metadata, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(_) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + + let validateFieldOfCollectionOfStringTypeOnChangeInOnBlurMode = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, string, 'message, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(_) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + + let validateFieldOfCollectionOfStringTypeOnChangeInOnBlurModeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + string, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(_) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + + let validateFieldOfOptionStringTypeOnChangeInOnBlurMode = ( + ~input: 'input, + ~fieldStatus: fieldStatus, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator<'input, option, 'message, 'action>, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(Some("")) as result + | Ok(None) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + } + + let validateFieldOfOptionStringTypeOnChangeInOnBlurModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata< + 'input, + option, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(Some("")) as result + | Ok(None) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + + let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurMode = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, option, 'message, 'action>, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(Some("")) as result + | Ok(None) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + + let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurModeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + option, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some("")) as result + | Ok(None) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => + Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + + let validateFieldOnChangeInOnChangeMode = ( + ~input: 'input, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + } + + let validateFieldOnChangeInOnChangeModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + + let validateFieldOfCollectionOnChangeInOnChangeMode = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + + let validateFieldOfCollectionOnChangeInOnChangeModeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + + let validateFieldOfOptionTypeOnChangeInOnChangeMode = ( + ~input: 'input, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + } + + let validateFieldOfOptionTypeOnChangeInOnChangeModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + + let validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeMode = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + + let validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeModeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + + let validateFieldOfStringTypeOnChangeInOnChangeMode = ( + ~input: 'input, + ~fieldStatus: fieldStatus, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator<'input, string, 'message, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + } + + let validateFieldOfStringTypeOnChangeInOnChangeModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata<'input, string, 'message, 'metadata, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + + let validateFieldOfCollectionOfStringTypeOnChangeInOnChangeMode = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, string, 'message, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + + let validateFieldOfCollectionOfStringTypeOnChangeInOnChangeModeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + string, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + + let validateFieldOfOptionStringTypeOnChangeInOnChangeMode = ( + ~input: 'input, + ~fieldStatus: fieldStatus, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidator<'input, option, 'message, 'action>, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input) { + | Ok(Some("")) as result + | Ok(None) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input), Hidden)->setStatus + } + + let validateFieldOfOptionStringTypeOnChangeInOnChangeModeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, 'message>, + ~submissionStatus: submissionStatus, + ~validator: singleValueValidatorWithMetadata< + 'input, + option, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, metadata) { + | Ok(Some("")) as result + | Ok(None) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, metadata), Hidden)->setStatus + } + + let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeMode = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator<'input, option, 'message, 'action>, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index) { + | Ok(Some("")) as result + | Ok(None) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + } + + let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeModeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, 'message>, + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + option, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): 'statuses => + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some("")) as result + | Ok(None) as result => + Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus + } + + let validateDependentFieldOnChange = ( + ~input: 'input, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: singleValueValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Pristine + | Validating(_) + | Dirty(_, Hidden) => + None + | Dirty(_, Shown) => Dirty(validator.validate(input), Shown)->setStatus->Some + } + + let validateDependentFieldOnChangeWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: singleValueValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Pristine + | Validating(_) + | Dirty(_, Hidden) => + None + | Dirty(_, Shown) => Dirty(validator.validate(input, metadata), Shown)->setStatus->Some + } + + let validateDependentFieldOfCollectionOnChange = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Pristine + | Validating(_) + | Dirty(_, Hidden) => + None + | Dirty(_, Shown) => Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some + } + + let validateDependentFieldOfCollectionOnChangeWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Pristine + | Validating(_) + | Dirty(_, Hidden) => + None + | Dirty(_, Shown) => + Dirty(validator.validate(input, ~at=index, ~metadata), Shown)->setStatus->Some + } + + let validateFieldOnBlur = ( + ~input: 'input, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: singleValueValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input) { + | Ok(x) => Validating(x)->setStatus->Some + | Error(_) as result => Dirty(result, Shown)->setStatus->Some + } + } + } + + let validateFieldOnBlurWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: singleValueValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, metadata) { + | Ok(x) => Validating(x)->setStatus->Some + | Error(_) as result => Dirty(result, Shown)->setStatus->Some + } + } + } + + let validateFieldOfCollectionOnBlur = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, ~at=index) { + | Ok(x) => Validating(x)->setStatus->Some + | Error(_) as result => Dirty(result, Shown)->setStatus->Some + } + } + } + + let validateFieldOfCollectionOnBlurWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(x) => Validating(x)->setStatus->Some + | Error(_) as result => Dirty(result, Shown)->setStatus->Some + } + } + } + + let validateFieldOfOptionTypeOnBlur = ( + ~input: 'input, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: singleValueValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input) { + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + } + } + } + + let validateFieldOfOptionTypeOnBlurWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: singleValueValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, metadata) { + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + } + } + } + + let validateFieldOfCollectionOfOptionTypeOnBlur = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidator<'input, 'outputValue, 'message, 'action>, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, ~at=index) { + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + } + } + } + + let validateFieldOfCollectionOfOptionTypeOnBlurWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus<'outputValue, 'message>, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + 'outputValue, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus<'outputValue, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + } + } + } + + let validateFieldOfStringTypeOnBlur = ( + ~input: 'input, + ~fieldStatus: fieldStatus, + ~validator: singleValueValidator<'input, string, 'message, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + | Ok(x) => Validating(x)->setStatus->Some + } + } + } + + let validateFieldOfStringTypeOnBlurWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, + ~validator: singleValueValidatorWithMetadata<'input, string, 'message, 'metadata, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, metadata) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + | Ok(x) => Validating(x)->setStatus->Some + } + } + } + + let validateFieldOfCollectionOfStringTypeOnBlur = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus, + ~validator: valueOfCollectionValidator<'input, string, 'message, 'action>, + ~setStatus: fieldStatus => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, ~at=index) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + | Ok(x) => Validating(x)->setStatus->Some + } + } + } + + let validateFieldOfCollectionOfStringTypeOnBlurWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + string, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok("") as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + | Ok(x) => Validating(x)->setStatus->Some + } + } + } + + let validateFieldOfOptionStringTypeOnBlur = ( + ~input: 'input, + ~fieldStatus: fieldStatus, 'message>, + ~validator: singleValueValidator<'input, option, 'message, 'action>, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + } + } + } + + let validateFieldOfOptionStringTypeOnBlurWithMetadata = ( + ~input: 'input, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, 'message>, + ~validator: singleValueValidatorWithMetadata< + 'input, + option, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, metadata) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + } + } + } + + let validateFieldOfCollectionOfOptionStringTypeOnBlur = ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus, 'message>, + ~validator: valueOfCollectionValidator<'input, option, 'message, 'action>, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, ~at=index) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + } + } + } + + let validateFieldOfCollectionOfOptionStringTypeOnBlurWithMetadata = ( + ~input: 'input, + ~index: index, + ~metadata: 'metadata, + ~fieldStatus: fieldStatus, 'message>, + ~validator: valueOfCollectionValidatorWithMetadata< + 'input, + option, + 'message, + 'metadata, + 'action, + >, + ~setStatus: fieldStatus, 'message> => 'statuses, + ): option<'statuses> => + switch fieldStatus { + | Validating(_) + | Dirty(_, Shown) => + None + | Pristine + | Dirty(_, Hidden) => + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index, ~metadata), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch validator.validate(input, ~at=index, ~metadata) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => + Dirty(result, Shown)->setStatus->Some + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + } + } + } +} diff --git a/lib/src/FormalityCompat.re b/lib/src/FormalityCompat.re deleted file mode 100644 index c62d470f..00000000 --- a/lib/src/FormalityCompat.re +++ /dev/null @@ -1,21 +0,0 @@ -include FormalityCompat__Validation.Result; -include FormalityCompat__Validation.Sync; -include FormalityCompat__PublicHelpers; - -module Strategy = FormalityCompat__Strategy; -module FormStatus = FormalityCompat__FormStatus; - -module Make = FormalityCompat__Form.Make; -module MakeWithId = FormalityCompat__FormWithId.Make; - -module Async = { - include FormalityCompat__Validation.Async; - - module Make = FormalityCompat__FormAsyncOnChange.Make; - module MakeWithId = FormalityCompat__FormAsyncOnChangeWithId.Make; - - module MakeOnBlur = FormalityCompat__FormAsyncOnBlur.Make; - module MakeOnBlurWithId = FormalityCompat__FormAsyncOnBlurWithId.Make; - - let debounceInterval = FormalityCompat__FormAsyncOnChangeWithId.defaultDebounceInterval; -}; diff --git a/lib/src/FormalityCompat.rei b/lib/src/FormalityCompat.rei deleted file mode 100644 index 2a6c1045..00000000 --- a/lib/src/FormalityCompat.rei +++ /dev/null @@ -1,64 +0,0 @@ -module Dom = FormalityCompat__PublicHelpers.Dom; -module Strategy = FormalityCompat__Strategy; -module FormStatus = FormalityCompat__FormStatus; - -module Make = FormalityCompat__Form.Make; -module MakeWithId = FormalityCompat__FormWithId.Make; - -type ok = FormalityCompat__Validation.Result.ok = | Valid | NoValue; - -type result('message) = Belt.Result.t(ok, 'message); - -type status('message) = - FormalityCompat__Validation.Sync.status('message) = - | Pristine - | Dirty( - FormalityCompat__Validation.Result.result('message), - FormalityCompat__Validation.Visibility.t, - ); - -type validate('state, 'message) = - 'state => FormalityCompat__Validation.Result.result('message); - -type validator('field, 'state, 'message) = - FormalityCompat__Validation.Sync.validator('field, 'state, 'message) = { - field: 'field, - strategy: FormalityCompat__Strategy.t, - dependents: option(list('field)), - validate: validate('state, 'message), - }; - -module Async: { - module Make = FormalityCompat__FormAsyncOnChange.Make; - module MakeWithId = FormalityCompat__FormAsyncOnChangeWithId.Make; - - module MakeOnBlur = FormalityCompat__FormAsyncOnBlur.Make; - module MakeOnBlurWithId = FormalityCompat__FormAsyncOnBlurWithId.Make; - - let debounceInterval: int; - - type status('message) = - FormalityCompat__Validation.Async.status('message) = - | Pristine - | Dirty( - FormalityCompat__Validation.Result.result('message), - FormalityCompat__Validation.Visibility.t, - ) - | Validating; - - type validate('state, 'message) = - 'state => - Js.Promise.t(FormalityCompat__Validation.Result.result('message)); - - type equalityChecker('state) = ('state, 'state) => bool; - - type validator('field, 'state, 'message) = - FormalityCompat__Validation.Async.validator('field, 'state, 'message) = { - field: 'field, - strategy: FormalityCompat__Strategy.t, - dependents: option(list('field)), - validate: FormalityCompat__Validation.Sync.validate('state, 'message), - validateAsync: - option((validate('state, 'message), equalityChecker('state))), - }; -}; diff --git a/lib/src/FormalityCompat.res b/lib/src/FormalityCompat.res new file mode 100644 index 00000000..3e7e7a85 --- /dev/null +++ b/lib/src/FormalityCompat.res @@ -0,0 +1,21 @@ +include FormalityCompat__Validation.Result +include FormalityCompat__Validation.Sync +include FormalityCompat__PublicHelpers + +module Strategy = FormalityCompat__Strategy +module FormStatus = FormalityCompat__FormStatus + +module Make = FormalityCompat__Form.Make +module MakeWithId = FormalityCompat__FormWithId.Make + +module Async = { + include FormalityCompat__Validation.Async + + module Make = FormalityCompat__FormAsyncOnChange.Make + module MakeWithId = FormalityCompat__FormAsyncOnChangeWithId.Make + + module MakeOnBlur = FormalityCompat__FormAsyncOnBlur.Make + module MakeOnBlurWithId = FormalityCompat__FormAsyncOnBlurWithId.Make + + let debounceInterval = FormalityCompat__FormAsyncOnChangeWithId.defaultDebounceInterval +} diff --git a/lib/src/FormalityCompat.resi b/lib/src/FormalityCompat.resi new file mode 100644 index 00000000..10857f41 --- /dev/null +++ b/lib/src/FormalityCompat.resi @@ -0,0 +1,66 @@ +module Dom = FormalityCompat__PublicHelpers.Dom +module Strategy = FormalityCompat__Strategy +module FormStatus = FormalityCompat__FormStatus + +module Make = FormalityCompat__Form.Make +module MakeWithId = FormalityCompat__FormWithId.Make + +type ok = FormalityCompat__Validation.Result.ok = Valid | NoValue + +type result<'message> = Belt.Result.t + +type status<'message> = FormalityCompat__Validation.Sync.status<'message> = + | Pristine + | Dirty( + FormalityCompat__Validation.Result.result<'message>, + FormalityCompat__Validation.Visibility.t, + ) + +type validate<'state, 'message> = 'state => FormalityCompat__Validation.Result.result<'message> + +type validator<'field, 'state, 'message> = FormalityCompat__Validation.Sync.validator< + 'field, + 'state, + 'message, +> = { + field: 'field, + strategy: FormalityCompat__Strategy.t, + dependents: option>, + validate: validate<'state, 'message>, +} + +module Async: { + module Make = FormalityCompat__FormAsyncOnChange.Make + module MakeWithId = FormalityCompat__FormAsyncOnChangeWithId.Make + + module MakeOnBlur = FormalityCompat__FormAsyncOnBlur.Make + module MakeOnBlurWithId = FormalityCompat__FormAsyncOnBlurWithId.Make + + let debounceInterval: int + + type status<'message> = FormalityCompat__Validation.Async.status<'message> = + | Pristine + | Dirty( + FormalityCompat__Validation.Result.result<'message>, + FormalityCompat__Validation.Visibility.t, + ) + | Validating + + type validate<'state, 'message> = 'state => Js.Promise.t< + FormalityCompat__Validation.Result.result<'message>, + > + + type equalityChecker<'state> = ('state, 'state) => bool + + type validator<'field, 'state, 'message> = FormalityCompat__Validation.Async.validator< + 'field, + 'state, + 'message, + > = { + field: 'field, + strategy: FormalityCompat__Strategy.t, + dependents: option>, + validate: FormalityCompat__Validation.Sync.validate<'state, 'message>, + validateAsync: option<(validate<'state, 'message>, equalityChecker<'state>)>, + } +} diff --git a/lib/src/FormalityCompat__Form.re b/lib/src/FormalityCompat__Form.re deleted file mode 100644 index f5c8ac26..00000000 --- a/lib/src/FormalityCompat__Form.re +++ /dev/null @@ -1,19 +0,0 @@ -module Validation = FormalityCompat__FormWithId.Validation; - -module type Form = { - type field; - type state; - type message; - type submissionError; - let validators: list(Validation.validator(field, state, message)); -}; - -module Make = (Form: Form) => - FormalityCompat__FormWithId.Make({ - include Form; - module FieldId = - Id.MakeComparable({ - type t = Form.field; - let cmp = Pervasives.compare; - }); - }); diff --git a/lib/src/FormalityCompat__Form.res b/lib/src/FormalityCompat__Form.res new file mode 100644 index 00000000..bdc2f581 --- /dev/null +++ b/lib/src/FormalityCompat__Form.res @@ -0,0 +1,17 @@ +module Validation = FormalityCompat__FormWithId.Validation + +module type Form = { + type field + type state + type message + type submissionError + let validators: list> +} + +module Make = (Form: Form) => FormalityCompat__FormWithId.Make({ + include Form + module FieldId = Id.MakeComparable({ + type t = Form.field + let cmp = Pervasives.compare + }) +}) diff --git a/lib/src/FormalityCompat__FormAsyncOnBlur.re b/lib/src/FormalityCompat__FormAsyncOnBlur.re deleted file mode 100644 index 19b0fb5d..00000000 --- a/lib/src/FormalityCompat__FormAsyncOnBlur.re +++ /dev/null @@ -1,19 +0,0 @@ -module Validation = FormalityCompat__FormAsyncOnBlurWithId.Validation; - -module type Form = { - type field; - type state; - type message; - type submissionError; - let validators: list(Validation.Async.validator(field, state, message)); -}; - -module Make = (Form: Form) => - FormalityCompat__FormAsyncOnBlurWithId.Make({ - include Form; - module FieldId = - Id.MakeComparable({ - type t = Form.field; - let cmp = Pervasives.compare; - }); - }); diff --git a/lib/src/FormalityCompat__FormAsyncOnBlur.res b/lib/src/FormalityCompat__FormAsyncOnBlur.res new file mode 100644 index 00000000..a1c03502 --- /dev/null +++ b/lib/src/FormalityCompat__FormAsyncOnBlur.res @@ -0,0 +1,17 @@ +module Validation = FormalityCompat__FormAsyncOnBlurWithId.Validation + +module type Form = { + type field + type state + type message + type submissionError + let validators: list> +} + +module Make = (Form: Form) => FormalityCompat__FormAsyncOnBlurWithId.Make({ + include Form + module FieldId = Id.MakeComparable({ + type t = Form.field + let cmp = Pervasives.compare + }) +}) diff --git a/lib/src/FormalityCompat__FormAsyncOnBlurWithId.re b/lib/src/FormalityCompat__FormAsyncOnBlurWithId.re deleted file mode 100644 index 60de4602..00000000 --- a/lib/src/FormalityCompat__FormAsyncOnBlurWithId.re +++ /dev/null @@ -1,476 +0,0 @@ -module Validation = FormalityCompat__Validation; -module Strategy = FormalityCompat__Strategy; -module FormStatus = FormalityCompat__FormStatus; -module ReactUpdate = FormalityCompat__ReactUpdate; - -module type Form = { - type field; - type state; - type message; - type submissionError; - let validators: list(Validation.Async.validator(field, state, message)); - module FieldId: { - type identity; - type t = field; - let cmp: Belt.Id.cmp(t, identity); - }; -}; - -module Make = (Form: Form) => { - module FieldId = Form.FieldId; - - type state = { - input: Form.state, - status: FormStatus.t(Form.submissionError), - fields: - Map.t( - Form.field, - Validation.Async.status(Form.message), - FieldId.identity, - ), - validators: - ref( - Map.t( - Form.field, - Validation.Async.validator(Form.field, Form.state, Form.message), - FieldId.identity, - ), - ), - submittedOnce: bool, - }; - - type action = - | Change(Form.field, Form.state) - | Blur(Form.field) - | ApplyAsyncResult( - Form.field, - Form.state, - Validation.Result.result(Form.message), - ) - | Submit - | SetSubmittedStatus(option(Form.state)) - | SetSubmissionFailedStatus(Form.submissionError) - | MapSubmissionError(Form.submissionError => Form.submissionError) - | DismissSubmissionError - | DismissSubmissionResult - | Reset; - - type interface = { - state: Form.state, - status: FormStatus.t(Form.submissionError), - result: Form.field => option(Validation.Result.result(Form.message)), - dirty: unit => bool, - validating: Form.field => bool, - submitting: bool, - change: (Form.field, Form.state) => unit, - blur: Form.field => unit, - submit: unit => unit, - mapSubmissionError: (Form.submissionError => Form.submissionError) => unit, - dismissSubmissionError: unit => unit, - dismissSubmissionResult: unit => unit, - reset: unit => unit, - }; - - let getInitialState = input => { - input, - status: FormStatus.Editing, - fields: - Form.validators->List.reduce( - Map.make(~id=(module FieldId)), (fields, validator) => - fields->Map.set(validator.field, Validation.Async.Pristine) - ), - validators: - ref( - Form.validators->List.reduce( - Map.make(~id=(module FieldId)), (fields, validator) => - fields->Map.set(validator.field, validator) - ), - ), - submittedOnce: false, - }; - - let useForm = - ( - ~initialState: Form.state, - ~onSubmit: - ( - Form.state, - Validation.submissionCallbacks(Form.state, 'submissionError) - ) => - unit, - ) => { - let memoizedInitialState = - React.useMemo1(() => initialState->getInitialState, [|initialState|]); - - let (state, dispatch) = - ReactUpdate.useReducer(memoizedInitialState, (state, action) => - switch (action) { - | Change(field, input) => - let validator = (state.validators^)->Map.get(field); - switch (validator) { - | None => - Update({ - ...state, - input, - fields: - state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), - }) - | Some(validator) => - let status = state.fields->Map.get(field); - let result = input->(validator.validate); - let fields = - switch (validator.dependents) { - | None => state.fields - | Some(dependents) => - dependents->List.reduce( - state.fields, - (fields, field) => { - let status = fields->Map.get(field); - switch (status) { - | None - | Some(Pristine) - | Some(Validating) - | Some(Dirty(_, Hidden)) => fields - | Some(Dirty(_, Shown)) => - let validator = (state.validators^)->Map.getExn(field); - fields->Map.set( - field, - Dirty(input->(validator.validate), Shown), - ); - }; - }, - ) - }; - switch (validator.strategy, status, state.submittedOnce) { - | (_, Some(Dirty(_, Shown)), _) - | (_, _, true) - | (OnFirstChange, _, false) => - switch (result, validator.validateAsync) { - | (_, None) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - | (Ok(Valid), Some(_)) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - | (Ok(NoValue) | Error(_), Some(_)) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - } - - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, false) => - switch (result, validator.validateAsync) { - | (Ok(Valid | NoValue), None) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - | (Error(_), None) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - - | (Ok(Valid), Some(_)) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - | (Ok(NoValue), Some(_)) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - | (Error(_), Some(_)) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - } - - | (OnFirstBlur | OnSubmit, _, false) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - }; - }; - - | Blur(field) => - let status = state.fields->Map.get(field); - let validator = (state.validators^)->Map.get(field); - switch (status, validator) { - | (Some(Validating), _) - | (Some(Dirty(_, Shown)), Some(_) | None) - | (Some(Dirty(_, Hidden)), None) => NoUpdate - | (Some(Pristine) | None, None) => - Update({ - ...state, - fields: - state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), - }) - - | (Some(Pristine | Dirty(_, Hidden)) | None, Some(validator)) => - let result = state.input->(validator.validate); - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Hidden)), - }) - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (result, validator.validateAsync) { - | (_, None) => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Shown)), - }) - | (Ok(Valid), Some((validateAsync, _))) => - UpdateWithSideEffects( - { - ...state, - fields: state.fields->Map.set(field, Validating), - }, - ({dispatch}) => - Js.Promise.( - state.input - ->validateAsync - ->then_( - result => { - ApplyAsyncResult(field, state.input, result) - ->dispatch; - resolve(); - }, - _, - ) - ->ignore - ), - ) - | (Ok(NoValue) | Error(_), Some((_, _))) => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Shown)), - }) - } - }; - }; - - | ApplyAsyncResult(field, input, result) => - let validator = (state.validators^)->Map.getExn(field); - let eq = validator.validateAsync->Option.getExn->snd; - if (input->eq(state.input)) { - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Shown)), - }); - } else { - NoUpdate; - }; - - | Submit => - switch (state.status) { - | Submitting(_) => NoUpdate - | Editing - | Submitted - | SubmissionFailed(_) => - let (valid, fields, validating) = - (state.validators^) - ->Map.reduce( - (true, state.fields, false), - ((valid, fields, validating), field, validator) => { - let status = fields->Map.get(field); - switch (status) { - | _ when validating => (valid, fields, true) - | Some(Validating) => (valid, fields, true) - | Some(_) - | None => - let currentResultIsInvalid = - switch (status) { - | Some(Dirty(Error(_), _)) => true - | Some(Dirty(Ok(_), _) | Pristine | Validating) - | None => false - }; - let result = state.input->(validator.validate); - let fields = - switch ( - currentResultIsInvalid, - result, - validator.validateAsync, - ) { - | (true, Ok(Valid), Some(_)) => fields - | (_, _, _) => - fields->Map.set(field, Dirty(result, Shown)) - }; - switch (valid, fields->Map.get(field)) { - | (false, _) - | (true, Some(Dirty(Error(_), _))) => ( - false, - fields, - false, - ) - | ( - true, - Some( - Dirty(Ok(Valid | NoValue), _) | Pristine | - Validating, - ), - ) - | (true, None) => (true, fields, false) - }; - }; - }, - ); - if (validating) { - NoUpdate; - } else if (valid) { - UpdateWithSideEffects( - { - ...state, - fields, - status: - FormStatus.Submitting( - switch (state.status) { - | SubmissionFailed(error) => Some(error) - | Editing - | Submitted - | Submitting(_) => None - }, - ), - submittedOnce: true, - }, - ({state, dispatch}) => - state.input - ->onSubmit({ - notifyOnSuccess: data => - data->SetSubmittedStatus->dispatch, - notifyOnFailure: error => - SetSubmissionFailedStatus(error)->dispatch, - reset: () => Reset->dispatch, - dismissSubmissionResult: () => - DismissSubmissionResult->dispatch, - }), - ); - } else { - Update({ - ...state, - fields, - status: FormStatus.Editing, - submittedOnce: true, - }); - }; - } - - | SetSubmittedStatus(data) => - switch (data) { - | Some(data) => - Update({ - ...state, - input: data, - status: FormStatus.Submitted, - fields: state.fields->Map.map(_ => Validation.Async.Pristine), - }) - | None => - Update({ - ...state, - status: FormStatus.Submitted, - fields: state.fields->Map.map(_ => Validation.Async.Pristine), - }) - } - - | SetSubmissionFailedStatus(error) => - Update({...state, status: FormStatus.SubmissionFailed(error)}) - - | MapSubmissionError(map) => - switch (state.status) { - | Submitting(Some(error)) => - Update({...state, status: Submitting(Some(error->map))}) - | SubmissionFailed(error) => - Update({...state, status: SubmissionFailed(error->map)}) - | Editing - | Submitting(None) - | Submitted => NoUpdate - } - - | DismissSubmissionError => - switch (state.status) { - | Editing - | Submitting(_) - | Submitted => NoUpdate - | SubmissionFailed(_) => - Update({...state, status: FormStatus.Editing}) - } - - | DismissSubmissionResult => - switch (state.status) { - | Editing - | Submitting(_) => NoUpdate - | Submitted - | SubmissionFailed(_) => - Update({...state, status: FormStatus.Editing}) - } - - | Reset => Update(initialState->getInitialState) - } - ); - - { - state: state.input, - status: state.status, - result: field => - switch (state.fields->Map.get(field)) { - | None - | Some(Pristine) - | Some(Validating) - | Some(Dirty(_, Hidden)) => None - | Some(Dirty(result, Shown)) => Some(result) - }, - dirty: () => - state.fields - ->Map.some((_, status) => - switch (status) { - | Dirty(_) - | Validating => true - | Pristine => false - } - ), - validating: field => - switch (state.fields->Map.get(field)) { - | Some(Validating) => true - | None - | Some(Pristine) - | Some(Dirty(_)) => false - }, - submitting: - switch (state.status) { - | Submitting(_) => true - | Editing - | Submitted - | SubmissionFailed(_) => false - }, - change: (field, state) => Change(field, state)->dispatch, - blur: field => Blur(field)->dispatch, - submit: () => Submit->dispatch, - mapSubmissionError: map => MapSubmissionError(map)->dispatch, - dismissSubmissionError: () => DismissSubmissionError->dispatch, - dismissSubmissionResult: () => DismissSubmissionResult->dispatch, - reset: () => Reset->dispatch, - }; - }; -}; diff --git a/lib/src/FormalityCompat__FormAsyncOnBlurWithId.res b/lib/src/FormalityCompat__FormAsyncOnBlurWithId.res new file mode 100644 index 00000000..8a13d4a9 --- /dev/null +++ b/lib/src/FormalityCompat__FormAsyncOnBlurWithId.res @@ -0,0 +1,425 @@ +module Validation = FormalityCompat__Validation +module Strategy = FormalityCompat__Strategy +module FormStatus = FormalityCompat__FormStatus +module ReactUpdate = FormalityCompat__ReactUpdate + +module type Form = { + type field + type state + type message + type submissionError + let validators: list> + module FieldId: { + type identity + type t = field + let cmp: Belt.Id.cmp + } +} + +module Make = (Form: Form) => { + module FieldId = Form.FieldId + + type state = { + input: Form.state, + status: FormStatus.t, + fields: Map.t, FieldId.identity>, + validators: ref< + Map.t< + Form.field, + Validation.Async.validator, + FieldId.identity, + >, + >, + submittedOnce: bool, + } + + type action = + | Change(Form.field, Form.state) + | Blur(Form.field) + | ApplyAsyncResult(Form.field, Form.state, Validation.Result.result) + | Submit + | SetSubmittedStatus(option) + | SetSubmissionFailedStatus(Form.submissionError) + | MapSubmissionError(Form.submissionError => Form.submissionError) + | DismissSubmissionError + | DismissSubmissionResult + | Reset + + type interface = { + state: Form.state, + status: FormStatus.t, + result: Form.field => option>, + dirty: unit => bool, + validating: Form.field => bool, + submitting: bool, + change: (Form.field, Form.state) => unit, + blur: Form.field => unit, + submit: unit => unit, + mapSubmissionError: (Form.submissionError => Form.submissionError) => unit, + dismissSubmissionError: unit => unit, + dismissSubmissionResult: unit => unit, + reset: unit => unit, + } + + let getInitialState = input => { + input, + status: FormStatus.Editing, + fields: Form.validators->List.reduce(Map.make(~id=module(FieldId)), (fields, validator) => + fields->Map.set(validator.field, Validation.Async.Pristine) + ), + validators: ref( + Form.validators->List.reduce(Map.make(~id=module(FieldId)), (fields, validator) => + fields->Map.set(validator.field, validator) + ), + ), + submittedOnce: false, + } + + let useForm = ( + ~initialState: Form.state, + ~onSubmit: (Form.state, Validation.submissionCallbacks) => unit, + ) => { + let memoizedInitialState = React.useMemo1(() => initialState->getInitialState, [initialState]) + + let (state, dispatch) = ReactUpdate.useReducer(memoizedInitialState, (state, action) => + switch action { + | Change(field, input) => + let validator = state.validators.contents->Map.get(field) + switch validator { + | None => + Update({ + ...state, + input, + fields: state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), + }) + | Some(validator) => + let status = state.fields->Map.get(field) + let result = input->validator.validate + let fields = switch validator.dependents { + | None => state.fields + | Some(dependents) => + dependents->List.reduce(state.fields, (fields, field) => { + let status = fields->Map.get(field) + switch status { + | None + | Some(Pristine) + | Some(Validating) + | Some(Dirty(_, Hidden)) => fields + | Some(Dirty(_, Shown)) => + let validator = state.validators.contents->Map.getExn(field) + fields->Map.set(field, Dirty(input->validator.validate, Shown)) + } + }) + } + switch (validator.strategy, status, state.submittedOnce) { + | (_, Some(Dirty(_, Shown)), _) + | (_, _, true) + | (OnFirstChange, _, false) => + switch (result, validator.validateAsync) { + | (_, None) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + | (Ok(Valid), Some(_)) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + | (Ok(NoValue) | Error(_), Some(_)) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + } + + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, false) => + switch (result, validator.validateAsync) { + | (Ok(Valid | NoValue), None) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + | (Error(_), None) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + + | (Ok(Valid), Some(_)) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + | (Ok(NoValue), Some(_)) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + | (Error(_), Some(_)) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + } + + | (OnFirstBlur | OnSubmit, _, false) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + } + } + + | Blur(field) => + let status = state.fields->Map.get(field) + let validator = state.validators.contents->Map.get(field) + switch (status, validator) { + | (Some(Validating), _) + | (Some(Dirty(_, Shown)), Some(_) | None) + | (Some(Dirty(_, Hidden)), None) => + NoUpdate + | (Some(Pristine) | None, None) => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), + }) + + | (Some(Pristine | Dirty(_, Hidden)) | None, Some(validator)) => + let result = state.input->validator.validate + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Hidden)), + }) + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch (result, validator.validateAsync) { + | (_, None) => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Shown)), + }) + | (Ok(Valid), Some((validateAsync, _))) => + UpdateWithSideEffects( + { + ...state, + fields: state.fields->Map.set(field, Validating), + }, + ({dispatch}) => { + open Js.Promise + state.input + ->validateAsync + ->then_(result => { + ApplyAsyncResult(field, state.input, result)->dispatch + resolve() + }, _) + ->ignore + }, + ) + | (Ok(NoValue) | Error(_), Some((_, _))) => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Shown)), + }) + } + } + } + + | ApplyAsyncResult(field, input, result) => + let validator = state.validators.contents->Map.getExn(field) + let eq = validator.validateAsync->Option.getExn->snd + if input->eq(state.input) { + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Shown)), + }) + } else { + NoUpdate + } + + | Submit => + switch state.status { + | Submitting(_) => NoUpdate + | Editing + | Submitted + | SubmissionFailed(_) => + let (valid, fields, validating) = state.validators.contents->Map.reduce( + (true, state.fields, false), + ((valid, fields, validating), field, validator) => { + let status = fields->Map.get(field) + switch status { + | _ if validating => (valid, fields, true) + | Some(Validating) => (valid, fields, true) + | Some(_) + | None => + let currentResultIsInvalid = switch status { + | Some(Dirty(Error(_), _)) => true + | Some(Dirty(Ok(_), _) | Pristine | Validating) + | None => false + } + let result = state.input->validator.validate + let fields = switch (currentResultIsInvalid, result, validator.validateAsync) { + | (true, Ok(Valid), Some(_)) => fields + | (_, _, _) => fields->Map.set(field, Dirty(result, Shown)) + } + switch (valid, fields->Map.get(field)) { + | (false, _) + | (true, Some(Dirty(Error(_), _))) => (false, fields, false) + | ( + true, + Some( + Dirty(Ok(Valid | NoValue), _) + | Pristine + | Validating, + ), + ) + | (true, None) => (true, fields, false) + } + } + }, + ) + if validating { + NoUpdate + } else if valid { + UpdateWithSideEffects( + { + ...state, + fields, + status: FormStatus.Submitting( + switch state.status { + | SubmissionFailed(error) => Some(error) + | Editing + | Submitted + | Submitting(_) => + None + }, + ), + submittedOnce: true, + }, + ({state, dispatch}) => + state.input->onSubmit({ + notifyOnSuccess: data => data->SetSubmittedStatus->dispatch, + notifyOnFailure: error => SetSubmissionFailedStatus(error)->dispatch, + reset: () => Reset->dispatch, + dismissSubmissionResult: () => DismissSubmissionResult->dispatch, + }), + ) + } else { + Update({ + ...state, + fields, + status: FormStatus.Editing, + submittedOnce: true, + }) + } + } + + | SetSubmittedStatus(data) => + switch data { + | Some(data) => + Update({ + ...state, + input: data, + status: FormStatus.Submitted, + fields: state.fields->Map.map(_ => Validation.Async.Pristine), + }) + | None => + Update({ + ...state, + status: FormStatus.Submitted, + fields: state.fields->Map.map(_ => Validation.Async.Pristine), + }) + } + + | SetSubmissionFailedStatus(error) => + Update({...state, status: FormStatus.SubmissionFailed(error)}) + + | MapSubmissionError(map) => + switch state.status { + | Submitting(Some(error)) => Update({...state, status: Submitting(Some(error->map))}) + | SubmissionFailed(error) => Update({...state, status: SubmissionFailed(error->map)}) + | Editing + | Submitting(None) + | Submitted => + NoUpdate + } + + | DismissSubmissionError => + switch state.status { + | Editing + | Submitting(_) + | Submitted => + NoUpdate + | SubmissionFailed(_) => Update({...state, status: FormStatus.Editing}) + } + + | DismissSubmissionResult => + switch state.status { + | Editing + | Submitting(_) => + NoUpdate + | Submitted + | SubmissionFailed(_) => + Update({...state, status: FormStatus.Editing}) + } + + | Reset => Update(initialState->getInitialState) + } + ) + + { + state: state.input, + status: state.status, + result: field => + switch state.fields->Map.get(field) { + | None + | Some(Pristine) + | Some(Validating) + | Some(Dirty(_, Hidden)) => + None + | Some(Dirty(result, Shown)) => Some(result) + }, + dirty: () => + state.fields->Map.some((_, status) => + switch status { + | Dirty(_) + | Validating => true + | Pristine => false + } + ), + validating: field => + switch state.fields->Map.get(field) { + | Some(Validating) => true + | None + | Some(Pristine) + | Some(Dirty(_)) => false + }, + submitting: switch state.status { + | Submitting(_) => true + | Editing + | Submitted + | SubmissionFailed(_) => false + }, + change: (field, state) => Change(field, state)->dispatch, + blur: field => Blur(field)->dispatch, + submit: () => Submit->dispatch, + mapSubmissionError: map => MapSubmissionError(map)->dispatch, + dismissSubmissionError: () => DismissSubmissionError->dispatch, + dismissSubmissionResult: () => DismissSubmissionResult->dispatch, + reset: () => Reset->dispatch, + } + } +} diff --git a/lib/src/FormalityCompat__FormAsyncOnChange.re b/lib/src/FormalityCompat__FormAsyncOnChange.re deleted file mode 100644 index 0ae8a183..00000000 --- a/lib/src/FormalityCompat__FormAsyncOnChange.re +++ /dev/null @@ -1,22 +0,0 @@ -module Validation = FormalityCompat__FormAsyncOnChangeWithId.Validation; - -let defaultDebounceInterval = FormalityCompat__FormAsyncOnChangeWithId.defaultDebounceInterval; - -module type Form = { - type field; - type state; - type message; - type submissionError; - let debounceInterval: int; - let validators: list(Validation.Async.validator(field, state, message)); -}; - -module Make = (Form: Form) => - FormalityCompat__FormAsyncOnChangeWithId.Make({ - include Form; - module FieldId = - Id.MakeComparable({ - type t = Form.field; - let cmp = Pervasives.compare; - }); - }); diff --git a/lib/src/FormalityCompat__FormAsyncOnChange.res b/lib/src/FormalityCompat__FormAsyncOnChange.res new file mode 100644 index 00000000..f291a8a3 --- /dev/null +++ b/lib/src/FormalityCompat__FormAsyncOnChange.res @@ -0,0 +1,20 @@ +module Validation = FormalityCompat__FormAsyncOnChangeWithId.Validation + +let defaultDebounceInterval = FormalityCompat__FormAsyncOnChangeWithId.defaultDebounceInterval + +module type Form = { + type field + type state + type message + type submissionError + let debounceInterval: int + let validators: list> +} + +module Make = (Form: Form) => FormalityCompat__FormAsyncOnChangeWithId.Make({ + include Form + module FieldId = Id.MakeComparable({ + type t = Form.field + let cmp = Pervasives.compare + }) +}) diff --git a/lib/src/FormalityCompat__FormAsyncOnChangeWithId.re b/lib/src/FormalityCompat__FormAsyncOnChangeWithId.re deleted file mode 100644 index 6fa085e5..00000000 --- a/lib/src/FormalityCompat__FormAsyncOnChangeWithId.re +++ /dev/null @@ -1,508 +0,0 @@ -module Validation = FormalityCompat__Validation; -module Strategy = FormalityCompat__Strategy; -module FormStatus = FormalityCompat__FormStatus; -module ReactUpdate = FormalityCompat__ReactUpdate; - -let defaultDebounceInterval = 700; - -module type Form = { - type field; - type state; - type message; - type submissionError; - let debounceInterval: int; - let validators: list(Validation.Async.validator(field, state, message)); - module FieldId: { - type identity; - type t = field; - let cmp: Belt.Id.cmp(t, identity); - }; -}; - -module Make = (Form: Form) => { - module FieldId = Form.FieldId; - - type state = { - input: Form.state, - status: FormStatus.t(Form.submissionError), - fields: - Map.t( - Form.field, - Validation.Async.status(Form.message), - FieldId.identity, - ), - validators: - ref(Map.t(Form.field, debouncedAsyncValidator, FieldId.identity)), - submittedOnce: bool, - } - and action = - | Change(Form.field, Form.state) - | Blur(Form.field) - | ApplyAsyncResult( - Form.field, - Form.state, - Validation.Result.result(Form.message), - ) - | Submit - | SetSubmittedStatus(option(Form.state)) - | SetSubmissionFailedStatus(Form.submissionError) - | MapSubmissionError(Form.submissionError => Form.submissionError) - | DismissSubmissionError - | DismissSubmissionResult - | Reset - and debouncedAsyncValidator = { - field: Form.field, - strategy: Strategy.t, - dependents: option(list(Form.field)), - validate: Validation.validate(Form.state, Form.message), - validateAsync: - option( - ( - ((Form.field, Form.state, ReactUpdate.dispatch(action))) => unit, - Validation.Async.equalityChecker(Form.state), - ), - ), - }; - - type interface = { - state: Form.state, - status: FormStatus.t(Form.submissionError), - result: Form.field => option(Validation.Result.result(Form.message)), - dirty: unit => bool, - validating: Form.field => bool, - submitting: bool, - change: (Form.field, Form.state) => unit, - blur: Form.field => unit, - submit: unit => unit, - mapSubmissionError: (Form.submissionError => Form.submissionError) => unit, - dismissSubmissionError: unit => unit, - dismissSubmissionResult: unit => unit, - reset: unit => unit, - }; - - let debounce = (~wait, validate) => { - let fn = ((field, input, dispatch)) => - Js.Promise.( - input - ->validate - ->then_( - result => { - ApplyAsyncResult(field, input, result)->dispatch; - resolve(); - }, - _, - ) - ->ignore - ); - fn->(Debounce.make(~wait)); - }; - - let getInitialState = input => { - input, - status: FormStatus.Editing, - fields: - Form.validators->List.reduce( - Map.make(~id=(module FieldId)), (fields, validator) => - fields->Map.set(validator.field, Validation.Async.Pristine) - ), - validators: - ref( - Form.validators->List.reduce( - Map.make(~id=(module FieldId)), (validators, validator) => - validators->Map.set( - validator.field, - { - field: validator.field, - strategy: validator.strategy, - dependents: validator.dependents, - validate: validator.validate, - validateAsync: - validator.validateAsync - ->Option.map(((fn, eq)) => - (fn->debounce(~wait=Form.debounceInterval), eq) - ), - }, - ) - ), - ), - submittedOnce: false, - }; - - let useForm = - ( - ~initialState: Form.state, - ~onSubmit: - ( - Form.state, - Validation.submissionCallbacks(Form.state, Form.submissionError) - ) => - unit, - ) => { - let memoizedInitialState = - React.useMemo1(() => initialState->getInitialState, [|initialState|]); - - let (state, dispatch) = - ReactUpdate.useReducer(memoizedInitialState, (state, action) => - switch (action) { - | Change(field, input) => - let validator = (state.validators^)->Map.get(field); - switch (validator) { - | None => - Update({ - ...state, - input, - fields: - state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), - }) - | Some(validator) => - let status = state.fields->Map.get(field); - let result = input->(validator.validate); - let fields = - switch (validator.dependents) { - | None => state.fields - | Some(dependents) => - dependents->List.reduce( - state.fields, - (fields, field) => { - let status = fields->Map.get(field); - switch (status) { - | None - | Some(Pristine) - | Some(Validating) - | Some(Dirty(_, Hidden)) => fields - | Some(Dirty(_, Shown)) => - let validator = (state.validators^)->Map.getExn(field); - fields->Map.set( - field, - Dirty(input->(validator.validate), Shown), - ); - }; - }, - ) - }; - switch (validator.strategy, status, state.submittedOnce) { - | (_, Some(Dirty(_, Shown)), _) - | (_, _, true) - | (OnFirstChange, _, false) => - switch (result, validator.validateAsync) { - | (_, None) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - | (Ok(Valid), Some((validateAsync, _))) => - UpdateWithSideEffects( - { - ...state, - input, - fields: fields->Map.set(field, Validating), - }, - ({dispatch}) => validateAsync((field, input, dispatch)), - ) - | (Ok(NoValue) | Error(_), Some(_)) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - } - - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, false) => - switch (result, validator.validateAsync) { - | (Ok(Valid | NoValue), None) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - | (Error(_), None) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - - | (Ok(Valid), Some((validateAsync, _))) => - UpdateWithSideEffects( - { - ...state, - input, - fields: fields->Map.set(field, Validating), - }, - ({dispatch}) => validateAsync((field, input, dispatch)), - ) - | (Ok(NoValue), Some(_)) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - | (Error(_), Some(_)) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - } - - | (OnFirstBlur | OnSubmit, _, false) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - }; - }; - - | Blur(field) => - let status = state.fields->Map.get(field); - let validator = (state.validators^)->Map.get(field); - switch (status, validator) { - | (Some(Validating), _) - | (Some(Dirty(_, Shown)), Some(_) | None) - | (Some(Dirty(_, Hidden)), None) => NoUpdate - | (Some(Pristine) | None, None) => - Update({ - ...state, - fields: - state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), - }) - | (Some(Pristine | Dirty(_, Hidden)) | None, Some(validator)) => - let result = state.input->(validator.validate); - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Hidden)), - }) - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - switch (result, validator.validateAsync) { - | (_, None) => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Shown)), - }) - | (Ok(Valid), Some((validateAsync, _))) => - UpdateWithSideEffects( - { - ...state, - fields: state.fields->Map.set(field, Validating), - }, - ({dispatch}) => - validateAsync((field, state.input, dispatch)), - ) - | (Ok(NoValue) | Error(_), Some(_)) => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Shown)), - }) - } - }; - }; - - | ApplyAsyncResult(field, input, result) => - let validator = (state.validators^)->Map.getExn(field); - let eq = validator.validateAsync->Option.getExn->snd; - if (input->eq(state.input)) { - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Shown)), - }); - } else { - NoUpdate; - }; - - | Submit => - switch (state.status) { - | Submitting(_) => NoUpdate - | Editing - | Submitted - | SubmissionFailed(_) => - let (valid, fields, validating) = - (state.validators^) - ->Map.reduce( - (true, state.fields, false), - ((valid, fields, validating), field, validator) => { - let status = fields->Map.get(field); - switch (status) { - | _ when validating => (valid, fields, true) - | Some(Validating) => (valid, fields, true) - | Some(_) - | None => - let currentResultIsInvalid = - switch (status) { - | Some(Dirty(Error(_), _)) => true - | Some(Dirty(Ok(_), _) | Pristine | Validating) - | None => false - }; - let result = state.input->(validator.validate); - let fields = - switch ( - currentResultIsInvalid, - result, - validator.validateAsync, - ) { - | (true, Ok(Valid), Some(_)) => fields - | (_, _, _) => - fields->Map.set(field, Dirty(result, Shown)) - }; - switch (valid, fields->Map.get(field)) { - | (false, _) - | (true, Some(Dirty(Error(_), _))) => ( - false, - fields, - false, - ) - | ( - true, - Some( - Dirty(Ok(Valid | NoValue), _) | Pristine | - Validating, - ), - ) - | (true, None) => (true, fields, false) - }; - }; - }, - ); - if (validating) { - NoUpdate; - } else if (valid) { - UpdateWithSideEffects( - { - ...state, - fields, - status: - FormStatus.Submitting( - switch (state.status) { - | SubmissionFailed(error) => Some(error) - | Editing - | Submitted - | Submitting(_) => None - }, - ), - submittedOnce: true, - }, - ({state, dispatch}) => - state.input - ->onSubmit({ - notifyOnSuccess: data => - data->SetSubmittedStatus->dispatch, - notifyOnFailure: error => - SetSubmissionFailedStatus(error)->dispatch, - reset: () => Reset->dispatch, - dismissSubmissionResult: () => - DismissSubmissionResult->dispatch, - }), - ); - } else { - Update({ - ...state, - fields, - status: FormStatus.Editing, - submittedOnce: true, - }); - }; - } - - | SetSubmittedStatus(data) => - switch (data) { - | Some(data) => - Update({ - ...state, - input: data, - status: FormStatus.Submitted, - fields: state.fields->Map.map(_ => Validation.Async.Pristine), - }) - | None => - Update({ - ...state, - status: FormStatus.Submitted, - fields: state.fields->Map.map(_ => Validation.Async.Pristine), - }) - } - - | SetSubmissionFailedStatus(error) => - Update({...state, status: FormStatus.SubmissionFailed(error)}) - - | MapSubmissionError(map) => - switch (state.status) { - | Submitting(Some(error)) => - Update({...state, status: Submitting(Some(error->map))}) - | SubmissionFailed(error) => - Update({...state, status: SubmissionFailed(error->map)}) - | Editing - | Submitting(None) - | Submitted => NoUpdate - } - - | DismissSubmissionError => - switch (state.status) { - | Editing - | Submitting(_) - | Submitted => NoUpdate - | SubmissionFailed(_) => - Update({...state, status: FormStatus.Editing}) - } - - | DismissSubmissionResult => - switch (state.status) { - | Editing - | Submitting(_) => NoUpdate - | Submitted - | SubmissionFailed(_) => - Update({...state, status: FormStatus.Editing}) - } - - | Reset => Update(initialState->getInitialState) - } - ); - - { - state: state.input, - status: state.status, - result: field => - switch (state.fields->Map.get(field)) { - | None - | Some(Pristine) - | Some(Validating) - | Some(Dirty(_, Hidden)) => None - | Some(Dirty(result, Shown)) => Some(result) - }, - dirty: () => - state.fields - ->Map.some((_, status) => - switch (status) { - | Dirty(_) - | Validating => true - | Pristine => false - } - ), - validating: field => - switch (state.fields->Map.get(field)) { - | Some(Validating) => true - | None - | Some(Pristine) - | Some(Dirty(_)) => false - }, - submitting: - switch (state.status) { - | Submitting(_) => true - | Editing - | Submitted - | SubmissionFailed(_) => false - }, - change: (field, state) => Change(field, state)->dispatch, - blur: field => Blur(field)->dispatch, - submit: () => Submit->dispatch, - mapSubmissionError: map => MapSubmissionError(map)->dispatch, - dismissSubmissionError: () => DismissSubmissionError->dispatch, - dismissSubmissionResult: () => DismissSubmissionResult->dispatch, - reset: () => Reset->dispatch, - }; - }; -}; diff --git a/lib/src/FormalityCompat__FormAsyncOnChangeWithId.res b/lib/src/FormalityCompat__FormAsyncOnChangeWithId.res new file mode 100644 index 00000000..746c765e --- /dev/null +++ b/lib/src/FormalityCompat__FormAsyncOnChangeWithId.res @@ -0,0 +1,456 @@ +module Validation = FormalityCompat__Validation +module Strategy = FormalityCompat__Strategy +module FormStatus = FormalityCompat__FormStatus +module ReactUpdate = FormalityCompat__ReactUpdate + +let defaultDebounceInterval = 700 + +module type Form = { + type field + type state + type message + type submissionError + let debounceInterval: int + let validators: list> + module FieldId: { + type identity + type t = field + let cmp: Belt.Id.cmp + } +} + +module Make = (Form: Form) => { + module FieldId = Form.FieldId + + type rec state = { + input: Form.state, + status: FormStatus.t, + fields: Map.t, FieldId.identity>, + validators: ref>, + submittedOnce: bool, + } + and action = + | Change(Form.field, Form.state) + | Blur(Form.field) + | ApplyAsyncResult(Form.field, Form.state, Validation.Result.result) + | Submit + | SetSubmittedStatus(option) + | SetSubmissionFailedStatus(Form.submissionError) + | MapSubmissionError(Form.submissionError => Form.submissionError) + | DismissSubmissionError + | DismissSubmissionResult + | Reset + and debouncedAsyncValidator = { + field: Form.field, + strategy: Strategy.t, + dependents: option>, + validate: Validation.validate, + validateAsync: option<( + ((Form.field, Form.state, ReactUpdate.dispatch)) => unit, + Validation.Async.equalityChecker, + )>, + } + + type interface = { + state: Form.state, + status: FormStatus.t, + result: Form.field => option>, + dirty: unit => bool, + validating: Form.field => bool, + submitting: bool, + change: (Form.field, Form.state) => unit, + blur: Form.field => unit, + submit: unit => unit, + mapSubmissionError: (Form.submissionError => Form.submissionError) => unit, + dismissSubmissionError: unit => unit, + dismissSubmissionResult: unit => unit, + reset: unit => unit, + } + + let debounce = (~wait, validate) => { + let fn = ((field, input, dispatch)) => { + open Js.Promise + input + ->validate + ->then_(result => { + ApplyAsyncResult(field, input, result)->dispatch + resolve() + }, _) + ->ignore + } + fn->Debounce.make(~wait) + } + + let getInitialState = input => { + input, + status: FormStatus.Editing, + fields: Form.validators->List.reduce(Map.make(~id=module(FieldId)), (fields, validator) => + fields->Map.set(validator.field, Validation.Async.Pristine) + ), + validators: ref( + Form.validators->List.reduce(Map.make(~id=module(FieldId)), (validators, validator) => + validators->Map.set( + validator.field, + { + field: validator.field, + strategy: validator.strategy, + dependents: validator.dependents, + validate: validator.validate, + validateAsync: validator.validateAsync->Option.map(((fn, eq)) => ( + fn->debounce(~wait=Form.debounceInterval), + eq, + )), + }, + ) + ), + ), + submittedOnce: false, + } + + let useForm = ( + ~initialState: Form.state, + ~onSubmit: ( + Form.state, + Validation.submissionCallbacks, + ) => unit, + ) => { + let memoizedInitialState = React.useMemo1(() => initialState->getInitialState, [initialState]) + + let (state, dispatch) = ReactUpdate.useReducer(memoizedInitialState, (state, action) => + switch action { + | Change(field, input) => + let validator = state.validators.contents->Map.get(field) + switch validator { + | None => + Update({ + ...state, + input, + fields: state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), + }) + | Some(validator) => + let status = state.fields->Map.get(field) + let result = input->validator.validate + let fields = switch validator.dependents { + | None => state.fields + | Some(dependents) => + dependents->List.reduce(state.fields, (fields, field) => { + let status = fields->Map.get(field) + switch status { + | None + | Some(Pristine) + | Some(Validating) + | Some(Dirty(_, Hidden)) => fields + | Some(Dirty(_, Shown)) => + let validator = state.validators.contents->Map.getExn(field) + fields->Map.set(field, Dirty(input->validator.validate, Shown)) + } + }) + } + switch (validator.strategy, status, state.submittedOnce) { + | (_, Some(Dirty(_, Shown)), _) + | (_, _, true) + | (OnFirstChange, _, false) => + switch (result, validator.validateAsync) { + | (_, None) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + | (Ok(Valid), Some((validateAsync, _))) => + UpdateWithSideEffects( + { + ...state, + input, + fields: fields->Map.set(field, Validating), + }, + ({dispatch}) => validateAsync((field, input, dispatch)), + ) + | (Ok(NoValue) | Error(_), Some(_)) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + } + + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, false) => + switch (result, validator.validateAsync) { + | (Ok(Valid | NoValue), None) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + | (Error(_), None) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + + | (Ok(Valid), Some((validateAsync, _))) => + UpdateWithSideEffects( + { + ...state, + input, + fields: fields->Map.set(field, Validating), + }, + ({dispatch}) => validateAsync((field, input, dispatch)), + ) + | (Ok(NoValue), Some(_)) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + | (Error(_), Some(_)) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + } + + | (OnFirstBlur | OnSubmit, _, false) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + } + } + + | Blur(field) => + let status = state.fields->Map.get(field) + let validator = state.validators.contents->Map.get(field) + switch (status, validator) { + | (Some(Validating), _) + | (Some(Dirty(_, Shown)), Some(_) | None) + | (Some(Dirty(_, Hidden)), None) => + NoUpdate + | (Some(Pristine) | None, None) => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), + }) + | (Some(Pristine | Dirty(_, Hidden)) | None, Some(validator)) => + let result = state.input->validator.validate + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Hidden)), + }) + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch (result, validator.validateAsync) { + | (_, None) => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Shown)), + }) + | (Ok(Valid), Some((validateAsync, _))) => + UpdateWithSideEffects( + { + ...state, + fields: state.fields->Map.set(field, Validating), + }, + ({dispatch}) => validateAsync((field, state.input, dispatch)), + ) + | (Ok(NoValue) | Error(_), Some(_)) => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Shown)), + }) + } + } + } + + | ApplyAsyncResult(field, input, result) => + let validator = state.validators.contents->Map.getExn(field) + let eq = validator.validateAsync->Option.getExn->snd + if input->eq(state.input) { + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Shown)), + }) + } else { + NoUpdate + } + + | Submit => + switch state.status { + | Submitting(_) => NoUpdate + | Editing + | Submitted + | SubmissionFailed(_) => + let (valid, fields, validating) = state.validators.contents->Map.reduce( + (true, state.fields, false), + ((valid, fields, validating), field, validator) => { + let status = fields->Map.get(field) + switch status { + | _ if validating => (valid, fields, true) + | Some(Validating) => (valid, fields, true) + | Some(_) + | None => + let currentResultIsInvalid = switch status { + | Some(Dirty(Error(_), _)) => true + | Some(Dirty(Ok(_), _) | Pristine | Validating) + | None => false + } + let result = state.input->validator.validate + let fields = switch (currentResultIsInvalid, result, validator.validateAsync) { + | (true, Ok(Valid), Some(_)) => fields + | (_, _, _) => fields->Map.set(field, Dirty(result, Shown)) + } + switch (valid, fields->Map.get(field)) { + | (false, _) + | (true, Some(Dirty(Error(_), _))) => (false, fields, false) + | ( + true, + Some( + Dirty(Ok(Valid | NoValue), _) + | Pristine + | Validating, + ), + ) + | (true, None) => (true, fields, false) + } + } + }, + ) + if validating { + NoUpdate + } else if valid { + UpdateWithSideEffects( + { + ...state, + fields, + status: FormStatus.Submitting( + switch state.status { + | SubmissionFailed(error) => Some(error) + | Editing + | Submitted + | Submitting(_) => + None + }, + ), + submittedOnce: true, + }, + ({state, dispatch}) => + state.input->onSubmit({ + notifyOnSuccess: data => data->SetSubmittedStatus->dispatch, + notifyOnFailure: error => SetSubmissionFailedStatus(error)->dispatch, + reset: () => Reset->dispatch, + dismissSubmissionResult: () => DismissSubmissionResult->dispatch, + }), + ) + } else { + Update({ + ...state, + fields, + status: FormStatus.Editing, + submittedOnce: true, + }) + } + } + + | SetSubmittedStatus(data) => + switch data { + | Some(data) => + Update({ + ...state, + input: data, + status: FormStatus.Submitted, + fields: state.fields->Map.map(_ => Validation.Async.Pristine), + }) + | None => + Update({ + ...state, + status: FormStatus.Submitted, + fields: state.fields->Map.map(_ => Validation.Async.Pristine), + }) + } + + | SetSubmissionFailedStatus(error) => + Update({...state, status: FormStatus.SubmissionFailed(error)}) + + | MapSubmissionError(map) => + switch state.status { + | Submitting(Some(error)) => Update({...state, status: Submitting(Some(error->map))}) + | SubmissionFailed(error) => Update({...state, status: SubmissionFailed(error->map)}) + | Editing + | Submitting(None) + | Submitted => + NoUpdate + } + + | DismissSubmissionError => + switch state.status { + | Editing + | Submitting(_) + | Submitted => + NoUpdate + | SubmissionFailed(_) => Update({...state, status: FormStatus.Editing}) + } + + | DismissSubmissionResult => + switch state.status { + | Editing + | Submitting(_) => + NoUpdate + | Submitted + | SubmissionFailed(_) => + Update({...state, status: FormStatus.Editing}) + } + + | Reset => Update(initialState->getInitialState) + } + ) + + { + state: state.input, + status: state.status, + result: field => + switch state.fields->Map.get(field) { + | None + | Some(Pristine) + | Some(Validating) + | Some(Dirty(_, Hidden)) => + None + | Some(Dirty(result, Shown)) => Some(result) + }, + dirty: () => + state.fields->Map.some((_, status) => + switch status { + | Dirty(_) + | Validating => true + | Pristine => false + } + ), + validating: field => + switch state.fields->Map.get(field) { + | Some(Validating) => true + | None + | Some(Pristine) + | Some(Dirty(_)) => false + }, + submitting: switch state.status { + | Submitting(_) => true + | Editing + | Submitted + | SubmissionFailed(_) => false + }, + change: (field, state) => Change(field, state)->dispatch, + blur: field => Blur(field)->dispatch, + submit: () => Submit->dispatch, + mapSubmissionError: map => MapSubmissionError(map)->dispatch, + dismissSubmissionError: () => DismissSubmissionError->dispatch, + dismissSubmissionResult: () => DismissSubmissionResult->dispatch, + reset: () => Reset->dispatch, + } + } +} diff --git a/lib/src/FormalityCompat__FormStatus.re b/lib/src/FormalityCompat__FormStatus.re deleted file mode 100644 index 77179eaa..00000000 --- a/lib/src/FormalityCompat__FormStatus.re +++ /dev/null @@ -1,5 +0,0 @@ -type t('submissionError) = - | Editing - | Submitting(option('submissionError)) - | Submitted - | SubmissionFailed('submissionError); diff --git a/lib/src/FormalityCompat__FormStatus.res b/lib/src/FormalityCompat__FormStatus.res new file mode 100644 index 00000000..1087a269 --- /dev/null +++ b/lib/src/FormalityCompat__FormStatus.res @@ -0,0 +1,5 @@ +type t<'submissionError> = + | Editing + | Submitting(option<'submissionError>) + | Submitted + | SubmissionFailed('submissionError) diff --git a/lib/src/FormalityCompat__FormWithId.re b/lib/src/FormalityCompat__FormWithId.re deleted file mode 100644 index 7c35caaf..00000000 --- a/lib/src/FormalityCompat__FormWithId.re +++ /dev/null @@ -1,374 +0,0 @@ -module Validation = FormalityCompat__Validation; -module Strategy = FormalityCompat__Strategy; -module FormStatus = FormalityCompat__FormStatus; -module ReactUpdate = FormalityCompat__ReactUpdate; - -module type Form = { - type field; - type state; - type message; - type submissionError; - let validators: list(Validation.validator(field, state, message)); - module FieldId: { - type identity; - type t = field; - let cmp: Belt.Id.cmp(t, identity); - }; -}; -module Make = (Form: Form) => { - module FieldId = Form.FieldId; - - type state = { - input: Form.state, - status: FormStatus.t(Form.submissionError), - fields: - Map.t(Form.field, Validation.status(Form.message), FieldId.identity), - validators: - ref( - Map.t( - Form.field, - Validation.validator(Form.field, Form.state, Form.message), - FieldId.identity, - ), - ), - submittedOnce: bool, - }; - - type action = - | Change(Form.field, Form.state) - | Blur(Form.field) - | Submit - | SetSubmittedStatus(option(Form.state)) - | SetSubmissionFailedStatus(Form.submissionError) - | MapSubmissionError(Form.submissionError => Form.submissionError) - | DismissSubmissionError - | DismissSubmissionResult - | Reset; - - type interface = { - state: Form.state, - status: FormStatus.t(Form.submissionError), - result: Form.field => option(Validation.Result.result(Form.message)), - dirty: unit => bool, - valid: unit => bool, - submitting: bool, - change: (Form.field, Form.state) => unit, - blur: Form.field => unit, - submit: unit => unit, - mapSubmissionError: (Form.submissionError => Form.submissionError) => unit, - dismissSubmissionError: unit => unit, - dismissSubmissionResult: unit => unit, - reset: unit => unit, - }; - - let getInitialState = input => { - input, - status: FormStatus.Editing, - fields: - Form.validators->List.reduce( - Map.make(~id=(module FieldId)), (fields, validator) => - fields->Map.set(validator.field, Validation.Pristine) - ), - validators: - ref( - Form.validators->List.reduce( - Map.make(~id=(module FieldId)), (fields, validator) => - fields->Map.set(validator.field, validator) - ), - ), - submittedOnce: false, - }; - - let useForm = - ( - ~initialState: Form.state, - ~onSubmit: - ( - Form.state, - Validation.submissionCallbacks(Form.state, Form.submissionError) - ) => - unit, - ) => { - let memoizedInitialState = - React.useMemo1(() => initialState->getInitialState, [|initialState|]); - - let (state, dispatch) = - ReactUpdate.useReducer(memoizedInitialState, (state, action) => - switch (action) { - | Change(field, input) => - let validator = (state.validators^)->Map.get(field); - switch (validator) { - | None => - Update({ - ...state, - input, - fields: - state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), - }) - | Some(validator) => - let status = state.fields->Map.get(field); - let result = input->(validator.validate); - let fields = - switch (validator.dependents) { - | None => state.fields - | Some(dependents) => - dependents->List.reduce( - state.fields, - (fields, field) => { - let status = fields->Map.get(field); - switch (status) { - | None - | Some(Pristine) - | Some(Dirty(_, Hidden)) => fields - | Some(Dirty(_, Shown)) => - let validator = (state.validators^)->Map.getExn(field); - fields->Map.set( - field, - Dirty(input->(validator.validate), Shown), - ); - }; - }, - ) - }; - switch (validator.strategy, status, state.submittedOnce) { - | (_, Some(Dirty(_, Shown)), _) - | (_, _, true) - | (OnFirstChange, _, false) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Shown)), - }) - | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, false) => - Update({ - ...state, - input, - fields: - switch (result) { - | Ok(Valid | NoValue) => - fields->Map.set(field, Dirty(result, Shown)) - | Error(_) => fields->Map.set(field, Dirty(result, Hidden)) - }, - }) - | (OnFirstBlur | OnSubmit, _, false) => - Update({ - ...state, - input, - fields: fields->Map.set(field, Dirty(result, Hidden)), - }) - }; - }; - - | Blur(field) => - let status = state.fields->Map.get(field); - let validator = (state.validators^)->Map.get(field); - switch (status, validator) { - | (Some(Dirty(_, Shown)), Some(_) | None) - | (Some(Dirty(_, Hidden)), None) => NoUpdate - | (Some(Pristine) | None, None) => - Update({ - ...state, - fields: - state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), - }) - | (Some(Pristine) | None, Some(validator)) => - let result = state.input->(validator.validate); - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Hidden)), - }) - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Shown)), - }) - }; - | (Some(Dirty(_, Hidden)), Some(validator)) => - let result = state.input->(validator.validate); - switch (validator.strategy) { - | OnFirstChange - | OnFirstSuccess - | OnSubmit => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Hidden)), - }) - | OnFirstBlur - | OnFirstSuccessOrFirstBlur => - Update({ - ...state, - fields: state.fields->Map.set(field, Dirty(result, Shown)), - }) - }; - }; - - | Submit => - switch (state.status) { - | Submitting(_) => NoUpdate - | Editing - | Submitted - | SubmissionFailed(_) => - let (valid, fields) = - (state.validators^) - ->Map.reduce( - (true, state.fields), - ((valid, fields), field, validator) => { - let result = state.input->(validator.validate); - let fields = - fields->Map.set(field, Dirty(result, Shown)); - switch (valid, result) { - | (false, _) - | (true, Error(_)) => (false, fields) - | (true, Ok(Valid | NoValue)) => (true, fields) - }; - }, - ); - if (valid) { - UpdateWithSideEffects( - { - ...state, - fields, - status: - FormStatus.Submitting( - switch (state.status) { - | SubmissionFailed(error) => Some(error) - | Editing - | Submitted - | Submitting(_) => None - }, - ), - submittedOnce: true, - }, - ({state, dispatch}) => - state.input - ->onSubmit({ - notifyOnSuccess: state => - SetSubmittedStatus(state)->dispatch, - notifyOnFailure: error => - SetSubmissionFailedStatus(error)->dispatch, - reset: () => Reset->dispatch, - dismissSubmissionResult: () => - DismissSubmissionResult->dispatch, - }), - ); - } else { - Update({ - ...state, - fields, - status: FormStatus.Editing, - submittedOnce: true, - }); - }; - } - - | SetSubmittedStatus(data) => - switch (data) { - | Some(data) => - Update({ - ...state, - input: data, - status: FormStatus.Submitted, - fields: state.fields->Map.map(_ => Validation.Pristine), - }) - | None => - Update({ - ...state, - status: FormStatus.Submitted, - fields: state.fields->Map.map(_ => Validation.Pristine), - }) - } - - | SetSubmissionFailedStatus(error) => - Update({...state, status: FormStatus.SubmissionFailed(error)}) - - | MapSubmissionError(map) => - switch (state.status) { - | Submitting(Some(error)) => - Update({...state, status: Submitting(Some(error->map))}) - | SubmissionFailed(error) => - Update({...state, status: SubmissionFailed(error->map)}) - | Editing - | Submitting(None) - | Submitted => NoUpdate - } - - | DismissSubmissionError => - switch (state.status) { - | Editing - | Submitting(_) - | Submitted => NoUpdate - | SubmissionFailed(_) => - Update({...state, status: FormStatus.Editing}) - } - - | DismissSubmissionResult => - switch (state.status) { - | Editing - | Submitting(_) => NoUpdate - | Submitted - | SubmissionFailed(_) => - Update({...state, status: FormStatus.Editing}) - } - - | Reset => Update(initialState->getInitialState) - } - ); - - { - state: state.input, - status: state.status, - result: field => - switch (state.fields->Map.get(field)) { - | None - | Some(Pristine) - | Some(Dirty(_, Hidden)) => None - | Some(Dirty(result, Shown)) => Some(result) - }, - dirty: () => - state.fields - ->Map.some((_, status) => - switch (status) { - | Dirty(_) => true - | Pristine => false - } - ), - valid: () => - state.fields - ->Map.every((field, status) => - switch (status) { - | Dirty(Ok(_), _) => true - | Dirty(Error(_), _) => false - | Pristine => - (state.validators^) - ->Map.get(field) - ->Option.map(validator => - switch (state.input->(validator.validate)) { - | Ok(_) => true - | Error(_) => false - } - ) - ->Option.getWithDefault(true) - } - ), - submitting: - switch (state.status) { - | Submitting(_) => true - | Editing - | Submitted - | SubmissionFailed(_) => false - }, - change: (field, state) => Change(field, state)->dispatch, - blur: field => Blur(field)->dispatch, - submit: () => Submit->dispatch, - mapSubmissionError: map => MapSubmissionError(map)->dispatch, - dismissSubmissionError: () => DismissSubmissionError->dispatch, - dismissSubmissionResult: () => DismissSubmissionResult->dispatch, - reset: () => Reset->dispatch, - }; - }; -}; diff --git a/lib/src/FormalityCompat__FormWithId.res b/lib/src/FormalityCompat__FormWithId.res new file mode 100644 index 00000000..1d0fb291 --- /dev/null +++ b/lib/src/FormalityCompat__FormWithId.res @@ -0,0 +1,345 @@ +module Validation = FormalityCompat__Validation +module Strategy = FormalityCompat__Strategy +module FormStatus = FormalityCompat__FormStatus +module ReactUpdate = FormalityCompat__ReactUpdate + +module type Form = { + type field + type state + type message + type submissionError + let validators: list> + module FieldId: { + type identity + type t = field + let cmp: Belt.Id.cmp + } +} +module Make = (Form: Form) => { + module FieldId = Form.FieldId + + type state = { + input: Form.state, + status: FormStatus.t, + fields: Map.t, FieldId.identity>, + validators: ref< + Map.t< + Form.field, + Validation.validator, + FieldId.identity, + >, + >, + submittedOnce: bool, + } + + type action = + | Change(Form.field, Form.state) + | Blur(Form.field) + | Submit + | SetSubmittedStatus(option) + | SetSubmissionFailedStatus(Form.submissionError) + | MapSubmissionError(Form.submissionError => Form.submissionError) + | DismissSubmissionError + | DismissSubmissionResult + | Reset + + type interface = { + state: Form.state, + status: FormStatus.t, + result: Form.field => option>, + dirty: unit => bool, + valid: unit => bool, + submitting: bool, + change: (Form.field, Form.state) => unit, + blur: Form.field => unit, + submit: unit => unit, + mapSubmissionError: (Form.submissionError => Form.submissionError) => unit, + dismissSubmissionError: unit => unit, + dismissSubmissionResult: unit => unit, + reset: unit => unit, + } + + let getInitialState = input => { + input, + status: FormStatus.Editing, + fields: Form.validators->List.reduce(Map.make(~id=module(FieldId)), (fields, validator) => + fields->Map.set(validator.field, Validation.Pristine) + ), + validators: ref( + Form.validators->List.reduce(Map.make(~id=module(FieldId)), (fields, validator) => + fields->Map.set(validator.field, validator) + ), + ), + submittedOnce: false, + } + + let useForm = ( + ~initialState: Form.state, + ~onSubmit: ( + Form.state, + Validation.submissionCallbacks, + ) => unit, + ) => { + let memoizedInitialState = React.useMemo1(() => initialState->getInitialState, [initialState]) + + let (state, dispatch) = ReactUpdate.useReducer(memoizedInitialState, (state, action) => + switch action { + | Change(field, input) => + let validator = state.validators.contents->Map.get(field) + switch validator { + | None => + Update({ + ...state, + input, + fields: state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), + }) + | Some(validator) => + let status = state.fields->Map.get(field) + let result = input->validator.validate + let fields = switch validator.dependents { + | None => state.fields + | Some(dependents) => + dependents->List.reduce(state.fields, (fields, field) => { + let status = fields->Map.get(field) + switch status { + | None + | Some(Pristine) + | Some(Dirty(_, Hidden)) => fields + | Some(Dirty(_, Shown)) => + let validator = state.validators.contents->Map.getExn(field) + fields->Map.set(field, Dirty(input->validator.validate, Shown)) + } + }) + } + switch (validator.strategy, status, state.submittedOnce) { + | (_, Some(Dirty(_, Shown)), _) + | (_, _, true) + | (OnFirstChange, _, false) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Shown)), + }) + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, false) => + Update({ + ...state, + input, + fields: switch result { + | Ok(Valid | NoValue) => fields->Map.set(field, Dirty(result, Shown)) + | Error(_) => fields->Map.set(field, Dirty(result, Hidden)) + }, + }) + | (OnFirstBlur | OnSubmit, _, false) => + Update({ + ...state, + input, + fields: fields->Map.set(field, Dirty(result, Hidden)), + }) + } + } + + | Blur(field) => + let status = state.fields->Map.get(field) + let validator = state.validators.contents->Map.get(field) + switch (status, validator) { + | (Some(Dirty(_, Shown)), Some(_) | None) + | (Some(Dirty(_, Hidden)), None) => + NoUpdate + | (Some(Pristine) | None, None) => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(Ok(Valid), Hidden)), + }) + | (Some(Pristine) | None, Some(validator)) => + let result = state.input->validator.validate + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Hidden)), + }) + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Shown)), + }) + } + | (Some(Dirty(_, Hidden)), Some(validator)) => + let result = state.input->validator.validate + switch validator.strategy { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Hidden)), + }) + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + Update({ + ...state, + fields: state.fields->Map.set(field, Dirty(result, Shown)), + }) + } + } + + | Submit => + switch state.status { + | Submitting(_) => NoUpdate + | Editing + | Submitted + | SubmissionFailed(_) => + let (valid, fields) = state.validators.contents->Map.reduce((true, state.fields), ( + (valid, fields), + field, + validator, + ) => { + let result = state.input->validator.validate + let fields = fields->Map.set(field, Dirty(result, Shown)) + switch (valid, result) { + | (false, _) + | (true, Error(_)) => (false, fields) + | (true, Ok(Valid | NoValue)) => (true, fields) + } + }) + if valid { + UpdateWithSideEffects( + { + ...state, + fields, + status: FormStatus.Submitting( + switch state.status { + | SubmissionFailed(error) => Some(error) + | Editing + | Submitted + | Submitting(_) => + None + }, + ), + submittedOnce: true, + }, + ({state, dispatch}) => + state.input->onSubmit({ + notifyOnSuccess: state => SetSubmittedStatus(state)->dispatch, + notifyOnFailure: error => SetSubmissionFailedStatus(error)->dispatch, + reset: () => Reset->dispatch, + dismissSubmissionResult: () => DismissSubmissionResult->dispatch, + }), + ) + } else { + Update({ + ...state, + fields, + status: FormStatus.Editing, + submittedOnce: true, + }) + } + } + + | SetSubmittedStatus(data) => + switch data { + | Some(data) => + Update({ + ...state, + input: data, + status: FormStatus.Submitted, + fields: state.fields->Map.map(_ => Validation.Pristine), + }) + | None => + Update({ + ...state, + status: FormStatus.Submitted, + fields: state.fields->Map.map(_ => Validation.Pristine), + }) + } + + | SetSubmissionFailedStatus(error) => + Update({...state, status: FormStatus.SubmissionFailed(error)}) + + | MapSubmissionError(map) => + switch state.status { + | Submitting(Some(error)) => Update({...state, status: Submitting(Some(error->map))}) + | SubmissionFailed(error) => Update({...state, status: SubmissionFailed(error->map)}) + | Editing + | Submitting(None) + | Submitted => + NoUpdate + } + + | DismissSubmissionError => + switch state.status { + | Editing + | Submitting(_) + | Submitted => + NoUpdate + | SubmissionFailed(_) => Update({...state, status: FormStatus.Editing}) + } + + | DismissSubmissionResult => + switch state.status { + | Editing + | Submitting(_) => + NoUpdate + | Submitted + | SubmissionFailed(_) => + Update({...state, status: FormStatus.Editing}) + } + + | Reset => Update(initialState->getInitialState) + } + ) + + { + state: state.input, + status: state.status, + result: field => + switch state.fields->Map.get(field) { + | None + | Some(Pristine) + | Some(Dirty(_, Hidden)) => + None + | Some(Dirty(result, Shown)) => Some(result) + }, + dirty: () => + state.fields->Map.some((_, status) => + switch status { + | Dirty(_) => true + | Pristine => false + } + ), + valid: () => + state.fields->Map.every((field, status) => + switch status { + | Dirty(Ok(_), _) => true + | Dirty(Error(_), _) => false + | Pristine => + state.validators.contents + ->Map.get(field) + ->Option.map(validator => + switch state.input->validator.validate { + | Ok(_) => true + | Error(_) => false + } + ) + ->Option.getWithDefault(true) + } + ), + submitting: switch state.status { + | Submitting(_) => true + | Editing + | Submitted + | SubmissionFailed(_) => false + }, + change: (field, state) => Change(field, state)->dispatch, + blur: field => Blur(field)->dispatch, + submit: () => Submit->dispatch, + mapSubmissionError: map => MapSubmissionError(map)->dispatch, + dismissSubmissionError: () => DismissSubmissionError->dispatch, + dismissSubmissionResult: () => DismissSubmissionResult->dispatch, + reset: () => Reset->dispatch, + } + } +} diff --git a/lib/src/FormalityCompat__PublicHelpers.re b/lib/src/FormalityCompat__PublicHelpers.re deleted file mode 100644 index 921a141f..00000000 --- a/lib/src/FormalityCompat__PublicHelpers.re +++ /dev/null @@ -1,13 +0,0 @@ -module Dom = { - let preventDefault = (submit, event) => { - if (!event->ReactEvent.Form.defaultPrevented) { - event->ReactEvent.Form.preventDefault; - }; - submit(); - }; - - let toValueOnChange = event => event->ReactEvent.Form.target##value; - let toValueOnBlur = event => event->ReactEvent.Focus.target##value; - let toCheckedOnChange = event => event->ReactEvent.Form.target##checked; - let toCheckedOnBlur = event => event->ReactEvent.Focus.target##checked; -}; diff --git a/lib/src/FormalityCompat__PublicHelpers.rei b/lib/src/FormalityCompat__PublicHelpers.rei deleted file mode 100644 index 010caca3..00000000 --- a/lib/src/FormalityCompat__PublicHelpers.rei +++ /dev/null @@ -1,15 +0,0 @@ -module Dom: { - let preventDefault: (unit => 'a, ReactEvent.Form.t) => 'a; - - [@deprecated "Use event->ReactEvent.Form.target##value instead."] - let toValueOnChange: ReactEvent.Form.t => 'a; - - [@deprecated "Use event->ReactEvent.Focus.target##value instead."] - let toValueOnBlur: ReactEvent.Focus.t => 'a; - - [@deprecated "Use event->ReactEvent.Form.target##checked instead."] - let toCheckedOnChange: ReactEvent.Form.t => 'a; - - [@deprecated "Use event->ReactEvent.Focus.target##checked instead."] - let toCheckedOnBlur: ReactEvent.Focus.t => 'a; -}; diff --git a/lib/src/FormalityCompat__PublicHelpers.res b/lib/src/FormalityCompat__PublicHelpers.res new file mode 100644 index 00000000..550a8e87 --- /dev/null +++ b/lib/src/FormalityCompat__PublicHelpers.res @@ -0,0 +1,13 @@ +module Dom = { + let preventDefault = (submit, event) => { + if !(event->ReactEvent.Form.defaultPrevented) { + event->ReactEvent.Form.preventDefault + } + submit() + } + + let toValueOnChange = event => (event->ReactEvent.Form.target)["value"] + let toValueOnBlur = event => (event->ReactEvent.Focus.target)["value"] + let toCheckedOnChange = event => (event->ReactEvent.Form.target)["checked"] + let toCheckedOnBlur = event => (event->ReactEvent.Focus.target)["checked"] +} diff --git a/lib/src/FormalityCompat__PublicHelpers.resi b/lib/src/FormalityCompat__PublicHelpers.resi new file mode 100644 index 00000000..a5bf5289 --- /dev/null +++ b/lib/src/FormalityCompat__PublicHelpers.resi @@ -0,0 +1,15 @@ +module Dom: { + let preventDefault: (unit => 'a, ReactEvent.Form.t) => 'a + + @deprecated("Use event->ReactEvent.Form.target##value instead.") + let toValueOnChange: ReactEvent.Form.t => 'a + + @deprecated("Use event->ReactEvent.Focus.target##value instead.") + let toValueOnBlur: ReactEvent.Focus.t => 'a + + @deprecated("Use event->ReactEvent.Form.target##checked instead.") + let toCheckedOnChange: ReactEvent.Form.t => 'a + + @deprecated("Use event->ReactEvent.Focus.target##checked instead.") + let toCheckedOnBlur: ReactEvent.Focus.t => 'a +} diff --git a/lib/src/FormalityCompat__ReactUpdate.re b/lib/src/FormalityCompat__ReactUpdate.re deleted file mode 100644 index e2db5c40..00000000 --- a/lib/src/FormalityCompat__ReactUpdate.re +++ /dev/null @@ -1,42 +0,0 @@ -[@ocaml.warning "-30"]; - -type update('action, 'state) = - | NoUpdate - | Update('state) - | UpdateWithSideEffects('state, self('state, 'action) => unit) -and dispatch('action) = 'action => unit -and self('state, 'action) = { - state: 'state, - dispatch: dispatch('action), -} -and fullState('state, 'action) = { - state: 'state, - sideEffects: ref(array(self('state, 'action) => unit)), -}; - -let useReducer = (initialState, reducer) => { - let ({state, sideEffects}, dispatch) = - React.useReducer( - ({state, sideEffects} as fullState, action) => - switch (reducer(state, action)) { - | NoUpdate => fullState - | Update(state) => {...fullState, state} - | UpdateWithSideEffects(state, sideEffect) => { - state, - sideEffects: Array.concat(sideEffects^, [|sideEffect|])->ref, - } - }, - {state: initialState, sideEffects: [||]->ref}, - ); - React.useEffect1( - () => { - if (Array.length(sideEffects^) > 0) { - Array.forEach(sideEffects^, fn => fn({state, dispatch})); - sideEffects := [||]; - }; - None; - }, - [|sideEffects^|], - ); - (state, dispatch); -}; diff --git a/lib/src/FormalityCompat__ReactUpdate.res b/lib/src/FormalityCompat__ReactUpdate.res new file mode 100644 index 00000000..12ad5c67 --- /dev/null +++ b/lib/src/FormalityCompat__ReactUpdate.res @@ -0,0 +1,38 @@ +@@ocaml.warning("-30") + +type rec update<'action, 'state> = + | NoUpdate + | Update('state) + | UpdateWithSideEffects('state, self<'state, 'action> => unit) +and dispatch<'action> = 'action => unit +and self<'state, 'action> = { + state: 'state, + dispatch: dispatch<'action>, +} +and fullState<'state, 'action> = { + state: 'state, + sideEffects: ref => unit>>, +} + +let useReducer = (initialState, reducer) => { + let ({state, sideEffects}, dispatch) = React.useReducer( + ({state, sideEffects} as fullState, action) => + switch reducer(state, action) { + | NoUpdate => fullState + | Update(state) => {...fullState, state} + | UpdateWithSideEffects(state, sideEffect) => { + state, + sideEffects: Array.concat(sideEffects.contents, [sideEffect])->ref, + } + }, + {state: initialState, sideEffects: []->ref}, + ) + React.useEffect1(() => { + if Array.length(sideEffects.contents) > 0 { + Array.forEach(sideEffects.contents, fn => fn({state, dispatch})) + sideEffects := [] + } + None + }, [sideEffects.contents]) + (state, dispatch) +} diff --git a/lib/src/FormalityCompat__Strategy.re b/lib/src/FormalityCompat__Strategy.res similarity index 86% rename from lib/src/FormalityCompat__Strategy.re rename to lib/src/FormalityCompat__Strategy.res index b8b72632..2e073be6 100644 --- a/lib/src/FormalityCompat__Strategy.re +++ b/lib/src/FormalityCompat__Strategy.res @@ -3,4 +3,4 @@ type t = | OnFirstChange | OnFirstSuccess | OnFirstSuccessOrFirstBlur - | OnSubmit; + | OnSubmit diff --git a/lib/src/FormalityCompat__Validation.re b/lib/src/FormalityCompat__Validation.re deleted file mode 100644 index f24c28ef..00000000 --- a/lib/src/FormalityCompat__Validation.re +++ /dev/null @@ -1,60 +0,0 @@ -module Startegy = FormalityCompat__Strategy; - -module Result = { - type ok = - | Valid - | NoValue; - - type result('message) = Belt.Result.t(ok, 'message); -}; - -module Visibility = { - type t = - | Shown - | Hidden; -}; - -module Sync = { - type status('message) = - | Pristine - | Dirty(Result.result('message), Visibility.t); - - type validate('state, 'message) = 'state => Result.result('message); - - type validator('field, 'state, 'message) = { - field: 'field, - strategy: Startegy.t, - dependents: option(list('field)), - validate: validate('state, 'message), - }; -}; - -include Sync; - -module Async = { - type status('message) = - | Pristine - | Dirty(Result.result('message), Visibility.t) - | Validating; - - type validate('state, 'message) = - 'state => Js.Promise.t(Result.result('message)); - - type equalityChecker('state) = ('state, 'state) => bool; - - type validator('field, 'state, 'message) = { - field: 'field, - strategy: Startegy.t, - dependents: option(list('field)), - validate: Sync.validate('state, 'message), - validateAsync: - option((validate('state, 'message), equalityChecker('state))), - }; -}; - -type submissionCallbacks('state, 'submissionError) = { - notifyOnSuccess: option('state) => unit, - notifyOnFailure: 'submissionError => unit, - reset: unit => unit, - dismissSubmissionResult: unit => unit, -}; diff --git a/lib/src/FormalityCompat__Validation.res b/lib/src/FormalityCompat__Validation.res new file mode 100644 index 00000000..a75d9201 --- /dev/null +++ b/lib/src/FormalityCompat__Validation.res @@ -0,0 +1,58 @@ +module Startegy = FormalityCompat__Strategy + +module Result = { + type ok = + | Valid + | NoValue + + type result<'message> = Belt.Result.t +} + +module Visibility = { + type t = + | Shown + | Hidden +} + +module Sync = { + type status<'message> = + | Pristine + | Dirty(Result.result<'message>, Visibility.t) + + type validate<'state, 'message> = 'state => Result.result<'message> + + type validator<'field, 'state, 'message> = { + field: 'field, + strategy: Startegy.t, + dependents: option>, + validate: validate<'state, 'message>, + } +} + +include Sync + +module Async = { + type status<'message> = + | Pristine + | Dirty(Result.result<'message>, Visibility.t) + | Validating + + type validate<'state, 'message> = 'state => Js.Promise.t> + + type equalityChecker<'state> = ('state, 'state) => bool + + type validator<'field, 'state, 'message> = { + field: 'field, + strategy: Startegy.t, + dependents: option>, + validate: Sync.validate<'state, 'message>, + validateAsync: option<(validate<'state, 'message>, equalityChecker<'state>)>, + } +} + +type submissionCallbacks<'state, 'submissionError> = { + notifyOnSuccess: option<'state> => unit, + notifyOnFailure: 'submissionError => unit, + reset: unit => unit, + dismissSubmissionResult: unit => unit, +} diff --git a/lib/src/Formality__Debouncer.re b/lib/src/Formality__Debouncer.re deleted file mode 100644 index cc89358a..00000000 --- a/lib/src/Formality__Debouncer.re +++ /dev/null @@ -1 +0,0 @@ -include Debounce; diff --git a/lib/src/Formality__Debouncer.res b/lib/src/Formality__Debouncer.res new file mode 100644 index 00000000..4abaff1c --- /dev/null +++ b/lib/src/Formality__Debouncer.res @@ -0,0 +1 @@ +include Debounce diff --git a/lib/src/Formality__ReactUpdate.re b/lib/src/Formality__ReactUpdate.re deleted file mode 100644 index 0d140cc4..00000000 --- a/lib/src/Formality__ReactUpdate.re +++ /dev/null @@ -1,44 +0,0 @@ -[@ocaml.warning "-30"]; - -type update('state, 'action) = - | NoUpdate - | Update('state) - | UpdateWithSideEffects('state, self('state, 'action) => unit) -and dispatch('action) = 'action => unit -and self('state, 'action) = { - state: 'state, - dispatch: dispatch('action), -} -and fullState('state, 'action) = { - state: 'state, - sideEffects: ref(array(self('state, 'action) => unit)), -}; - -type reducer('state, 'action) = ('state, 'action) => update('state, 'action); - -let useReducer = (initialState: 'state, reducer: reducer('state, 'action)) => { - let ({state, sideEffects}, dispatch) = - React.useReducer( - ({state, sideEffects} as fullState, action) => - switch (reducer(state, action)) { - | NoUpdate => fullState - | Update(state) => {...fullState, state} - | UpdateWithSideEffects(state, sideEffect) => { - state, - sideEffects: Array.concat(sideEffects^, [|sideEffect|])->ref, - } - }, - {state: initialState, sideEffects: [||]->ref}, - ); - React.useEffect1( - () => { - if (Array.length(sideEffects^) > 0) { - Array.forEach(sideEffects^, fn => fn({state, dispatch})); - sideEffects := [||]; - }; - None; - }, - [|sideEffects^|], - ); - (state, dispatch); -}; diff --git a/lib/src/Formality__ReactUpdate.res b/lib/src/Formality__ReactUpdate.res new file mode 100644 index 00000000..281630ac --- /dev/null +++ b/lib/src/Formality__ReactUpdate.res @@ -0,0 +1,40 @@ +@@ocaml.warning("-30") + +type rec update<'state, 'action> = + | NoUpdate + | Update('state) + | UpdateWithSideEffects('state, self<'state, 'action> => unit) +and dispatch<'action> = 'action => unit +and self<'state, 'action> = { + state: 'state, + dispatch: dispatch<'action>, +} +and fullState<'state, 'action> = { + state: 'state, + sideEffects: ref => unit>>, +} + +type reducer<'state, 'action> = ('state, 'action) => update<'state, 'action> + +let useReducer = (initialState: 'state, reducer: reducer<'state, 'action>) => { + let ({state, sideEffects}, dispatch) = React.useReducer( + ({state, sideEffects} as fullState, action) => + switch reducer(state, action) { + | NoUpdate => fullState + | Update(state) => {...fullState, state} + | UpdateWithSideEffects(state, sideEffect) => { + state, + sideEffects: Array.concat(sideEffects.contents, [sideEffect])->ref, + } + }, + {state: initialState, sideEffects: []->ref}, + ) + React.useEffect1(() => { + if Array.length(sideEffects.contents) > 0 { + Array.forEach(sideEffects.contents, fn => fn({state, dispatch})) + sideEffects := [] + } + None + }, [sideEffects.contents]) + (state, dispatch) +} diff --git a/linux.patch b/linux.patch deleted file mode 100644 index 2b129aba..00000000 --- a/linux.patch +++ /dev/null @@ -1,10 +0,0 @@ -diff --git a/ppx/bin/dune b/ppx/bin/dune -index 0be22c0..d1faa33 100644 ---- a/ppx/bin/dune -+++ b/ppx/bin/dune -@@ -2,4 +2,5 @@ - (name bin) - (public_name re-formality-ppx) - (libraries re-formality-ppx.lib) -+ (flags (:standard -ccopt -static)) - ) diff --git a/nix/ocaml/flake.lock b/nix/ocaml/flake.lock deleted file mode 100644 index b4647409..00000000 --- a/nix/ocaml/flake.lock +++ /dev/null @@ -1,61 +0,0 @@ -{ - "nodes": { - "flake-utils": { - "inputs": { - "systems": "systems" - }, - "locked": { - "lastModified": 1694529238, - "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "nixpkgs": { - "locked": { - "lastModified": 1694767346, - "narHash": "sha256-5uH27SiVFUwsTsqC5rs3kS7pBoNhtoy9QfTP9BmknGk=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "ace5093e36ab1e95cb9463863491bee90d5a4183", - "type": "github" - }, - "original": { - "owner": "NixOS", - "ref": "nixos-unstable", - "repo": "nixpkgs", - "type": "github" - } - }, - "root": { - "inputs": { - "flake-utils": "flake-utils", - "nixpkgs": "nixpkgs" - } - }, - "systems": { - "locked": { - "lastModified": 1681028828, - "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", - "owner": "nix-systems", - "repo": "default", - "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", - "type": "github" - }, - "original": { - "owner": "nix-systems", - "repo": "default", - "type": "github" - } - } - }, - "root": "root", - "version": 7 -} diff --git a/nix/ocaml/flake.nix b/nix/ocaml/flake.nix deleted file mode 100644 index 17105dee..00000000 --- a/nix/ocaml/flake.nix +++ /dev/null @@ -1,50 +0,0 @@ -{ - description = "OCaml 4.12 packages for ReScript PPX development"; - - inputs = { - nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable"; - flake-utils.url = "github:numtide/flake-utils"; - }; - - outputs = { self, nixpkgs, flake-utils }: - flake-utils.lib.eachDefaultSystem (system: - let - overlay = (final: prev: { - ocaml-ng = prev.ocaml-ng // { - ocamlPackages_4_12 = prev.ocaml-ng.ocamlPackages_4_12 // { - ppxlib = prev.ocaml-ng.ocamlPackages_4_12.ppxlib.overrideAttrs (_: { - version = "git"; - src = pkgs.fetchFromGitHub { - owner = "zth"; - repo = "ppxlib"; - rev = "32f83395fb89693a873541298b6367449f23bc4a"; - sha256 = "sha256-8bkmeFh5Unda8n3F2MQWi81QPt2NdkwFcy4wZTJ0STo="; - }; - patches = []; - }); - }; - }; - }); - - pkgs = import nixpkgs { - inherit system; - overlays = [ overlay ]; - }; - - ocamlPackages = pkgs.ocaml-ng.ocamlPackages_4_12; - in - { - packages = { - ocaml = ocamlPackages.ocaml; - dune = ocamlPackages.dune_3; - reason = ocamlPackages.reason; - result = ocamlPackages.result; - findlib = ocamlPackages.findlib; - ppxlib = ocamlPackages.ppxlib; - alcotest = ocamlPackages.alcotest; - merlin = ocamlPackages.merlin; - lsp = ocamlPackages.ocaml-lsp; - }; - } - ); -} diff --git a/package.json b/package.json index 788c4678..20ffadc9 100644 --- a/package.json +++ b/package.json @@ -1,8 +1,8 @@ { "name": "re-formality", - "version": "4.0.0-beta.20", + "version": "4.0.0-beta.21", "description": "Form validation tool for @rescript/react", - "author": "Alex Fedoseev ", + "author": "Alex Fedoseev ", "license": "MIT", "repository": { "type": "git", @@ -11,8 +11,7 @@ "workspaces": [ "lib", "specs", - "examples", - "ppx/sandbox" + "examples" ], "keywords": [ "react", diff --git a/ppx/bin/Bin.ml b/ppx/bin/Bin.ml new file mode 100644 index 00000000..07cb7b13 --- /dev/null +++ b/ppx/bin/Bin.ml @@ -0,0 +1 @@ +Ppxlib.Driver.run_as_ppx_rewriter () diff --git a/ppx/bin/Bin.re b/ppx/bin/Bin.re deleted file mode 100644 index 25d3caf0..00000000 --- a/ppx/bin/Bin.re +++ /dev/null @@ -1 +0,0 @@ -Ppxlib.Driver.run_as_ppx_rewriter(); diff --git a/ppx/bin/dune b/ppx/bin/dune index 0be22c04..b0d97d6f 100644 --- a/ppx/bin/dune +++ b/ppx/bin/dune @@ -1,5 +1,10 @@ +(env + (static + (flags + (:standard -ccopt -static)))) + (executable - (name bin) - (public_name re-formality-ppx) - (libraries re-formality-ppx.lib) -) + (package re-formality-ppx) + (name bin) + (public_name re-formality-ppx) + (libraries re-formality-ppx.lib)) diff --git a/ppx/lib/Ast.ml b/ppx/lib/Ast.ml new file mode 100644 index 00000000..82127156 --- /dev/null +++ b/ppx/lib/Ast.ml @@ -0,0 +1,11 @@ +open Ppxlib + +let str ~loc (x : string) = { txt = x; loc } +let lid ~loc (x : Longident.t) = { txt = x; loc } + +let explicit_arity ~loc = + { attr_name = "explicit_arity" |> str ~loc + ; attr_payload = PStr [] + ; attr_loc = Location.none + } +;; diff --git a/ppx/lib/Ast.re b/ppx/lib/Ast.re deleted file mode 100644 index 309f4047..00000000 --- a/ppx/lib/Ast.re +++ /dev/null @@ -1,10 +0,0 @@ -open Ppxlib; - -let str = (~loc, x: string) => {txt: x, loc}; -let lid = (~loc, x: Longident.t) => {txt: x, loc}; - -let explicit_arity = (~loc) => { - attr_name: "explicit_arity" |> str(~loc), - attr_payload: PStr([]), - attr_loc: Location.none, -}; diff --git a/ppx/lib/AstHelpers.ml b/ppx/lib/AstHelpers.ml new file mode 100644 index 00000000..0133e322 --- /dev/null +++ b/ppx/lib/AstHelpers.ml @@ -0,0 +1,271 @@ +open Ast +open Meta +open Ppxlib +open Ast_helper + +module T = struct + let constructor ~loc ?(args : core_type list option) x = + Type.constructor + ?args: + (match args with + | Some args -> Some (Pcstr_tuple args) + | None -> None) + (x |> str ~loc) + ;; +end + +module P = struct + let rec or_ ~pat ~make list = + match list with + | [] -> pat + | x :: list -> or_ ~pat:(x |> make |> Pat.or_ pat) ~make list + ;; +end + +module E = struct + let some ~loc x = + Exp.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Some" |> lid ~loc) + (Some (Exp.tuple [ x ])) + ;; + + let rec seq ~exp ~make list = + match list with + | [] -> exp + | x :: list -> seq ~exp:(x |> make |> Exp.sequence exp) ~make list + ;; + + let rec conj ~exp ~make ~loc list = + match list with + | [] -> exp + | x :: list -> + conj + ~exp: + (Exp.apply + (Exp.ident (Lident "&&" |> lid ~loc)) + [ Nolabel, exp; Nolabel, x |> make ~loc ]) + ~make + ~loc + list + ;; + + let ref_ ~loc x = + Exp.apply + (Exp.ident (Lident "!" |> lid ~loc)) + [ Nolabel, Exp.ident (Lident x |> lid ~loc) ] + ;; + + let record ~loc (xs : (string * expression) list) = + Exp.record + (xs |> List.rev |> List.rev_map (fun (name, expr) -> Lident name |> lid ~loc, expr)) + None + ;; + + let field ~in_:record ~loc field = + Exp.field (Exp.ident (Lident record |> lid ~loc)) (Lident field |> lid ~loc) + ;; + + let field2 ~in_:(record1, record2) ~loc field = + Exp.field + (Exp.field (Exp.ident (Lident record1 |> lid ~loc)) (Lident record2 |> lid ~loc)) + (Lident field |> lid ~loc) + ;; + + let field3 ~in_:(record1, record2, record3) ~loc field = + Exp.field + (Exp.field + (Exp.field (Exp.ident (Lident record1 |> lid ~loc)) (Lident record2 |> lid ~loc)) + (Lident record3 |> lid ~loc)) + (Lident field |> lid ~loc) + ;; + + let field4 ~in_:(record1, record2, record3, record4) ~loc field = + Exp.field + (Exp.field + (Exp.field + (Exp.field + (Exp.ident (Lident record1 |> lid ~loc)) + (Lident record2 |> lid ~loc)) + (Lident record3 |> lid ~loc)) + (Lident record4 |> lid ~loc)) + (Lident field |> lid ~loc) + ;; + + let field_of_collection ~in_ ~(collection : Collection.t) ~loc field_name = + Exp.field + (Exp.apply + ~attrs:[ Uncurried.uapp ] + [%expr Belt.Array.getUnsafe] + [ Nolabel, collection.plural |> field ~in_ ~loc; Nolabel, [%expr index] ]) + (Lident field_name |> lid ~loc) + ;; + + let field_of_collection2 ~in_ ~(collection : Collection.t) ~loc field_name = + Exp.field + (Exp.apply + ~attrs:[ Uncurried.uapp ] + [%expr Belt.Array.getUnsafe] + [ Nolabel, collection.plural |> field2 ~in_ ~loc; Nolabel, [%expr index] ]) + (Lident field_name |> lid ~loc) + ;; + + let ref_field ~in_:record ~loc field = + Exp.field (record |> ref_ ~loc) (Lident field |> lid ~loc) + ;; + + let ref_field2 ~in_:(record1, record2) ~loc field = + Exp.field + (Exp.field (record1 |> ref_ ~loc) (Lident record2 |> lid ~loc)) + (Lident field |> lid ~loc) + ;; + + let ref_field_of_collection ~in_:record ~(collection : Collection.t) ~loc field_name = + Exp.field + (Exp.apply + ~attrs:[ Uncurried.uapp ] + [%expr Belt.Array.getUnsafe] + [ Nolabel, Exp.field (record |> ref_ ~loc) (Lident collection.plural |> lid ~loc) + ; Nolabel, [%expr index] + ]) + (Lident field_name |> lid ~loc) + ;; + + let apply_field ~in_ ~fn ~args ~loc = + Exp.apply ~attrs:[ Uncurried.uapp ] (field ~in_ ~loc fn) args + ;; + + let apply_field2 ~in_ ~fn ~args ~loc = + Exp.apply ~attrs:[ Uncurried.uapp ] (field2 ~in_ ~loc fn) args + ;; + + let apply_field3 ~in_ ~fn ~args ~loc = + Exp.apply ~attrs:[ Uncurried.uapp ] (field3 ~in_ ~loc fn) args + ;; + + let apply_field4 ~in_ ~fn ~args ~loc = + Exp.apply ~attrs:[ Uncurried.uapp ] (field4 ~in_ ~loc fn) args + ;; + + let update_field ~in_:record ~with_:value ~loc field = + Exp.record + [ Lident field |> lid ~loc, value ] + (Some (Exp.ident (Lident record |> lid ~loc))) + ;; + + let update_field2 ~in_:(record1, record2) ~with_:value ~loc field = + Exp.record + [ Lident field |> lid ~loc, value ] + (Some + (Exp.field (Exp.ident (Lident record1 |> lid ~loc)) (Lident record2 |> lid ~loc))) + ;; + + let update_field3 ~in_:(record1, record2, record3) ~with_:value ~loc field = + Exp.record + [ Lident field |> lid ~loc, value ] + (Some + (Exp.field + (Exp.field + (Exp.ident (Lident record1 |> lid ~loc)) + (Lident record2 |> lid ~loc)) + (Lident record3 |> lid ~loc))) + ;; + + let update_ref_field ~in_:record ~with_:value ~loc field = + Exp.record [ Lident field |> lid ~loc, value ] (Some (record |> ref_ ~loc)) + ;; + + let update_ref_field2 ~in_:(record1, record2) ~with_:value ~loc field = + Exp.record + [ Lident field |> lid ~loc, value ] + (Some (Exp.field (record1 |> ref_ ~loc) (Lident record2 |> lid ~loc))) + ;; + + let update_field_of_collection + ~in_:record + ~(collection : Collection.t) + ~with_:value + ~loc + field_name + = + Exp.record + [ ( Lident collection.plural |> lid ~loc + , Exp.apply + ~attrs:[ Uncurried.uapp ] + [%expr Belt.Array.mapWithIndex] + [ Nolabel, collection.plural |> field ~in_:record ~loc + ; ( Nolabel + , Uncurried.fn + ~loc + ~arity:2 + [%expr + fun index' item -> + if index' = index + then [%e field_name |> update_field ~in_:"item" ~with_:value ~loc] + else item] ) + ] ) + ] + (Some (Exp.ident (Lident record |> lid ~loc))) + ;; + + let update_field_of_collection2 + ~in_:(record1, record2) + ~(collection : Collection.t) + ~with_:value + ~loc + field_name + = + Exp.record + [ ( Lident collection.plural |> lid ~loc + , Exp.apply + ~attrs:[ Uncurried.uapp ] + [%expr Belt.Array.mapWithIndex] + [ Nolabel, collection.plural |> field2 ~in_:(record1, record2) ~loc + ; ( Nolabel + , Uncurried.fn + ~loc + ~arity:2 + [%expr + fun index' item -> + if index' = index + then [%e field_name |> update_field ~in_:"item" ~with_:value ~loc] + else item] ) + ] ) + ] + (Some (record2 |> field ~in_:record1 ~loc)) + ;; + + let update_ref_field_of_collection + ~in_:record + ~(collection : Collection.t) + ~with_:value + ?(index_token = "index") + ~loc + field_name + = + Exp.record + [ ( Lident collection.plural |> lid ~loc + , Exp.apply + ~attrs:[ Uncurried.uapp ] + [%expr Belt.Array.mapWithIndex] + [ Nolabel, collection.plural |> ref_field ~in_:record ~loc + ; ( Nolabel + , Uncurried.fn + ~loc + ~arity:2 + [%expr + fun idx_ item -> + if idx_ = [%e Exp.ident (Lident index_token |> lid ~loc)] + then [%e field_name |> update_field ~in_:"item" ~with_:value ~loc] + else item] ) + ] ) + ] + (Some (record |> ref_ ~loc)) + ;; + + let field_of_collection_validator ~validators ~(collection : Collection.t) ~loc field = + field |> field3 ~in_:(validators, collection.plural, "fields") ~loc + ;; +end + +let warning_4_disable ~loc = Attr.mk ("warning" |> str ~loc) (PStr [ [%stri "-4"] ]) diff --git a/ppx/lib/AstHelpers.re b/ppx/lib/AstHelpers.re deleted file mode 100644 index 73dc080a..00000000 --- a/ppx/lib/AstHelpers.re +++ /dev/null @@ -1,351 +0,0 @@ -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), - ); -}; - -module P = { - let rec or_ = (~pat, ~make, list) => { - switch (list) { - | [] => pat - | [x, ...list] => or_(~pat=x |> make |> Pat.or_(pat), ~make, list) - }; - }; -}; - -module E = { - let some = (~loc, x) => - Exp.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Some") |> lid(~loc), - Some(Exp.tuple([x])), - ); - - let rec seq = (~exp, ~make, list) => { - switch (list) { - | [] => exp - | [x, ...list] => seq(~exp=x |> make |> Exp.sequence(exp), ~make, list) - }; - }; - - let rec conj = (~exp, ~make, ~loc, list) => { - switch (list) { - | [] => exp - | [x, ...list] => - conj( - ~exp= - Exp.apply( - Exp.ident(Lident("&&") |> lid(~loc)), - [(Nolabel, exp), (Nolabel, x |> make(~loc))], - ), - ~make, - ~loc, - list, - ) - }; - }; - - let ref_ = (~loc, x) => - Exp.apply( - Exp.ident(Lident("!") |> lid(~loc)), - [(Nolabel, Exp.ident(Lident(x) |> lid(~loc)))], - ); - - let record = (~loc, xs: list((string, expression))) => - Exp.record( - xs - |> List.rev - |> List.rev_map(((name, expr)) => (Lident(name) |> lid(~loc), expr)), - None, - ); - - let field = (~in_ as record, ~loc, field) => - Exp.field( - Exp.ident(Lident(record) |> lid(~loc)), - Lident(field) |> lid(~loc), - ); - - let field2 = (~in_ as (record1, record2), ~loc, field) => - Exp.field( - Exp.field( - Exp.ident(Lident(record1) |> lid(~loc)), - Lident(record2) |> lid(~loc), - ), - Lident(field) |> lid(~loc), - ); - - let field3 = (~in_ as (record1, record2, record3), ~loc, field) => - Exp.field( - Exp.field( - Exp.field( - Exp.ident(Lident(record1) |> lid(~loc)), - Lident(record2) |> lid(~loc), - ), - Lident(record3) |> lid(~loc), - ), - Lident(field) |> lid(~loc), - ); - - let field4 = (~in_ as (record1, record2, record3, record4), ~loc, field) => - Exp.field( - Exp.field( - Exp.field( - Exp.field( - Exp.ident(Lident(record1) |> lid(~loc)), - Lident(record2) |> lid(~loc), - ), - Lident(record3) |> lid(~loc), - ), - Lident(record4) |> lid(~loc), - ), - Lident(field) |> lid(~loc), - ); - - let field_of_collection = - (~in_, ~collection: Collection.t, ~loc, field_name) => - Exp.field( - Exp.apply( - [%expr Belt.Array.getUnsafe], - [ - (Nolabel, collection.plural |> field(~in_, ~loc)), - (Nolabel, [%expr index]), - ], - ), - Lident(field_name) |> lid(~loc), - ); - - let field_of_collection2 = - (~in_, ~collection: Collection.t, ~loc, field_name) => - Exp.field( - Exp.apply( - [%expr Belt.Array.getUnsafe], - [ - (Nolabel, collection.plural |> field2(~in_, ~loc)), - (Nolabel, [%expr index]), - ], - ), - Lident(field_name) |> lid(~loc), - ); - - let ref_field = (~in_ as record, ~loc, field) => - Exp.field(record |> ref_(~loc), Lident(field) |> lid(~loc)); - - let ref_field2 = (~in_ as (record1, record2), ~loc, field) => - Exp.field( - Exp.field(record1 |> ref_(~loc), Lident(record2) |> lid(~loc)), - Lident(field) |> lid(~loc), - ); - - let ref_field_of_collection = - (~in_ as record, ~collection: Collection.t, ~loc, field_name) => - Exp.field( - Exp.apply( - [%expr Belt.Array.getUnsafe], - [ - ( - Nolabel, - Exp.field( - record |> ref_(~loc), - Lident(collection.plural) |> lid(~loc), - ), - ), - (Nolabel, [%expr index]), - ], - ), - Lident(field_name) |> lid(~loc), - ); - - let apply_field = (~in_, ~fn, ~args, ~loc) => - Exp.apply(field(~in_, ~loc, fn), args); - - let apply_field2 = (~in_, ~fn, ~args, ~loc) => - Exp.apply(field2(~in_, ~loc, fn), args); - - let apply_field3 = (~in_, ~fn, ~args, ~loc) => - Exp.apply(field3(~in_, ~loc, fn), args); - - let apply_field4 = (~in_, ~fn, ~args, ~loc) => - Exp.apply(field4(~in_, ~loc, fn), args); - - let update_field = (~in_ as record, ~with_ as value, ~loc, field) => - Exp.record( - [(Lident(field) |> lid(~loc), value)], - Some(Exp.ident(Lident(record) |> lid(~loc))), - ); - - let update_field2 = - (~in_ as (record1, record2), ~with_ as value, ~loc, field) => - Exp.record( - [(Lident(field) |> lid(~loc), value)], - Some( - Exp.field( - Exp.ident(Lident(record1) |> lid(~loc)), - Lident(record2) |> lid(~loc), - ), - ), - ); - - let update_field3 = - (~in_ as (record1, record2, record3), ~with_ as value, ~loc, field) => - Exp.record( - [(Lident(field) |> lid(~loc), value)], - Some( - Exp.field( - Exp.field( - Exp.ident(Lident(record1) |> lid(~loc)), - Lident(record2) |> lid(~loc), - ), - Lident(record3) |> lid(~loc), - ), - ), - ); - - let update_ref_field = (~in_ as record, ~with_ as value, ~loc, field) => - Exp.record( - [(Lident(field) |> lid(~loc), value)], - Some(record |> ref_(~loc)), - ); - - let update_ref_field2 = - (~in_ as (record1, record2), ~with_ as value, ~loc, field) => - Exp.record( - [(Lident(field) |> lid(~loc), value)], - Some( - Exp.field(record1 |> ref_(~loc), Lident(record2) |> lid(~loc)), - ), - ); - - let update_field_of_collection = - ( - ~in_ as record, - ~collection: Collection.t, - ~with_ as value, - ~loc, - field_name, - ) => - Exp.record( - [ - ( - Lident(collection.plural) |> lid(~loc), - Exp.apply( - [%expr Belt.Array.mapWithIndex], - [ - (Nolabel, collection.plural |> field(~in_=record, ~loc)), - ( - Nolabel, - [%expr - (index', item) => - if (index' == index) { - %e - field_name - |> update_field(~in_="item", ~with_=value, ~loc); - } else { - item; - } - ], - ), - ], - ), - ), - ], - Some(Exp.ident(Lident(record) |> lid(~loc))), - ); - - let update_field_of_collection2 = - ( - ~in_ as (record1, record2), - ~collection: Collection.t, - ~with_ as value, - ~loc, - field_name, - ) => - Exp.record( - [ - ( - Lident(collection.plural) |> lid(~loc), - Exp.apply( - [%expr Belt.Array.mapWithIndex], - [ - ( - Nolabel, - collection.plural |> field2(~in_=(record1, record2), ~loc), - ), - ( - Nolabel, - [%expr - (index', item) => - if (index' == index) { - %e - field_name - |> update_field(~in_="item", ~with_=value, ~loc); - } else { - item; - } - ], - ), - ], - ), - ), - ], - Some(record2 |> field(~in_=record1, ~loc)), - ); - - let update_ref_field_of_collection = - ( - ~in_ as record, - ~collection: Collection.t, - ~with_ as value, - ~index_token="index", - ~loc, - field_name, - ) => - Exp.record( - [ - ( - Lident(collection.plural) |> lid(~loc), - Exp.apply( - [%expr Belt.Array.mapWithIndex], - [ - (Nolabel, collection.plural |> ref_field(~in_=record, ~loc)), - ( - Nolabel, - [%expr - (idx_, item) => - if (idx_ - == [%e Exp.ident(Lident(index_token) |> lid(~loc))]) { - %e - field_name - |> update_field(~in_="item", ~with_=value, ~loc); - } else { - item; - } - ], - ), - ], - ), - ), - ], - Some(record |> ref_(~loc)), - ); - - let field_of_collection_validator = - (~validators, ~collection: Collection.t, ~loc, field) => - field |> field3(~in_=(validators, collection.plural, "fields"), ~loc); -}; - -// Disables warning 4 to prevent stack overflow -// Details: https://github.com/BuckleScript/bucklescript/issues/4327 -let warning_4_disable = (~loc) => - Attr.mk("warning" |> str(~loc), PStr([[%stri "-4"]])); diff --git a/ppx/lib/Form.ml b/ppx/lib/Form.ml new file mode 100644 index 00000000..fcce74a4 --- /dev/null +++ b/ppx/lib/Form.ml @@ -0,0 +1,315 @@ +open Meta +open Ppxlib +open Ast_helper + +let ext = + Extension.declare + "form" + Extension.Context.module_expr + Ast_pattern.__ + (fun ~loc ~path:_ expr -> + match expr with + | PStr structure -> + (match structure |> Metadata.make with + | Ok + { scheme + ; async + ; output_type + ; message_type + ; submission_error_type + ; validators_record + ; metadata + ; debounce_interval + } -> + let head = [ Form_Attributes.ast ~loc; Form_OpenFormality.ast ~loc ] in + let types = + let types = + ref + [ Form_FieldsStatusesType.ast ~scheme ~loc + ; Form_CollectionsStatusesType.ast ~scheme ~loc + ; Form_StateType.ast ~loc + ; Form_ActionType.ast ~scheme ~loc + ; Form_ValidatorsType.ast ~scheme ~metadata ~loc + ; Form_InterfaceType.ast ~scheme ~async ~loc + ] + in + (match submission_error_type with + | None -> types := SubmissionErrorType.default ~loc :: !types + | Some () -> ()); + (match message_type with + | None -> types := MessageType.default ~loc :: !types + | Some () -> ()); + (match output_type with + | NotProvided -> types := OutputType.default ~loc :: !types + | AliasOfInput | Record _ -> ()); + !types + in + let values = + let values = ref [] in + (match debounce_interval with + | None when async -> values := DebounceInterval.default ~loc :: !values + | None | Some () -> ()); + !values + in + let funcs = + [ Form_InitialFieldsStatusesFn.ast ~scheme ~loc + ; Form_InitialCollectionsStatuses.ast ~scheme ~loc + ; Form_InitialStateFn.ast ~loc + ; (match async with + | true -> Form_ValidateFormFn.Async.ast ~scheme ~metadata ~loc + | false -> Form_ValidateFormFn.Sync.ast ~scheme ~metadata ~loc) + ; Form_UseFormFn.ast ~scheme ~async ~metadata ~loc + ] + in + let structure = + (structure + |> List.rev + |> List.fold_left + (fun acc (structure_item : structure_item) -> + match structure_item with + | { pstr_desc = Pstr_value (rec_flag, value_bindings); pstr_loc } -> + let value_bindings, search_result = + value_bindings + |> List.rev + |> List.fold_left + (fun (acc, (res : [ `Found | `NotFound ])) value -> + match value with + | { pvb_pat = + { ppat_desc = Ppat_var { txt = "validators" } } + } as value -> + ( (value + |> Form_ValidatorsRecord.ast + ~scheme + ~metadata + ~validators:validators_record) + :: acc + , `Found ) + | _ as value -> value :: acc, res) + ([], `NotFound) + in + let structure_item = + { pstr_desc = Pstr_value (rec_flag, value_bindings); pstr_loc } + in + (match search_result with + | `NotFound -> structure_item :: acc + | `Found -> + List.rev_append + (types |> List.rev |> List.rev_append values) + (structure_item :: acc)) + | _ -> structure_item :: acc) + funcs + : structure) + in + Mod.mk (Pmod_structure (structure |> List.rev_append (head |> List.rev))) + | 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 + (InvalidAttributes + ( InvalidAsyncField (InvalidPayload loc) + | InvalidCollectionField (InvalidAsyncField (InvalidPayload loc)) ))) -> + Location.raise_errorf + ~loc + "`@field.async` attribute accepts only optional record `{mode: OnChange | \ + OnBlur}`" + | Error + (InputTypeParseError + (InvalidAttributes + ( InvalidAsyncField (InvalidAsyncMode loc) + | InvalidCollectionField (InvalidAsyncField (InvalidAsyncMode loc)) ))) + -> + Location.raise_errorf + ~loc + "Invalid async mode. Use either `OnChange` or `OnBlur`." + | Error + (InputTypeParseError + (InvalidAttributes + ( InvalidFieldDeps (DepsParseError loc) + | InvalidCollectionField (InvalidFieldDeps (DepsParseError loc)) ))) -> + Location.raise_errorf + ~loc + "`@field.deps` attribute must contain field or tuple of fields" + | Error + (InputTypeParseError + (InvalidAttributes + ( InvalidFieldDeps (DepNotFound dep) + | InvalidCollectionField (InvalidFieldDeps (DepNotFound dep)) ))) -> + let field, loc = + match dep with + | UnvalidatedDepField { name; loc } -> name, loc + | UnvalidatedDepFieldOfCollection { collection; field; f_loc } -> + collection ^ "." ^ field, f_loc + in + Location.raise_errorf ~loc "Field `%s` doesn't exist in input" field + | Error + (InputTypeParseError + (InvalidAttributes + ( InvalidFieldDeps (DepOfItself (`Field (name, loc))) + | InvalidCollectionField + (InvalidFieldDeps (DepOfItself (`Field (name, loc)))) ))) -> + Location.raise_errorf ~loc "Field `%s` depends on itself" name + | Error + (InputTypeParseError + (InvalidAttributes + ( InvalidFieldDeps (DepDuplicate dep) + | InvalidCollectionField (InvalidFieldDeps (DepDuplicate dep)) ))) -> + let field, loc = + match dep with + | UnvalidatedDepField { name; loc } -> name, loc + | UnvalidatedDepFieldOfCollection { collection; field; f_loc } -> + collection ^ "." ^ field, f_loc + in + Location.raise_errorf + ~loc + "Field `%s` is already declared as a dependency for this field" + field + | Error + (InputTypeParseError + (InvalidAttributes (Conflict (`AsyncWithCollection loc)))) -> + Location.raise_errorf + ~loc + "Collection can not be `async`. If you want to make specific fields in \ + collection async, you can apply `field.async` attribute to specific \ + fields." + | Error + (InputTypeParseError + (InvalidAttributes (Conflict (`DepsWithCollection loc)))) -> + Location.raise_errorf ~loc "Collection can not have deps" + | Error + (InputTypeParseError + (InvalidAttributes (InvalidCollectionField (NotArray loc)))) -> + Location.raise_errorf ~loc "Collection must be an array of records" + | Error + (InputTypeParseError + (InvalidAttributes (InvalidCollectionField (InvalidTypeRef loc)))) -> + Location.raise_errorf + ~loc + "Collection must be an array of records. Record type of collection entry \ + must be defined within this module." + | Error + (InputTypeParseError + (InvalidAttributes (InvalidCollectionField (RecordNotFound loc)))) -> + Location.raise_errorf + ~loc + "This type can not be found. Record type of collection entry must be \ + defined within this module." + | Error + (InputTypeParseError + (InvalidAttributes (InvalidCollectionField (NotRecord loc)))) -> + Location.raise_errorf ~loc "Type of collection entry must be a record" + | 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 (OutputTypeParseError (InputNotAvailable loc)) -> + Location.raise_errorf ~loc "`input` type is not found or in invalid state" + | Error + (OutputTypeParseError (OutputCollectionNotFound { input_collection; loc })) + -> + Location.raise_errorf + ~loc + "`output` type for %s collection that is defined in `input` is not found or \ + in invalid state" + input_collection.plural + | Error + (OutputTypeParseError + (InvalidCollection + ( InvalidCollectionTypeRef loc + | CollectionTypeNotRecord loc + | CollectionTypeNotFound loc + | CollectionOutputNotArray loc ))) -> + Location.raise_errorf + ~loc + "Collection must be an array of records. Record type of collection entry \ + must be defined within this module." + | Error (ValidatorsRecordParseError NotFound) -> + Location.raise_errorf ~loc "`validators` record not found" + | Error (ValidatorsRecordParseError (NotRecord loc | RecordParseError loc)) -> + Location.raise_errorf + ~loc + "Failed to parse `validators` record. Please, file an issue with your \ + use-case." + | Error (ValidatorsRecordParseError (BadTypeAnnotation loc)) -> + Location.raise_errorf + ~loc + "`validators` binding must be of `validators` type. You can safely remove \ + type annotation and it will be annotated for you under the hood." + | Error + (ValidatorsRecordParseError + (ValidatorError + (`BadRequiredValidator (field, (`Some loc | `None loc), reason)))) -> + (match reason with + | `DifferentIO (_input_type, _output_type) -> + Location.raise_errorf + ~loc + "Validator for `%s` field is required because its input and output types \ + are different. So validator function is required to produce value of \ + output type from an input value." + (match field with + | ValidatedInputField field -> field.name + | ValidatedInputFieldOfCollection { collection; field } -> + collection.singular ^ "." ^ field.name) + | `IncludedInDeps in_deps_of_field -> + Location.raise_errorf + ~loc + "Validator for `%s` field is required because this field is included in \ + deps of `%s` field" + (match field with + | ValidatedInputField field -> field.name + | ValidatedInputFieldOfCollection { collection; field } -> + collection.singular ^ "." ^ field.name) + (match in_deps_of_field with + | ValidatedInputField field -> field.name + | ValidatedInputFieldOfCollection { collection; field } -> + collection.singular ^ "." ^ field.name)) + | Error (IOMismatch (OutputFieldsNotInInput { fields })) -> + (match fields with + | [] -> + failwith + "Empty list of non-matched fields in IOMatchError(OutputFieldsNotInInput)" + | field :: [] | field :: _ -> + Location.raise_errorf + ~loc + "`output` field `%s` doesn't exist in `input` type" + (match field with + | OutputField field -> field.name + | OutputFieldOfCollection { collection; field } -> + collection.singular ^ "." ^ field.name)) + | Error (IOMismatch (InputFieldsNotInOutput { fields; loc })) + | Error + (IOMismatch + (Both + { input_fields_not_in_output = fields + ; output_fields_not_in_input = _ + ; loc + })) -> + (match fields with + | [] -> failwith "Empty list of non-matched fields in IOMatchError(Both)" + | field :: [] -> + Location.raise_errorf + ~loc + "`input` field `%s` doesn't exist in `output` type" + (match field with + | ValidatedInputField field -> field.name + | ValidatedInputFieldOfCollection { collection; field } -> + collection.singular ^ "." ^ field.name) + | fields -> + Location.raise_errorf + ~loc + "Some `input` fields don't exist in `output` type: %s" + (fields + |> List.rev + |> List.rev_map (fun (field : InputField.validated) -> + match field with + | ValidatedInputField field -> field.name + | ValidatedInputFieldOfCollection { collection; field } -> + collection.singular ^ "." ^ field.name) + |> String.concat ", "))) + | _ -> Location.raise_errorf ~loc "Must be a structure") +;; diff --git a/ppx/lib/Form.re b/ppx/lib/Form.re deleted file mode 100644 index 43c44325..00000000 --- a/ppx/lib/Form.re +++ /dev/null @@ -1,436 +0,0 @@ -open Meta; - -open Ppxlib; -open Ast_helper; - -let ext = - Extension.declare( - "form", - Extension.Context.module_expr, - Ast_pattern.__, - (~loc, ~path as _, expr) => { - switch (expr) { - | PStr(structure) => - switch (structure |> Metadata.make) { - | Ok({ - scheme, - async, - output_type, - message_type, - submission_error_type, - validators_record, - metadata, - debounce_interval, - }) => - // Once all required metadata is gathered and ensured that requirements are met - // We need to iterate over user provided config and do the following: - // 1. Disable some compiler warnings - // 2. Open Formality module at the top of the generated module - // 3. Inject types and values that either optional and weren't provided - // or just generated by ppx - // 4. Update validators record (see Form_ValidatorsRecord for details) - // 5. Append neccessary functions including useForm hook - // - // The strategy would be to find structure_item which contains - // validators record and prepend types and values right before it. - // Then prepend `open Formality` at the top & append functions - // to the result list so those are at the bottom of the module. - let head = [ - Form_Attributes.ast(~loc), - Form_OpenFormality.ast(~loc), - ]; - - let types = { - let types = - ref([ - Form_FieldsStatusesType.ast(~scheme, ~loc), - Form_CollectionsStatusesType.ast(~scheme, ~loc), - Form_StateType.ast(~loc), - Form_ActionType.ast(~scheme, ~loc), - Form_ValidatorsType.ast(~scheme, ~metadata, ~loc), - Form_InterfaceType.ast(~scheme, ~async, ~loc), - ]); - switch (submission_error_type) { - | None => types := [SubmissionErrorType.default(~loc), ...types^] - | Some () => () - }; - switch (message_type) { - | None => types := [MessageType.default(~loc), ...types^] - | Some () => () - }; - switch (output_type) { - | NotProvided => types := [OutputType.default(~loc), ...types^] - | AliasOfInput - | Record(_) => () - }; - types^; - }; - - let values = { - let values = ref([]); - switch (debounce_interval) { - | None when async => - values := [DebounceInterval.default(~loc), ...values^] - | None - | Some () => () - }; - values^; - }; - - let funcs = [ - Form_InitialFieldsStatusesFn.ast(~scheme, ~loc), - Form_InitialCollectionsStatuses.ast(~scheme, ~loc), - Form_InitialStateFn.ast(~loc), - async - ? Form_ValidateFormFn.Async.ast(~scheme, ~metadata, ~loc) - : Form_ValidateFormFn.Sync.ast(~scheme, ~metadata, ~loc), - Form_UseFormFn.ast(~scheme, ~async, ~metadata, ~loc), - ]; - - let structure: structure = - structure - |> List.rev - |> List.fold_left( - (acc, structure_item: structure_item) => - switch (structure_item) { - | { - pstr_desc: Pstr_value(rec_flag, value_bindings), - pstr_loc, - } => - let (value_bindings, search_result) = - value_bindings - |> List.rev - |> List.fold_left( - ((acc, res: [ | `Found | `NotFound]), value) => - switch (value) { - | { - pvb_pat: { - ppat_desc: Ppat_var({txt: "validators"}), - }, - } as value => ( - [ - value - |> Form_ValidatorsRecord.ast( - ~scheme, - ~metadata, - ~validators=validators_record, - ), - ...acc, - ], - `Found, - ) - | _ as value => ([value, ...acc], res) - }, - ([], `NotFound), - ); - let structure_item = { - pstr_desc: Pstr_value(rec_flag, value_bindings), - pstr_loc, - }; - switch (search_result) { - | `NotFound => [structure_item, ...acc] - | `Found => - List.rev_append( - types |> List.rev |> List.rev_append(values), - [structure_item, ...acc], - ) - }; - | _ => [structure_item, ...acc] - }, - funcs, - ); - - Mod.mk( - Pmod_structure(structure |> List.rev_append(head |> List.rev)), - ); - - | 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( - InvalidAttributes( - InvalidAsyncField(InvalidPayload(loc)) | - InvalidCollectionField(InvalidAsyncField(InvalidPayload(loc))), - ), - ), - ) => - Location.raise_errorf( - ~loc, - "`@field.async` attribute accepts only optional record `{mode: OnChange | OnBlur}`", - ) - | Error( - InputTypeParseError( - InvalidAttributes( - InvalidAsyncField(InvalidAsyncMode(loc)) | - InvalidCollectionField( - InvalidAsyncField(InvalidAsyncMode(loc)), - ), - ), - ), - ) => - Location.raise_errorf( - ~loc, - "Invalid async mode. Use either `OnChange` or `OnBlur`.", - ) - | Error( - InputTypeParseError( - InvalidAttributes( - InvalidFieldDeps(DepsParseError(loc)) | - InvalidCollectionField(InvalidFieldDeps(DepsParseError(loc))), - ), - ), - ) => - Location.raise_errorf( - ~loc, - "`@field.deps` attribute must contain field or tuple of fields", - ) - | Error( - InputTypeParseError( - InvalidAttributes( - InvalidFieldDeps(DepNotFound(dep)) | - InvalidCollectionField(InvalidFieldDeps(DepNotFound(dep))), - ), - ), - ) => - let (field, loc) = - switch (dep) { - | UnvalidatedDepField({name, loc}) => (name, loc) - | UnvalidatedDepFieldOfCollection({collection, field, f_loc}) => ( - collection ++ "." ++ field, - f_loc, - ) - }; - Location.raise_errorf( - ~loc, - "Field `%s` doesn't exist in input", - field, - ); - | Error( - InputTypeParseError( - InvalidAttributes( - InvalidFieldDeps(DepOfItself(`Field(name, loc))) | - InvalidCollectionField( - InvalidFieldDeps(DepOfItself(`Field(name, loc))), - ), - ), - ), - ) => - Location.raise_errorf(~loc, "Field `%s` depends on itself", name) - | Error( - InputTypeParseError( - InvalidAttributes( - InvalidFieldDeps(DepDuplicate(dep)) | - InvalidCollectionField(InvalidFieldDeps(DepDuplicate(dep))), - ), - ), - ) => - let (field, loc) = - switch (dep) { - | UnvalidatedDepField({name, loc}) => (name, loc) - | UnvalidatedDepFieldOfCollection({collection, field, f_loc}) => ( - collection ++ "." ++ field, - f_loc, - ) - }; - Location.raise_errorf( - ~loc, - "Field `%s` is already declared as a dependency for this field", - field, - ); - | Error( - InputTypeParseError( - InvalidAttributes(Conflict(`AsyncWithCollection(loc))), - ), - ) => - Location.raise_errorf( - ~loc, - "Collection can not be `async`. If you want to make specific fields in collection async, you can apply `field.async` attribute to specific fields.", - ) - | Error( - InputTypeParseError( - InvalidAttributes(Conflict(`DepsWithCollection(loc))), - ), - ) => - Location.raise_errorf(~loc, "Collection can not have deps") - | Error( - InputTypeParseError( - InvalidAttributes(InvalidCollectionField(NotArray(loc))), - ), - ) => - Location.raise_errorf(~loc, "Collection must be an array of records") - | Error( - InputTypeParseError( - InvalidAttributes(InvalidCollectionField(InvalidTypeRef(loc))), - ), - ) => - Location.raise_errorf( - ~loc, - "Collection must be an array of records. Record type of collection entry must be defined within this module.", - ) - | Error( - InputTypeParseError( - InvalidAttributes(InvalidCollectionField(RecordNotFound(loc))), - ), - ) => - Location.raise_errorf( - ~loc, - "This type can not be found. Record type of collection entry must be defined within this module.", - ) - | Error( - InputTypeParseError( - InvalidAttributes(InvalidCollectionField(NotRecord(loc))), - ), - ) => - Location.raise_errorf( - ~loc, - "Type of collection entry must be a record", - ) - | 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(OutputTypeParseError(InputNotAvailable(loc))) => - Location.raise_errorf( - ~loc, - "`input` type is not found or in invalid state", - ) - | Error( - OutputTypeParseError( - OutputCollectionNotFound({input_collection, loc}), - ), - ) => - Location.raise_errorf( - ~loc, - "`output` type for %s collection that is defined in `input` is not found or in invalid state", - input_collection.plural, - ) - | Error( - OutputTypeParseError( - InvalidCollection( - InvalidCollectionTypeRef(loc) | CollectionTypeNotRecord(loc) | - CollectionTypeNotFound(loc) | - CollectionOutputNotArray(loc), - ), - ), - ) => - Location.raise_errorf( - ~loc, - "Collection must be an array of records. Record type of collection entry must be defined within this module.", - ) - | Error(ValidatorsRecordParseError(NotFound)) => - Location.raise_errorf(~loc, "`validators` record not found") - | Error( - ValidatorsRecordParseError(NotRecord(loc) | RecordParseError(loc)), - ) => - Location.raise_errorf( - ~loc, - "Failed to parse `validators` record. Please, file an issue with your use-case.", - ) - | Error(ValidatorsRecordParseError(BadTypeAnnotation(loc))) => - Location.raise_errorf( - ~loc, - "`validators` binding must be of `validators` type. You can safely remove type annotation and it will be annotated for you under the hood.", - ) - | Error( - ValidatorsRecordParseError( - ValidatorError( - `BadRequiredValidator(field, `Some(loc) | `None(loc), reason), - ), - ), - ) => - switch (reason) { - | `DifferentIO(_input_type, _output_type) => - Location.raise_errorf( - ~loc, - "Validator for `%s` field is required because its input and output types are different. So validator function is required to produce value of output type from an input value.", - switch (field) { - | ValidatedInputField(field) => field.name - | ValidatedInputFieldOfCollection({collection, field}) => - collection.singular ++ "." ++ field.name - }, - ) - | `IncludedInDeps(in_deps_of_field) => - Location.raise_errorf( - ~loc, - "Validator for `%s` field is required because this field is included in deps of `%s` field", - switch (field) { - | ValidatedInputField(field) => field.name - | ValidatedInputFieldOfCollection({collection, field}) => - collection.singular ++ "." ++ field.name - }, - switch (in_deps_of_field) { - | ValidatedInputField(field) => field.name - | ValidatedInputFieldOfCollection({collection, field}) => - collection.singular ++ "." ++ field.name - }, - ) - } - | Error(IOMismatch(OutputFieldsNotInInput({fields}))) => - switch (fields) { - | [] => - failwith( - "Empty list of non-matched fields in IOMatchError(OutputFieldsNotInInput)", - ) - | [field] - | [field, ..._] => - Location.raise_errorf( - ~loc, - "`output` field `%s` doesn't exist in `input` type", - switch (field) { - | OutputField(field) => field.name - | OutputFieldOfCollection({collection, field}) => - collection.singular ++ "." ++ field.name - }, - ) - } - | 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", - switch (field) { - | ValidatedInputField(field) => field.name - | ValidatedInputFieldOfCollection({collection, field}) => - collection.singular ++ "." ++ field.name - }, - ) - | fields => - Location.raise_errorf( - ~loc, - "Some `input` fields don't exist in `output` type: %s", - fields - |> List.rev - |> List.rev_map((field: InputField.validated) => - switch (field) { - | ValidatedInputField(field) => field.name - | ValidatedInputFieldOfCollection({collection, field}) => - collection.singular ++ "." ++ field.name - } - ) - |> String.concat(", "), - ) - } - } - | _ => Location.raise_errorf(~loc, "Must be a structure") - } - }); diff --git a/ppx/lib/Form_ActionType.ml b/ppx/lib/Form_ActionType.ml new file mode 100644 index 00000000..4dd83d8d --- /dev/null +++ b/ppx/lib/Form_ActionType.ml @@ -0,0 +1,140 @@ +open Meta +open Ast +open AstHelpers +open Printer +open Ppxlib +open Ast_helper + +let ast ~(scheme : Scheme.t) ~loc = + let update_actions = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + (FieldPrinter.update_action ~field:field.name + |> T.constructor + ~args:[ Uncurried.ty ~loc ~arity:1 [%type: input -> input] ] + ~loc) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + (FieldOfCollectionPrinter.update_action ~collection ~field:field.name + |> T.constructor + ~args: + [ Uncurried.ty ~loc ~arity:1 [%type: input -> input] + ; [%type: index] + ] + ~loc) + :: acc) + acc) + [] + in + let blur_actions = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + (FieldPrinter.blur_action ~field:field.name |> T.constructor ~loc) :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + (FieldOfCollectionPrinter.blur_action ~collection ~field:field.name + |> T.constructor ~args:[ [%type: index] ] ~loc) + :: acc) + acc) + [] + in + let apply_async_result_actions = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field { validator = SyncValidator _ } -> acc + | Field ({ validator = AsyncValidator _ } as field) -> + (FieldPrinter.apply_async_result_action ~field:field.name + |> T.constructor + ~args: + [ field.output_type |> ItemType.unpack + ; Typ.constr + (Lident "result" |> lid ~loc) + [ field.output_type |> ItemType.unpack + ; Typ.constr (Lident "message" |> lid ~loc) [] + ] + ] + ~loc) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + match field with + | { validator = SyncValidator _ } -> acc + | { validator = AsyncValidator _ } as field -> + (FieldOfCollectionPrinter.apply_async_result_action + ~collection + ~field:field.name + |> T.constructor + ~args: + [ field.output_type |> ItemType.unpack + ; [%type: index] + ; Typ.constr + (Lident "result" |> lid ~loc) + [ field.output_type |> ItemType.unpack + ; Typ.constr (Lident "message" |> lid ~loc) [] + ] + ] + ~loc) + :: acc) + acc) + [] + in + let collections_actions = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field _ -> acc + | Collection { collection; input_type } -> + (collection + |> CollectionPrinter.remove_action + |> T.constructor ~args:[ [%type: index] ] ~loc) + :: (collection + |> CollectionPrinter.add_action + |> T.constructor ~args:[ input_type |> ItemType.unpack ] ~loc) + :: acc) + [] + in + let rest_actions = + [ "Submit" |> T.constructor ~loc + ; "SetSubmittedStatus" |> T.constructor ~args:[ [%type: input option] ] ~loc + ; "SetSubmissionFailedStatus" |> T.constructor ~args:[ [%type: submissionError] ] ~loc + ; "MapSubmissionError" + |> T.constructor + ~args: + [ Uncurried.ty ~loc ~arity:1 [%type: submissionError -> submissionError] ] + ~loc + ; "DismissSubmissionError" |> T.constructor ~loc + ; "DismissSubmissionResult" |> T.constructor ~loc + ; "Reset" |> T.constructor ~loc + ] + in + Str.type_ + ~loc + Recursive + [ "action" + |> str ~loc + |> Type.mk + ~kind: + (Ptype_variant + (rest_actions + |> List.rev_append collections_actions + |> List.rev_append apply_async_result_actions + |> List.rev_append blur_actions + |> List.rev_append update_actions)) + ] +;; diff --git a/ppx/lib/Form_ActionType.re b/ppx/lib/Form_ActionType.re deleted file mode 100644 index dac657b0..00000000 --- a/ppx/lib/Form_ActionType.re +++ /dev/null @@ -1,182 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; -open Printer; - -open Ppxlib; -open Ast_helper; - -let ast = (~scheme: Scheme.t, ~loc) => { - let update_actions = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - FieldPrinter.update_action(~field=field.name) - |> T.constructor(~args=[[%type: input => input]], ~loc), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - FieldOfCollectionPrinter.update_action( - ~collection, - ~field=field.name, - ) - |> T.constructor( - ~args=[[%type: input => input], [%type: index]], - ~loc, - ), - ...acc, - ], - acc, - ) - }, - [], - ); - - let blur_actions = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - FieldPrinter.blur_action(~field=field.name) - |> T.constructor(~loc), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - FieldOfCollectionPrinter.blur_action( - ~collection, - ~field=field.name, - ) - |> T.constructor(~args=[[%type: index]], ~loc), - ...acc, - ], - acc, - ) - }, - [], - ); - - let apply_async_result_actions = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field({validator: SyncValidator(_)}) => acc - | Field({validator: AsyncValidator(_)} as field) => [ - FieldPrinter.apply_async_result_action(~field=field.name) - |> T.constructor( - ~args=[ - field.output_type |> ItemType.unpack, - Typ.constr( - Lident("result") |> lid(~loc), - [ - field.output_type |> ItemType.unpack, - Typ.constr(Lident("message") |> lid(~loc), []), - ], - ), - ], - ~loc, - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - switch (field) { - | {validator: SyncValidator(_)} => acc - | {validator: AsyncValidator(_)} as field => [ - FieldOfCollectionPrinter.apply_async_result_action( - ~collection, - ~field=field.name, - ) - |> T.constructor( - ~args=[ - field.output_type |> ItemType.unpack, - [%type: index], - Typ.constr( - Lident("result") |> lid(~loc), - [ - field.output_type |> ItemType.unpack, - Typ.constr( - Lident("message") |> lid(~loc), - [], - ), - ], - ), - ], - ~loc, - ), - ...acc, - ] - }, - acc, - ) - }, - [], - ); - - let collections_actions = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(_) => acc - | Collection({collection, input_type}) => [ - collection - |> CollectionPrinter.remove_action - |> T.constructor(~args=[[%type: index]], ~loc), - collection - |> CollectionPrinter.add_action - |> T.constructor(~args=[input_type |> ItemType.unpack], ~loc), - ...acc, - ] - }, - [], - ); - - 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), - ]; - - Str.type_( - ~loc, - Recursive, - [ - "action" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_variant( - rest_actions - |> List.rev_append(collections_actions) - |> List.rev_append(apply_async_result_actions) - |> List.rev_append(blur_actions) - |> List.rev_append(update_actions), - ), - ), - ], - ); -}; diff --git a/ppx/lib/Form_Attributes.ml b/ppx/lib/Form_Attributes.ml new file mode 100644 index 00000000..ee6259ea --- /dev/null +++ b/ppx/lib/Form_Attributes.ml @@ -0,0 +1,5 @@ +open Ppxlib +open Ast_helper + +let warnings = [ "-23"; "-40"; "-42" ] |> List.fold_left (fun acc x -> acc ^ x) "" +let ast ~loc = [%stri [@@@ocaml.warning [%e warnings |> Const.string |> Exp.constant]]] diff --git a/ppx/lib/Form_Attributes.re b/ppx/lib/Form_Attributes.re deleted file mode 100644 index 0f0d85f4..00000000 --- a/ppx/lib/Form_Attributes.re +++ /dev/null @@ -1,29 +0,0 @@ -open Ppxlib; -open Ast_helper; - -let warnings = - [ - // What: - // Warns on spread in single field record: - // type t = {a: int}; - // let inc = x => {...x, a: x.a + 1}; - // Why disabled: - // Handling this introduces more complexity for no profit - // since it's purely stylistic thing and doesn't affect JS output. - "-23", - // What: - // Warns if some type is not in scope and if type annotation - // would be removed, meaning of code might change. - // Why disabled: - // We already have all type annotations in place - // so opening `Async` module everywhere where it's required - // is more work to do for little benefit. Disabling for now. - "-40", - // Legacy - "-42", - ] - |> List.fold_left((acc, x) => acc ++ x, ""); - -let ast = (~loc) => [%stri - [@ocaml.warning [%e warnings |> Const.string |> Exp.constant]] -]; diff --git a/ppx/lib/Form_CollectionsStatusesType.ml b/ppx/lib/Form_CollectionsStatusesType.ml new file mode 100644 index 00000000..79f3597b --- /dev/null +++ b/ppx/lib/Form_CollectionsStatusesType.ml @@ -0,0 +1,28 @@ +open Meta +open Ast +open Ppxlib +open Ast_helper + +let ast ~(scheme : Scheme.t) ~loc = + match scheme |> Scheme.collections with + | [] -> [%stri type collectionsStatuses = unit] + | collections -> + Str.type_ + ~loc + Recursive + [ "collectionsStatuses" + |> str ~loc + |> Type.mk + ~kind: + (Ptype_record + (collections + |> List.rev + |> List.rev_map (fun ({ collection; validator } : Scheme.collection) -> + Type.field + (collection.plural |> str ~loc) + (match validator with + | Ok (Some _) | Error () -> + [%type: message collectionStatus option] + | Ok None -> [%type: unit])))) + ] +;; diff --git a/ppx/lib/Form_CollectionsStatusesType.re b/ppx/lib/Form_CollectionsStatusesType.re deleted file mode 100644 index 32c50acd..00000000 --- a/ppx/lib/Form_CollectionsStatusesType.re +++ /dev/null @@ -1,40 +0,0 @@ -open Meta; -open Ast; - -open Ppxlib; -open Ast_helper; - -let ast = (~scheme: Scheme.t, ~loc) => { - switch (scheme |> Scheme.collections) { - | [] => [%stri type collectionsStatuses = unit] - | collections => - Str.type_( - ~loc, - Recursive, - [ - "collectionsStatuses" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - collections - |> List.rev - |> List.rev_map( - ({collection, validator}: Scheme.collection) => - Type.field( - collection.plural |> str(~loc), - switch (validator) { - | Ok(Some(_)) - | Error () => [%type: - option(collectionStatus(message)) - ] - | Ok(None) => [%type: unit] - }, - ) - ), - ), - ), - ], - ) - }; -}; diff --git a/ppx/lib/Form_FieldsStatusesType.ml b/ppx/lib/Form_FieldsStatusesType.ml new file mode 100644 index 00000000..64145675 --- /dev/null +++ b/ppx/lib/Form_FieldsStatusesType.ml @@ -0,0 +1,60 @@ +open Meta +open Ast +open Printer +open Ppxlib +open Ast_helper + +let field_type ~loc (field : Scheme.field) = + Type.field + (field.name |> str ~loc) + (match field.validator with + | SyncValidator _ -> + [%type: ([%t field.output_type |> ItemType.unpack], message) fieldStatus] + | AsyncValidator _ -> + [%type: ([%t field.output_type |> ItemType.unpack], message) Async.fieldStatus]) +;; + +let collection_type ~loc (collection : Collection.t) = + Type.field + (collection.plural |> str ~loc) + [%type: + [%t + Typ.constr + (Lident (collection |> CollectionPrinter.fields_statuses_type) |> lid ~loc) + []] + array] +;; + +let ast ~(scheme : Scheme.t) ~loc = + let main_decl = + "fieldsStatuses" + |> str ~loc + |> Type.mk + ~kind: + (Ptype_record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> field |> field_type ~loc + | Collection { collection } -> collection |> collection_type ~loc))) + in + let collections_decls = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field _ -> acc + | Collection { collection; fields } -> + (collection + |> CollectionPrinter.fields_statuses_type + |> str ~loc + |> Type.mk + ~kind: + (Ptype_record (fields |> List.rev |> List.rev_map (field_type ~loc))) + ) + :: acc) + [] + in + Str.type_ ~loc Recursive (main_decl :: collections_decls) +;; diff --git a/ppx/lib/Form_FieldsStatusesType.re b/ppx/lib/Form_FieldsStatusesType.re deleted file mode 100644 index 747657d0..00000000 --- a/ppx/lib/Form_FieldsStatusesType.re +++ /dev/null @@ -1,79 +0,0 @@ -open Meta; -open Ast; -open Printer; - -open Ppxlib; -open Ast_helper; - -let field_type = (~loc, field: Scheme.field) => - Type.field( - field.name |> str(~loc), - switch (field.validator) { - | SyncValidator(_) => [%type: - fieldStatus([%t field.output_type |> ItemType.unpack], message) - ] - | AsyncValidator(_) => [%type: - Async.fieldStatus([%t field.output_type |> ItemType.unpack], message) - ] - }, - ); - -let collection_type = (~loc, collection: Collection.t) => - Type.field( - collection.plural |> str(~loc), - [%type: - array( - [%t - Typ.constr( - Lident(collection |> CollectionPrinter.fields_statuses_type) - |> lid(~loc), - [], - ) - ], - ) - ], - ); - -let ast = (~scheme: Scheme.t, ~loc) => { - let main_decl = - "fieldsStatuses" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => field |> field_type(~loc) - | Collection({collection}) => - collection |> collection_type(~loc) - } - ), - ), - ); - - let collections_decls = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(_) => acc - | Collection({collection, fields}) => [ - collection - |> CollectionPrinter.fields_statuses_type - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - fields |> List.rev |> List.rev_map(field_type(~loc)), - ), - ), - ...acc, - ] - }, - [], - ); - - Str.type_(~loc, Recursive, [main_decl, ...collections_decls]); -}; diff --git a/ppx/lib/Form_InitialCollectionsStatuses.ml b/ppx/lib/Form_InitialCollectionsStatuses.ml new file mode 100644 index 00000000..14edea43 --- /dev/null +++ b/ppx/lib/Form_InitialCollectionsStatuses.ml @@ -0,0 +1,24 @@ +open Meta +open Ast +open Ppxlib +open Ast_helper + +let ast ~(scheme : Scheme.t) ~loc = + [%stri + let initialCollectionsStatuses = + ([%e + match scheme |> Scheme.collections with + | [] -> [%expr ()] + | collections -> + Exp.record + (collections + |> List.rev + |> List.rev_map (fun ({ collection; validator } : Scheme.collection) -> + ( Lident collection.plural |> lid ~loc + , match validator with + | Ok (Some ()) | Error () -> [%expr None] + | Ok None -> [%expr ()] ))) + None] + : collectionsStatuses) + ;;] +;; diff --git a/ppx/lib/Form_InitialCollectionsStatuses.re b/ppx/lib/Form_InitialCollectionsStatuses.re deleted file mode 100644 index 029896e1..00000000 --- a/ppx/lib/Form_InitialCollectionsStatuses.re +++ /dev/null @@ -1,36 +0,0 @@ -open Meta; -open Ast; - -open Ppxlib; -open Ast_helper; - -let ast = (~scheme: Scheme.t, ~loc) => { - [%stri - let initialCollectionsStatuses: collectionsStatuses = - switch%e (scheme |> Scheme.collections) { - | [] => - %expr - () - | collections => - Exp.record( - collections - |> List.rev - |> List.rev_map(({collection, validator}: Scheme.collection) => - ( - Lident(collection.plural) |> lid(~loc), - switch (validator) { - | Ok(Some ()) - | Error () => - %expr - None - | Ok(None) => - %expr - () - }, - ) - ), - None, - ) - } - ]; -}; diff --git a/ppx/lib/Form_InitialFieldsStatusesFn.ml b/ppx/lib/Form_InitialFieldsStatusesFn.ml new file mode 100644 index 00000000..05636539 --- /dev/null +++ b/ppx/lib/Form_InitialFieldsStatusesFn.ml @@ -0,0 +1,45 @@ +open Meta +open Ast +open AstHelpers +open Printer +open Ppxlib +open Ast_helper + +let ast ~(scheme : Scheme.t) ~loc = + [%stri + let initialFieldsStatuses + ([%p + match scheme |> Scheme.collections with + | [] -> [%pat? _input] + | _ -> [%pat? input]] : + input) + : fieldsStatuses + = + [%e + Exp.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> Lident field.name |> lid ~loc, [%expr Pristine] + | Collection { collection; fields } -> + ( Lident collection.plural |> lid ~loc + , [%expr + Belt.Array.make + (Belt.Array.length + [%e collection.plural |> E.field ~in_:"input" ~loc]) + [%e + Exp.constraint_ + (Exp.record + (fields + |> List.rev + |> List.rev_map (fun (field : Scheme.field) -> + Lident field.name |> lid ~loc, [%expr Pristine])) + None) + (Typ.constr + (Lident (collection |> CollectionPrinter.fields_statuses_type) + |> lid ~loc) + [])] [@res.uapp]] ))) + None] + ;;] +;; diff --git a/ppx/lib/Form_InitialFieldsStatusesFn.re b/ppx/lib/Form_InitialFieldsStatusesFn.re deleted file mode 100644 index 4dfa94ab..00000000 --- a/ppx/lib/Form_InitialFieldsStatusesFn.re +++ /dev/null @@ -1,69 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; -open Printer; - -open Ppxlib; -open Ast_helper; - -let ast = (~scheme: Scheme.t, ~loc) => { - [%stri - let initialFieldsStatuses = - ( - [%p - switch (scheme |> Scheme.collections) { - | [] => [%pat? _input] - | _ => [%pat? input] - } - ]: input, - ) - : fieldsStatuses => [%e - Exp.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => ( - Lident(field.name) |> lid(~loc), - [%expr Pristine], - ) - | Collection({collection, fields}) => ( - Lident(collection.plural) |> lid(~loc), - [%expr - Belt.Array.make( - Belt.Array.length( - [%e collection.plural |> E.field(~in_="input", ~loc)], - ), - [%e - Exp.constraint_( - Exp.record( - fields - |> List.rev - |> List.rev_map((field: Scheme.field) => - ( - Lident(field.name) |> lid(~loc), - [%expr Pristine], - ) - ), - None, - ), - Typ.constr( - Lident( - collection - |> CollectionPrinter.fields_statuses_type, - ) - |> lid(~loc), - [], - ), - ) - ], - ) - ], - ) - } - ), - None, - ) - ] - ]; -}; diff --git a/ppx/lib/Form_InitialStateFn.ml b/ppx/lib/Form_InitialStateFn.ml new file mode 100644 index 00000000..aa0c6216 --- /dev/null +++ b/ppx/lib/Form_InitialStateFn.ml @@ -0,0 +1,19 @@ +open Ppxlib + +let ast ~loc = + [%stri + let initialState = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun input -> + { input + ; fieldsStatuses = initialFieldsStatuses input [@res.uapp] + ; collectionsStatuses = initialCollectionsStatuses + ; formStatus = Editing + ; submissionStatus = NeverSubmitted + }]] + ;;] +;; diff --git a/ppx/lib/Form_InitialStateFn.re b/ppx/lib/Form_InitialStateFn.re deleted file mode 100644 index 1f443a74..00000000 --- a/ppx/lib/Form_InitialStateFn.re +++ /dev/null @@ -1,11 +0,0 @@ -open Ppxlib; - -let ast = (~loc) => [%stri - let initialState = input => { - input, - fieldsStatuses: input->initialFieldsStatuses, - collectionsStatuses: initialCollectionsStatuses, - formStatus: Editing, - submissionStatus: NeverSubmitted, - } -]; diff --git a/ppx/lib/Form_InterfaceType.ml b/ppx/lib/Form_InterfaceType.ml new file mode 100644 index 00000000..68712991 --- /dev/null +++ b/ppx/lib/Form_InterfaceType.ml @@ -0,0 +1,198 @@ +open Meta +open Ast +open Printer +open Ppxlib +open Ast_helper + +let ast ~(scheme : Scheme.t) ~(async : bool) ~loc = + let f x t = t |> Type.field (x |> str ~loc) in + let base = + [ f "input" [%type: input] + ; f "status" [%type: submissionError formStatus] + ; f "dirty" (Uncurried.ty ~loc ~arity:1 [%type: unit -> bool]) + ; f + "valid" + (match async with + | true -> Uncurried.ty ~loc ~arity:1 [%type: unit -> bool option] + | false -> Uncurried.ty ~loc ~arity:1 [%type: unit -> bool]) + ; f "submitting" [%type: bool] + ; f "submit" (Uncurried.ty ~loc ~arity:1 [%type: unit -> unit]) + ; f "dismissSubmissionError" (Uncurried.ty ~loc ~arity:1 [%type: unit -> unit]) + ; f "dismissSubmissionResult" (Uncurried.ty ~loc ~arity:1 [%type: unit -> unit]) + ; f + "mapSubmissionError" + (Uncurried.ty + ~loc + ~arity:1 + [%type: + [%t Uncurried.ty ~loc ~arity:1 [%type: submissionError -> submissionError]] + -> unit]) + ; f "reset" (Uncurried.ty ~loc ~arity:1 [%type: unit -> unit]) + ] + in + let update_fns = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + f + (FieldPrinter.update_fn ~field:field.name) + (Uncurried.ty + ~loc + ~arity:2 + [%type: + [%t + Uncurried.ty + ~loc + ~arity:2 + [%type: + input -> [%t field.input_type |> ItemType.unpack] -> input]] + -> [%t field.input_type |> ItemType.unpack] + -> unit]) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + f + (FieldOfCollectionPrinter.update_fn ~collection ~field:field.name) + (Uncurried.ty + ~loc + ~arity:3 + [%type: + at:index + -> [%t + Uncurried.ty + ~loc + ~arity:2 + [%type: + input + -> [%t field.input_type |> ItemType.unpack] + -> input]] + -> [%t field.input_type |> ItemType.unpack] + -> unit]) + :: acc) + acc) + [] + in + let blur_fns = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + f + (FieldPrinter.blur_fn ~field:field.name) + (Uncurried.ty ~loc ~arity:1 [%type: unit -> unit]) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + f + (FieldOfCollectionPrinter.blur_fn ~collection ~field:field.name) + (Uncurried.ty ~loc ~arity:1 [%type: at:index -> unit]) + :: acc) + acc) + [] + in + let result_entries = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + f + (FieldPrinter.result_value ~field:field.name) + (match field.validator with + | SyncValidator _ -> + [%type: + ([%t field.output_type |> ItemType.unpack], message) result option] + | AsyncValidator _ -> + [%type: + ( [%t field.output_type |> ItemType.unpack] + , message ) + Async.exposedFieldStatus + option]) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + f + (FieldOfCollectionPrinter.result_fn ~collection ~field:field.name) + (match field.validator with + | SyncValidator _ -> + Uncurried.ty + ~loc + ~arity:1 + [%type: + at:index + -> ( [%t field.output_type |> ItemType.unpack] + , message ) + result + option] + | AsyncValidator _ -> + Uncurried.ty + ~loc + ~arity:1 + [%type: + at:index + -> ( [%t field.output_type |> ItemType.unpack] + , message ) + Async.exposedFieldStatus + option]) + :: acc) + acc) + [] + in + let collection_entries = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field _ -> acc + | Collection { collection; validator; input_type } -> + let add_fn = + f + (collection |> CollectionPrinter.add_fn) + (Uncurried.ty + ~loc + ~arity:1 + [%type: [%t input_type |> ItemType.unpack] -> unit]) + in + let remove_fn = + f + (collection |> CollectionPrinter.remove_fn) + (Uncurried.ty ~loc ~arity:1 [%type: at:index -> unit]) + in + let result_value = + match validator with + | Ok (Some ()) | Error () -> + Some + (f + (collection |> CollectionPrinter.result_value) + [%type: message collectionStatus option]) + | Ok None -> None + in + (match result_value with + | Some result_value -> result_value :: remove_fn :: add_fn :: acc + | None -> remove_fn :: add_fn :: acc)) + [] + in + Str.type_ + ~loc + Recursive + [ "interface" + |> str ~loc + |> Type.mk + ~kind: + (Ptype_record + (base + |> List.rev_append collection_entries + |> List.rev_append result_entries + |> List.rev_append blur_fns + |> List.rev_append update_fns)) + ] +;; diff --git a/ppx/lib/Form_InterfaceType.re b/ppx/lib/Form_InterfaceType.re deleted file mode 100644 index 6a317aa2..00000000 --- a/ppx/lib/Form_InterfaceType.re +++ /dev/null @@ -1,241 +0,0 @@ -open Meta; -open Ast; -open Printer; - -open Ppxlib; -open Ast_helper; - -let ast = (~scheme: Scheme.t, ~async: bool, ~loc) => { - 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", - async ? [%type: unit => option(bool)] : [%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 = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - f( - FieldPrinter.update_fn(~field=field.name), - [%type: - ( - (input, [%t field.input_type |> ItemType.unpack]) => input, - [%t field.input_type |> ItemType.unpack] - ) => - unit - ], - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - f( - FieldOfCollectionPrinter.update_fn( - ~collection, - ~field=field.name, - ), - [%type: - ( - ~at: index, - ( - input, - [%t field.input_type |> ItemType.unpack] - ) => - input, - [%t field.input_type |> ItemType.unpack] - ) => - unit - ], - ), - ...acc, - ], - acc, - ) - }, - [], - ); - - let blur_fns = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - f( - FieldPrinter.blur_fn(~field=field.name), - [%type: unit => unit], - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - f( - FieldOfCollectionPrinter.blur_fn( - ~collection, - ~field=field.name, - ), - [%type: (~at: index) => unit], - ), - ...acc, - ], - acc, - ) - }, - [], - ); - - let result_entries = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - f( - FieldPrinter.result_value(~field=field.name), - switch (field.validator) { - | SyncValidator(_) => [%type: - option( - result( - [%t field.output_type |> ItemType.unpack], - message, - ), - ) - ] - | AsyncValidator(_) => [%type: - option( - Async.exposedFieldStatus( - [%t field.output_type |> ItemType.unpack], - message, - ), - ) - ] - }, - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - f( - FieldOfCollectionPrinter.result_fn( - ~collection, - ~field=field.name, - ), - switch (field.validator) { - | SyncValidator(_) => [%type: - (~at: index) => - option( - result( - [%t field.output_type |> ItemType.unpack], - message, - ), - ) - ] - | AsyncValidator(_) => [%type: - (~at: index) => - option( - Async.exposedFieldStatus( - [%t field.output_type |> ItemType.unpack], - message, - ), - ) - ] - }, - ), - ...acc, - ], - acc, - ) - }, - [], - ); - - let collection_entries = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(_) => acc - | Collection({collection, validator, input_type}) => - let add_fn = - f( - collection |> CollectionPrinter.add_fn, - [%type: [%t input_type |> ItemType.unpack] => unit], - ); - let remove_fn = - f( - collection |> CollectionPrinter.remove_fn, - [%type: (~at: index) => unit], - ); - - let result_value = - switch (validator) { - | Ok(Some ()) - | Error () => - Some( - f( - collection |> CollectionPrinter.result_value, - [%type: option(collectionStatus(message))], - ), - ) - | Ok(None) => None - }; - - switch (result_value) { - | Some(result_value) => [ - result_value, - remove_fn, - add_fn, - ...acc, - ] - | None => [remove_fn, add_fn, ...acc] - }; - }, - [], - ); - - Str.type_( - ~loc, - Recursive, - [ - "interface" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - base - |> List.rev_append(collection_entries) - |> List.rev_append(result_entries) - |> List.rev_append(blur_fns) - |> List.rev_append(update_fns), - ), - ), - ], - ); -}; diff --git a/ppx/lib/Form_OpenFormality.ml b/ppx/lib/Form_OpenFormality.ml new file mode 100644 index 00000000..de5b1654 --- /dev/null +++ b/ppx/lib/Form_OpenFormality.ml @@ -0,0 +1,3 @@ +open Ppxlib + +let ast ~loc = [%stri open Formality] diff --git a/ppx/lib/Form_OpenFormality.re b/ppx/lib/Form_OpenFormality.re deleted file mode 100644 index 2da4824d..00000000 --- a/ppx/lib/Form_OpenFormality.re +++ /dev/null @@ -1,3 +0,0 @@ -open Ppxlib; - -let ast = (~loc) => [%stri open Formality]; diff --git a/ppx/lib/Form_StateType.ml b/ppx/lib/Form_StateType.ml new file mode 100644 index 00000000..39b0267b --- /dev/null +++ b/ppx/lib/Form_StateType.ml @@ -0,0 +1,12 @@ +open Ppxlib + +let ast ~loc = + [%stri + type state = + { input : input + ; fieldsStatuses : fieldsStatuses + ; collectionsStatuses : collectionsStatuses + ; formStatus : submissionError formStatus + ; submissionStatus : submissionStatus + }] +;; diff --git a/ppx/lib/Form_StateType.re b/ppx/lib/Form_StateType.re deleted file mode 100644 index 847c763d..00000000 --- a/ppx/lib/Form_StateType.re +++ /dev/null @@ -1,11 +0,0 @@ -open Ppxlib; - -let ast = (~loc) => [%stri - type state = { - input, - fieldsStatuses, - collectionsStatuses, - formStatus: formStatus(submissionError), - submissionStatus, - } -]; diff --git a/ppx/lib/Form_UseFormFn.ml b/ppx/lib/Form_UseFormFn.ml new file mode 100644 index 00000000..4196995a --- /dev/null +++ b/ppx/lib/Form_UseFormFn.ml @@ -0,0 +1,85 @@ +open Meta +open AstHelpers +open Ppxlib +open Ast_helper +module RestActions = Form_UseFormFn_RestActions +module CollectionsActions = Form_UseFormFn_CollectionsActions +module ApplyAsyncResultActions = Form_UseFormFn_ApplyAsyncResultActions +module BlurActions = Form_UseFormFn_BlurActions +module UpdateActions = Form_UseFormFn_UpdateActions + +let ast ~(scheme : Scheme.t) ~(async : bool) ~(metadata : unit option) ~loc = + let initial_input_arg = Pat.constraint_ ~loc [%pat? initialInput] [%type: input] in + let metadata_arg = + match metadata with + | Some () -> Some (Pat.constraint_ ~loc [%pat? metadata] [%type: metadata]) + | None -> None + in + let on_submit_arg = + Pat.constraint_ + ~loc + [%pat? onSubmit] + (Uncurried.ty + ~loc + ~arity:2 + [%type: output -> (input, submissionError) submissionCallbacks -> unit]) + in + let body = + [%expr + let memoizedInitialState = + (React.useMemo1 + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun () -> (initialState initialInput [@res.uapp])]] + [| initialInput |] [@res.uapp]) + in + let state, dispatch = + let open ReactUpdate in + (useReducer + memoizedInitialState + [%e + Uncurried.fn + ~loc + ~arity:2 + [%expr + fun state action -> + [%e + Exp.match_ + ~attrs:[ warning_4_disable ~loc ] + [%expr action] + (RestActions.ast ~loc ~async ~metadata + |> List.rev_append (CollectionsActions.ast ~loc ~metadata scheme) + |> List.rev_append (ApplyAsyncResultActions.ast ~loc scheme) + |> List.rev_append (BlurActions.ast ~loc ~metadata scheme) + |> List.rev_append (UpdateActions.ast ~loc ~metadata scheme))]]] + [@res.uapp]) + in + [%e Form_UseFormFn_Interface.ast ~scheme ~async ~metadata ~loc]] + in + [%stri + let useForm = + [%e + Uncurried.fn + ~loc + ~arity: + (match metadata with + | Some _ -> 3 + | None -> 2) + (Exp.fun_ + ~loc + (Labelled "initialInput") + None + initial_input_arg + (match metadata_arg with + | Some metadata_arg -> + Exp.fun_ + ~loc + (Labelled "metadata") + None + metadata_arg + (Exp.fun_ ~loc (Labelled "onSubmit") None on_submit_arg body) + | None -> Exp.fun_ ~loc (Labelled "onSubmit") None on_submit_arg body))] + ;;] +;; diff --git a/ppx/lib/Form_UseFormFn.re b/ppx/lib/Form_UseFormFn.re deleted file mode 100644 index b4dd8b10..00000000 --- a/ppx/lib/Form_UseFormFn.re +++ /dev/null @@ -1,92 +0,0 @@ -open Meta; -open AstHelpers; - -open Ppxlib; -open Ast_helper; - -let ast = (~scheme: Scheme.t, ~async: bool, ~metadata: option(unit), ~loc) => { - let initial_input_arg = - Pat.constraint_(~loc, [%pat? initialInput], [%type: input]); - - let metadata_arg = - switch (metadata) { - | Some () => - Some(Pat.constraint_(~loc, [%pat? metadata], [%type: metadata])) - | None => None - }; - - let on_submit_arg = - Pat.constraint_( - ~loc, - [%pat? onSubmit], - [%type: (output, submissionCallbacks(input, submissionError)) => unit], - ); - - let body = { - %expr - { - let memoizedInitialState = - React.useMemo1(() => initialInput->initialState, [|initialInput|]); - let (state, dispatch) = - ReactUpdate.( - memoizedInitialState->useReducer((state, action) => { - %e - { - Exp.match( - ~attrs=[warning_4_disable(~loc)], - [%expr action], - Form_UseFormFn_RestActions.ast(~loc, ~async, ~metadata) - |> List.rev_append( - Form_UseFormFn_CollectionsActions.ast( - ~loc, - ~metadata, - scheme, - ), - ) - |> List.rev_append( - Form_UseFormFn_ApplyAsyncResultActions.ast(~loc, scheme), - ) - |> List.rev_append( - Form_UseFormFn_BlurActions.ast(~loc, ~metadata, scheme), - ) - |> List.rev_append( - Form_UseFormFn_UpdateActions.ast( - ~loc, - ~metadata, - scheme, - ), - ), - ); - } - }) - ); - %e - { - Form_UseFormFn_Interface.ast(~scheme, ~async, ~metadata, ~loc); - }; - }; - }; - - [%stri - let useForm = [%e - Exp.fun_( - ~loc, - Labelled("initialInput"), - None, - initial_input_arg, - switch (metadata_arg) { - | Some(metadata_arg) => - Exp.fun_( - ~loc, - Labelled("metadata"), - None, - metadata_arg, - Exp.fun_(~loc, Labelled("onSubmit"), None, on_submit_arg, body), - ) - | None => - Exp.fun_(~loc, Labelled("onSubmit"), None, on_submit_arg, body) - }, - ) - ] - ]; -}; diff --git a/ppx/lib/Form_UseFormFn_ApplyAsyncResultActions.ml b/ppx/lib/Form_UseFormFn_ApplyAsyncResultActions.ml new file mode 100644 index 00000000..d40e9385 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_ApplyAsyncResultActions.ml @@ -0,0 +1,94 @@ +open Meta +open Ast +open AstHelpers +open Printer +open Ppxlib +open Ast_helper + +let ast ~loc (scheme : Scheme.t) = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field { validator = SyncValidator _ } -> acc + | Field ({ validator = AsyncValidator _ } as field) -> + Exp.case + (Pat.construct + (Lident (FieldPrinter.apply_async_result_action ~field:field.name) + |> lid ~loc) + (Some + (Pat.tuple + [ Pat.var ("value" |> str ~loc); Pat.var ("result" |> str ~loc) ]))) + [%expr + let validator = [%e field.name |> E.field ~in_:"validators" ~loc] in + match + [%e field.name |> E.field2 ~in_:("state", "fieldsStatuses") ~loc] + with + | Validating x when validator.eq x value [@res.uapp] -> + Update + { state with + fieldsStatuses = + [%e + field.name + |> E.update_field2 + ~in_:("state", "fieldsStatuses") + ~with_:[%expr Dirty (result, Shown)] + ~loc] + } + | Validating _ | Pristine | Dirty (_, (Shown | Hidden)) -> NoUpdate] + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + match field.validator with + | SyncValidator _ -> acc + | AsyncValidator _ -> + Exp.case + (Pat.construct + (Lident + (FieldOfCollectionPrinter.apply_async_result_action + ~collection + ~field:field.name) + |> lid ~loc) + (Some + (Pat.tuple + [ Pat.var ("value" |> str ~loc) + ; Pat.var ("index" |> str ~loc) + ; Pat.var ("result" |> str ~loc) + ]))) + [%expr + let validator = + [%e + field.name + |> E.field_of_collection_validator + ~validators:"validators" + ~collection + ~loc] + in + match + [%e + field.name + |> E.field_of_collection2 + ~in_:("state", "fieldsStatuses") + ~collection + ~loc] + with + | Validating x when validator.eq x value [@res.uapp] -> + Update + { state with + fieldsStatuses = + [%e + field.name + |> E.update_field_of_collection2 + ~in_:("state", "fieldsStatuses") + ~collection + ~with_:[%expr Dirty (result, Shown)] + ~loc] + } + | Validating _ | Pristine | Dirty (_, (Shown | Hidden)) -> + NoUpdate] + :: acc) + acc) + [] +;; diff --git a/ppx/lib/Form_UseFormFn_ApplyAsyncResultActions.re b/ppx/lib/Form_UseFormFn_ApplyAsyncResultActions.re deleted file mode 100644 index cdee9ed0..00000000 --- a/ppx/lib/Form_UseFormFn_ApplyAsyncResultActions.re +++ /dev/null @@ -1,134 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; -open Printer; - -open Ppxlib; -open Ast_helper; - -let ast = (~loc, scheme: Scheme.t) => - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field({validator: SyncValidator(_)}) => acc - | Field({validator: AsyncValidator(_)} as field) => [ - Exp.case( - Pat.construct( - Lident( - FieldPrinter.apply_async_result_action(~field=field.name), - ) - |> lid(~loc), - Some( - Pat.tuple([ - Pat.var("value" |> str(~loc)), - Pat.var("result" |> str(~loc)), - ]), - ), - ), - { - %expr - { - let validator = [%e - field.name |> E.field(~in_="validators", ~loc) - ]; - switch ( - [%e - field.name - |> E.field2(~in_=("state", "fieldsStatuses"), ~loc) - ] - ) { - | Validating(x) when validator.eq(x, value) => - Update({ - ...state, - fieldsStatuses: [%e - field.name - |> E.update_field2( - ~in_=("state", "fieldsStatuses"), - ~with_=[%expr Dirty(result, Shown)], - ~loc, - ) - ], - }) - | Validating(_) - | Pristine - | Dirty(_, Shown | Hidden) => NoUpdate - }; - }; - }, - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - switch (field.validator) { - | SyncValidator(_) => acc - | AsyncValidator(_) => [ - Exp.case( - Pat.construct( - Lident( - FieldOfCollectionPrinter.apply_async_result_action( - ~collection, - ~field=field.name, - ), - ) - |> lid(~loc), - Some( - Pat.tuple([ - Pat.var("value" |> str(~loc)), - Pat.var("index" |> str(~loc)), - Pat.var("result" |> str(~loc)), - ]), - ), - ), - { - %expr - { - let validator = [%e - field.name - |> E.field_of_collection_validator( - ~validators="validators", - ~collection, - ~loc, - ) - ]; - switch ( - [%e - field.name - |> E.field_of_collection2( - ~in_=("state", "fieldsStatuses"), - ~collection, - ~loc, - ) - ] - ) { - | Validating(x) when validator.eq(x, value) => - Update({ - ...state, - fieldsStatuses: [%e - field.name - |> E.update_field_of_collection2( - ~in_=("state", "fieldsStatuses"), - ~collection, - ~with_=[%expr Dirty(result, Shown)], - ~loc, - ) - ], - }) - | Validating(_) - | Pristine - | Dirty(_, Shown | Hidden) => NoUpdate - }; - }; - }, - ), - ...acc, - ] - }, - acc, - ) - }, - [], - ); diff --git a/ppx/lib/Form_UseFormFn_BlurActions.ml b/ppx/lib/Form_UseFormFn_BlurActions.ml new file mode 100644 index 00000000..1e123279 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_BlurActions.ml @@ -0,0 +1,114 @@ +open Meta +open Ast +open AstHelpers +open Printer +open Ppxlib +open Ast_helper + +let ast ~loc ~(metadata : unit option) (scheme : Scheme.t) = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + Exp.case + (Pat.construct + (Lident (FieldPrinter.blur_action ~field:field.name) |> lid ~loc) + None) + (let field_status_expr = + field.name |> E.field2 ~in_:("state", "fieldsStatuses") ~loc + in + let field_input_expr = + field.name |> E.field2 ~in_:("state", "input") ~loc + in + let validator_expr = field.name |> E.field ~in_:"validators" ~loc in + let set_status_expr = + field.name + |> E.update_field2 + ~in_:("state", "fieldsStatuses") + ~with_:[%expr status] + ~loc + in + match field.validator with + | SyncValidator validator -> + Form_UseFormFn_BlurActions_SyncField.ast + ~loc + ~validator + ~metadata + ~field_status_expr + ~field_input_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { optionality } -> + Form_UseFormFn_BlurActions_AsyncField.ast + ~loc + ~field + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + Exp.case + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident + (FieldOfCollectionPrinter.blur_action + ~collection + ~field:field.name) + |> lid ~loc) + (Some (Pat.tuple [ Pat.var ("index" |> str ~loc) ]))) + (let field_status_expr = + field.name + |> E.field_of_collection2 + ~in_:("state", "fieldsStatuses") + ~collection + ~loc + in + let field_input_expr = + field.name + |> E.field_of_collection2 ~in_:("state", "input") ~collection ~loc + in + let validator_expr = + field.name + |> E.field_of_collection_validator + ~validators:"validators" + ~collection + ~loc + in + let set_status_expr = + field.name + |> E.update_field_of_collection2 + ~in_:("state", "fieldsStatuses") + ~collection + ~with_:[%expr status] + ~loc + in + match field.validator with + | SyncValidator validator -> + Form_UseFormFn_BlurActions_SyncFieldOfCollection.ast + ~loc + ~validator + ~metadata + ~field_status_expr + ~field_input_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { optionality } -> + Form_UseFormFn_BlurActions_AsyncFieldOfCollection.ast + ~loc + ~field + ~collection + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr) + :: acc) + acc) + [] +;; diff --git a/ppx/lib/Form_UseFormFn_BlurActions.re b/ppx/lib/Form_UseFormFn_BlurActions.re deleted file mode 100644 index ae764c0a..00000000 --- a/ppx/lib/Form_UseFormFn_BlurActions.re +++ /dev/null @@ -1,142 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; -open Printer; - -open Ppxlib; -open Ast_helper; - -let ast = (~loc, ~metadata: option(unit), scheme: Scheme.t) => - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - Exp.case( - Pat.construct( - Lident(FieldPrinter.blur_action(~field=field.name)) - |> lid(~loc), - None, - ), - { - let field_status_expr = - field.name - |> E.field2(~in_=("state", "fieldsStatuses"), ~loc); - let field_input_expr = - field.name |> E.field2(~in_=("state", "input"), ~loc); - let validator_expr = - field.name |> E.field(~in_="validators", ~loc); - let set_status_expr = - field.name - |> E.update_field2( - ~in_=("state", "fieldsStatuses"), - ~with_=[%expr status], - ~loc, - ); - - switch (field.validator) { - | SyncValidator(validator) => - Form_UseFormFn_BlurActions_SyncField.ast( - ~loc, - ~validator, - ~metadata, - ~field_status_expr, - ~field_input_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({optionality}) => - Form_UseFormFn_BlurActions_AsyncField.ast( - ~loc, - ~field, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - }; - }, - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - Exp.case( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident( - FieldOfCollectionPrinter.blur_action( - ~collection, - ~field=field.name, - ), - ) - |> lid(~loc), - Some(Pat.tuple([Pat.var("index" |> str(~loc))])), - ), - { - let field_status_expr = - field.name - |> E.field_of_collection2( - ~in_=("state", "fieldsStatuses"), - ~collection, - ~loc, - ); - let field_input_expr = - field.name - |> E.field_of_collection2( - ~in_=("state", "input"), - ~collection, - ~loc, - ); - let validator_expr = - field.name - |> E.field_of_collection_validator( - ~validators="validators", - ~collection, - ~loc, - ); - let set_status_expr = - field.name - |> E.update_field_of_collection2( - ~in_=("state", "fieldsStatuses"), - ~collection, - ~with_=[%expr status], - ~loc, - ); - - switch (field.validator) { - | SyncValidator(validator) => - Form_UseFormFn_BlurActions_SyncFieldOfCollection.ast( - ~loc, - ~validator, - ~metadata, - ~field_status_expr, - ~field_input_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({optionality}) => - Form_UseFormFn_BlurActions_AsyncFieldOfCollection.ast( - ~loc, - ~field, - ~collection, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - }; - }, - ), - ...acc, - ], - acc, - ) - }, - [], - ); diff --git a/ppx/lib/Form_UseFormFn_BlurActions_AsyncField.ml b/ppx/lib/Form_UseFormFn_BlurActions_AsyncField.ml new file mode 100644 index 00000000..a61c660d --- /dev/null +++ b/ppx/lib/Form_UseFormFn_BlurActions_AsyncField.ml @@ -0,0 +1,120 @@ +open Meta +open AstHelpers +open Ppxlib + +let ast + ~loc + ~(field : Scheme.field) + ~(metadata : unit option) + ~(optionality : FieldOptionality.t option) + ~(field_status_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + let result = + [%e + match metadata, optionality with + | None, None -> + [%expr + Async.validateFieldOnBlur + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some OptionType -> + [%expr + Async.validateFieldOfOptionTypeOnBlur + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some StringType -> + [%expr + Async.validateFieldOfStringTypeOnBlur + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some OptionStringType -> + [%expr + Async.validateFieldOfOptionStringTypeOnBlur + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), None -> + [%expr + Async.validateFieldOnBlurWithMetadata + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some OptionType -> + [%expr + Async.validateFieldOfOptionTypeOnBlurWithMetadata + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some StringType -> + [%expr + Async.validateFieldOfStringTypeOnBlurWithMetadata + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some OptionStringType -> + [%expr + Async.validateFieldOfOptionStringTypeOnBlurWithMetadata + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + in + match result with + | None -> NoUpdate + | Some fieldsStatuses -> + (match [%e field.name |> E.field ~in_:"fieldsStatuses" ~loc] with + | Validating value -> + UpdateWithSideEffects + ( { state with fieldsStatuses } + , [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun { state = _; dispatch } -> + [%e + E.apply_field2 + ~in_:("validators", field.name) + ~fn:"validateAsync" + ~args: + [ ( Nolabel + , match metadata with + | None -> [%expr value, dispatch] + | Some () -> [%expr value, metadata, dispatch] ) + ] + ~loc]]] ) + | Pristine | Dirty (_, (Shown | Hidden)) -> Update { state with fieldsStatuses })] +;; diff --git a/ppx/lib/Form_UseFormFn_BlurActions_AsyncField.re b/ppx/lib/Form_UseFormFn_BlurActions_AsyncField.re deleted file mode 100644 index c5ccdf59..00000000 --- a/ppx/lib/Form_UseFormFn_BlurActions_AsyncField.re +++ /dev/null @@ -1,140 +0,0 @@ -open Meta; -open AstHelpers; - -open Ppxlib; - -let ast = - ( - ~loc, - ~field: Scheme.field, - ~metadata: option(unit), - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => { - %expr - { - let result = - switch%e (metadata, optionality) { - | (None, None) => - %expr - { - Async.validateFieldOnBlur( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionType)) => - %expr - { - Async.validateFieldOfOptionTypeOnBlur( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(StringType)) => - %expr - { - Async.validateFieldOfStringTypeOnBlur( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionStringType)) => - %expr - { - Async.validateFieldOfOptionStringTypeOnBlur( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), None) => - %expr - { - Async.validateFieldOnBlurWithMetadata( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionType)) => - %expr - { - Async.validateFieldOfOptionTypeOnBlurWithMetadata( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(StringType)) => - %expr - { - Async.validateFieldOfStringTypeOnBlurWithMetadata( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionStringType)) => - %expr - { - Async.validateFieldOfOptionStringTypeOnBlurWithMetadata( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }; - - switch (result) { - | None => NoUpdate - | Some(fieldsStatuses) => - switch ([%e field.name |> E.field(~in_="fieldsStatuses", ~loc)]) { - | Validating(value) => - UpdateWithSideEffects( - {...state, fieldsStatuses}, - ({state: _, dispatch}) => { - %e - E.apply_field2( - ~in_=("validators", field.name), - ~fn="validateAsync", - ~args=[ - ( - Nolabel, - switch (metadata) { - | None => - %expr - (value, dispatch) - | Some () => - %expr - (value, metadata, dispatch) - }, - ), - ], - ~loc, - ) - }, - ) - | Pristine - | Dirty(_, Shown | Hidden) => Update({...state, fieldsStatuses}) - } - }; - }; -}; diff --git a/ppx/lib/Form_UseFormFn_BlurActions_AsyncFieldOfCollection.ml b/ppx/lib/Form_UseFormFn_BlurActions_AsyncFieldOfCollection.ml new file mode 100644 index 00000000..aa1db879 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_BlurActions_AsyncFieldOfCollection.ml @@ -0,0 +1,131 @@ +open Meta +open AstHelpers +open Ppxlib + +let ast + ~loc + ~(field : Scheme.field) + ~(collection : Collection.t) + ~(metadata : unit option) + ~(optionality : FieldOptionality.t option) + ~(field_status_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + let result = + [%e + match metadata, optionality with + | None, None -> + [%expr + Async.validateFieldOfCollectionOnBlur + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some OptionType -> + [%expr + Async.validateFieldOfCollectionOfOptionTypeOnBlur + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some StringType -> + [%expr + Async.validateFieldOfCollectionOfStringTypeOnBlur + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some OptionStringType -> + [%expr + Async.validateFieldOfCollectionOfOptionStringTypeOnBlur + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), None -> + [%expr + Async.validateFieldOfCollectionOnBlurWithMetadata + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some OptionType -> + [%expr + Async.validateFieldOfCollectionOfOptionTypeOnBlurWithMetadata + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some StringType -> + [%expr + Async.validateFieldOfCollectionOfStringTypeOnBlurWithMetadata + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some OptionStringType -> + [%expr + Async.validateFieldOfCollectionOfOptionStringTypeOnBlurWithMetadata + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + in + match result with + | None -> NoUpdate + | Some fieldsStatuses -> + (match + [%e field.name |> E.field_of_collection ~in_:"fieldsStatuses" ~collection ~loc] + with + | Validating value -> + UpdateWithSideEffects + ( { state with fieldsStatuses } + , [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun { state = _; dispatch } -> + [%e + E.apply_field4 + ~in_:("validators", collection.plural, "fields", field.name) + ~fn:"validateAsync" + ~args: + [ ( Nolabel + , match metadata with + | None -> [%expr value, index, dispatch] + | Some () -> [%expr value, index, metadata, dispatch] ) + ] + ~loc]]] ) + | Pristine | Dirty (_, (Shown | Hidden)) -> Update { state with fieldsStatuses })] +;; diff --git a/ppx/lib/Form_UseFormFn_BlurActions_AsyncFieldOfCollection.re b/ppx/lib/Form_UseFormFn_BlurActions_AsyncFieldOfCollection.re deleted file mode 100644 index 8990b9db..00000000 --- a/ppx/lib/Form_UseFormFn_BlurActions_AsyncFieldOfCollection.re +++ /dev/null @@ -1,154 +0,0 @@ -open Meta; -open AstHelpers; - -open Ppxlib; - -let ast = - ( - ~loc, - ~field: Scheme.field, - ~collection: Collection.t, - ~metadata: option(unit), - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => { - %expr - { - let result = - switch%e (metadata, optionality) { - | (None, None) => - %expr - { - Async.validateFieldOfCollectionOnBlur( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionTypeOnBlur( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(StringType)) => - %expr - { - Async.validateFieldOfCollectionOfStringTypeOnBlur( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionStringType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionStringTypeOnBlur( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), None) => - %expr - { - Async.validateFieldOfCollectionOnBlurWithMetadata( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionTypeOnBlurWithMetadata( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(StringType)) => - %expr - { - Async.validateFieldOfCollectionOfStringTypeOnBlurWithMetadata( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionStringType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionStringTypeOnBlurWithMetadata( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }; - - switch (result) { - | None => NoUpdate - | Some(fieldsStatuses) => - switch ( - [%e - field.name - |> E.field_of_collection(~in_="fieldsStatuses", ~collection, ~loc) - ] - ) { - | Validating(value) => - UpdateWithSideEffects( - {...state, fieldsStatuses}, - ({state: _, dispatch}) => { - %e - E.apply_field4( - ~in_=("validators", collection.plural, "fields", field.name), - ~fn="validateAsync", - ~args=[ - ( - Nolabel, - switch (metadata) { - | None => - %expr - (value, index, dispatch) - | Some () => - %expr - (value, index, metadata, dispatch) - }, - ), - ], - ~loc, - ) - }, - ) - | Pristine - | Dirty(_, Shown | Hidden) => Update({...state, fieldsStatuses}) - } - }; - }; -}; diff --git a/ppx/lib/Form_UseFormFn_BlurActions_SyncField.ml b/ppx/lib/Form_UseFormFn_BlurActions_SyncField.ml new file mode 100644 index 00000000..b4f1c7bc --- /dev/null +++ b/ppx/lib/Form_UseFormFn_BlurActions_SyncField.ml @@ -0,0 +1,52 @@ +open Meta +open Ppxlib + +let ast + ~loc + ~(validator : (FieldValidator.sync, unit) result) + ~(metadata : unit option) + ~(field_status_expr : expression) + ~(field_input_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + let result = + [%e + match validator with + | Ok (Required | Optional (Some _)) | Error () -> + (match metadata with + | None -> + [%expr + validateFieldOnBlurWithValidator + ~input:state.input + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some () -> + [%expr + validateFieldOnBlurWithValidatorAndMetadata + ~input:state.input + ~metadata + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]) + | Ok (Optional None) -> + [%expr + validateFieldOnBlurWithoutValidator + ~fieldInput:[%e field_input_expr] + ~fieldStatus:[%e field_status_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + in + match result with + | Some fieldsStatuses -> Update { state with fieldsStatuses } + | None -> NoUpdate] +;; diff --git a/ppx/lib/Form_UseFormFn_BlurActions_SyncField.re b/ppx/lib/Form_UseFormFn_BlurActions_SyncField.re deleted file mode 100644 index cdbe18b7..00000000 --- a/ppx/lib/Form_UseFormFn_BlurActions_SyncField.re +++ /dev/null @@ -1,55 +0,0 @@ -open Meta; - -open Ppxlib; - -let ast = - ( - ~loc, - ~validator: result(FieldValidator.sync, unit), - ~metadata: option(unit), - ~field_status_expr: expression, - ~field_input_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => { - %expr - { - let result = - switch%e (validator) { - | Ok(Required | Optional(Some(_))) - | Error () => - switch (metadata) { - | None => - %expr - validateFieldOnBlurWithValidator( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - | Some () => - %expr - validateFieldOnBlurWithValidatorAndMetadata( - ~input=state.input, - ~metadata, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - } - - | Ok(Optional(None)) => - %expr - validateFieldOnBlurWithoutValidator( - ~fieldInput=[%e field_input_expr], - ~fieldStatus=[%e field_status_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - }; - - switch (result) { - | Some(fieldsStatuses) => Update({...state, fieldsStatuses}) - | None => NoUpdate - }; - }; -}; diff --git a/ppx/lib/Form_UseFormFn_BlurActions_SyncFieldOfCollection.ml b/ppx/lib/Form_UseFormFn_BlurActions_SyncFieldOfCollection.ml new file mode 100644 index 00000000..48a0fd46 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_BlurActions_SyncFieldOfCollection.ml @@ -0,0 +1,54 @@ +open Meta +open Ppxlib + +let ast + ~loc + ~(validator : (FieldValidator.sync, unit) result) + ~(metadata : unit option) + ~(field_status_expr : expression) + ~(field_input_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + let result = + [%e + match validator with + | Ok (Required | Optional (Some _)) | Error () -> + (match metadata with + | None -> + [%expr + validateFieldOfCollectionOnBlurWithValidator + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some () -> + [%expr + validateFieldOfCollectionOnBlurWithValidatorAndMetadata + ~input:state.input + ~index + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]) + | Ok (Optional None) -> + [%expr + validateFieldOnBlurWithoutValidator + ~fieldInput:[%e field_input_expr] + ~fieldStatus:[%e field_status_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + in + match result with + | Some fieldsStatuses -> Update { state with fieldsStatuses } + | None -> NoUpdate] +;; diff --git a/ppx/lib/Form_UseFormFn_BlurActions_SyncFieldOfCollection.re b/ppx/lib/Form_UseFormFn_BlurActions_SyncFieldOfCollection.re deleted file mode 100644 index 7ae728c6..00000000 --- a/ppx/lib/Form_UseFormFn_BlurActions_SyncFieldOfCollection.re +++ /dev/null @@ -1,56 +0,0 @@ -open Meta; - -open Ppxlib; - -let ast = - ( - ~loc, - ~validator: result(FieldValidator.sync, unit), - ~metadata: option(unit), - ~field_status_expr: expression, - ~field_input_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => { - %expr - { - let result = - switch%e (validator) { - | Ok(Required | Optional(Some(_))) - | Error () => - switch (metadata) { - | None => - %expr - validateFieldOfCollectionOnBlurWithValidator( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - | Some () => - %expr - validateFieldOfCollectionOnBlurWithValidatorAndMetadata( - ~input=state.input, - ~index, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - } - | Ok(Optional(None)) => - %expr - validateFieldOnBlurWithoutValidator( - ~fieldInput=[%e field_input_expr], - ~fieldStatus=[%e field_status_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - }; - - switch (result) { - | Some(fieldsStatuses) => Update({...state, fieldsStatuses}) - | None => NoUpdate - }; - }; -}; diff --git a/ppx/lib/Form_UseFormFn_CollectionsActions.ml b/ppx/lib/Form_UseFormFn_CollectionsActions.ml new file mode 100644 index 00000000..e8a75fdd --- /dev/null +++ b/ppx/lib/Form_UseFormFn_CollectionsActions.ml @@ -0,0 +1,218 @@ +open Meta +open Ast +open AstHelpers +open Printer +open Ppxlib +open Ast_helper + +let ast ~loc ~(metadata : unit option) (scheme : Scheme.t) = + let collections = scheme |> Scheme.collections in + collections + |> List.fold_left + (fun acc ({ collection; validator; fields } : Scheme.collection) -> + let deps = + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + acc |> List.rev_append (field.deps |> List.rev)) + [] + in + let add_action_pat = + Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident (collection |> CollectionPrinter.add_action) |> lid ~loc) + (Some (Pat.tuple [ Pat.var ("entry" |> str ~loc) ])) + in + let add_entry_to_input_exp = + collection.plural + |> E.update_field2 + ~in_:("state", "input") + ~with_: + [%expr + Belt.Array.concat + [%e collection.plural |> E.field2 ~in_:("state", "input") ~loc] + [| entry |] [@res.uapp]] + ~loc + in + let add_entry_to_fields_statuses_exp = + collection.plural + |> E.update_field2 + ~in_:("state", "fieldsStatuses") + ~with_: + [%expr + Belt.Array.concat + [%e + collection.plural + |> E.field2 ~in_:("state", "fieldsStatuses") ~loc] + [| [%e + Exp.record + (fields + |> List.rev + |> List.rev_map (fun (field : Scheme.field) -> + Lident field.name |> lid ~loc, [%expr Pristine])) + None] + |] [@res.uapp]] + ~loc + in + let remove_action_pat = + Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident (collection |> CollectionPrinter.remove_action) |> lid ~loc) + (Some (Pat.tuple [ Pat.var ("index" |> str ~loc) ])) + in + let remove_entry_from_input_exp = + collection.plural + |> E.update_field2 + ~in_:("state", "input") + ~with_: + [%expr + Belt.Array.keepWithIndex + [%e collection.plural |> E.field2 ~in_:("state", "input") ~loc] + [%e Uncurried.fn ~loc ~arity:2 [%expr fun _ i -> i <> index]] + [@res.uapp]] + ~loc + in + let remove_entry_from_fields_statuses_exp = + collection.plural + |> E.update_field2 + ~in_:("state", "fieldsStatuses") + ~with_: + [%expr + Belt.Array.keepWithIndex + [%e + collection.plural + |> E.field2 ~in_:("state", "fieldsStatuses") ~loc] + [%e Uncurried.fn ~loc ~arity:2 [%expr fun _ i -> i <> index]] + [@res.uapp]] + ~loc + in + let update_collections_statuses = + Exp.record + [ ( Lident collection.plural |> lid ~loc + , [%expr + Some + [%e + E.apply_field2 + ~in_:("validators", collection.plural) + ~fn:"collection" + ~args: + (match metadata with + | None -> [ Nolabel, [%expr nextInput] ] + | Some () -> + [ Nolabel, [%expr nextInput]; Nolabel, [%expr metadata] ]) + ~loc]] ) + ] + (match collections with + | [] -> None + | _x :: [] -> None + | _ -> Some [%expr state.collectionsStatuses]) + in + Exp.case + remove_action_pat + (match deps with + | [] -> + [%expr + let nextInput = [%e remove_entry_from_input_exp] in + let nextFieldsStatuses = [%e remove_entry_from_fields_statuses_exp] in + [%e + match validator with + | Ok (Some ()) | Error () -> + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = nextFieldsStatuses + ; collectionsStatuses = [%e update_collections_statuses] + }] + | Ok None -> + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = nextFieldsStatuses + }]]] + | dep :: deps -> + [%expr + let nextInput = [%e remove_entry_from_input_exp] in + let nextFieldsStatuses = ref [%e remove_entry_from_fields_statuses_exp] in + [%e + scheme + |> Form_UseFormFn_DependentFields.ast + ~loc + ~dep + ~deps + ~trigger:(`Collection collection) + ~metadata]; + [%e + match validator with + | Ok (Some ()) | Error () -> + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = !nextFieldsStatuses + ; collectionsStatuses = [%e update_collections_statuses] + }] + | Ok None -> + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = !nextFieldsStatuses + }]]]) + :: Exp.case + add_action_pat + (match deps with + | [] -> + [%expr + let nextInput = [%e add_entry_to_input_exp] in + let nextFieldsStatuses = [%e add_entry_to_fields_statuses_exp] in + [%e + match validator with + | Ok (Some ()) | Error () -> + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = nextFieldsStatuses + ; collectionsStatuses = [%e update_collections_statuses] + }] + | Ok None -> + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = nextFieldsStatuses + }]]] + | dep :: deps -> + [%expr + let nextInput = [%e add_entry_to_input_exp] in + let nextFieldsStatuses = ref [%e add_entry_to_fields_statuses_exp] in + [%e + scheme + |> Form_UseFormFn_DependentFields.ast + ~loc + ~dep + ~deps + ~trigger:(`Collection collection) + ~metadata]; + [%e + match validator with + | Ok (Some ()) | Error () -> + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = !nextFieldsStatuses + ; collectionsStatuses = [%e update_collections_statuses] + }] + | Ok None -> + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = !nextFieldsStatuses + }]]]) + :: acc) + [] +;; diff --git a/ppx/lib/Form_UseFormFn_CollectionsActions.re b/ppx/lib/Form_UseFormFn_CollectionsActions.re deleted file mode 100644 index 9aa91dc7..00000000 --- a/ppx/lib/Form_UseFormFn_CollectionsActions.re +++ /dev/null @@ -1,294 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; -open Printer; - -open Ppxlib; -open Ast_helper; - -let ast = (~loc, ~metadata: option(unit), scheme: Scheme.t) => { - let collections = scheme |> Scheme.collections; - collections - |> List.fold_left( - (acc, {collection, validator, fields}: Scheme.collection) => { - let deps = - fields - |> List.fold_left( - (acc, field: Scheme.field) => - acc |> List.rev_append(field.deps |> List.rev), - [], - ); - - let add_action_pat = - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident(collection |> CollectionPrinter.add_action) |> lid(~loc), - Some(Pat.tuple([Pat.var("entry" |> str(~loc))])), - ); - - let add_entry_to_input_exp = - collection.plural - |> E.update_field2( - ~in_=("state", "input"), - ~with_=[%expr - Belt.Array.concat( - [%e - collection.plural - |> E.field2(~in_=("state", "input"), ~loc) - ], - [|entry|], - ) - ], - ~loc, - ); - - let add_entry_to_fields_statuses_exp = - collection.plural - |> E.update_field2( - ~in_=("state", "fieldsStatuses"), - ~with_=[%expr - Belt.Array.concat( - [%e - collection.plural - |> E.field2(~in_=("state", "fieldsStatuses"), ~loc) - ], - [| - [%e - Exp.record( - fields - |> List.rev - |> List.rev_map((field: Scheme.field) => - ( - Lident(field.name) |> lid(~loc), - [%expr Pristine], - ) - ), - None, - ) - ], - |], - ) - ], - ~loc, - ); - - let remove_action_pat = - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident(collection |> CollectionPrinter.remove_action) - |> lid(~loc), - Some(Pat.tuple([Pat.var("index" |> str(~loc))])), - ); - - let remove_entry_from_input_exp = - collection.plural - |> E.update_field2( - ~in_=("state", "input"), - ~with_=[%expr - Belt.Array.keepWithIndex( - [%e - collection.plural - |> E.field2(~in_=("state", "input"), ~loc) - ], - (_, i) => - i != index - ) - ], - ~loc, - ); - - let remove_entry_from_fields_statuses_exp = - collection.plural - |> E.update_field2( - ~in_=("state", "fieldsStatuses"), - ~with_=[%expr - Belt.Array.keepWithIndex( - [%e - collection.plural - |> E.field2(~in_=("state", "fieldsStatuses"), ~loc) - ], - (_, i) => - i != index - ) - ], - ~loc, - ); - - let update_collections_statuses = - Exp.record( - [ - ( - Lident(collection.plural) |> lid(~loc), - [%expr - Some( - [%e - E.apply_field2( - ~in_=("validators", collection.plural), - ~fn="collection", - ~args= - switch (metadata) { - | None => [(Nolabel, [%expr nextInput])] - | Some () => [ - (Nolabel, [%expr nextInput]), - (Nolabel, [%expr metadata]), - ] - }, - ~loc, - ) - ], - ) - ], - ), - ], - switch (collections) { - | [] => None - | [_x] => None - | _ => Some([%expr state.collectionsStatuses]) - }, - ); - - [ - Exp.case( - remove_action_pat, - switch (deps) { - | [] => - %expr - { - let nextInput = [%e remove_entry_from_input_exp]; - let nextFieldsStatuses = [%e - remove_entry_from_fields_statuses_exp - ]; - switch%e (validator) { - | Ok(Some ()) - | Error () => - %expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: nextFieldsStatuses, - collectionsStatuses: [%e update_collections_statuses], - }) - | Ok(None) => - %expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: nextFieldsStatuses, - }) - }; - } - | [dep, ...deps] => - %expr - { - let nextInput = [%e remove_entry_from_input_exp]; - let nextFieldsStatuses = - ref([%e remove_entry_from_fields_statuses_exp]); - - %e - { - scheme - |> Form_UseFormFn_DependentFields.ast( - ~loc, - ~dep, - ~deps, - ~trigger=`Collection(collection), - ~metadata, - ); - }; - - switch%e (validator) { - | Ok(Some ()) - | Error () => - %expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: nextFieldsStatuses^, - collectionsStatuses: [%e update_collections_statuses], - }) - | Ok(None) => - %expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: nextFieldsStatuses^, - }) - }; - } - }, - ), - Exp.case( - add_action_pat, - switch (deps) { - | [] => - %expr - { - let nextInput = [%e add_entry_to_input_exp]; - let nextFieldsStatuses = [%e - add_entry_to_fields_statuses_exp - ]; - switch%e (validator) { - | Ok(Some ()) - | Error () => - %expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: nextFieldsStatuses, - collectionsStatuses: [%e update_collections_statuses], - }) - | Ok(None) => - %expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: nextFieldsStatuses, - }) - }; - } - | [dep, ...deps] => - %expr - { - let nextInput = [%e add_entry_to_input_exp]; - let nextFieldsStatuses = - ref([%e add_entry_to_fields_statuses_exp]); - - %e - { - scheme - |> Form_UseFormFn_DependentFields.ast( - ~loc, - ~dep, - ~deps, - ~trigger=`Collection(collection), - ~metadata, - ); - }; - - switch%e (validator) { - | Ok(Some ()) - | Error () => - %expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: nextFieldsStatuses^, - collectionsStatuses: [%e update_collections_statuses], - }) - | Ok(None) => - %expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: nextFieldsStatuses^, - }) - }; - } - }, - ), - ...acc, - ]; - }, - [], - ); -}; diff --git a/ppx/lib/Form_UseFormFn_DependentFields.ml b/ppx/lib/Form_UseFormFn_DependentFields.ml new file mode 100644 index 00000000..811529c3 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_DependentFields.ml @@ -0,0 +1,338 @@ +open Meta +open AstHelpers +open Ppxlib + +let ast + ~loc + ~(dep : FieldDep.t) + ~(deps : FieldDep.t list) + ~(trigger : + [ `Field of string + | `Collection of Collection.t + | `FieldOfCollection of Collection.t * string + ]) + ~(metadata : unit option) + (scheme : Scheme.t) + = + let validate_dep (dep : FieldDep.t) = + match + scheme + |> List.fold_left + (fun res (entry : Scheme.entry) -> + match res, entry, dep with + | Some _, _, _ -> res + | None, Field field, DepField dep -> + (match field.name = dep with + | true -> Some (`DepField field) + | false -> None) + | ( None + , Collection { collection; fields } + , DepFieldOfCollection { collection = dep_collection; field = dep_field } ) + -> + if collection.plural <> dep_collection.plural + then None + else + Some + (`DepFieldOfCollection + ( collection + , fields + |> List.find (fun (field : Scheme.field) -> field.name = dep_field) + )) + | None, Collection _, DepField _ | None, Field _, DepFieldOfCollection _ -> + res) + None + with + | None -> + failwith "Dep is not found in scheme. Please, file an issue with your use-case." + | Some (`DepField field) -> + let field_status_expr = field.name |> E.ref_field ~in_:"nextFieldsStatuses" ~loc in + let validator_expr = field.name |> E.field ~in_:"validators" ~loc in + let set_status_expr = + field.name + |> E.update_ref_field ~in_:"nextFieldsStatuses" ~with_:[%expr status] ~loc + in + (match field.validator with + | SyncValidator (Ok (Required | Optional (Some _)) | Error ()) -> + [%expr + match + [%e + match metadata with + | None -> + [%expr + validateDependentFieldOnChange + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some () -> + [%expr + validateDependentFieldOnChangeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]]] + with + | Some result -> nextFieldsStatuses := result + | None -> ()] + | SyncValidator (Ok (Optional None)) -> [%expr ()] + | AsyncValidator { mode = OnChange | OnBlur } -> + [%expr + match + [%e + match metadata with + | None -> + [%expr + Async.validateDependentFieldOnChange + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some () -> + [%expr + Async.validateDependentFieldOnChangeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]]] + with + | Some result -> nextFieldsStatuses := result + | None -> ()]) + | Some (`DepFieldOfCollection (collection, field)) -> + let collection_statuses_expr = + collection.plural |> E.ref_field ~in_:"nextFieldsStatuses" ~loc + in + let field_status_expr = field.name |> E.field ~in_:"item" ~loc in + let validator_expr = + field.name + |> E.field_of_collection_validator ~validators:"validators" ~collection ~loc + in + let set_status_expr = + field.name + |> E.update_ref_field_of_collection + ~in_:"nextFieldsStatuses" + ~collection + ~with_:[%expr status] + ~index_token:"index'" + ~loc + in + (match trigger with + | `FieldOfCollection (collection', field') + when collection.plural = collection'.plural && field.name = field' -> + (match field.validator with + | SyncValidator (Ok (Required | Optional (Some _)) | Error ()) -> + [%expr + Belt.Array.forEachWithIndex + [%e collection_statuses_expr] + [%e + Uncurried.fn + ~loc + ~arity:2 + [%expr + fun index' item -> + if index <> index' + then ( + match + [%e + match metadata with + | None -> + [%expr + validateDependentFieldOfCollectionOnChange + ~input:nextInput + ~index:index' + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some () -> + [%expr + validateDependentFieldOfCollectionOnChangeWithMetadata + ~input:nextInput + ~index:index' + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + with + | Some result -> nextFieldsStatuses := result + | None -> ()) + else ()]] [@res.uapp]] + | SyncValidator (Ok (Optional None)) -> [%expr ()] + | AsyncValidator { mode = OnChange | OnBlur } -> + [%expr + Belt.Array.forEachWithIndex + [%e collection_statuses_expr] + [%e + Uncurried.fn + ~loc + ~arity:2 + [%expr + fun index' item -> + if index <> index' + then ( + match + [%e + match metadata with + | None -> + [%expr + Async.validateDependentFieldOfCollectionOnChange + ~input:nextInput + ~index:index' + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some () -> + [%expr + Async + .validateDependentFieldOfCollectionOnChangeWithMetadata + ~input:nextInput + ~index:index' + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + with + | Some result -> nextFieldsStatuses := result + | None -> ()) + else ()]] [@res.uapp]]) + | `Field _ | `Collection _ | `FieldOfCollection (_, _) -> + (match field.validator with + | SyncValidator (Ok (Required | Optional (Some _)) | Error ()) -> + [%expr + Belt.Array.forEachWithIndex + [%e collection_statuses_expr] + [%e + Uncurried.fn + ~loc + ~arity:2 + [%expr + fun index' item -> + match + [%e + match metadata with + | None -> + [%expr + validateDependentFieldOfCollectionOnChange + ~input:nextInput + ~index:index' + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some () -> + [%expr + validateDependentFieldOfCollectionOnChangeWithMetadata + ~input:nextInput + ~index:index' + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + with + | Some result -> nextFieldsStatuses := result + | None -> ()]] [@res.uapp]] + | SyncValidator (Ok (Optional None)) -> [%expr ()] + | AsyncValidator { mode = OnChange | OnBlur } -> + [%expr + Belt.Array.forEachWithIndex + [%e collection_statuses_expr] + [%e + Uncurried.fn + ~loc + ~arity:2 + [%expr + fun index' item -> + match + [%e + match metadata with + | None -> + [%expr + Async.validateDependentFieldOfCollectionOnChange + ~input:nextInput + ~index:index' + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some () -> + [%expr + Async + .validateDependentFieldOfCollectionOnChangeWithMetadata + ~input:nextInput + ~index:index' + ~fieldStatus:[%e field_status_expr] + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + with + | Some result -> nextFieldsStatuses := result + | None -> ()]] [@res.uapp]])) + in + deps |> E.seq ~exp:(dep |> validate_dep) ~make:validate_dep +;; diff --git a/ppx/lib/Form_UseFormFn_DependentFields.re b/ppx/lib/Form_UseFormFn_DependentFields.re deleted file mode 100644 index ec971977..00000000 --- a/ppx/lib/Form_UseFormFn_DependentFields.re +++ /dev/null @@ -1,312 +0,0 @@ -open Meta; -open AstHelpers; - -open Ppxlib; - -let ast = - ( - ~loc, - ~dep: FieldDep.t, - ~deps: list(FieldDep.t), - ~trigger: [ - | `Field(string) - | `Collection(Collection.t) - | `FieldOfCollection(Collection.t, string) - ], - ~metadata: option(unit), - scheme: Scheme.t, - ) => { - let validate_dep = (dep: FieldDep.t) => { - switch ( - scheme - |> List.fold_left( - (res, entry: Scheme.entry) => - switch (res, entry, dep) { - | (Some(_), _, _) => res - | (None, Field(field), DepField(dep)) => - field.name == dep ? Some(`DepField(field)) : None - | ( - None, - Collection({collection, fields}), - DepFieldOfCollection({ - collection: dep_collection, - field: dep_field, - }), - ) => - if (collection.plural != dep_collection.plural) { - None; - } else { - Some( - `DepFieldOfCollection(( - collection, - fields - |> List.find((field: Scheme.field) => - field.name == dep_field - ), - )), - ); - } - | (None, Collection(_), DepField(_)) - | (None, Field(_), DepFieldOfCollection(_)) => res - }, - None, - ) - ) { - | None => - failwith( - "Dep is not found in scheme. Please, file an issue with your use-case.", - ) - | Some(`DepField(field)) => - let field_status_expr = - field.name |> E.ref_field(~in_="nextFieldsStatuses", ~loc); - let validator_expr = field.name |> E.field(~in_="validators", ~loc); - let set_status_expr = - field.name - |> E.update_ref_field( - ~in_="nextFieldsStatuses", - ~with_=[%expr status], - ~loc, - ); - - switch (field.validator) { - | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => - switch%expr ( - switch%e (metadata) { - | None => - %expr - validateDependentFieldOnChange( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - | Some () => - %expr - validateDependentFieldOnChangeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - } - ) { - | Some(result) => nextFieldsStatuses := result - | None => () - } - | SyncValidator(Ok(Optional(None))) => - %expr - () - // Should we trigger async validator of dependency? - | AsyncValidator({mode: OnChange | OnBlur}) => - switch%expr ( - switch%e (metadata) { - | None => - %expr - Async.validateDependentFieldOnChange( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - | Some () => - %expr - Async.validateDependentFieldOnChangeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - } - ) { - | Some(result) => nextFieldsStatuses := result - | None => () - } - }; - | Some(`DepFieldOfCollection(collection, field)) => - let collection_statuses_expr = - collection.plural |> E.ref_field(~in_="nextFieldsStatuses", ~loc); - let field_status_expr = field.name |> E.field(~in_="item", ~loc); - let validator_expr = - field.name - |> E.field_of_collection_validator( - ~validators="validators", - ~collection, - ~loc, - ); - let set_status_expr = - field.name - |> E.update_ref_field_of_collection( - ~in_="nextFieldsStatuses", - ~collection, - ~with_=[%expr status], - ~index_token="index'", - ~loc, - ); - - switch (trigger) { - | `FieldOfCollection(collection', field') - when collection.plural == collection'.plural && field.name == field' => - switch (field.validator) { - | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => - %expr - { - Belt.Array.forEachWithIndex( - [%e collection_statuses_expr], (index', item) => - if (index != index') { - switch ( - switch%e (metadata) { - | None => - %expr - validateDependentFieldOfCollectionOnChange( - ~input=nextInput, - ~index=index', - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - | Some () => - %expr - validateDependentFieldOfCollectionOnChangeWithMetadata( - ~input=nextInput, - ~index=index', - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - } - ) { - | Some(result) => nextFieldsStatuses := result - | None => () - }; - } else { - (); - } - ); - } - - | SyncValidator(Ok(Optional(None))) => - %expr - () - // Should we trigger async validator of dependency? - | AsyncValidator({mode: OnChange | OnBlur}) => - %expr - { - Belt.Array.forEachWithIndex( - [%e collection_statuses_expr], (index', item) => - if (index != index') { - switch ( - switch%e (metadata) { - | None => - %expr - Async.validateDependentFieldOfCollectionOnChange( - ~input=nextInput, - ~index=index', - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - | Some () => - %expr - Async.validateDependentFieldOfCollectionOnChangeWithMetadata( - ~input=nextInput, - ~index=index', - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - } - ) { - | Some(result) => nextFieldsStatuses := result - | None => () - }; - } else { - (); - } - ); - } - } - | `Field(_) - | `Collection(_) - | `FieldOfCollection(_, _) => - switch (field.validator) { - | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => - %expr - { - Belt.Array.forEachWithIndex( - [%e collection_statuses_expr], (index', item) => - switch ( - switch%e (metadata) { - | None => - %expr - validateDependentFieldOfCollectionOnChange( - ~input=nextInput, - ~index=index', - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - | Some () => - %expr - validateDependentFieldOfCollectionOnChangeWithMetadata( - ~input=nextInput, - ~index=index', - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - } - ) { - | Some(result) => nextFieldsStatuses := result - | None => () - } - ); - } - | SyncValidator(Ok(Optional(None))) => - %expr - () - // Should we trigger async validator of dependency? - | AsyncValidator({mode: OnChange | OnBlur}) => - %expr - { - Belt.Array.forEachWithIndex( - [%e collection_statuses_expr], (index', item) => - switch ( - switch%e (metadata) { - | None => - %expr - Async.validateDependentFieldOfCollectionOnChange( - ~input=nextInput, - ~index=index', - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - | Some () => - %expr - Async.validateDependentFieldOfCollectionOnChangeWithMetadata( - ~input=nextInput, - ~index=index', - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - } - ) { - | Some(result) => nextFieldsStatuses := result - | None => () - } - ); - } - } - }; - }; - }; - - deps |> E.seq(~exp=dep |> validate_dep, ~make=validate_dep); -}; diff --git a/ppx/lib/Form_UseFormFn_Interface.ml b/ppx/lib/Form_UseFormFn_Interface.ml new file mode 100644 index 00000000..fda21d64 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_Interface.ml @@ -0,0 +1,433 @@ +open Meta +open Ast +open AstHelpers +open Printer +open Ppxlib +open Ast_helper + +module Dirty = struct + type context = + | FieldsOnly + | CollectionsOnly of { collections_cond : expression } + | FieldsAndCollections of { collections_cond : expression } + + let collection_cond ~loc ({ collection; fields } : Scheme.collection) = + [%expr + Belt.Array.every + [%e E.field2 ~in_:("state", "fieldsStatuses") ~loc collection.plural] + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun item -> + [%e + Exp.match_ + ~attrs:[ warning_4_disable ~loc ] + [%expr item] + [ Exp.case + (Pat.record + (fields + |> List.rev_map (fun (field : Scheme.field) -> + Lident field.name |> lid ~loc, [%pat? Pristine])) + Closed) + [%expr false] + ; Exp.case + (Pat.record + (fields + |> List.rev_map (fun (field : Scheme.field) -> + ( Lident field.name |> lid ~loc + , match fields, field.validator with + | _x :: [], SyncValidator _ -> [%pat? Dirty _] + | _x :: [], AsyncValidator _ -> + [%pat? Dirty _ | Validating _] + | _, SyncValidator _ -> [%pat? Pristine | Dirty _] + | _, AsyncValidator _ -> + [%pat? Pristine | Dirty _ | Validating _] ))) + Closed) + [%expr true] + ]]]] [@res.uapp]] + ;; +end + +let ast ~(scheme : Scheme.t) ~(async : bool) ~(metadata : unit option) ~loc = + let dirty = + let fields = scheme |> Scheme.fields in + let collections = scheme |> Scheme.collections in + let context = + match fields, collections with + | _fields :: _, [] -> Dirty.FieldsOnly + | [], collection :: collections -> + Dirty.CollectionsOnly + { collections_cond = + collections + |> E.conj + ~loc + ~exp:(Dirty.collection_cond ~loc collection) + ~make:Dirty.collection_cond + } + | _fields :: _, collection :: collections -> + Dirty.FieldsAndCollections + { collections_cond = + collections + |> E.conj + ~loc + ~exp:(Dirty.collection_cond ~loc collection) + ~make:Dirty.collection_cond + } + | [], [] -> + failwith + "No fields and no collections in the schema. Please, file an issue with your \ + use-case." + in + let no_case = + Exp.case + (Pat.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> Lident field.name |> lid ~loc, [%pat? Pristine] + | Collection { collection } -> + Lident collection.plural |> lid ~loc, [%pat? _])) + Closed) + [%expr false] + in + let yes_case = + Exp.case + (Pat.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> + ( Lident field.name |> lid ~loc + , (match + ( scheme + |> List.filter (fun (entry : Scheme.entry) -> + match entry with + | Field _ -> true + | Collection _ -> false) + , field.validator ) + with + | _x :: [], SyncValidator _ -> [%pat? Dirty _] + | _x :: [], AsyncValidator _ -> [%pat? Dirty _ | Validating _] + | _, SyncValidator _ -> [%pat? Pristine | Dirty _] + | _, AsyncValidator _ -> [%pat? Pristine | Dirty _ | Validating _]) ) + | Collection { collection } -> + Lident collection.plural |> lid ~loc, [%pat? _])) + Closed) + [%expr true] + in + let match_exp = + Exp.match_ + ~attrs:[ warning_4_disable ~loc ] + [%expr state.fieldsStatuses] + [ no_case; yes_case ] + in + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun () -> + [%e + match context with + | FieldsOnly -> match_exp + | CollectionsOnly { collections_cond } -> collections_cond + | FieldsAndCollections { collections_cond } -> + [%expr if [%e collections_cond] then true else [%e match_exp]]]] + in + let valid = + if async + then + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun () -> + match + [%e + match metadata with + | None -> + [%expr + validateForm + state.input + ~validators + ~fieldsStatuses:state.fieldsStatuses [@res.uapp]] + | Some () -> + [%expr + validateForm + state.input + ~validators + ~fieldsStatuses:state.fieldsStatuses + ~metadata [@res.uapp]]] + with + | Validating _ -> None + | Valid _ -> Some true + | Invalid _ -> Some false] + else + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun () -> + match + [%e + match metadata with + | None -> + [%expr + validateForm + state.input + ~validators + ~fieldsStatuses:state.fieldsStatuses [@res.uapp]] + | Some () -> + [%expr + validateForm + state.input + ~validators + ~fieldsStatuses:state.fieldsStatuses + ~metadata [@res.uapp]]] + with + | Valid _ -> true + | Invalid _ -> false] + in + let base = + [ "input", [%expr state.input] + ; "status", [%expr state.formStatus] + ; "dirty", dirty + ; "valid", valid + ; ( "submitting" + , [%expr + match state.formStatus with + | Submitting _ -> true + | Editing | Submitted | SubmissionFailed _ -> false] ) + ; "submit", Uncurried.fn ~loc ~arity:1 [%expr fun () -> (dispatch Submit [@res.uapp])] + ; ( "mapSubmissionError" + , Uncurried.fn + ~loc + ~arity:1 + [%expr fun map -> (dispatch (MapSubmissionError map) [@res.uapp])] ) + ; ( "dismissSubmissionError" + , Uncurried.fn + ~loc + ~arity:1 + [%expr fun () -> (dispatch DismissSubmissionError [@res.uapp])] ) + ; ( "dismissSubmissionResult" + , Uncurried.fn + ~loc + ~arity:1 + [%expr fun () -> (dispatch DismissSubmissionResult [@res.uapp])] ) + ; "reset", Uncurried.fn ~loc ~arity:1 [%expr fun () -> (dispatch Reset [@res.uapp])] + ] + in + let update_fns = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + ( FieldPrinter.update_fn ~field:field.name + , Uncurried.fn + ~loc + ~arity:2 + [%expr + fun nextInputFn nextValue -> + (dispatch + [%e + Exp.construct + (Lident (FieldPrinter.update_action ~field:field.name) + |> lid ~loc) + (Some + (Uncurried.fn + ~loc + ~arity:1 + [%expr + fun __x -> (nextInputFn __x nextValue [@res.uapp])]))] + [@res.uapp])] ) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + ( FieldOfCollectionPrinter.update_fn ~collection ~field:field.name + , Uncurried.fn + ~loc + ~arity:3 + [%expr + fun ~at:index nextInputFn nextValue -> + (dispatch + [%e + Exp.construct + (Lident + (FieldOfCollectionPrinter.update_action + ~collection + ~field:field.name) + |> lid ~loc) + (Some + [%expr + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun __x -> + (nextInputFn __x nextValue [@res.uapp])]] + , index])] [@res.uapp])] ) + :: acc) + acc) + [] + in + let blur_fns = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + ( FieldPrinter.blur_fn ~field:field.name + , Uncurried.fn + ~loc + ~arity:1 + [%expr + fun () -> + (dispatch + [%e + Exp.construct + (Lident (FieldPrinter.blur_action ~field:field.name) + |> lid ~loc) + None] [@res.uapp])] ) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + ( FieldOfCollectionPrinter.blur_fn ~collection ~field:field.name + , Uncurried.fn + ~loc + ~arity:1 + [%expr + fun ~at:index -> + (dispatch + [%e + Exp.construct + (Lident + (FieldOfCollectionPrinter.blur_action + ~collection + ~field:field.name) + |> lid ~loc) + (Some [%expr index])] [@res.uapp])] ) + :: acc) + acc) + [] + in + let result_entries = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + ( FieldPrinter.result_value ~field:field.name + , match field.validator with + | SyncValidator _ -> + [%expr + exposeFieldResult + [%e field.name |> E.field2 ~in_:("state", "fieldsStatuses") ~loc] + [@res.uapp]] + | AsyncValidator _ -> + [%expr + Async.exposeFieldResult + [%e field.name |> E.field2 ~in_:("state", "fieldsStatuses") ~loc] + [@res.uapp]] ) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + ( FieldOfCollectionPrinter.result_fn ~collection ~field:field.name + , match field.validator with + | SyncValidator _ -> + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun ~at:index -> + (exposeFieldResult + [%e + field.name + |> E.field_of_collection2 + ~in_:("state", "fieldsStatuses") + ~collection + ~loc] [@res.uapp])] + | AsyncValidator _ -> + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun ~at:index -> + (Async.exposeFieldResult + [%e + field.name + |> E.field_of_collection2 + ~in_:("state", "fieldsStatuses") + ~collection + ~loc] [@res.uapp])] ) + :: acc) + acc) + [] + in + let collection_entries = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field _ -> acc + | Collection { collection; validator } -> + let add_fn = + ( collection |> CollectionPrinter.add_fn + , Uncurried.fn + ~loc + ~arity:1 + [%expr + fun entry -> + (dispatch + [%e + Exp.construct + (Lident (collection |> CollectionPrinter.add_action) + |> lid ~loc) + (Some [%expr entry])] [@res.uapp])] ) + in + let remove_fn = + ( collection |> CollectionPrinter.remove_fn + , Uncurried.fn + ~loc + ~arity:1 + [%expr + fun ~at:index -> + (dispatch + [%e + Exp.construct + (Lident (collection |> CollectionPrinter.remove_action) + |> lid ~loc) + (Some [%expr index])] [@res.uapp])] ) + in + let result_value = + match validator with + | Ok (Some ()) | Error () -> + Some + ( collection |> CollectionPrinter.result_value + , collection.plural + |> E.field2 ~in_:("state", "collectionsStatuses") ~loc ) + | Ok None -> None + in + (match result_value with + | Some result_value -> result_value :: remove_fn :: add_fn :: acc + | None -> remove_fn :: add_fn :: acc)) + [] + in + E.record + ~loc + (base + |> List.rev_append collection_entries + |> List.rev_append result_entries + |> List.rev_append blur_fns + |> List.rev_append update_fns) +;; diff --git a/ppx/lib/Form_UseFormFn_Interface.re b/ppx/lib/Form_UseFormFn_Interface.re deleted file mode 100644 index d33728bc..00000000 --- a/ppx/lib/Form_UseFormFn_Interface.re +++ /dev/null @@ -1,544 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; -open Printer; - -open Ppxlib; -open Ast_helper; - -module Dirty = { - type context = - | FieldsOnly - | CollectionsOnly({collections_cond: expression}) - | FieldsAndCollections({collections_cond: expression}); - - // Disables warning 4 to prevent stack overflow - // Details: https://github.com/BuckleScript/bucklescript/issues/4327 - let warning_4_disable = (~loc) => - Attr.mk("warning" |> str(~loc), PStr([[%stri "-4"]])); - - let collection_cond = (~loc, {collection, fields}: Scheme.collection) => [%expr - Belt.Array.every( - [%e - E.field2(~in_=("state", "fieldsStatuses"), ~loc, collection.plural) - ], - item => { - %e - Exp.match( - ~attrs=[warning_4_disable(~loc)], - [%expr item], - [ - Exp.case( - Pat.record( - fields - |> List.rev_map((field: Scheme.field) => - (Lident(field.name) |> lid(~loc), [%pat? Pristine]) - ), - Closed, - ), - [%expr false], - ), - Exp.case( - Pat.record( - fields - |> List.rev_map((field: Scheme.field) => - ( - Lident(field.name) |> lid(~loc), - switch (fields, field.validator) { - | ([_x], SyncValidator(_)) => [%pat? Dirty(_)] - | ([_x], AsyncValidator(_)) => [%pat? - Dirty(_) | Validating(_) - ] - | (_, SyncValidator(_)) => [%pat? Pristine | Dirty(_)] - | (_, AsyncValidator(_)) => [%pat? - Pristine | Dirty(_) | Validating(_) - ] - }, - ) - ), - Closed, - ), - [%expr true], - ), - ], - ) - }) - ]; -}; - -let ast = (~scheme: Scheme.t, ~async: bool, ~metadata: option(unit), ~loc) => { - let dirty = { - let fields = scheme |> Scheme.fields; - let collections = scheme |> Scheme.collections; - - let context = - switch (fields, collections) { - | ([_fields, ..._], []) => Dirty.FieldsOnly - | ([], [collection, ...collections]) => - Dirty.CollectionsOnly({ - collections_cond: - collections - |> E.conj( - ~loc, - ~exp=Dirty.collection_cond(~loc, collection), - ~make=Dirty.collection_cond, - ), - }) - | ([_fields, ..._], [collection, ...collections]) => - Dirty.FieldsAndCollections({ - collections_cond: - collections - |> E.conj( - ~loc, - ~exp=Dirty.collection_cond(~loc, collection), - ~make=Dirty.collection_cond, - ), - }) - | ([], []) => - failwith( - "No fields and no collections in the schema. Please, file an issue with your use-case.", - ) - }; - - let no_case = { - Exp.case( - Pat.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => ( - Lident(field.name) |> lid(~loc), - [%pat? Pristine], - ) - | Collection({collection}) => ( - Lident(collection.plural) |> lid(~loc), - [%pat? _], - ) - } - ), - Closed, - ), - [%expr false], - ); - }; - - let yes_case = { - Exp.case( - Pat.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => ( - Lident(field.name) |> lid(~loc), - switch ( - scheme - |> List.filter((entry: Scheme.entry) => - switch (entry) { - | Field(_) => true - | Collection(_) => false - } - ), - field.validator, - ) { - | ([_x], SyncValidator(_)) => [%pat? Dirty(_)] - | ([_x], AsyncValidator(_)) => [%pat? - Dirty(_) | Validating(_) - ] - | (_, SyncValidator(_)) => [%pat? Pristine | Dirty(_)] - | (_, AsyncValidator(_)) => [%pat? - Pristine | Dirty(_) | Validating(_) - ] - }, - ) - | Collection({collection}) => ( - Lident(collection.plural) |> lid(~loc), - [%pat? _], - ) - } - ), - Closed, - ), - [%expr true], - ); - }; - - let match_exp = - Exp.match( - ~attrs=[warning_4_disable(~loc)], - [%expr state.fieldsStatuses], - [no_case, yes_case], - ); - - %expr - () => - switch%e (context) { - | FieldsOnly => match_exp - | CollectionsOnly({collections_cond}) => collections_cond - | FieldsAndCollections({collections_cond}) => - if%expr ([%e collections_cond]) { - true; - } else { - %e - match_exp; - } - }; - }; - - let valid = - if (async) { - %expr - () => - switch ( - switch%e (metadata) { - | None => - %expr - state.input - ->validateForm(~validators, ~fieldsStatuses=state.fieldsStatuses) - | Some () => - %expr - state.input - ->validateForm( - ~validators, - ~fieldsStatuses=state.fieldsStatuses, - ~metadata, - ) - } - ) { - | Validating(_) => None - | Valid(_) => Some(true) - | Invalid(_) => Some(false) - }; - } else { - %expr - () => - switch ( - switch%e (metadata) { - | None => - %expr - state.input - ->validateForm(~validators, ~fieldsStatuses=state.fieldsStatuses) - | Some () => - %expr - state.input - ->validateForm( - ~validators, - ~fieldsStatuses=state.fieldsStatuses, - ~metadata, - ) - } - ) { - | Valid(_) => true - | Invalid(_) => false - }; - }; - - let base = [ - ("input", [%expr state.input]), - ("status", [%expr state.formStatus]), - ("dirty", dirty), - ("valid", valid), - ( - "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 = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - ( - FieldPrinter.update_fn(~field=field.name), - [%expr - ( - (nextInputFn, nextValue) => { - [%e - Exp.construct( - Lident( - FieldPrinter.update_action(~field=field.name), - ) - |> lid(~loc), - Some([%expr nextInputFn(_, nextValue)]), - ) - ] - ->dispatch; - } - ) - ], - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - ( - FieldOfCollectionPrinter.update_fn( - ~collection, - ~field=field.name, - ), - [%expr - (~at as index, nextInputFn, nextValue) => { - [%e - Exp.construct( - Lident( - FieldOfCollectionPrinter.update_action( - ~collection, - ~field=field.name, - ), - ) - |> lid(~loc), - Some( - [%expr (nextInputFn(_, nextValue), index)], - ), - ) - ] - ->dispatch; - } - ], - ), - ...acc, - ], - acc, - ) - }, - [], - ); - - let blur_fns = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - ( - FieldPrinter.blur_fn(~field=field.name), - [%expr - ( - () => - [%e - Exp.construct( - Lident( - FieldPrinter.blur_action(~field=field.name), - ) - |> lid(~loc), - None, - ) - ] - ->dispatch - ) - ], - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - ( - FieldOfCollectionPrinter.blur_fn( - ~collection, - ~field=field.name, - ), - [%expr - (~at as index) => - [%e - Exp.construct( - Lident( - FieldOfCollectionPrinter.blur_action( - ~collection, - ~field=field.name, - ), - ) - |> lid(~loc), - Some([%expr index]), - ) - ] - ->dispatch - ], - ), - ...acc, - ], - acc, - ) - }, - [], - ); - - let result_entries = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - ( - FieldPrinter.result_value(~field=field.name), - switch (field.validator) { - | SyncValidator(_) => - %expr - exposeFieldResult( - [%e - field.name - |> E.field2(~in_=("state", "fieldsStatuses"), ~loc) - ], - ) - | AsyncValidator(_) => - %expr - Async.exposeFieldResult( - [%e - field.name - |> E.field2(~in_=("state", "fieldsStatuses"), ~loc) - ], - ) - }, - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - ( - FieldOfCollectionPrinter.result_fn( - ~collection, - ~field=field.name, - ), - switch (field.validator) { - | SyncValidator(_) => - %expr - ( - (~at as index) => { - exposeFieldResult( - [%e - field.name - |> E.field_of_collection2( - ~in_=("state", "fieldsStatuses"), - ~collection, - ~loc, - ) - ], - ); - } - ) - | AsyncValidator(_) => - %expr - ( - (~at as index) => { - Async.exposeFieldResult( - [%e - field.name - |> E.field_of_collection2( - ~in_=("state", "fieldsStatuses"), - ~collection, - ~loc, - ) - ], - ); - } - ) - }, - ), - ...acc, - ], - acc, - ) - }, - [], - ); - - let collection_entries = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(_) => acc - | Collection({collection, validator}) => - let add_fn = ( - collection |> CollectionPrinter.add_fn, - [%expr - ( - entry => - [%e - Exp.construct( - Lident(collection |> CollectionPrinter.add_action) - |> lid(~loc), - Some([%expr entry]), - ) - ] - ->dispatch - ) - ], - ); - let remove_fn = ( - collection |> CollectionPrinter.remove_fn, - [%expr - ( - (~at as index) => - [%e - Exp.construct( - Lident(collection |> CollectionPrinter.remove_action) - |> lid(~loc), - Some([%expr index]), - ) - ] - ->dispatch - ) - ], - ); - let result_value = - switch (validator) { - | Ok(Some ()) - | Error () => - Some(( - collection |> CollectionPrinter.result_value, - collection.plural - |> E.field2(~in_=("state", "collectionsStatuses"), ~loc), - )) - | Ok(None) => None - }; - - switch (result_value) { - | Some(result_value) => [ - result_value, - remove_fn, - add_fn, - ...acc, - ] - | None => [remove_fn, add_fn, ...acc] - }; - }, - [], - ); - - E.record( - ~loc, - base - |> List.rev_append(collection_entries) - |> List.rev_append(result_entries) - |> List.rev_append(blur_fns) - |> List.rev_append(update_fns), - ); -}; diff --git a/ppx/lib/Form_UseFormFn_RestActions.ml b/ppx/lib/Form_UseFormFn_RestActions.ml new file mode 100644 index 00000000..fae510f8 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_RestActions.ml @@ -0,0 +1,223 @@ +open Ppxlib +open Ast_helper + +let ast ~loc ~async ~metadata = + [ (if async + then + Exp.case + [%pat? Submit] + [%expr + match state.formStatus with + | Submitting _ -> NoUpdate + | Editing | Submitted | SubmissionFailed _ -> + (match + [%e + match metadata with + | None -> + [%expr + validateForm + state.input + ~validators + ~fieldsStatuses:state.fieldsStatuses [@res.uapp]] + | Some () -> + [%expr + validateForm + state.input + ~validators + ~fieldsStatuses:state.fieldsStatuses + ~metadata [@res.uapp]]] + with + | Validating { fieldsStatuses; collectionsStatuses } -> + Update { state with fieldsStatuses; collectionsStatuses } + | Valid { output; fieldsStatuses; collectionsStatuses } -> + UpdateWithSideEffects + ( { state with + fieldsStatuses + ; collectionsStatuses + ; formStatus = + Submitting + (match state.formStatus with + | SubmissionFailed error -> Some error + | Editing | Submitted | Submitting _ -> None) + ; submissionStatus = AttemptedToSubmit + } + , [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun { state = _; dispatch } -> + (onSubmit + output + { notifyOnSuccess = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun input -> + (dispatch + (SetSubmittedStatus input) [@res.uapp])]] + ; notifyOnFailure = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun error -> + (dispatch + (SetSubmissionFailedStatus error) + [@res.uapp])]] + ; reset = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun () -> (dispatch Reset [@res.uapp])]] + ; dismissSubmissionResult = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun () -> + (dispatch DismissSubmissionResult [@res.uapp])]] + } [@res.uapp])]] ) + | Invalid { fieldsStatuses; collectionsStatuses } -> + Update + { state with + fieldsStatuses + ; collectionsStatuses + ; formStatus = Editing + ; submissionStatus = AttemptedToSubmit + })] + else + Exp.case + [%pat? Submit] + [%expr + match state.formStatus with + | Submitting _ -> NoUpdate + | Editing | Submitted | SubmissionFailed _ -> + (match + [%e + match metadata with + | None -> + [%expr + validateForm + state.input + ~validators + ~fieldsStatuses:state.fieldsStatuses [@res.uapp]] + | Some () -> + [%expr + validateForm + state.input + ~validators + ~fieldsStatuses:state.fieldsStatuses + ~metadata [@res.uapp]]] + with + | Valid { output; fieldsStatuses; collectionsStatuses } -> + UpdateWithSideEffects + ( { state with + fieldsStatuses + ; collectionsStatuses + ; formStatus = + Submitting + (match state.formStatus with + | SubmissionFailed error -> Some error + | Editing | Submitted | Submitting _ -> None) + ; submissionStatus = AttemptedToSubmit + } + , [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun { state = _; dispatch } -> + (onSubmit + output + { notifyOnSuccess = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun input -> + (dispatch + (SetSubmittedStatus input) [@res.uapp])]] + ; notifyOnFailure = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun error -> + (dispatch + (SetSubmissionFailedStatus error) + [@res.uapp])]] + ; reset = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun () -> (dispatch Reset [@res.uapp])]] + ; dismissSubmissionResult = + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun () -> + (dispatch DismissSubmissionResult [@res.uapp])]] + } [@res.uapp])]] ) + | Invalid { fieldsStatuses; collectionsStatuses } -> + Update + { state with + fieldsStatuses + ; collectionsStatuses + ; formStatus = Editing + ; submissionStatus = AttemptedToSubmit + })]) + ; Exp.case + [%pat? SetSubmittedStatus input] + [%expr + match input with + | Some input -> + Update + { state with + input + ; formStatus = Submitted + ; fieldsStatuses = initialFieldsStatuses input [@res.uapp] + } + | None -> + Update + { state with + formStatus = Submitted + ; fieldsStatuses = initialFieldsStatuses state.input [@res.uapp] + }] + ; Exp.case + [%pat? SetSubmissionFailedStatus error] + [%expr Update { state with formStatus = SubmissionFailed error }] + ; Exp.case + [%pat? MapSubmissionError map] + [%expr + match state.formStatus with + | Submitting (Some error) -> + Update { state with formStatus = Submitting (Some (map error [@res.uapp])) } + | SubmissionFailed error -> + Update { state with formStatus = SubmissionFailed (map error [@res.uapp]) } + | Editing | Submitting None | Submitted -> NoUpdate] + ; Exp.case + [%pat? DismissSubmissionError] + [%expr + match state.formStatus with + | Editing | Submitting _ | Submitted -> NoUpdate + | SubmissionFailed _ -> Update { state with formStatus = Editing }] + ; Exp.case + [%pat? DismissSubmissionResult] + [%expr + match state.formStatus with + | Editing | Submitting _ -> NoUpdate + | Submitted | SubmissionFailed _ -> Update { state with formStatus = Editing }] + ; Exp.case [%pat? Reset] [%expr Update (initialState initialInput [@res.uapp])] + ] +;; diff --git a/ppx/lib/Form_UseFormFn_RestActions.re b/ppx/lib/Form_UseFormFn_RestActions.re deleted file mode 100644 index 3190eb2a..00000000 --- a/ppx/lib/Form_UseFormFn_RestActions.re +++ /dev/null @@ -1,185 +0,0 @@ -open Ppxlib; -open Ast_helper; - -let ast = (~loc, ~async, ~metadata) => [ - if (async) { - Exp.case( - [%pat? Submit], - switch%expr (state.formStatus) { - | Submitting(_) => NoUpdate - | Editing - | Submitted - | SubmissionFailed(_) => - switch ( - switch%e (metadata) { - | None => - %expr - state.input - ->validateForm(~validators, ~fieldsStatuses=state.fieldsStatuses) - | Some () => - %expr - state.input - ->validateForm( - ~validators, - ~fieldsStatuses=state.fieldsStatuses, - ~metadata, - ) - } - ) { - | Validating({fieldsStatuses, collectionsStatuses}) => - Update({...state, fieldsStatuses, collectionsStatuses}) - | Valid({output, fieldsStatuses, collectionsStatuses}) => - UpdateWithSideEffects( - { - ...state, - fieldsStatuses, - collectionsStatuses, - formStatus: - Submitting( - switch (state.formStatus) { - | SubmissionFailed(error) => Some(error) - | Editing - | Submitted - | Submitting(_) => None - }, - ), - submissionStatus: AttemptedToSubmit, - }, - ({state: _, dispatch}) => - output->onSubmit({ - notifyOnSuccess: input => SetSubmittedStatus(input)->dispatch, - notifyOnFailure: error => - SetSubmissionFailedStatus(error)->dispatch, - reset: () => Reset->dispatch, - dismissSubmissionResult: () => - DismissSubmissionResult->dispatch, - }), - ) - | Invalid({fieldsStatuses, collectionsStatuses}) => - Update({ - ...state, - fieldsStatuses, - collectionsStatuses, - formStatus: Editing, - submissionStatus: AttemptedToSubmit, - }) - } - }, - ); - } else { - Exp.case( - [%pat? Submit], - switch%expr (state.formStatus) { - | Submitting(_) => NoUpdate - | Editing - | Submitted - | SubmissionFailed(_) => - switch ( - switch%e (metadata) { - | None => - %expr - state.input - ->validateForm(~validators, ~fieldsStatuses=state.fieldsStatuses) - | Some () => - %expr - state.input - ->validateForm( - ~validators, - ~fieldsStatuses=state.fieldsStatuses, - ~metadata, - ) - } - ) { - | Valid({output, fieldsStatuses, collectionsStatuses}) => - UpdateWithSideEffects( - { - ...state, - fieldsStatuses, - collectionsStatuses, - formStatus: - Submitting( - switch (state.formStatus) { - | SubmissionFailed(error) => Some(error) - | Editing - | Submitted - | Submitting(_) => None - }, - ), - submissionStatus: AttemptedToSubmit, - }, - ({state: _, dispatch}) => - output->onSubmit({ - notifyOnSuccess: input => SetSubmittedStatus(input)->dispatch, - notifyOnFailure: error => - SetSubmissionFailedStatus(error)->dispatch, - reset: () => Reset->dispatch, - dismissSubmissionResult: () => - DismissSubmissionResult->dispatch, - }), - ) - | Invalid({fieldsStatuses, collectionsStatuses}) => - Update({ - ...state, - fieldsStatuses, - collectionsStatuses, - 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)]), -]; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions.ml b/ppx/lib/Form_UseFormFn_UpdateActions.ml new file mode 100644 index 00000000..ed4c3101 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_UpdateActions.ml @@ -0,0 +1,266 @@ +open Meta +open Ast +open AstHelpers +open Printer +open Ppxlib +open Ast_helper + +let ast ~loc ~(metadata : unit option) (scheme : Scheme.t) = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field field -> + Exp.case + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident (FieldPrinter.update_action ~field:field.name) |> lid ~loc) + (Some (Pat.tuple [ Pat.var ("nextInputFn" |> str ~loc) ]))) + (match field.deps with + | [] -> + let field_status_expr = + field.name |> E.field2 ~in_:("state", "fieldsStatuses") ~loc + in + let field_input_expr = field.name |> E.field ~in_:"nextInput" ~loc in + let validator_expr = field.name |> E.field ~in_:"validators" ~loc in + let set_status_expr = + field.name + |> E.update_field2 + ~in_:("state", "fieldsStatuses") + ~with_:[%expr status] + ~loc + in + [%expr + let nextInput = (nextInputFn state.input [@res.uapp]) in + [%e + match field.validator with + | SyncValidator validator -> + Form_UseFormFn_UpdateActions_SyncField.ast + ~loc + ~validator + ~metadata + ~field_status_expr + ~field_input_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { mode = OnBlur; optionality } -> + Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ast + ~loc + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { mode = OnChange; optionality } -> + Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ast + ~loc + ~field + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr]] + | dep :: deps -> + [%expr + let nextInput = (nextInputFn state.input [@res.uapp]) in + let nextFieldsStatuses = ref state.fieldsStatuses in + [%e + scheme + |> Form_UseFormFn_DependentFields.ast + ~loc + ~dep + ~deps + ~trigger:(`Field field.name) + ~metadata]; + [%e + let field_status_expr = + field.name |> E.ref_field ~in_:"nextFieldsStatuses" ~loc + in + let field_input_expr = field.name |> E.field ~in_:"nextInput" ~loc in + let validator_expr = field.name |> E.field ~in_:"validators" ~loc in + let set_status_expr = + field.name + |> E.update_ref_field + ~in_:"nextFieldsStatuses" + ~with_:[%expr status] + ~loc + in + match field.validator with + | SyncValidator validator -> + Form_UseFormFn_UpdateActions_SyncField.ast + ~loc + ~validator + ~metadata + ~field_status_expr + ~field_input_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { mode = OnBlur; optionality } -> + Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ast + ~loc + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { mode = OnChange; optionality } -> + Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ast + ~loc + ~field + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr]]) + :: acc + | Collection { collection; fields } -> + fields + |> List.fold_left + (fun acc (field : Scheme.field) -> + Exp.case + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident + (FieldOfCollectionPrinter.update_action + ~collection + ~field:field.name) + |> lid ~loc) + (Some + (Pat.tuple + [ Pat.var ("nextInputFn" |> str ~loc) + ; Pat.var ("index" |> str ~loc) + ]))) + (match field.deps with + | [] -> + let field_status_expr = + field.name + |> E.field_of_collection2 + ~in_:("state", "fieldsStatuses") + ~collection + ~loc + in + let field_input_expr = + field.name + |> E.field_of_collection ~in_:"nextInput" ~collection ~loc + in + let validator_expr = + field.name + |> E.field_of_collection_validator + ~validators:"validators" + ~collection + ~loc + in + let set_status_expr = + field.name + |> E.update_field_of_collection2 + ~in_:("state", "fieldsStatuses") + ~collection + ~with_:[%expr status] + ~loc + in + [%expr + let nextInput = (nextInputFn state.input [@res.uapp]) in + [%e + match field.validator with + | SyncValidator validator -> + Form_UseFormFn_UpdateActions_SyncFieldOfCollection.ast + ~loc + ~validator + ~metadata + ~field_status_expr + ~field_input_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { mode = OnBlur; optionality } -> + Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode + .ast + ~loc + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { mode = OnChange; optionality } -> + Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode + .ast + ~loc + ~field + ~collection + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr]] + | dep :: deps -> + [%expr + let nextInput = (nextInputFn state.input [@res.uapp]) in + let nextFieldsStatuses = ref state.fieldsStatuses in + [%e + scheme + |> Form_UseFormFn_DependentFields.ast + ~loc + ~dep + ~deps + ~trigger:(`FieldOfCollection (collection, field.name)) + ~metadata]; + [%e + let field_status_expr = + field.name + |> E.ref_field_of_collection + ~in_:"nextFieldsStatuses" + ~collection + ~loc + in + let field_input_expr = + field.name + |> E.field_of_collection ~in_:"nextInput" ~collection ~loc + in + let validator_expr = + field.name + |> E.field_of_collection_validator + ~validators:"validators" + ~collection + ~loc + in + let set_status_expr = + field.name + |> E.update_ref_field_of_collection + ~in_:"nextFieldsStatuses" + ~collection + ~with_:[%expr status] + ~loc + in + match field.validator with + | SyncValidator validator -> + Form_UseFormFn_UpdateActions_SyncFieldOfCollection.ast + ~loc + ~validator + ~metadata + ~field_status_expr + ~field_input_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { mode = OnBlur; optionality } -> + Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode + .ast + ~loc + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr + | AsyncValidator { mode = OnChange; optionality } -> + Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode + .ast + ~loc + ~field + ~collection + ~metadata + ~optionality + ~field_status_expr + ~validator_expr + ~set_status_expr]]) + :: acc) + acc) + [] +;; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions.re b/ppx/lib/Form_UseFormFn_UpdateActions.re deleted file mode 100644 index 837581b8..00000000 --- a/ppx/lib/Form_UseFormFn_UpdateActions.re +++ /dev/null @@ -1,336 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; -open Printer; - -open Ppxlib; -open Ast_helper; - -let ast = (~loc, ~metadata: option(unit), scheme: Scheme.t) => - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(field) => [ - Exp.case( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident(FieldPrinter.update_action(~field=field.name)) - |> lid(~loc), - Some(Pat.tuple([Pat.var("nextInputFn" |> str(~loc))])), - ), - switch (field.deps) { - | [] => - let field_status_expr = - field.name - |> E.field2(~in_=("state", "fieldsStatuses"), ~loc); - let field_input_expr = - field.name |> E.field(~in_="nextInput", ~loc); - let validator_expr = - field.name |> E.field(~in_="validators", ~loc); - let set_status_expr = - field.name - |> E.update_field2( - ~in_=("state", "fieldsStatuses"), - ~with_=[%expr status], - ~loc, - ); - - %expr - { - let nextInput = nextInputFn(state.input); - - switch%e (field.validator) { - | SyncValidator(validator) => - Form_UseFormFn_UpdateActions_SyncField.ast( - ~loc, - ~validator, - ~metadata, - ~field_status_expr, - ~field_input_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnBlur, optionality}) => - Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ast( - ~loc, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnChange, optionality}) => - Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ast( - ~loc, - ~field, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - }; - }; - - | [dep, ...deps] => - %expr - { - let nextInput = nextInputFn(state.input); - let nextFieldsStatuses = ref(state.fieldsStatuses); - - %e - { - scheme - |> Form_UseFormFn_DependentFields.ast( - ~loc, - ~dep, - ~deps, - ~trigger=`Field(field.name), - ~metadata, - ); - }; - - %e - { - let field_status_expr = - field.name - |> E.ref_field(~in_="nextFieldsStatuses", ~loc); - let field_input_expr = - field.name |> E.field(~in_="nextInput", ~loc); - let validator_expr = - field.name |> E.field(~in_="validators", ~loc); - let set_status_expr = - field.name - |> E.update_ref_field( - ~in_="nextFieldsStatuses", - ~with_=[%expr status], - ~loc, - ); - - switch (field.validator) { - | SyncValidator(validator) => - Form_UseFormFn_UpdateActions_SyncField.ast( - ~loc, - ~validator, - ~metadata, - ~field_status_expr, - ~field_input_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnBlur, optionality}) => - Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ast( - ~loc, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnChange, optionality}) => - Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ast( - ~loc, - ~field, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - }; - }; - } - }, - ), - ...acc, - ] - | Collection({collection, fields}) => - fields - |> List.fold_left( - (acc, field: Scheme.field) => - [ - Exp.case( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident( - FieldOfCollectionPrinter.update_action( - ~collection, - ~field=field.name, - ), - ) - |> lid(~loc), - Some( - Pat.tuple([ - Pat.var("nextInputFn" |> str(~loc)), - Pat.var("index" |> str(~loc)), - ]), - ), - ), - switch (field.deps) { - | [] => - let field_status_expr = - field.name - |> E.field_of_collection2( - ~in_=("state", "fieldsStatuses"), - ~collection, - ~loc, - ); - let field_input_expr = - field.name - |> E.field_of_collection( - ~in_="nextInput", - ~collection, - ~loc, - ); - let validator_expr = - field.name - |> E.field_of_collection_validator( - ~validators="validators", - ~collection, - ~loc, - ); - let set_status_expr = - field.name - |> E.update_field_of_collection2( - ~in_=("state", "fieldsStatuses"), - ~collection, - ~with_=[%expr status], - ~loc, - ); - - %expr - { - let nextInput = nextInputFn(state.input); - - switch%e (field.validator) { - | SyncValidator(validator) => - Form_UseFormFn_UpdateActions_SyncFieldOfCollection.ast( - ~loc, - ~validator, - ~metadata, - ~field_status_expr, - ~field_input_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnBlur, optionality}) => - Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode.ast( - ~loc, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnChange, optionality}) => - Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode.ast( - ~loc, - ~field, - ~collection, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - }; - }; - - | [dep, ...deps] => - %expr - { - let nextInput = nextInputFn(state.input); - let nextFieldsStatuses = ref(state.fieldsStatuses); - - %e - { - scheme - |> Form_UseFormFn_DependentFields.ast( - ~loc, - ~dep, - ~deps, - ~trigger= - `FieldOfCollection(( - collection, - field.name, - )), - ~metadata, - ); - }; - - %e - { - let field_status_expr = - field.name - |> E.ref_field_of_collection( - ~in_="nextFieldsStatuses", - ~collection, - ~loc, - ); - let field_input_expr = - field.name - |> E.field_of_collection( - ~in_="nextInput", - ~collection, - ~loc, - ); - let validator_expr = - field.name - |> E.field_of_collection_validator( - ~validators="validators", - ~collection, - ~loc, - ); - let set_status_expr = - field.name - |> E.update_ref_field_of_collection( - ~in_="nextFieldsStatuses", - ~collection, - ~with_=[%expr status], - ~loc, - ); - - switch (field.validator) { - | SyncValidator(validator) => - Form_UseFormFn_UpdateActions_SyncFieldOfCollection.ast( - ~loc, - ~validator, - ~metadata, - ~field_status_expr, - ~field_input_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnBlur, optionality}) => - Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode.ast( - ~loc, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnChange, optionality}) => - Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode.ast( - ~loc, - ~field, - ~collection, - ~metadata, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - }; - }; - } - }, - ), - ...acc, - ], - acc, - ) - }, - [], - ); diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ml b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ml new file mode 100644 index 00000000..1b1a7f51 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ml @@ -0,0 +1,128 @@ +open Meta +open Ppxlib + +let ast + ~loc + ~(metadata : unit option) + ~(optionality : FieldOptionality.t option) + ~(field_status_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = + [%e + match metadata, optionality with + | None, None -> + [%expr + Async.validateFieldOnChangeInOnBlurMode + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | None, Some OptionType -> + [%expr + Async.validateFieldOfOptionTypeOnChangeInOnBlurMode + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | None, Some StringType -> + [%expr + Async.validateFieldOfStringTypeOnChangeInOnBlurMode + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | None, Some OptionStringType -> + [%expr + Async.validateFieldOfOptionStringTypeOnChangeInOnBlurMode + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some (), None -> + [%expr + Async.validateFieldOnChangeInOnBlurModeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some (), Some OptionType -> + [%expr + Async.validateFieldOfOptionTypeOnChangeInOnBlurModeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some (), Some StringType -> + [%expr + Async.validateFieldOfStringTypeOnChangeInOnBlurModeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some (), Some OptionStringType -> + [%expr + Async.validateFieldOfOptionStringTypeOnChangeInOnBlurModeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]]] + }] +;; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.re b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.re deleted file mode 100644 index 5cf80b05..00000000 --- a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.re +++ /dev/null @@ -1,113 +0,0 @@ -open Meta; - -open Ppxlib; - -let ast = - ( - ~loc, - ~metadata: option(unit), - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => [%expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: - switch%e (metadata, optionality) { - | (None, None) => - %expr - { - Async.validateFieldOnChangeInOnBlurMode( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionType)) => - %expr - { - Async.validateFieldOfOptionTypeOnChangeInOnBlurMode( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(StringType)) => - %expr - { - Async.validateFieldOfStringTypeOnChangeInOnBlurMode( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionStringType)) => - %expr - { - Async.validateFieldOfOptionStringTypeOnChangeInOnBlurMode( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), None) => - %expr - { - Async.validateFieldOnChangeInOnBlurModeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionType)) => - %expr - { - Async.validateFieldOfOptionTypeOnChangeInOnBlurModeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(StringType)) => - %expr - { - Async.validateFieldOfStringTypeOnChangeInOnBlurModeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionStringType)) => - %expr - { - Async.validateFieldOfOptionStringTypeOnChangeInOnBlurModeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }, - }) -]; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ml b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ml new file mode 100644 index 00000000..9b67a352 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ml @@ -0,0 +1,126 @@ +open Meta +open AstHelpers +open Ppxlib + +let ast + ~loc + ~(field : Scheme.field) + ~(metadata : unit option) + ~(optionality : FieldOptionality.t option) + ~(field_status_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + let nextFieldsStatuses = + [%e + match metadata, optionality with + | None, None -> + [%expr + Async.validateFieldOnChangeInOnChangeMode + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some OptionType -> + [%expr + Async.validateFieldOfOptionTypeOnChangeInOnChangeMode + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some StringType -> + [%expr + Async.validateFieldOfStringTypeOnChangeInOnChangeMode + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some OptionStringType -> + [%expr + Async.validateFieldOfOptionStringTypeOnChangeInOnChangeMode + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), None -> + [%expr + Async.validateFieldOnChangeInOnChangeModeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some OptionType -> + [%expr + Async.validateFieldOfOptionTypeOnChangeInOnChangeModeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some StringType -> + [%expr + Async.validateFieldOfStringTypeOnChangeInOnChangeModeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some OptionStringType -> + [%expr + Async.validateFieldOfOptionStringTypeOnChangeInOnChangeModeWithMetadata + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + in + match [%e field.name |> E.field ~in_:"nextFieldsStatuses" ~loc] with + | Validating value -> + UpdateWithSideEffects + ( { state with input = nextInput; fieldsStatuses = nextFieldsStatuses } + , [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun { state = _; dispatch } -> + [%e + E.apply_field2 + ~in_:("validators", field.name) + ~fn:"validateAsync" + ~args: + [ ( Nolabel + , match metadata with + | None -> [%expr value, dispatch] + | Some () -> [%expr value, metadata, dispatch] ) + ] + ~loc]]] ) + | Pristine | Dirty (_, (Shown | Hidden)) -> + Update { state with input = nextInput; fieldsStatuses = nextFieldsStatuses }] +;; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.re b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.re deleted file mode 100644 index afe7eeb5..00000000 --- a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.re +++ /dev/null @@ -1,144 +0,0 @@ -open Meta; -open AstHelpers; - -open Ppxlib; - -let ast = - ( - ~loc, - ~field: Scheme.field, - ~metadata: option(unit), - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => { - %expr - { - let nextFieldsStatuses = - switch%e (metadata, optionality) { - | (None, None) => - %expr - { - Async.validateFieldOnChangeInOnChangeMode( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionType)) => - %expr - { - Async.validateFieldOfOptionTypeOnChangeInOnChangeMode( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(StringType)) => - %expr - { - Async.validateFieldOfStringTypeOnChangeInOnChangeMode( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionStringType)) => - %expr - { - Async.validateFieldOfOptionStringTypeOnChangeInOnChangeMode( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), None) => - %expr - { - Async.validateFieldOnChangeInOnChangeModeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionType)) => - %expr - { - Async.validateFieldOfOptionTypeOnChangeInOnChangeModeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(StringType)) => - %expr - { - Async.validateFieldOfStringTypeOnChangeInOnChangeModeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionStringType)) => - %expr - { - Async.validateFieldOfOptionStringTypeOnChangeInOnChangeModeWithMetadata( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }; - switch ([%e field.name |> E.field(~in_="nextFieldsStatuses", ~loc)]) { - | Validating(value) => - UpdateWithSideEffects( - {...state, input: nextInput, fieldsStatuses: nextFieldsStatuses}, - ({state: _, dispatch}) => { - %e - E.apply_field2( - ~in_=("validators", field.name), - ~fn="validateAsync", - ~args=[ - ( - Nolabel, - switch (metadata) { - | None => - %expr - (value, dispatch) - | Some () => - %expr - (value, metadata, dispatch) - }, - ), - ], - ~loc, - ) - }, - ) - | Pristine - | Dirty(_, Shown | Hidden) => - Update({...state, input: nextInput, fieldsStatuses: nextFieldsStatuses}) - }; - }; -}; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode.ml b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode.ml new file mode 100644 index 00000000..a90ad7d2 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode.ml @@ -0,0 +1,139 @@ +open Meta +open Ppxlib + +let ast + ~loc + ~(metadata : unit option) + ~(optionality : FieldOptionality.t option) + ~(field_status_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = + [%e + match metadata, optionality with + | None, None -> + [%expr + Async.validateFieldOfCollectionOnChangeInOnBlurMode + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | None, Some OptionType -> + [%expr + Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurMode + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | None, Some StringType -> + [%expr + Async.validateFieldOfCollectionOfStringTypeOnChangeInOnBlurMode + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | None, Some OptionStringType -> + [%expr + Async.validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurMode + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some (), None -> + [%expr + Async.validateFieldOfCollectionOnChangeInOnBlurModeWithMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some (), Some OptionType -> + [%expr + Async + .validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurModeWithMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some (), Some StringType -> + [%expr + Async + .validateFieldOfCollectionOfStringTypeOnChangeInOnBlurModeWithMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some (), Some OptionStringType -> + [%expr + Async + .validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurModeWithMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]]] + }] +;; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode.re b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode.re deleted file mode 100644 index 4ba1a5b2..00000000 --- a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnBlurMode.re +++ /dev/null @@ -1,121 +0,0 @@ -open Meta; - -open Ppxlib; - -let ast = - ( - ~loc, - ~metadata: option(unit), - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => [%expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: - switch%e (metadata, optionality) { - | (None, None) => - %expr - { - Async.validateFieldOfCollectionOnChangeInOnBlurMode( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurMode( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(StringType)) => - %expr - { - Async.validateFieldOfCollectionOfStringTypeOnChangeInOnBlurMode( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionStringType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurMode( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), None) => - %expr - { - Async.validateFieldOfCollectionOnChangeInOnBlurModeWithMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurModeWithMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(StringType)) => - %expr - { - Async.validateFieldOfCollectionOfStringTypeOnChangeInOnBlurModeWithMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionStringType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurModeWithMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }, - }) -]; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode.ml b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode.ml new file mode 100644 index 00000000..3a86f39f --- /dev/null +++ b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode.ml @@ -0,0 +1,138 @@ +open Meta +open AstHelpers +open Ppxlib + +let ast + ~loc + ~(field : Scheme.field) + ~(collection : Collection.t) + ~(metadata : unit option) + ~(optionality : FieldOptionality.t option) + ~(field_status_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + let nextFieldsStatuses = + [%e + match metadata, optionality with + | None, None -> + [%expr + Async.validateFieldOfCollectionOnChangeInOnChangeMode + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some OptionType -> + [%expr + Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeMode + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some StringType -> + [%expr + Async.validateFieldOfCollectionOfStringTypeOnChangeInOnChangeMode + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | None, Some OptionStringType -> + [%expr + Async.validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeMode + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), None -> + [%expr + Async.validateFieldOfCollectionOnChangeInOnChangeModeWithMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some OptionType -> + [%expr + Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeModeWithMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some StringType -> + [%expr + Async.validateFieldOfCollectionOfStringTypeOnChangeInOnChangeModeWithMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]] + | Some (), Some OptionStringType -> + [%expr + Async + .validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeModeWithMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e Uncurried.fn ~loc ~arity:1 [%expr fun status -> [%e set_status_expr]]] + [@res.uapp]]] + in + match + [%e field.name |> E.field_of_collection ~in_:"nextFieldsStatuses" ~collection ~loc] + with + | Validating value -> + UpdateWithSideEffects + ( { state with input = nextInput; fieldsStatuses = nextFieldsStatuses } + , [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun { state = _; dispatch } -> + [%e + E.apply_field4 + ~in_:("validators", collection.plural, "fields", field.name) + ~fn:"validateAsync" + ~args: + [ ( Nolabel + , match metadata with + | None -> [%expr value, index, dispatch] + | Some () -> [%expr value, index, metadata, dispatch] ) + ] + ~loc]]] ) + | Pristine | Dirty (_, (Shown | Hidden)) -> + Update { state with input = nextInput; fieldsStatuses = nextFieldsStatuses }] +;; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode.re b/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode.re deleted file mode 100644 index 12c9b4fd..00000000 --- a/ppx/lib/Form_UseFormFn_UpdateActions_AsyncFieldOfCollectionInOnChangeMode.re +++ /dev/null @@ -1,158 +0,0 @@ -open Meta; -open AstHelpers; - -open Ppxlib; - -let ast = - ( - ~loc, - ~field: Scheme.field, - ~collection: Collection.t, - ~metadata: option(unit), - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => { - %expr - { - let nextFieldsStatuses = - switch%e (metadata, optionality) { - | (None, None) => - %expr - { - Async.validateFieldOfCollectionOnChangeInOnChangeMode( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeMode( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(StringType)) => - %expr - { - Async.validateFieldOfCollectionOfStringTypeOnChangeInOnChangeMode( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (None, Some(OptionStringType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeMode( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), None) => - %expr - { - Async.validateFieldOfCollectionOnChangeInOnChangeModeWithMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeModeWithMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(StringType)) => - %expr - { - Async.validateFieldOfCollectionOfStringTypeOnChangeInOnChangeModeWithMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | (Some (), Some(OptionStringType)) => - %expr - { - Async.validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeModeWithMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }; - switch ( - [%e - field.name - |> E.field_of_collection(~in_="nextFieldsStatuses", ~collection, ~loc) - ] - ) { - | Validating(value) => - UpdateWithSideEffects( - {...state, input: nextInput, fieldsStatuses: nextFieldsStatuses}, - ({state: _, dispatch}) => { - %e - E.apply_field4( - ~in_=("validators", collection.plural, "fields", field.name), - ~fn="validateAsync", - ~args=[ - ( - Nolabel, - switch (metadata) { - | None => - %expr - (value, index, dispatch) - | Some () => - %expr - (value, index, metadata, dispatch) - }, - ), - ], - ~loc, - ) - }, - ) - | Pristine - | Dirty(_, Shown | Hidden) => - Update({...state, input: nextInput, fieldsStatuses: nextFieldsStatuses}) - }; - }; -}; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_SyncField.ml b/ppx/lib/Form_UseFormFn_UpdateActions_SyncField.ml new file mode 100644 index 00000000..c8a66185 --- /dev/null +++ b/ppx/lib/Form_UseFormFn_UpdateActions_SyncField.ml @@ -0,0 +1,60 @@ +open Meta +open Ppxlib + +let ast + ~loc + ~(validator : (FieldValidator.sync, unit) result) + ~(metadata : unit option) + ~(field_status_expr : expression) + ~(field_input_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = + [%e + match validator with + | Ok (Required | Optional (Some _)) | Error () -> + (match metadata with + | None -> + [%expr + validateFieldOnChangeWithValidator + ~input:nextInput + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some () -> + [%expr + validateFieldOnChangeWithValidatorAndMetadata + ~input:nextInput + ~metadata + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]]) + | Ok (Optional None) -> + [%expr + validateFieldOnChangeWithoutValidator + ~fieldInput:[%e field_input_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]]] + }] +;; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_SyncField.re b/ppx/lib/Form_UseFormFn_UpdateActions_SyncField.re deleted file mode 100644 index 12be095c..00000000 --- a/ppx/lib/Form_UseFormFn_UpdateActions_SyncField.re +++ /dev/null @@ -1,56 +0,0 @@ -open Meta; - -open Ppxlib; - -let ast = - ( - ~loc, - ~validator: result(FieldValidator.sync, unit), - ~metadata: option(unit), - ~field_status_expr: expression, - ~field_input_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => [%expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: - switch%e (validator) { - | Ok(Required | Optional(Some(_))) - | Error () => - switch (metadata) { - | None => - %expr - { - validateFieldOnChangeWithValidator( - ~input=nextInput, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some () => - %expr - { - validateFieldOnChangeWithValidatorAndMetadata( - ~input=nextInput, - ~metadata, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - } - - | Ok(Optional(None)) => - %expr - validateFieldOnChangeWithoutValidator( - ~fieldInput=[%e field_input_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - }, - }) -]; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_SyncFieldOfCollection.ml b/ppx/lib/Form_UseFormFn_UpdateActions_SyncFieldOfCollection.ml new file mode 100644 index 00000000..49ec5c6f --- /dev/null +++ b/ppx/lib/Form_UseFormFn_UpdateActions_SyncFieldOfCollection.ml @@ -0,0 +1,62 @@ +open Meta +open Ppxlib + +let ast + ~loc + ~(validator : (FieldValidator.sync, unit) result) + ~(metadata : unit option) + ~(field_status_expr : expression) + ~(field_input_expr : expression) + ~(validator_expr : expression) + ~(set_status_expr : expression) + = + [%expr + Update + { state with + input = nextInput + ; fieldsStatuses = + [%e + match validator with + | Ok (Required | Optional (Some _)) | Error () -> + (match metadata with + | None -> + [%expr + validateFieldOfCollectionOnChangeWithValidator + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]] + | Some () -> + [%expr + validateFieldOfCollectionOnChangeWithValidatorAndMetadata + ~input:nextInput + ~index + ~fieldStatus:[%e field_status_expr] + ~submissionStatus:state.submissionStatus + ~validator:[%e validator_expr] + ~metadata + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]]) + | Ok (Optional None) -> + [%expr + validateFieldOnChangeWithoutValidator + ~fieldInput:[%e field_input_expr] + ~setStatus: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr fun status -> [%e set_status_expr]]] [@res.uapp]]] + }] +;; diff --git a/ppx/lib/Form_UseFormFn_UpdateActions_SyncFieldOfCollection.re b/ppx/lib/Form_UseFormFn_UpdateActions_SyncFieldOfCollection.re deleted file mode 100644 index 537204ec..00000000 --- a/ppx/lib/Form_UseFormFn_UpdateActions_SyncFieldOfCollection.re +++ /dev/null @@ -1,58 +0,0 @@ -open Meta; - -open Ppxlib; - -let ast = - ( - ~loc, - ~validator: result(FieldValidator.sync, unit), - ~metadata: option(unit), - ~field_status_expr: expression, - ~field_input_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => [%expr - Update({ - ...state, - input: nextInput, - fieldsStatuses: - switch%e (validator) { - | Ok(Required | Optional(Some(_))) - | Error () => - switch (metadata) { - | None => - %expr - { - validateFieldOfCollectionOnChangeWithValidator( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some () => - %expr - { - validateFieldOfCollectionOnChangeWithValidatorAndMetadata( - ~input=nextInput, - ~index, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~metadata, - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - } - - | Ok(Optional(None)) => - %expr - validateFieldOnChangeWithoutValidator( - ~fieldInput=[%e field_input_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - }, - }) -]; diff --git a/ppx/lib/Form_ValidateFormFn.ml b/ppx/lib/Form_ValidateFormFn.ml new file mode 100644 index 00000000..3b456de1 --- /dev/null +++ b/ppx/lib/Form_ValidateFormFn.ml @@ -0,0 +1,1241 @@ +open Meta +open Ast +open AstHelpers +open Printer +open Ppxlib +open Ast_helper + +let field_result_var ~(field : string) = field ^ "Result" +let field_result_visibility_var ~(field : string) = field ^ "ResultVisibility" + +let fields_of_collection_result_var (collection : Collection.t) = + collection.plural ^ "CollectionFieldsResult" +;; + +let whole_collection_result_var (collection : Collection.t) = + collection.plural ^ "CollectionResult" +;; + +let collection_fields_statuses_var (collection : Collection.t) = + collection.plural ^ "CollectionFieldsStatuses" +;; + +let validate_field_without_validator ~(field : Scheme.field) ~loc = + [%expr Ok [%e field.name |> E.field ~in_:"input" ~loc], Hidden] +;; + +let validate_field_of_collection_without_validator + ~(collection : Collection.t) + ~(field : Scheme.field) + ~loc + = + [%expr + Ok + [%e + Exp.field + [%expr + Belt.Array.getUnsafe + [%e collection.plural |> E.field ~in_:"input" ~loc] + index [@res.uapp]] + (Lident field.name |> lid ~loc)] + , Hidden] +;; + +let validate_field_with_sync_validator + ~(field : Scheme.field) + ~(metadata : unit option) + ~loc + = + [%expr + (match [%e field.name |> E.field ~in_:"fieldsStatuses" ~loc] with + | Pristine -> + [%e + E.apply_field2 + ~in_:("validators", field.name) + ~fn:"validate" + ~args: + (match metadata with + | None -> [ Nolabel, [%expr input] ] + | Some () -> [ Nolabel, [%expr input]; Nolabel, [%expr metadata] ]) + ~loc] + | Dirty (result, _) -> result) + , Shown] +;; + +let validate_field_of_collection_with_sync_validator + ~(field : Scheme.field) + ~(collection : Collection.t) + ~(metadata : unit option) + ~loc + = + [%expr + (match [%e field.name |> E.field ~in_:"fieldStatus" ~loc] with + | Pristine -> + [%e + E.apply_field4 + ~in_:("validators", collection.plural, "fields", field.name) + ~fn:"validate" + ~args: + (match metadata with + | None -> [ Nolabel, [%expr input]; Labelled "at", [%expr index] ] + | Some () -> + [ Nolabel, [%expr input] + ; Labelled "at", [%expr index] + ; Labelled "metadata", [%expr metadata] + ]) + ~loc] + | Dirty (result, _) -> result) + , Shown] +;; + +let validate_field_with_async_validator + ~(field : Scheme.field) + ~(metadata : unit option) + ~loc + = + [%expr + (match [%e field.name |> E.field ~in_:"fieldsStatuses" ~loc] with + | Validating value -> `Validating value + | Pristine -> + `Result + [%e + E.apply_field2 + ~in_:("validators", field.name) + ~fn:"validate" + ~args: + (match metadata with + | None -> [ Nolabel, [%expr input] ] + | Some () -> [ Nolabel, [%expr input]; Nolabel, [%expr metadata] ]) + ~loc] + | Dirty (result, _) -> `Result result) + , Shown] +;; + +let validate_field_of_collection_with_async_validator + ~(field : Scheme.field) + ~(collection : Collection.t) + ~(metadata : unit option) + ~loc + = + [%expr + (match [%e field.name |> E.field ~in_:"fieldStatus" ~loc] with + | Validating value -> `Validating value + | Dirty (result, _) -> `Result result + | Pristine -> + `Result + [%e + E.apply_field4 + ~in_:("validators", collection.plural, "fields", field.name) + ~fn:"validate" + ~args: + (match metadata with + | None -> [ Nolabel, [%expr input]; Labelled "at", [%expr index] ] + | Some () -> + [ Nolabel, [%expr input] + ; Labelled "at", [%expr index] + ; Labelled "metadata", [%expr metadata] + ]) + ~loc]) + , Shown] +;; + +let validate_whole_collection ~(collection : Collection.t) ~(metadata : unit option) ~loc = + E.apply_field2 + ~in_:("validators", collection.plural) + ~fn:"collection" + ~args: + (match metadata with + | None -> [ Nolabel, [%expr input] ] + | Some () -> [ Nolabel, [%expr input]; Nolabel, [%expr metadata] ]) + ~loc +;; + +let ok_pat_for_sync_field ~loc (field : Scheme.field) = + Pat.tuple + [ Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Ok" |> lid ~loc) + (Some (Pat.tuple [ Pat.var (field.name |> str ~loc) ]))) + (field_result_var ~field:field.name |> str ~loc) + ; Pat.var (field_result_visibility_var ~field:field.name |> str ~loc) + ] +;; + +let ok_pat_for_async_field ~loc (field : Scheme.field) = + Pat.tuple + [ Pat.variant + "Result" + (Some + (Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Ok" |> lid ~loc) + (Some (Pat.tuple [ Pat.var (field.name |> str ~loc) ]))) + (field_result_var ~field:field.name |> str ~loc))) + ; Pat.var (field_result_visibility_var ~field:field.name |> str ~loc) + ] +;; + +let ok_pat_for_fields_of_async_collection ~loc (collection : Collection.t) = + Pat.variant + "FieldsOfCollectionResult" + (Some + (Pat.tuple + [ Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Ok" |> lid ~loc) + (Some (Pat.tuple [ Pat.var (collection.plural |> str ~loc) ])) + ; Pat.var (collection |> collection_fields_statuses_var |> str ~loc) + ])) +;; + +let ok_pat_for_collection ~loc (collection : Collection.t) = + Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Ok" |> lid ~loc) + (Some [%pat? ()])) + (collection |> whole_collection_result_var |> str ~loc) +;; + +let ok_pat_for_fields_of_collection ~loc (collection : Collection.t) = + Pat.tuple + [ Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Ok" |> lid ~loc) + (Some (Pat.tuple [ Pat.var (collection.plural |> str ~loc) ])) + ; Pat.var (collection |> collection_fields_statuses_var |> str ~loc) + ] +;; + +let result_pat_for_collection ~loc (collection : Collection.t) = + Pat.var (collection |> whole_collection_result_var |> str ~loc) +;; + +let error_pat_for_sync_field_in_single_field_form ~loc (field : Scheme.field) = + Pat.tuple + [ Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Error" |> lid ~loc) + (Some [%pat? _])) + (field_result_var ~field:field.name |> str ~loc) + ; Pat.var (field_result_visibility_var ~field:field.name |> str ~loc) + ] +;; + +let error_pat_for_async_field_in_single_field_form ~loc (field : Scheme.field) = + Pat.tuple + [ Pat.variant + "Result" + (Some + (Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Error" |> lid ~loc) + (Some [%pat? _])) + (field_result_var ~field:field.name |> str ~loc))) + ; Pat.var (field_result_visibility_var ~field:field.name |> str ~loc) + ] +;; + +let error_pat_for_sync_field_in_multi_field_form ~loc (field : Scheme.field) = + Pat.tuple + [ Pat.or_ + (Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Ok" |> lid ~loc) + (Some [%pat? _])) + (field_result_var ~field:field.name |> str ~loc)) + (Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Error" |> lid ~loc) + (Some [%pat? _])) + (field_result_var ~field:field.name |> str ~loc)) + ; Pat.var (field_result_visibility_var ~field:field.name |> str ~loc) + ] +;; + +let error_pat_for_async_field_in_multi_field_form ~loc (field : Scheme.field) = + Pat.tuple + [ Pat.variant + "Result" + (Some + (Pat.or_ + (Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Ok" |> lid ~loc) + (Some [%pat? _])) + (field_result_var ~field:field.name |> str ~loc)) + (Pat.alias + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Error" |> lid ~loc) + (Some [%pat? _])) + (field_result_var ~field:field.name |> str ~loc)))) + ; Pat.var (field_result_visibility_var ~field:field.name |> str ~loc) + ] +;; + +let error_pat_for_fields_of_collection_in_single_field_form_without_collection_validator + ~loc + (collection : Collection.t) + = + Pat.tuple + [ [%pat? Error _] + ; Pat.var (collection |> collection_fields_statuses_var |> str ~loc) + ] +;; + +let error_pat_for_fields_of_collection_in_multi_field_form_or_single_field_form_with_collection_validator + ~loc + (collection : Collection.t) + = + Pat.tuple + [ [%pat? Ok _ | Error _] + ; Pat.var (collection |> collection_fields_statuses_var |> str ~loc) + ] +;; + +let error_pat_for_fields_of_collection_in_single_field_async_form_without_collection_validator + ~loc + (collection : Collection.t) + = + Pat.variant + "FieldsOfCollectionResult" + (Some + (Pat.tuple + [ [%pat? Error _] + ; Pat.var (collection |> collection_fields_statuses_var |> str ~loc) + ])) +;; + +let error_pat_for_fields_statuses_of_async_collection ~loc (collection : Collection.t) = + Pat.variant + "FieldsOfCollectionResult" + (Some + (Pat.tuple + [ [%pat? Ok _ | Error _] + ; Pat.var (collection |> collection_fields_statuses_var |> str ~loc) + ])) +;; + +let result_and_visibility_pat_for_field ~loc (field : Scheme.field) = + Pat.tuple + [ Pat.var (field_result_var ~field:field.name |> str ~loc) + ; Pat.var (field_result_visibility_var ~field:field.name |> str ~loc) + ] +;; + +let result_and_visibility_pat_for_async_field ~loc (field : Scheme.field) = + Pat.tuple + [ Pat.variant + "Result" + (Some (Pat.var (field_result_var ~field:field.name |> str ~loc))) + ; Pat.var (field_result_visibility_var ~field:field.name |> str ~loc) + ] +;; + +let result_pat_for_fields_of_collection ~loc (collection : Collection.t) = + Pat.var (collection |> fields_of_collection_result_var |> str ~loc) +;; + +let output_field_record_field ~loc (field : Scheme.field) = + Lident field.name |> lid ~loc, Exp.ident (Lident field.name |> lid ~loc) +;; + +let output_collection_record_field ~loc (collection : Collection.t) = + Lident collection.plural |> lid ~loc, Exp.ident (Lident collection.plural |> lid ~loc) +;; + +let field_dirty_status_record_field ~loc (field : Scheme.field) = + ( Lident field.name |> lid ~loc + , [%expr + Dirty + ( [%e Exp.ident (Lident (field_result_var ~field:field.name) |> lid ~loc)] + , [%e + Exp.ident (Lident (field_result_visibility_var ~field:field.name) |> lid ~loc)] + )] ) +;; + +let async_field_dirty_or_validating_status_record_field ~loc (field : Scheme.field) = + ( Lident field.name |> lid ~loc + , [%expr + match [%e Exp.ident (Lident (field_result_var ~field:field.name) |> lid ~loc)] with + | `Validating value -> Validating value + | `Result result -> + Dirty + ( result + , [%e + Exp.ident + (Lident (field_result_visibility_var ~field:field.name) |> lid ~loc)] )] ) +;; + +let collection_that_might_be_in_validating_state_status_record_field + ~loc + (collection : Collection.t) + = + ( Lident collection.plural |> lid ~loc + , [%expr + match + [%e + Exp.ident (Lident (collection |> fields_of_collection_result_var) |> lid ~loc)] + with + | `ValidatingFieldsOfCollection statuses -> statuses + | `FieldsOfCollectionResult (_, statuses) -> statuses] ) +;; + +let collection_statuses_record_field ~loc (collection : Collection.t) = + ( Lident collection.plural |> lid ~loc + , Exp.ident (Lident (collection |> collection_fields_statuses_var) |> lid ~loc) ) +;; + +let collections_statuses_record ~loc (collections : Scheme.collection list) = + Exp.record + (collections + |> List.rev + |> List.rev_map (fun ({ collection; validator } : Scheme.collection) -> + ( Lident collection.plural |> lid ~loc + , match validator with + | Ok (Some ()) | Error () -> + [%expr + Some + [%e + Exp.ident (Lident (collection |> whole_collection_result_var) |> lid ~loc)]] + | Ok None -> [%expr ()] ))) + None +;; + +let validate_fields_of_collection_in_sync_form + ~(collection : Collection.t) + ~(fields : Scheme.field list) + ~(output_type : ItemType.t) + ~(metadata : unit option) + ~(loc : Location.t) + = + let match_values = + Exp.tuple + ([%expr output] + :: (fields + |> List.rev + |> List.rev_map (fun (field : Scheme.field) -> + match field.validator with + | SyncValidator (Ok (Required | Optional (Some _)) | Error ()) -> + validate_field_of_collection_with_sync_validator + ~collection + ~field + ~metadata + ~loc + | SyncValidator (Ok (Optional None)) -> + validate_field_of_collection_without_validator ~collection ~field ~loc + | AsyncValidator _ -> + failwith + "Form that supposed to be without async validators has one. Please, \ + file an issue with your use-case."))) + in + let ok_case = + Exp.case + (Pat.tuple + (Pat.construct + ~attrs:[ explicit_arity ~loc ] + (Lident "Ok" |> lid ~loc) + (Some (Pat.tuple [ Pat.var ("output" |> str ~loc) ])) + :: (fields |> List.rev |> List.rev_map (ok_pat_for_sync_field ~loc)))) + [%expr + ignore + (Js.Array2.push + output + [%e + Exp.record + (fields |> List.rev |> List.rev_map (output_field_record_field ~loc)) + None] [@res.uapp]) [@res.uapp]; + ignore + (Js.Array2.push + statuses + [%e + Exp.record + (fields + |> List.rev + |> List.rev_map (field_dirty_status_record_field ~loc)) + None] [@res.uapp]) [@res.uapp]; + Ok output, statuses] + in + let error_case = + Exp.case + (Pat.tuple + ([%pat? Ok _ | Error _] + :: (fields + |> List.rev + |> List.rev_map (result_and_visibility_pat_for_field ~loc)))) + [%expr + ignore + (Js.Array2.push + statuses + [%e + Exp.record + (fields + |> List.rev + |> List.rev_map (field_dirty_status_record_field ~loc)) + None] [@res.uapp]) [@res.uapp]; + Error (), statuses] + in + [%expr + Belt.Array.reduceWithIndex + [%e collection.plural |> E.field ~in_:"fieldsStatuses" ~loc] + (Ok [||], [||]) + [%e + Uncurried.fn + ~loc + ~arity:3 + [%expr + fun ( (output : ([%t output_type |> ItemType.unpack] array, unit) result) + , (statuses : + [%t + Typ.constr + (Lident (collection |> CollectionPrinter.fields_statuses_type) + |> lid ~loc) + []] + array) ) + fieldStatus + index -> + [%e + Exp.match_ + ~attrs:[ warning_4_disable ~loc ] + match_values + [ ok_case; error_case ]]]] [@res.uapp]] +;; + +let validate_fields_of_collection_in_async_form + ~(collection : Collection.t) + ~(fields : Scheme.field list) + ~(output_type : ItemType.t) + ~(metadata : unit option) + ~(loc : Location.t) + = + let fields_statuses_type = + Typ.constr + (Lident (collection |> CollectionPrinter.fields_statuses_type) |> lid ~loc) + [] + in + let match_values = + Exp.tuple + ([%expr result] + :: (fields + |> List.rev + |> List.rev_map (fun (field : Scheme.field) -> + match field.validator with + | SyncValidator (Ok (Required | Optional (Some _)) | Error ()) -> + validate_field_of_collection_with_sync_validator + ~collection + ~field + ~metadata + ~loc + | SyncValidator (Ok (Optional None)) -> + validate_field_of_collection_without_validator ~collection ~field ~loc + | AsyncValidator _ -> + validate_field_of_collection_with_async_validator + ~collection + ~field + ~metadata + ~loc))) + in + let validating_case = + Exp.case + (P.or_ + ~pat: + (Pat.tuple + ([%pat? `ValidatingFieldsOfCollection statuses] + :: (fields + |> List.rev + |> List.rev_map (result_and_visibility_pat_for_field ~loc)))) + ~make:(fun (field : Scheme.field) -> + Pat.tuple + ([%pat? `FieldsOfCollectionResult ((Ok _ | Error _), statuses)] + :: (fields + |> List.rev + |> List.rev_map (fun (field' : Scheme.field) -> + if field'.name = field.name + then + Pat.tuple + [ Pat.alias + (Pat.variant "Validating" (Some (Pat.any ()))) + (field_result_var ~field:field.name |> str ~loc) + ; Pat.var + (field_result_visibility_var ~field:field.name |> str ~loc) + ] + else field' |> result_and_visibility_pat_for_field ~loc)))) + (fields + |> List.filter (fun (field : Scheme.field) -> + match field.validator with + | SyncValidator _ -> false + | AsyncValidator _ -> true))) + [%expr + ignore + (Js.Array2.push + statuses + [%e + Exp.record + (fields + |> List.rev + |> List.rev_map (fun (field : Scheme.field) -> + match field.validator with + | SyncValidator _ -> field |> field_dirty_status_record_field ~loc + | AsyncValidator _ -> + field |> async_field_dirty_or_validating_status_record_field ~loc)) + None] [@res.uapp]) [@res.uapp]; + `ValidatingFieldsOfCollection statuses] + in + let ok_case = + Exp.case + (Pat.tuple + ([%pat? `FieldsOfCollectionResult (Ok output, statuses)] + :: (fields + |> List.rev + |> List.rev_map (fun (field : Scheme.field) -> + match field.validator with + | SyncValidator _ -> field |> ok_pat_for_sync_field ~loc + | AsyncValidator _ -> field |> ok_pat_for_async_field ~loc)))) + [%expr + ignore + (Js.Array2.push + output + [%e + Exp.record + (fields |> List.rev |> List.rev_map (output_field_record_field ~loc)) + None] [@res.uapp]) [@res.uapp]; + ignore + (Js.Array2.push + statuses + [%e + Exp.record + (fields + |> List.rev + |> List.rev_map (field_dirty_status_record_field ~loc)) + None] [@res.uapp]) [@res.uapp]; + `FieldsOfCollectionResult (Ok output, statuses)] + in + let error_case = + Exp.case + (Pat.tuple + ([%pat? `FieldsOfCollectionResult ((Ok _ | Error _), statuses)] + :: (fields + |> List.rev + |> List.rev_map (result_and_visibility_pat_for_field ~loc)))) + [%expr + ignore + (Js.Array2.push + statuses + [%e + Exp.record + (fields + |> List.rev + |> List.rev_map (fun (field : Scheme.field) -> + match field.validator with + | SyncValidator _ -> field |> field_dirty_status_record_field ~loc + | AsyncValidator _ -> + field |> async_field_dirty_or_validating_status_record_field ~loc)) + None] [@res.uapp]) [@res.uapp]; + `FieldsOfCollectionResult (Error (), statuses)] + in + [%expr + Belt.Array.reduceWithIndex + [%e collection.plural |> E.field ~in_:"fieldsStatuses" ~loc] + (`FieldsOfCollectionResult (Ok [||], [||])) + [%e + Uncurried.fn + ~loc + ~arity:3 + [%expr + fun (result : + [ `ValidatingFieldsOfCollection of [%t fields_statuses_type] array + | `FieldsOfCollectionResult of + ([%t output_type |> ItemType.unpack] array, unit) result + * [%t fields_statuses_type] array + ]) + fieldStatus + index -> + [%e + Exp.match_ + ~attrs:[ warning_4_disable ~loc ] + match_values + [ validating_case; ok_case; error_case ]]]] [@res.uapp]] +;; + +module Sync = struct + let ast ~(scheme : Scheme.t) ~(metadata : unit option) ~loc = + let anything_validatable = + scheme + |> List.exists (fun (entry : Scheme.entry) -> + match entry with + | Field + { validator = SyncValidator (Ok (Required | Optional (Some ())) | Error ()) } + -> true + | Field { validator = SyncValidator (Ok (Optional None)) } -> false + | Field { validator = AsyncValidator _ } -> true + | Collection { validator = Ok (Some ()) | Error () } -> true + | Collection { validator = Ok None; fields } -> + fields + |> List.exists (fun (field : Scheme.field) -> + match field.validator with + | SyncValidator (Ok (Required | Optional (Some ())) | Error ()) -> true + | SyncValidator (Ok (Optional None)) -> false + | AsyncValidator _ -> true)) + in + let body = + [%expr + [%e + let collections = scheme |> Scheme.collections in + let match_values = + let value (entry : Scheme.entry) = + match entry with + | Field + ({ validator = + SyncValidator (Ok (Required | Optional (Some _)) | Error ()) + } as field) -> validate_field_with_sync_validator ~field ~metadata ~loc + | Field ({ validator = SyncValidator (Ok (Optional None)) } as field) -> + validate_field_without_validator ~field ~loc + | Field { name = _; validator = AsyncValidator _ } -> + failwith + "Form that supposed to be without async validators has one. Please, \ + file an issue with your use-case." + | Collection { collection; fields; validator; output_type } -> + (match validator with + | Ok (Some ()) | Error () -> + [%expr + [%e validate_whole_collection ~collection ~metadata ~loc] + , [%e + validate_fields_of_collection_in_sync_form + ~collection + ~fields + ~output_type + ~metadata + ~loc]] + | Ok None -> + validate_fields_of_collection_in_sync_form + ~collection + ~fields + ~output_type + ~metadata + ~loc) + in + match scheme with + | x :: [] -> x |> value + | _ -> scheme |> List.rev |> List.rev_map value |> Exp.tuple + in + let ok_case = + let pat = + let entry (entry : Scheme.entry) = + match entry with + | Field field -> field |> ok_pat_for_sync_field ~loc + | Collection { collection; validator } -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> ok_pat_for_collection ~loc] + , [%p collection |> ok_pat_for_fields_of_collection ~loc] )] + | Ok None -> collection |> ok_pat_for_fields_of_collection ~loc) + in + match scheme with + | x :: [] -> x |> entry + | _ -> scheme |> List.rev |> List.rev_map entry |> Pat.tuple + in + let expr = + let output = + Exp.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> field |> output_field_record_field ~loc + | Collection { collection } -> + collection |> output_collection_record_field ~loc)) + None + in + let fields_statuses = + Exp.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> field |> field_dirty_status_record_field ~loc + | Collection { collection } -> + collection |> collection_statuses_record_field ~loc)) + None + in + match collections with + | [] -> + [%expr + Valid + { output = [%e output] + ; fieldsStatuses = [%e fields_statuses] + ; collectionsStatuses = () + }] + | collections -> + [%expr + Valid + { output = [%e output] + ; fieldsStatuses = [%e fields_statuses] + ; collectionsStatuses = + [%e collections |> collections_statuses_record ~loc] + }] + in + Exp.case pat expr + in + let error_case = + let pat = + let entry_of_one (entry : Scheme.entry) = + match entry with + | Field field -> + field |> error_pat_for_sync_field_in_single_field_form ~loc + | Collection { collection; validator } -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> result_pat_for_collection ~loc] + , [%p + collection + |> error_pat_for_fields_of_collection_in_multi_field_form_or_single_field_form_with_collection_validator + ~loc] )] + | Ok None -> + collection + |> error_pat_for_fields_of_collection_in_single_field_form_without_collection_validator + ~loc) + in + let entry_of_many (entry : Scheme.entry) = + match entry with + | Field field -> + field |> error_pat_for_sync_field_in_multi_field_form ~loc + | Collection { collection; validator } -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> result_pat_for_collection ~loc] + , [%p + collection + |> error_pat_for_fields_of_collection_in_multi_field_form_or_single_field_form_with_collection_validator + ~loc] )] + | Ok None -> + collection + |> error_pat_for_fields_of_collection_in_multi_field_form_or_single_field_form_with_collection_validator + ~loc) + in + match scheme with + | x :: [] -> x |> entry_of_one + | _ -> scheme |> List.rev |> List.rev_map entry_of_many |> Pat.tuple + in + let expr = + let fields_statuses = + Exp.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> field |> field_dirty_status_record_field ~loc + | Collection { collection } -> + collection |> collection_statuses_record_field ~loc)) + None + in + match collections with + | [] -> + [%expr + Invalid + { fieldsStatuses = [%e fields_statuses]; collectionsStatuses = () }] + | _ -> + [%expr + Invalid + { fieldsStatuses = [%e fields_statuses] + ; collectionsStatuses = + [%e collections |> collections_statuses_record ~loc] + }] + in + Exp.case pat expr + in + Exp.match_ + ~attrs:[ warning_4_disable ~loc ] + match_values + [ ok_case; error_case ]]] + in + let return_type = + [%type: (output, fieldsStatuses, collectionsStatuses) formValidationResult] + in + [%stri + let validateForm = + [%e + Uncurried.fn + ~loc + ~arity: + (match metadata with + | None -> 3 + | Some () -> 4) + (Exp.fun_ + Nolabel + None + (Pat.constraint_ [%pat? input] [%type: input]) + (Exp.fun_ + (Labelled "validators") + None + (Pat.constraint_ + (match anything_validatable with + | true -> [%pat? validators] + | false -> [%pat? _]) + [%type: validators]) + (Exp.fun_ + (Labelled "fieldsStatuses") + None + (Pat.constraint_ + (match anything_validatable with + | true -> [%pat? fieldsStatuses] + | false -> [%pat? _]) + [%type: fieldsStatuses]) + (match metadata with + | None -> return_type |> Exp.constraint_ body + | Some () -> + Exp.fun_ + (Labelled "metadata") + None + (Pat.constraint_ + (match anything_validatable with + | true -> [%pat? metadata] + | false -> [%pat? _]) + [%type: metadata]) + (return_type |> Exp.constraint_ body)))))] + ;;] + ;; +end + +module Async = struct + type validating_entry = + [ `AsyncField of Scheme.field + | `Collection of Collection.t + ] + + let ast ~(scheme : Scheme.t) ~(metadata : unit option) ~loc = + let body = + [%expr + [%e + let collections = scheme |> Scheme.collections in + let match_values = + let value (entry : Scheme.entry) = + match entry with + | Field + ({ validator = + SyncValidator (Ok (Required | Optional (Some _)) | Error ()) + } as field) -> validate_field_with_sync_validator ~field ~metadata ~loc + | Field ({ validator = SyncValidator (Ok (Optional None)) } as field) -> + validate_field_without_validator ~field ~loc + | Field ({ validator = AsyncValidator _ } as field) -> + validate_field_with_async_validator ~field ~metadata ~loc + | Collection { collection; fields; validator; output_type } -> + (match validator with + | Ok (Some ()) | Error () -> + [%expr + [%e validate_whole_collection ~collection ~metadata ~loc] + , [%e + validate_fields_of_collection_in_async_form + ~collection + ~fields + ~output_type + ~metadata + ~loc]] + | Ok None -> + validate_fields_of_collection_in_async_form + ~collection + ~fields + ~output_type + ~metadata + ~loc) + in + match scheme with + | x :: [] -> x |> value + | _ -> scheme |> List.rev |> List.rev_map value |> Exp.tuple + in + let validating_case = + let pat = + let entries_might_be_in_validating_state = + (scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field { validator = SyncValidator _ } -> acc + | Field ({ validator = AsyncValidator _ } as field) -> + `AsyncField field :: acc + | Collection { collection } -> `Collection collection :: acc) + [] + : validating_entry list) + in + let make (entry : validating_entry) = + match entry with + | `AsyncField current_field -> + let entry (entry : Scheme.entry) = + match entry with + | Field ({ validator = AsyncValidator _ } as field) + when field.name = current_field.name -> + Pat.tuple + [ Pat.alias + (Pat.variant "Validating" (Some (Pat.any ()))) + (field_result_var ~field:field.name |> str ~loc) + ; Pat.var + (field_result_visibility_var ~field:field.name |> str ~loc) + ] + | Field ({ validator = SyncValidator _ | AsyncValidator _ } as field) + -> field |> result_and_visibility_pat_for_field ~loc + | Collection { collection; validator } -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> result_pat_for_collection ~loc] + , [%p collection |> result_pat_for_fields_of_collection ~loc] )] + | Ok None -> collection |> result_pat_for_fields_of_collection ~loc) + in + (match scheme with + | x :: [] -> x |> entry + | _ -> scheme |> List.rev |> List.rev_map entry |> Pat.tuple) + | `Collection current_collection -> + let entry (entry : Scheme.entry) = + match entry with + | Field field -> field |> result_and_visibility_pat_for_field ~loc + | Collection { collection; validator } + when collection.plural = current_collection.plural -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> result_pat_for_collection ~loc] + , [%p + Pat.alias + (Pat.variant + "ValidatingFieldsOfCollection" + (Some (Pat.any ()))) + (collection + |> fields_of_collection_result_var + |> str ~loc)] )] + | Ok None -> + Pat.alias + (Pat.variant + "ValidatingFieldsOfCollection" + (Some (Pat.any ()))) + (collection |> fields_of_collection_result_var |> str ~loc)) + | Collection { collection; validator } -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> result_pat_for_collection ~loc] + , [%p collection |> result_pat_for_fields_of_collection ~loc] )] + | Ok None -> collection |> result_pat_for_fields_of_collection ~loc) + in + (match scheme with + | x :: [] -> x |> entry + | _ -> scheme |> List.rev |> List.rev_map entry |> Pat.tuple) + in + match entries_might_be_in_validating_state with + | [] -> + failwith + "No entries found that might be in validating state. Please, file an \ + issue with your use-case." + | x :: [] -> x |> make + | x :: rest -> P.or_ ~pat:(x |> make) ~make rest + in + let expr = + let fields_statuses = + Exp.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field ({ validator = SyncValidator _ } as field) -> + field |> field_dirty_status_record_field ~loc + | Field ({ validator = AsyncValidator _ } as field) -> + field |> async_field_dirty_or_validating_status_record_field ~loc + | Collection { collection } -> + collection + |> collection_that_might_be_in_validating_state_status_record_field + ~loc)) + None + in + match collections with + | [] -> + [%expr + Validating + { fieldsStatuses = [%e fields_statuses]; collectionsStatuses = () }] + | collections -> + [%expr + Validating + { fieldsStatuses = [%e fields_statuses] + ; collectionsStatuses = + [%e collections |> collections_statuses_record ~loc] + }] + in + Exp.case pat expr + in + let ok_case = + let pat = + let entry (entry : Scheme.entry) = + match entry with + | Field ({ validator = SyncValidator _ } as field) -> + field |> ok_pat_for_sync_field ~loc + | Field ({ validator = AsyncValidator _ } as field) -> + field |> ok_pat_for_async_field ~loc + | Collection { collection; validator } -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> ok_pat_for_collection ~loc] + , [%p collection |> ok_pat_for_fields_of_async_collection ~loc] )] + | Ok None -> collection |> ok_pat_for_fields_of_async_collection ~loc) + in + match scheme with + | x :: [] -> x |> entry + | _ -> scheme |> List.rev |> List.rev_map entry |> Pat.tuple + in + let expr = + let output = + Exp.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> field |> output_field_record_field ~loc + | Collection { collection } -> + collection |> output_collection_record_field ~loc)) + None + in + let fields_statuses = + Exp.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> field |> field_dirty_status_record_field ~loc + | Collection { collection } -> + collection |> collection_statuses_record_field ~loc)) + None + in + match collections with + | [] -> + [%expr + Valid + { output = [%e output] + ; fieldsStatuses = [%e fields_statuses] + ; collectionsStatuses = () + }] + | collections -> + [%expr + Valid + { output = [%e output] + ; fieldsStatuses = [%e fields_statuses] + ; collectionsStatuses = + [%e collections |> collections_statuses_record ~loc] + }] + in + Exp.case pat expr + in + let error_case = + let pat = + let entry_of_one (entry : Scheme.entry) = + match entry with + | Field field -> + field |> error_pat_for_async_field_in_single_field_form ~loc + | Collection { collection; validator } -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> result_pat_for_collection ~loc] + , [%p + collection + |> error_pat_for_fields_statuses_of_async_collection ~loc] )] + | Ok None -> + collection + |> error_pat_for_fields_of_collection_in_single_field_async_form_without_collection_validator + ~loc) + in + let entry_of_many (entry : Scheme.entry) = + match entry with + | Field ({ validator = SyncValidator _ } as field) -> + field |> result_and_visibility_pat_for_field ~loc + | Field ({ validator = AsyncValidator _ } as field) -> + field |> error_pat_for_async_field_in_multi_field_form ~loc + | Collection { collection; validator } -> + (match validator with + | Ok (Some ()) | Error () -> + [%pat? + ( [%p collection |> result_pat_for_collection ~loc] + , [%p + collection + |> error_pat_for_fields_statuses_of_async_collection ~loc] )] + | Ok None -> + collection |> error_pat_for_fields_statuses_of_async_collection ~loc) + in + match scheme with + | x :: [] -> x |> entry_of_one + | _ -> scheme |> List.rev |> List.rev_map entry_of_many |> Pat.tuple + in + let expr = + let fields_statuses = + Exp.record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> field |> field_dirty_status_record_field ~loc + | Collection { collection } -> + collection |> collection_statuses_record_field ~loc)) + None + in + match collections with + | [] -> + [%expr + Invalid + { fieldsStatuses = [%e fields_statuses]; collectionsStatuses = () }] + | collections -> + [%expr + Invalid + { fieldsStatuses = [%e fields_statuses] + ; collectionsStatuses = + [%e collections |> collections_statuses_record ~loc] + }] + in + Exp.case pat expr + in + Exp.match_ + ~attrs:[ warning_4_disable ~loc ] + match_values + [ validating_case; ok_case; error_case ]]] + in + let return_type = + [%type: (output, fieldsStatuses, collectionsStatuses) Async.formValidationResult] + in + [%stri + let validateForm = + [%e + Uncurried.fn + ~loc + ~arity: + (match metadata with + | None -> 3 + | Some () -> 4) + (Exp.fun_ + Nolabel + None + (Pat.constraint_ [%pat? input] [%type: input]) + (Exp.fun_ + (Labelled "validators") + None + (Pat.constraint_ [%pat? validators] [%type: validators]) + (Exp.fun_ + (Labelled "fieldsStatuses") + None + (Pat.constraint_ [%pat? fieldsStatuses] [%type: fieldsStatuses]) + (match metadata with + | None -> return_type |> Exp.constraint_ body + | Some () -> + Exp.fun_ + (Labelled "metadata") + None + (Pat.constraint_ [%pat? metadata] [%type: metadata]) + (return_type |> Exp.constraint_ body)))))] + ;;] + ;; +end diff --git a/ppx/lib/Form_ValidateFormFn.re b/ppx/lib/Form_ValidateFormFn.re deleted file mode 100644 index 42955171..00000000 --- a/ppx/lib/Form_ValidateFormFn.re +++ /dev/null @@ -1,1645 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; -open Printer; - -open Ppxlib; -open Ast_helper; - -let field_result_var = (~field: string) => field ++ "Result"; -let field_result_visibility_var = (~field: string) => - field ++ "ResultVisibility"; -let fields_of_collection_result_var = (collection: Collection.t) => - collection.plural ++ "CollectionFieldsResult"; -let whole_collection_result_var = (collection: Collection.t) => - collection.plural ++ "CollectionResult"; -let collection_fields_statuses_var = (collection: Collection.t) => - collection.plural ++ "CollectionFieldsStatuses"; - -let validate_field_without_validator = (~field: Scheme.field, ~loc) => [%expr - (Ok([%e field.name |> E.field(~in_="input", ~loc)]), Hidden) -]; - -let validate_field_of_collection_without_validator = - (~collection: Collection.t, ~field: Scheme.field, ~loc) => [%expr - ( - Ok( - [%e - Exp.field( - [%expr - Belt.Array.getUnsafe( - [%e collection.plural |> E.field(~in_="input", ~loc)], - index, - ) - ], - Lident(field.name) |> lid(~loc), - ) - ], - ), - Hidden, - ) -]; - -let validate_field_with_sync_validator = - (~field: Scheme.field, ~metadata: option(unit), ~loc) => [%expr - ( - switch ([%e field.name |> E.field(~in_="fieldsStatuses", ~loc)]) { - | Pristine => - %e - E.apply_field2( - ~in_=("validators", field.name), - ~fn="validate", - ~args= - switch (metadata) { - | None => [(Nolabel, [%expr input])] - | Some () => [ - (Nolabel, [%expr input]), - (Nolabel, [%expr metadata]), - ] - }, - ~loc, - ) - | Dirty(result, _) => result - }, - Shown, - ) -]; - -let validate_field_of_collection_with_sync_validator = - ( - ~field: Scheme.field, - ~collection: Collection.t, - ~metadata: option(unit), - ~loc, - ) => [%expr - ( - switch ([%e field.name |> E.field(~in_="fieldStatus", ~loc)]) { - | Pristine => - %e - E.apply_field4( - ~in_=("validators", collection.plural, "fields", field.name), - ~fn="validate", - ~args= - switch (metadata) { - | None => [ - (Nolabel, [%expr input]), - (Labelled("at"), [%expr index]), - ] - | Some () => [ - (Nolabel, [%expr input]), - (Labelled("at"), [%expr index]), - (Labelled("metadata"), [%expr metadata]), - ] - }, - ~loc, - ) - | Dirty(result, _) => result - }, - Shown, - ) -]; - -let validate_field_with_async_validator = - (~field: Scheme.field, ~metadata: option(unit), ~loc) => [%expr - ( - switch ([%e field.name |> E.field(~in_="fieldsStatuses", ~loc)]) { - | Validating(value) => `Validating(value) - | Pristine => - // If field is not touched, it either "empty" or has initial input - // If async field optional, then empty state is valid - // If it has initial value, in general it's from a server, hence valid - // If it's not from server and sync validator returned OK() but value is invalid, - // it should be rejected by the server on submit anyway - // So it doesn't worth to do 2+ requests on submission - `Result( - [%e - E.apply_field2( - ~in_=("validators", field.name), - ~fn="validate", - ~args= - switch (metadata) { - | None => [(Nolabel, [%expr input])] - | Some () => [ - (Nolabel, [%expr input]), - (Nolabel, [%expr metadata]), - ] - }, - ~loc, - ) - ], - ) - | Dirty(result, _) => - // This field was updated by user so all its validators already run - `Result(result) - }, - Shown, - ) -]; - -let validate_field_of_collection_with_async_validator = - ( - ~field: Scheme.field, - ~collection: Collection.t, - ~metadata: option(unit), - ~loc, - ) => [%expr - ( - switch ([%e field.name |> E.field(~in_="fieldStatus", ~loc)]) { - | Validating(value) => `Validating(value) - | Dirty(result, _) => `Result(result) - | Pristine => - `Result( - [%e - E.apply_field4( - ~in_=("validators", collection.plural, "fields", field.name), - ~fn="validate", - ~args= - switch (metadata) { - | None => [ - (Nolabel, [%expr input]), - (Labelled("at"), [%expr index]), - ] - | Some () => [ - (Nolabel, [%expr input]), - (Labelled("at"), [%expr index]), - (Labelled("metadata"), [%expr metadata]), - ] - }, - ~loc, - ) - ], - ) - }, - Shown, - ) -]; - -let validate_whole_collection = - (~collection: Collection.t, ~metadata: option(unit), ~loc) => - E.apply_field2( - ~in_=("validators", collection.plural), - ~fn="collection", - ~args= - switch (metadata) { - | None => [(Nolabel, [%expr input])] - | Some () => [(Nolabel, [%expr input]), (Nolabel, [%expr metadata])] - }, - ~loc, - ); - -let ok_pat_for_sync_field = (~loc, field: Scheme.field) => - Pat.tuple([ - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some(Pat.tuple([Pat.var(field.name |> str(~loc))])), - ), - field_result_var(~field=field.name) |> str(~loc), - ), - Pat.var(field_result_visibility_var(~field=field.name) |> str(~loc)), - ]); - -let ok_pat_for_async_field = (~loc, field: Scheme.field) => - Pat.tuple([ - Pat.variant( - "Result", - Some( - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some(Pat.tuple([Pat.var(field.name |> str(~loc))])), - ), - field_result_var(~field=field.name) |> str(~loc), - ), - ), - ), - Pat.var(field_result_visibility_var(~field=field.name) |> str(~loc)), - ]); - -let ok_pat_for_fields_of_async_collection = (~loc, collection: Collection.t) => - Pat.variant( - "FieldsOfCollectionResult", - Some( - Pat.tuple([ - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some(Pat.tuple([Pat.var(collection.plural |> str(~loc))])), - ), - Pat.var(collection |> collection_fields_statuses_var |> str(~loc)), - ]), - ), - ); - -let ok_pat_for_collection = (~loc, collection: Collection.t) => - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some([%pat? ()]), - ), - collection |> whole_collection_result_var |> str(~loc), - ); - -let ok_pat_for_fields_of_collection = (~loc, collection: Collection.t) => - Pat.tuple([ - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some(Pat.tuple([Pat.var(collection.plural |> str(~loc))])), - ), - Pat.var(collection |> collection_fields_statuses_var |> str(~loc)), - ]); - -let result_pat_for_collection = (~loc, collection: Collection.t) => - Pat.var(collection |> whole_collection_result_var |> str(~loc)); - -let error_pat_for_sync_field_in_single_field_form = - (~loc, field: Scheme.field) => - Pat.tuple([ - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Error") |> lid(~loc), - Some([%pat? _]), - ), - field_result_var(~field=field.name) |> str(~loc), - ), - Pat.var(field_result_visibility_var(~field=field.name) |> str(~loc)), - ]); - -let error_pat_for_async_field_in_single_field_form = - (~loc, field: Scheme.field) => - Pat.tuple([ - Pat.variant( - "Result", - Some( - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Error") |> lid(~loc), - Some([%pat? _]), - ), - field_result_var(~field=field.name) |> str(~loc), - ), - ), - ), - Pat.var(field_result_visibility_var(~field=field.name) |> str(~loc)), - ]); - -let error_pat_for_sync_field_in_multi_field_form = (~loc, field: Scheme.field) => - Pat.tuple([ - Pat.or_( - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some([%pat? _]), - ), - field_result_var(~field=field.name) |> str(~loc), - ), - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Error") |> lid(~loc), - Some([%pat? _]), - ), - field_result_var(~field=field.name) |> str(~loc), - ), - ), - Pat.var(field_result_visibility_var(~field=field.name) |> str(~loc)), - ]); - -let error_pat_for_async_field_in_multi_field_form = - (~loc, field: Scheme.field) => - Pat.tuple([ - Pat.variant( - "Result", - Some( - Pat.or_( - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some([%pat? _]), - ), - field_result_var(~field=field.name) |> str(~loc), - ), - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Error") |> lid(~loc), - Some([%pat? _]), - ), - field_result_var(~field=field.name) |> str(~loc), - ), - ), - ), - ), - Pat.var(field_result_visibility_var(~field=field.name) |> str(~loc)), - ]); - -let error_pat_for_fields_of_collection_in_single_field_form_without_collection_validator = - (~loc, collection: Collection.t) => - Pat.tuple([ - [%pat? Error(_)], - Pat.var(collection |> collection_fields_statuses_var |> str(~loc)), - ]); - -let error_pat_for_fields_of_collection_in_multi_field_form_or_single_field_form_with_collection_validator = - (~loc, collection: Collection.t) => - Pat.tuple([ - [%pat? Ok(_) | Error(_)], - Pat.var(collection |> collection_fields_statuses_var |> str(~loc)), - ]); - -let error_pat_for_fields_of_collection_in_single_field_async_form_without_collection_validator = - (~loc, collection: Collection.t) => - Pat.variant( - "FieldsOfCollectionResult", - Some( - Pat.tuple([ - [%pat? Error(_)], - Pat.var(collection |> collection_fields_statuses_var |> str(~loc)), - ]), - ), - ); - -let error_pat_for_fields_statuses_of_async_collection = - (~loc, collection: Collection.t) => - Pat.variant( - "FieldsOfCollectionResult", - Some( - Pat.tuple([ - [%pat? Ok(_) | Error(_)], - Pat.var(collection |> collection_fields_statuses_var |> str(~loc)), - ]), - ), - ); - -let result_and_visibility_pat_for_field = (~loc, field: Scheme.field) => - Pat.tuple([ - Pat.var(field_result_var(~field=field.name) |> str(~loc)), - Pat.var(field_result_visibility_var(~field=field.name) |> str(~loc)), - ]); - -let result_and_visibility_pat_for_async_field = (~loc, field: Scheme.field) => - Pat.tuple([ - Pat.variant( - "Result", - Some(Pat.var(field_result_var(~field=field.name) |> str(~loc))), - ), - Pat.var(field_result_visibility_var(~field=field.name) |> str(~loc)), - ]); - -let result_pat_for_fields_of_collection = (~loc, collection: Collection.t) => - Pat.var(collection |> fields_of_collection_result_var |> str(~loc)); - -let output_field_record_field = (~loc, field: Scheme.field) => ( - Lident(field.name) |> lid(~loc), - Exp.ident(Lident(field.name) |> lid(~loc)), -); - -let output_collection_record_field = (~loc, collection: Collection.t) => ( - Lident(collection.plural) |> lid(~loc), - Exp.ident(Lident(collection.plural) |> lid(~loc)), -); - -let field_dirty_status_record_field = (~loc, field: Scheme.field) => ( - Lident(field.name) |> lid(~loc), - [%expr - Dirty( - [%e - Exp.ident(Lident(field_result_var(~field=field.name)) |> lid(~loc)) - ], - [%e - Exp.ident( - Lident(field_result_visibility_var(~field=field.name)) - |> lid(~loc), - ) - ], - ) - ], -); - -let async_field_dirty_or_validating_status_record_field = - (~loc, field: Scheme.field) => ( - Lident(field.name) |> lid(~loc), - switch%expr ( - [%e - Exp.ident(Lident(field_result_var(~field=field.name)) |> lid(~loc)) - ] - ) { - | `Validating(value) => Validating(value) - | `Result(result) => - Dirty( - result, - [%e - Exp.ident( - Lident(field_result_visibility_var(~field=field.name)) - |> lid(~loc), - ) - ], - ) - }, -); - -let collection_that_might_be_in_validating_state_status_record_field = - (~loc, collection: Collection.t) => ( - Lident(collection.plural) |> lid(~loc), - switch%expr ( - [%e - Exp.ident( - Lident(collection |> fields_of_collection_result_var) |> lid(~loc), - ) - ] - ) { - | `ValidatingFieldsOfCollection(statuses) => statuses - | `FieldsOfCollectionResult(_, statuses) => statuses - }, -); - -let collection_statuses_record_field = (~loc, collection: Collection.t) => ( - Lident(collection.plural) |> lid(~loc), - Exp.ident( - Lident(collection |> collection_fields_statuses_var) |> lid(~loc), - ), -); - -let collections_statuses_record = - (~loc, collections: list(Scheme.collection)) => - Exp.record( - collections - |> List.rev - |> List.rev_map(({collection, validator}: Scheme.collection) => - ( - Lident(collection.plural) |> lid(~loc), - switch (validator) { - | Ok(Some ()) - | Error () => - %expr - Some( - [%e - Exp.ident( - Lident(collection |> whole_collection_result_var) - |> lid(~loc), - ) - ], - ) - | Ok(None) => - %expr - () - }, - ) - ), - None, - ); - -let validate_fields_of_collection_in_sync_form = - ( - ~collection: Collection.t, - ~fields: list(Scheme.field), - ~output_type: ItemType.t, - ~metadata: option(unit), - ~loc: Location.t, - ) => { - let match_values = - Exp.tuple([ - [%expr output], - ...fields - |> List.rev - |> List.rev_map((field: Scheme.field) => - switch (field.validator) { - | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => - validate_field_of_collection_with_sync_validator( - ~collection, - ~field, - ~metadata, - ~loc, - ) - | SyncValidator(Ok(Optional(None))) => - validate_field_of_collection_without_validator( - ~collection, - ~field, - ~loc, - ) - | AsyncValidator(_) => - failwith( - "Form that supposed to be without async validators has one. Please, file an issue with yoour use-case.", - ) - } - ), - ]); - - let ok_case = - Exp.case( - Pat.tuple([ - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some(Pat.tuple([Pat.var("output" |> str(~loc))])), - ), - ...fields |> List.rev |> List.rev_map(ok_pat_for_sync_field(~loc)), - ]), - [%expr - { - ignore( - Js.Array2.push( - output, - [%e - Exp.record( - fields - |> List.rev - |> List.rev_map(output_field_record_field(~loc)), - None, - ) - ], - ), - ); - ignore( - Js.Array2.push( - statuses, - [%e - Exp.record( - fields - |> List.rev - |> List.rev_map(field_dirty_status_record_field(~loc)), - None, - ) - ], - ), - ); - (Ok(output), statuses); - } - ], - ); - - let error_case = - Exp.case( - Pat.tuple([ - [%pat? Ok(_) | Error(_)], - ...fields - |> List.rev - |> List.rev_map(result_and_visibility_pat_for_field(~loc)), - ]), - [%expr - { - ignore( - Js.Array2.push( - statuses, - [%e - Exp.record( - fields - |> List.rev - |> List.rev_map(field_dirty_status_record_field(~loc)), - None, - ) - ], - ), - ); - (Error(), statuses); - } - ], - ); - - %expr - { - Belt.Array.reduceWithIndex( - [%e collection.plural |> E.field(~in_="fieldsStatuses", ~loc)], - (Ok([||]), [||]), - ( - ( - output: result(array([%t output_type |> ItemType.unpack]), unit), - statuses: - array( - [%t - Typ.constr( - Lident(collection |> CollectionPrinter.fields_statuses_type) - |> lid(~loc), - [], - ) - ], - ), - ), - fieldStatus, - index, - ) => { - %e - Exp.match( - ~attrs=[warning_4_disable(~loc)], - match_values, - [ok_case, error_case], - ) - }); - }; -}; - -let validate_fields_of_collection_in_async_form = - ( - ~collection: Collection.t, - ~fields: list(Scheme.field), - ~output_type: ItemType.t, - ~metadata: option(unit), - ~loc: Location.t, - ) => { - let fields_statuses_type = - Typ.constr( - Lident(collection |> CollectionPrinter.fields_statuses_type) - |> lid(~loc), - [], - ); - - let match_values = - Exp.tuple([ - [%expr result], - ...fields - |> List.rev - |> List.rev_map((field: Scheme.field) => - switch (field.validator) { - | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => - validate_field_of_collection_with_sync_validator( - ~collection, - ~field, - ~metadata, - ~loc, - ) - | SyncValidator(Ok(Optional(None))) => - validate_field_of_collection_without_validator( - ~collection, - ~field, - ~loc, - ) - | AsyncValidator(_) => - validate_field_of_collection_with_async_validator( - ~collection, - ~field, - ~metadata, - ~loc, - ) - } - ), - ]); - - let validating_case = - Exp.case( - P.or_( - ~pat= - Pat.tuple([ - [%pat? `ValidatingFieldsOfCollection(statuses)], - ...fields - |> List.rev - |> List.rev_map(result_and_visibility_pat_for_field(~loc)), - ]), - ~make= - (field: Scheme.field) => - Pat.tuple([ - [%pat? `FieldsOfCollectionResult(Ok(_) | Error(_), statuses)], - ...fields - |> List.rev - |> List.rev_map((field': Scheme.field) => - if (field'.name == field.name) { - Pat.tuple([ - Pat.alias( - Pat.variant("Validating", Some(Pat.any())), - field_result_var(~field=field.name) |> str(~loc), - ), - Pat.var( - field_result_visibility_var(~field=field.name) - |> str(~loc), - ), - ]); - } else { - field' |> result_and_visibility_pat_for_field(~loc); - } - ), - ]), - fields - |> List.filter((field: Scheme.field) => - switch (field.validator) { - | SyncValidator(_) => false - | AsyncValidator(_) => true - } - ), - ), - [%expr - { - ignore( - Js.Array2.push( - statuses, - [%e - Exp.record( - fields - |> List.rev - |> List.rev_map((field: Scheme.field) => - switch (field.validator) { - | SyncValidator(_) => - field |> field_dirty_status_record_field(~loc) - | AsyncValidator(_) => - field - |> async_field_dirty_or_validating_status_record_field( - ~loc, - ) - } - ), - None, - ) - ], - ), - ); - `ValidatingFieldsOfCollection(statuses); - } - ], - ); - - let ok_case = - Exp.case( - Pat.tuple([ - [%pat? `FieldsOfCollectionResult(Ok(output), statuses)], - ...fields - |> List.rev - |> List.rev_map((field: Scheme.field) => - switch (field.validator) { - | SyncValidator(_) => field |> ok_pat_for_sync_field(~loc) - | AsyncValidator(_) => field |> ok_pat_for_async_field(~loc) - } - ), - ]), - [%expr - { - ignore( - Js.Array2.push( - output, - [%e - Exp.record( - fields - |> List.rev - |> List.rev_map(output_field_record_field(~loc)), - None, - ) - ], - ), - ); - ignore( - Js.Array2.push( - statuses, - [%e - Exp.record( - fields - |> List.rev - |> List.rev_map(field_dirty_status_record_field(~loc)), - None, - ) - ], - ), - ); - `FieldsOfCollectionResult((Ok(output), statuses)); - } - ], - ); - - let error_case = - Exp.case( - Pat.tuple([ - [%pat? `FieldsOfCollectionResult(Ok(_) | Error(_), statuses)], - ...fields - |> List.rev - |> List.rev_map(result_and_visibility_pat_for_field(~loc)), - ]), - [%expr - { - ignore( - Js.Array2.push( - statuses, - [%e - Exp.record( - fields - |> List.rev - |> List.rev_map((field: Scheme.field) => - switch (field.validator) { - | SyncValidator(_) => - field |> field_dirty_status_record_field(~loc) - | AsyncValidator(_) => - field - |> async_field_dirty_or_validating_status_record_field( - ~loc, - ) - } - ), - None, - ) - ], - ), - ); - `FieldsOfCollectionResult((Error(), statuses)); - } - ], - ); - - %expr - { - Belt.Array.reduceWithIndex( - [%e collection.plural |> E.field(~in_="fieldsStatuses", ~loc)], - `FieldsOfCollectionResult((Ok([||]), [||])), - ( - result: [ - | `ValidatingFieldsOfCollection(array([%t fields_statuses_type])) - | `FieldsOfCollectionResult( - result(array([%t output_type |> ItemType.unpack]), unit), - array([%t fields_statuses_type]), - ) - ], - fieldStatus, - index, - ) => { - %e - Exp.match( - ~attrs=[warning_4_disable(~loc)], - match_values, - [validating_case, ok_case, error_case], - ) - }); - }; -}; - -module Sync = { - let ast = (~scheme: Scheme.t, ~metadata: option(unit), ~loc) => { - let anything_validatable = - scheme - |> List.exists((entry: Scheme.entry) => - switch (entry) { - | Field({ - validator: - SyncValidator(Ok(Required | Optional(Some ())) | Error ()), - }) => - true - | Field({validator: SyncValidator(Ok(Optional(None)))}) => false - | Field({validator: AsyncValidator(_)}) => true - | Collection({validator: Ok(Some ()) | Error ()}) => true - | Collection({validator: Ok(None), fields}) => - fields - |> List.exists((field: Scheme.field) => - switch (field.validator) { - | SyncValidator( - Ok(Required | Optional(Some ())) | Error (), - ) => - true - | SyncValidator(Ok(Optional(None))) => false - | AsyncValidator(_) => true - } - ) - } - ); - - let body = [%expr - { - %e - { - let collections = scheme |> Scheme.collections; - - let match_values = { - let value = (entry: Scheme.entry) => - switch (entry) { - | Field( - { - validator: - SyncValidator( - Ok(Required | Optional(Some(_))) | Error (), - ), - } as field, - ) => - validate_field_with_sync_validator(~field, ~metadata, ~loc) - | Field( - {validator: SyncValidator(Ok(Optional(None)))} as field, - ) => - validate_field_without_validator(~field, ~loc) - | Field({name: _, validator: AsyncValidator(_)}) => - failwith( - "Form that supposed to be without async validators has one. Please, file an issue with yoour use-case.", - ) - | Collection({collection, fields, validator, output_type}) => - switch (validator) { - | Ok(Some ()) - | Error () => - %expr - ( - [%e - validate_whole_collection(~collection, ~metadata, ~loc) - ], - [%e - validate_fields_of_collection_in_sync_form( - ~collection, - ~fields, - ~output_type, - ~metadata, - ~loc, - ) - ], - ) - | Ok(None) => - validate_fields_of_collection_in_sync_form( - ~collection, - ~fields, - ~output_type, - ~metadata, - ~loc, - ) - } - }; - switch (scheme) { - | [x] => x |> value - | _ => scheme |> List.rev |> List.rev_map(value) |> Exp.tuple - }; - }; - - let ok_case = { - let pat = { - let entry = (entry: Scheme.entry) => - switch (entry) { - | Field(field) => field |> ok_pat_for_sync_field(~loc) - | Collection({collection, validator}) => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> ok_pat_for_collection(~loc)], - [%p - collection |> ok_pat_for_fields_of_collection(~loc) - ], - ) - ] - | Ok(None) => - collection |> ok_pat_for_fields_of_collection(~loc) - } - }; - switch (scheme) { - | [x] => x |> entry - | _ => scheme |> List.rev |> List.rev_map(entry) |> Pat.tuple - }; - }; - let expr = { - let output = - Exp.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> output_field_record_field(~loc) - | Collection({collection}) => - collection |> output_collection_record_field(~loc) - } - ), - None, - ); - let fields_statuses = - Exp.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> field_dirty_status_record_field(~loc) - | Collection({collection}) => - collection |> collection_statuses_record_field(~loc) - } - ), - None, - ); - - switch (collections) { - | [] => - %expr - Valid({ - output: [%e output], - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: (), - }) - | collections => - %expr - Valid({ - output: [%e output], - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: [%e - collections |> collections_statuses_record(~loc) - ], - }) - }; - }; - Exp.case(pat, expr); - }; - - let error_case = { - let pat = { - let entry_of_one = (entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> error_pat_for_sync_field_in_single_field_form(~loc) - | Collection({collection, validator}) => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> result_pat_for_collection(~loc)], - [%p - collection - |> error_pat_for_fields_of_collection_in_multi_field_form_or_single_field_form_with_collection_validator( - ~loc, - ) - ], - ) - ] - | Ok(None) => - collection - |> error_pat_for_fields_of_collection_in_single_field_form_without_collection_validator( - ~loc, - ) - } - }; - let entry_of_many = (entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> error_pat_for_sync_field_in_multi_field_form(~loc) - | Collection({collection, validator}) => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> result_pat_for_collection(~loc)], - [%p - collection - |> error_pat_for_fields_of_collection_in_multi_field_form_or_single_field_form_with_collection_validator( - ~loc, - ) - ], - ) - ] - | Ok(None) => - collection - |> error_pat_for_fields_of_collection_in_multi_field_form_or_single_field_form_with_collection_validator( - ~loc, - ) - } - }; - switch (scheme) { - | [x] => x |> entry_of_one - | _ => - scheme |> List.rev |> List.rev_map(entry_of_many) |> Pat.tuple - }; - }; - let expr = { - let fields_statuses = - Exp.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> field_dirty_status_record_field(~loc) - | Collection({collection}) => - collection |> collection_statuses_record_field(~loc) - } - ), - None, - ); - - switch (collections) { - | [] => - %expr - Invalid({ - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: (), - }) - | _ => - %expr - Invalid({ - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: [%e - collections |> collections_statuses_record(~loc) - ], - }) - }; - }; - Exp.case(pat, expr); - }; - - Exp.match( - ~attrs=[warning_4_disable(~loc)], - match_values, - [ok_case, error_case], - ); - }; - } - ]; - - let return_type = [%type: - formValidationResult(output, fieldsStatuses, collectionsStatuses) - ]; - - [%stri - let validateForm = [%e - Exp.fun_( - Nolabel, - None, - Pat.constraint_([%pat? input], [%type: input]), - Exp.fun_( - Labelled("validators"), - None, - Pat.constraint_( - anything_validatable ? [%pat? validators] : [%pat? _], - [%type: validators], - ), - Exp.fun_( - Labelled("fieldsStatuses"), - None, - Pat.constraint_( - anything_validatable ? [%pat? fieldsStatuses] : [%pat? _], - [%type: fieldsStatuses], - ), - switch (metadata) { - | None => return_type |> Exp.constraint_(body) - | Some () => - Exp.fun_( - Labelled("metadata"), - None, - Pat.constraint_( - anything_validatable ? [%pat? metadata] : [%pat? _], - [%type: metadata], - ), - return_type |> Exp.constraint_(body), - ) - }, - ), - ), - ) - ] - ]; - }; -}; - -module Async = { - type validating_entry = [ - | `AsyncField(Scheme.field) - | `Collection(Collection.t) - ]; - - let ast = (~scheme: Scheme.t, ~metadata: option(unit), ~loc) => { - let body = [%expr - { - %e - { - let collections = scheme |> Scheme.collections; - - let match_values = { - let value = (entry: Scheme.entry) => - switch (entry) { - | Field( - { - validator: - SyncValidator( - Ok(Required | Optional(Some(_))) | Error (), - ), - } as field, - ) => - validate_field_with_sync_validator(~field, ~metadata, ~loc) - | Field( - {validator: SyncValidator(Ok(Optional(None)))} as field, - ) => - validate_field_without_validator(~field, ~loc) - | Field({validator: AsyncValidator(_)} as field) => - validate_field_with_async_validator(~field, ~metadata, ~loc) - | Collection({collection, fields, validator, output_type}) => - switch (validator) { - | Ok(Some ()) - | Error () => - %expr - ( - [%e - validate_whole_collection(~collection, ~metadata, ~loc) - ], - [%e - validate_fields_of_collection_in_async_form( - ~collection, - ~fields, - ~output_type, - ~metadata, - ~loc, - ) - ], - ) - | Ok(None) => - validate_fields_of_collection_in_async_form( - ~collection, - ~fields, - ~output_type, - ~metadata, - ~loc, - ) - } - }; - switch (scheme) { - | [x] => x |> value - | _ => scheme |> List.rev |> List.rev_map(value) |> Exp.tuple - }; - }; - - let validating_case = { - let pat = { - let entries_might_be_in_validating_state: list(validating_entry) = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field({validator: SyncValidator(_)}) => acc - | Field({validator: AsyncValidator(_)} as field) => [ - `AsyncField(field), - ...acc, - ] - | Collection({collection}) => [ - `Collection(collection), - ...acc, - ] - }, - [], - ); - let make = (entry: validating_entry) => - switch (entry) { - | `AsyncField(current_field) => - let entry = (entry: Scheme.entry) => - switch (entry) { - | Field({validator: AsyncValidator(_)} as field) - when field.name == current_field.name => - Pat.tuple([ - Pat.alias( - Pat.variant("Validating", Some(Pat.any())), - field_result_var(~field=field.name) |> str(~loc), - ), - Pat.var( - field_result_visibility_var(~field=field.name) - |> str(~loc), - ), - ]) - | Field( - {validator: SyncValidator(_) | AsyncValidator(_)} as field, - ) => - field |> result_and_visibility_pat_for_field(~loc) - | Collection({collection, validator}) => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> result_pat_for_collection(~loc)], - [%p - collection - |> result_pat_for_fields_of_collection(~loc) - ], - ) - ] - | Ok(None) => - collection - |> result_pat_for_fields_of_collection(~loc) - } - }; - switch (scheme) { - | [x] => x |> entry - | _ => - scheme |> List.rev |> List.rev_map(entry) |> Pat.tuple - }; - | `Collection(current_collection) => - let entry = (entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> result_and_visibility_pat_for_field(~loc) - | Collection({collection, validator}) - when collection.plural == current_collection.plural => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> result_pat_for_collection(~loc)], - [%p - Pat.alias( - Pat.variant( - "ValidatingFieldsOfCollection", - Some(Pat.any()), - ), - collection - |> fields_of_collection_result_var - |> str(~loc), - ) - ], - ) - ] - | Ok(None) => - Pat.alias( - Pat.variant( - "ValidatingFieldsOfCollection", - Some(Pat.any()), - ), - collection - |> fields_of_collection_result_var - |> str(~loc), - ) - } - | Collection({collection, validator}) => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> result_pat_for_collection(~loc)], - [%p - collection - |> result_pat_for_fields_of_collection(~loc) - ], - ) - ] - | Ok(None) => - collection - |> result_pat_for_fields_of_collection(~loc) - } - }; - switch (scheme) { - | [x] => x |> entry - | _ => - scheme |> List.rev |> List.rev_map(entry) |> Pat.tuple - }; - }; - switch (entries_might_be_in_validating_state) { - | [] => - failwith( - "No entries found that might be in validating state. Please, file an issue with your use-case.", - ) - | [x] => x |> make - | [x, ...rest] => P.or_(~pat=x |> make, ~make, rest) - }; - }; - let expr = { - let fields_statuses = - Exp.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field({validator: SyncValidator(_)} as field) => - field |> field_dirty_status_record_field(~loc) - | Field({validator: AsyncValidator(_)} as field) => - field - |> async_field_dirty_or_validating_status_record_field( - ~loc, - ) - | Collection({collection}) => - collection - |> collection_that_might_be_in_validating_state_status_record_field( - ~loc, - ) - } - ), - None, - ); - switch (collections) { - | [] => - %expr - { - Validating({ - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: (), - }); - } - | collections => - %expr - { - Validating({ - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: [%e - collections |> collections_statuses_record(~loc) - ], - }); - } - }; - }; - Exp.case(pat, expr); - }; - - let ok_case = { - let pat = { - let entry = (entry: Scheme.entry) => - switch (entry) { - | Field({validator: SyncValidator(_)} as field) => - field |> ok_pat_for_sync_field(~loc) - | Field({validator: AsyncValidator(_)} as field) => - field |> ok_pat_for_async_field(~loc) - | Collection({collection, validator}) => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> ok_pat_for_collection(~loc)], - [%p - collection - |> ok_pat_for_fields_of_async_collection(~loc) - ], - ) - ] - | Ok(None) => - collection |> ok_pat_for_fields_of_async_collection(~loc) - } - }; - switch (scheme) { - | [x] => x |> entry - | _ => scheme |> List.rev |> List.rev_map(entry) |> Pat.tuple - }; - }; - let expr = { - let output = - Exp.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> output_field_record_field(~loc) - | Collection({collection}) => - collection |> output_collection_record_field(~loc) - } - ), - None, - ); - let fields_statuses = - Exp.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> field_dirty_status_record_field(~loc) - | Collection({collection}) => - collection |> collection_statuses_record_field(~loc) - } - ), - None, - ); - switch (collections) { - | [] => - %expr - Valid({ - output: [%e output], - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: (), - }) - | collections => - %expr - Valid({ - output: [%e output], - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: [%e - collections |> collections_statuses_record(~loc) - ], - }) - }; - }; - Exp.case(pat, expr); - }; - - let error_case = { - let pat = { - let entry_of_one = (entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field - |> error_pat_for_async_field_in_single_field_form(~loc) - | Collection({collection, validator}) => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> result_pat_for_collection(~loc)], - [%p - collection - |> error_pat_for_fields_statuses_of_async_collection( - ~loc, - ) - ], - ) - ] - | Ok(None) => - collection - |> error_pat_for_fields_of_collection_in_single_field_async_form_without_collection_validator( - ~loc, - ) - } - }; - let entry_of_many = (entry: Scheme.entry) => - switch (entry) { - | Field({validator: SyncValidator(_)} as field) => - field |> result_and_visibility_pat_for_field(~loc) - | Field({validator: AsyncValidator(_)} as field) => - field |> error_pat_for_async_field_in_multi_field_form(~loc) - | Collection({collection, validator}) => - switch (validator) { - | Ok(Some ()) - | Error () => [%pat? - ( - [%p collection |> result_pat_for_collection(~loc)], - [%p - collection - |> error_pat_for_fields_statuses_of_async_collection( - ~loc, - ) - ], - ) - ] - | Ok(None) => - collection - |> error_pat_for_fields_statuses_of_async_collection(~loc) - } - }; - switch (scheme) { - | [x] => x |> entry_of_one - | _ => - scheme |> List.rev |> List.rev_map(entry_of_many) |> Pat.tuple - }; - }; - let expr = { - let fields_statuses = - Exp.record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => - field |> field_dirty_status_record_field(~loc) - | Collection({collection}) => - collection |> collection_statuses_record_field(~loc) - } - ), - None, - ); - - switch (collections) { - | [] => - %expr - Invalid({ - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: (), - }) - | collections => - %expr - Invalid({ - fieldsStatuses: [%e fields_statuses], - collectionsStatuses: [%e - collections |> collections_statuses_record(~loc) - ], - }) - }; - }; - Exp.case(pat, expr); - }; - - Exp.match( - ~attrs=[warning_4_disable(~loc)], - match_values, - [validating_case, ok_case, error_case], - ); - }; - } - ]; - - let return_type = [%type: - Async.formValidationResult(output, fieldsStatuses, collectionsStatuses) - ]; - - [%stri - let validateForm = [%e - Exp.fun_( - Nolabel, - None, - Pat.constraint_([%pat? input], [%type: input]), - Exp.fun_( - Labelled("validators"), - None, - Pat.constraint_([%pat? validators], [%type: validators]), - Exp.fun_( - Labelled("fieldsStatuses"), - None, - Pat.constraint_( - [%pat? fieldsStatuses], - [%type: fieldsStatuses], - ), - switch (metadata) { - | None => return_type |> Exp.constraint_(body) - | Some () => - Exp.fun_( - Labelled("metadata"), - None, - Pat.constraint_([%pat? metadata], [%type: metadata]), - return_type |> Exp.constraint_(body), - ) - }, - ), - ), - ) - ] - ]; - }; -}; diff --git a/ppx/lib/Form_ValidatorsRecord.ml b/ppx/lib/Form_ValidatorsRecord.ml new file mode 100644 index 00000000..72ecbea4 --- /dev/null +++ b/ppx/lib/Form_ValidatorsRecord.ml @@ -0,0 +1,375 @@ +open Meta +open Ast +open Printer +open Ppxlib +open Ast_helper + +let ensure_eq ~loc fields = + if fields + |> List.exists (fun ({ txt = lid }, _) -> + match lid with + | Lident "eq" -> true + | _ -> false) + then fields + else (Lident "eq" |> lid ~loc, [%expr ( = )]) :: fields +;; + +let update_async_validator_of_field + ~(field : string) + ~(output_type : ItemType.t) + ~(async_mode : AsyncMode.t) + ~(validator_loc : Location.t) + ~(metadata : unit option) + fields + = + fields + |> ensure_eq ~loc:validator_loc + |> List.rev + |> List.rev_map (fun (v_lid, ({ pexp_loc = loc } as expr)) -> + match v_lid with + | { txt = Lident "validateAsync" } -> + let fn = + match metadata with + | None -> + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun (value, dispatch) -> + let validate = + ([%e expr] + : ([%t output_type |> ItemType.unpack], message) Async.validateAsyncFn) + in + (Async.validateAsync + ~value + ~validate + ~andThen: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun res -> + (dispatch + [%e + Exp.construct + (Lident + (FieldPrinter.apply_async_result_action ~field) + |> lid ~loc) + (Some + (Exp.tuple + [ Exp.ident (Lident "value" |> lid ~loc) + ; Exp.ident (Lident "res" |> lid ~loc) + ]))] [@res.uapp])]] [@res.uapp])] + | Some () -> + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun (value, metadata, dispatch) -> + let validate = + ([%e expr] + : ( [%t output_type |> ItemType.unpack] + , message + , metadata ) + Async.validateAsyncFnWithMetadata) + in + (Async.validateAsyncWithMetadata + ~value + ~validate + ~metadata + ~andThen: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun res -> + (dispatch + [%e + Exp.construct + (Lident + (FieldPrinter.apply_async_result_action ~field) + |> lid ~loc) + (Some + (Exp.tuple + [ Exp.ident (Lident "value" |> lid ~loc) + ; Exp.ident (Lident "res" |> lid ~loc) + ]))] [@res.uapp])]] [@res.uapp])] + in + ( v_lid + , (match async_mode with + | OnBlur -> fn + | OnChange -> [%expr Debouncer.make ~wait:debounceInterval [%e fn] [@res.uapp]]) + ) + | _ -> v_lid, expr) +;; + +let update_async_validator_of_field_of_collection + ~(field : string) + ~(collection : Collection.t) + ~(output_type : ItemType.t) + ~(async_mode : AsyncMode.t) + ~(validator_loc : Location.t) + ~(metadata : unit option) + fields + = + fields + |> ensure_eq ~loc:validator_loc + |> List.rev + |> List.rev_map (fun (v_lid, ({ pexp_loc = loc } as expr)) -> + match v_lid with + | { txt = Lident "validateAsync" } -> + let fn = + match metadata with + | None -> + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun (value, index, dispatch) -> + let validate = + ([%e expr] + : ([%t output_type |> ItemType.unpack], message) Async.validateAsyncFn) + in + (Async.validateAsync + ~value + ~validate + ~andThen: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun res -> + (dispatch + [%e + Exp.construct + (Lident + (FieldOfCollectionPrinter.apply_async_result_action + ~collection + ~field) + |> lid ~loc) + (Some + (Exp.tuple + [ Exp.ident (Lident "value" |> lid ~loc) + ; Exp.ident (Lident "index" |> lid ~loc) + ; Exp.ident (Lident "res" |> lid ~loc) + ]))] [@res.uapp])]] [@res.uapp])] + | Some () -> + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun (value, index, metadata, dispatch) -> + let validate = + ([%e expr] + : ( [%t output_type |> ItemType.unpack] + , message + , metadata ) + Async.validateAsyncFnWithMetadata) + in + (Async.validateAsyncWithMetadata + ~value + ~validate + ~metadata + ~andThen: + [%e + Uncurried.fn + ~loc + ~arity:1 + [%expr + fun res -> + (dispatch + [%e + Exp.construct + (Lident + (FieldOfCollectionPrinter.apply_async_result_action + ~collection + ~field) + |> lid ~loc) + (Some + (Exp.tuple + [ Exp.ident (Lident "value" |> lid ~loc) + ; Exp.ident (Lident "index" |> lid ~loc) + ; Exp.ident (Lident "res" |> lid ~loc) + ]))] [@res.uapp])]] [@res.uapp])] + in + ( v_lid + , (match async_mode with + | OnBlur -> fn + | OnChange -> [%expr Debouncer.make ~wait:debounceInterval [%e fn] [@res.uapp]]) + ) + | _ -> v_lid, expr) +;; + +let ast + ~(scheme : Scheme.t) + ~(metadata : unit option) + ~(validators : ValidatorsRecord.t) + (value_binding : value_binding) + = + let fields = + validators.fields + |> List.rev + |> List.rev_map (fun (f_lid, expr) -> + match f_lid with + | { txt = Lident key } -> + let entry = + scheme + |> List.find_opt (function + | Scheme.Field field -> field.name = key + | Scheme.Collection { collection } -> collection.plural = key) + in + (match entry with + | None -> f_lid, expr + | Some (Field field) -> + (match field.validator with + | SyncValidator (Ok Required) -> f_lid, expr + | SyncValidator (Ok (Optional (Some ()))) -> f_lid, expr + | SyncValidator (Ok (Optional None)) -> + let loc = expr.pexp_loc in + f_lid, [%expr ()] + | SyncValidator (Error ()) -> f_lid, expr + | AsyncValidator { mode = async_mode } -> + ( f_lid + , (match expr with + | { pexp_desc = Pexp_record (fields, None) + ; pexp_loc + ; pexp_loc_stack + ; pexp_attributes + } -> + { pexp_desc = + Pexp_record + ( fields + |> update_async_validator_of_field + ~field:field.name + ~output_type:field.output_type + ~async_mode + ~validator_loc:pexp_loc + ~metadata + , None ) + ; pexp_loc + ; pexp_loc_stack + ; pexp_attributes + } + | _ -> expr) )) + | Some + (Collection + { collection + ; fields = collection_fields + ; validator = collection_validator + }) -> + ( f_lid + , (match expr with + | { pexp_desc = Pexp_record (collection_validator_fields, None) + ; pexp_loc + ; pexp_loc_stack + ; pexp_attributes + } -> + let fields = + collection_validator_fields + |> List.rev + |> List.rev_map (fun (c_lid, expr) -> + match c_lid with + | { txt = Lident "collection" } -> + ( c_lid + , (match collection_validator with + | Ok (Some ()) | Error () -> expr + | Ok None -> + let loc = expr.pexp_loc in + [%expr ()]) ) + | { txt = Lident "fields" } -> + ( c_lid + , (match expr with + | { pexp_desc = Pexp_record (field_validator_fields, None) + ; pexp_loc + ; pexp_loc_stack + ; pexp_attributes + } -> + let fields = + field_validator_fields + |> List.rev + |> List.rev_map (fun (f_lid, expr) -> + match f_lid with + | { txt = Lident key } -> + let field = + collection_fields + |> List.find_opt (fun (field : Scheme.field) -> + field.name = key) + in + (match field with + | None -> f_lid, expr + | Some { validator = SyncValidator (Ok Required) } -> + f_lid, expr + | Some + { validator = + SyncValidator (Ok (Optional (Some ()))) + } -> f_lid, expr + | Some + { validator = SyncValidator (Ok (Optional None)) } + -> + let loc = expr.pexp_loc in + f_lid, [%expr ()] + | Some { validator = SyncValidator (Error ()) } -> + f_lid, expr + | Some + ({ validator = AsyncValidator { mode = async_mode } + } as field) -> + ( f_lid + , (match expr with + | { pexp_desc = Pexp_record (fields, None) + ; pexp_loc + ; pexp_loc_stack + ; pexp_attributes + } -> + { pexp_desc = + Pexp_record + ( fields + |> update_async_validator_of_field_of_collection + ~field:field.name + ~collection + ~output_type:field.output_type + ~async_mode + ~validator_loc:pexp_loc + ~metadata + , None ) + ; pexp_loc + ; pexp_loc_stack + ; pexp_attributes + } + | _ -> expr) )) + | { txt = _ } -> f_lid, expr) + in + { pexp_desc = Pexp_record (fields, None) + ; pexp_loc + ; pexp_loc_stack + ; pexp_attributes + } + | _ -> expr) ) + | _ -> c_lid, expr) + in + { pexp_desc = Pexp_record (fields, None) + ; pexp_loc + ; pexp_loc_stack + ; pexp_attributes + } + | _ -> expr) )) + | _ -> f_lid, expr) + in + { value_binding with + pvb_expr = + { pexp_desc = + Pexp_constraint + ( { pexp_desc = Pexp_record (fields, None) + ; pexp_loc = validators.record_metadata.pexp_loc + ; pexp_loc_stack = validators.record_metadata.pexp_loc_stack + ; pexp_attributes = validators.record_metadata.pexp_attributes + } + , validators.annotation ) + ; pexp_loc = validators.constraint_metadata.pexp_loc + ; pexp_loc_stack = validators.constraint_metadata.pexp_loc_stack + ; pexp_attributes = validators.constraint_metadata.pexp_attributes + } + } +;; diff --git a/ppx/lib/Form_ValidatorsRecord.re b/ppx/lib/Form_ValidatorsRecord.re deleted file mode 100644 index ba11d423..00000000 --- a/ppx/lib/Form_ValidatorsRecord.re +++ /dev/null @@ -1,457 +0,0 @@ -open Meta; -open Ast; -open Printer; - -open Ppxlib; -open Ast_helper; - -let ensure_eq = (~loc, fields) => - if (fields - |> List.exists((({txt: lid}, _)) => - switch (lid) { - | Lident("eq") => true - | _ => false - } - )) { - fields; - } else { - [(Lident("eq") |> lid(~loc), [%expr (==)]), ...fields]; - }; - -let update_async_validator_of_field = - ( - ~field: string, - ~output_type: ItemType.t, - ~async_mode: AsyncMode.t, - ~validator_loc: Location.t, - ~metadata: option(unit), - fields, - ) => - fields - |> ensure_eq(~loc=validator_loc) - |> List.rev - |> List.rev_map(((v_lid, {pexp_loc: loc} as expr)) => - switch (v_lid) { - | {txt: Lident("validateAsync")} => - let fn = - switch (metadata) { - | None => - %expr - ( - ((value, dispatch)) => { - let validate: - Async.validateAsyncFn( - [%t output_type |> ItemType.unpack], - message, - ) = [%e - expr - ]; - Async.validateAsync(~value, ~validate, ~andThen=res => { - dispatch( - [%e - Exp.construct( - Lident( - FieldPrinter.apply_async_result_action(~field), - ) - |> lid(~loc), - Some( - Exp.tuple([ - Exp.ident(Lident("value") |> lid(~loc)), - Exp.ident(Lident("res") |> lid(~loc)), - ]), - ), - ) - ], - ) - }); - } - ) - | Some () => - %expr - ( - ((value, metadata, dispatch)) => { - let validate: - Async.validateAsyncFnWithMetadata( - [%t output_type |> ItemType.unpack], - message, - metadata, - ) = [%e - expr - ]; - Async.validateAsyncWithMetadata( - ~value, ~validate, ~metadata, ~andThen=res => { - dispatch( - [%e - Exp.construct( - Lident( - FieldPrinter.apply_async_result_action(~field), - ) - |> lid(~loc), - Some( - Exp.tuple([ - Exp.ident(Lident("value") |> lid(~loc)), - Exp.ident(Lident("res") |> lid(~loc)), - ]), - ), - ) - ], - ) - }); - } - ) - }; - - ( - v_lid, - switch (async_mode) { - | OnBlur => fn - | OnChange => - %expr - Debouncer.make(~wait=debounceInterval, [%e fn]) - }, - ); - | _ => (v_lid, expr) - } - ); - -let update_async_validator_of_field_of_collection = - ( - ~field: string, - ~collection: Collection.t, - ~output_type: ItemType.t, - ~async_mode: AsyncMode.t, - ~validator_loc: Location.t, - ~metadata: option(unit), - fields, - ) => - fields - |> ensure_eq(~loc=validator_loc) - |> List.rev - |> List.rev_map(((v_lid, {pexp_loc: loc} as expr)) => - switch (v_lid) { - | {txt: Lident("validateAsync")} => - let fn = - switch (metadata) { - | None => - %expr - ( - ((value, index, dispatch)) => { - let validate: - Async.validateAsyncFn( - [%t output_type |> ItemType.unpack], - message, - ) = [%e - expr - ]; - Async.validateAsync(~value, ~validate, ~andThen=res => { - dispatch( - [%e - Exp.construct( - Lident( - FieldOfCollectionPrinter.apply_async_result_action( - ~collection, - ~field, - ), - ) - |> lid(~loc), - Some( - Exp.tuple([ - Exp.ident(Lident("value") |> lid(~loc)), - Exp.ident(Lident("index") |> lid(~loc)), - Exp.ident(Lident("res") |> lid(~loc)), - ]), - ), - ) - ], - ) - }); - } - ) - | Some () => - %expr - ( - ((value, index, metadata, dispatch)) => { - let validate: - Async.validateAsyncFnWithMetadata( - [%t output_type |> ItemType.unpack], - message, - metadata, - ) = [%e - expr - ]; - Async.validateAsyncWithMetadata( - ~value, ~validate, ~metadata, ~andThen=res => { - dispatch( - [%e - Exp.construct( - Lident( - FieldOfCollectionPrinter.apply_async_result_action( - ~collection, - ~field, - ), - ) - |> lid(~loc), - Some( - Exp.tuple([ - Exp.ident(Lident("value") |> lid(~loc)), - Exp.ident(Lident("index") |> lid(~loc)), - Exp.ident(Lident("res") |> lid(~loc)), - ]), - ), - ) - ], - ) - }); - } - ) - }; - ( - v_lid, - switch (async_mode) { - | OnBlur => fn - | OnChange => - %expr - Debouncer.make(~wait=debounceInterval, [%e fn]) - }, - ); - | _ => (v_lid, expr) - } - ); - -// What we need to do here: -// 1. Update values of optional validators: set them to () instead of None -// 2. Wrap async validators so each dispatches appropriate action -// 3. Debounce async validators that run on change -// 4. Don't touch unknown, let compiler do its job -let ast = - ( - ~scheme: Scheme.t, - ~metadata: option(unit), - ~validators: ValidatorsRecord.t, - value_binding: value_binding, - ) => { - let fields = - validators.fields - |> List.rev - |> List.rev_map(((f_lid, expr)) => - switch (f_lid) { - | {txt: Lident(key)} => - let entry = - scheme - |> List.find_opt( - fun - | Scheme.Field(field) => field.name == key - | Scheme.Collection({collection}) => - collection.plural == key, - ); - switch (entry) { - | None => (f_lid, expr) - | Some(Field(field)) => - switch (field.validator) { - | SyncValidator(Ok(Required)) => (f_lid, expr) - | SyncValidator(Ok(Optional(Some ()))) => (f_lid, expr) - | SyncValidator(Ok(Optional(None))) => - let loc = expr.pexp_loc; - (f_lid, [%expr ()]); - | SyncValidator(Error ()) => (f_lid, expr) - | AsyncValidator({mode: async_mode}) => ( - f_lid, - switch (expr) { - | { - pexp_desc: Pexp_record(fields, None), - pexp_loc, - pexp_loc_stack, - pexp_attributes, - } => { - pexp_desc: - Pexp_record( - fields - |> update_async_validator_of_field( - ~field=field.name, - ~output_type=field.output_type, - ~async_mode, - ~validator_loc=pexp_loc, - ~metadata, - ), - None, - ), - pexp_loc, - pexp_loc_stack, - pexp_attributes, - } - | _ => expr - }, - ) - } - | Some( - Collection({ - collection, - fields: collection_fields, - validator: collection_validator, - }), - ) => ( - f_lid, - switch (expr) { - | { - pexp_desc: Pexp_record(collection_validator_fields, None), - pexp_loc, - pexp_loc_stack, - pexp_attributes, - } => - let fields = - collection_validator_fields - |> List.rev - |> List.rev_map(((c_lid, expr)) => - switch (c_lid) { - | {txt: Lident("collection")} => ( - c_lid, - switch (collection_validator) { - | Ok(Some ()) - | Error () => expr - | Ok(None) => - let loc = expr.pexp_loc; - %expr - (); - }, - ) - | {txt: Lident("fields")} => ( - c_lid, - switch (expr) { - | { - pexp_desc: - Pexp_record(field_validator_fields, None), - pexp_loc, - pexp_loc_stack, - pexp_attributes, - } => - let fields = - field_validator_fields - |> List.rev - |> List.rev_map(((f_lid, expr)) => - switch (f_lid) { - | {txt: Lident(key)} => - let field = - collection_fields - |> List.find_opt( - (field: Scheme.field) => - field.name == key - ); - switch (field) { - | None => (f_lid, expr) - | Some({ - validator: - SyncValidator(Ok(Required)), - }) => ( - f_lid, - expr, - ) - | Some({ - validator: - SyncValidator( - Ok(Optional(Some ())), - ), - }) => ( - f_lid, - expr, - ) - | Some({ - validator: - SyncValidator( - Ok(Optional(None)), - ), - }) => - let loc = expr.pexp_loc; - (f_lid, [%expr ()]); - | Some({ - validator: SyncValidator(Error ()), - }) => ( - f_lid, - expr, - ) - | Some( - { - validator: - AsyncValidator({ - mode: async_mode, - }), - } as field, - ) => ( - f_lid, - switch (expr) { - | { - pexp_desc: - Pexp_record(fields, None), - pexp_loc, - pexp_loc_stack, - pexp_attributes, - } => { - pexp_desc: - Pexp_record( - fields - |> update_async_validator_of_field_of_collection( - ~field=field.name, - ~collection, - ~output_type= - field.output_type, - ~async_mode, - ~validator_loc=pexp_loc, - ~metadata, - ), - None, - ), - pexp_loc, - pexp_loc_stack, - pexp_attributes, - } - | _ => expr - }, - ) - }; - | {txt: _} => (f_lid, expr) - } - ); - { - pexp_desc: Pexp_record(fields, None), - pexp_loc, - pexp_loc_stack, - pexp_attributes, - }; - | _ => expr - }, - ) - | _ => (c_lid, expr) - } - ); - - { - pexp_desc: Pexp_record(fields, None), - pexp_loc, - pexp_loc_stack, - pexp_attributes, - }; - | _ => expr - }, - ) - }; - | _ => (f_lid, expr) - } - ); - { - ...value_binding, - pvb_expr: { - pexp_desc: - Pexp_constraint( - { - pexp_desc: Pexp_record(fields, None), - pexp_loc: validators.record_metadata.pexp_loc, - pexp_loc_stack: validators.record_metadata.pexp_loc_stack, - pexp_attributes: validators.record_metadata.pexp_attributes, - }, - validators.annotation, - ), - pexp_loc: validators.constraint_metadata.pexp_loc, - pexp_loc_stack: validators.constraint_metadata.pexp_loc_stack, - pexp_attributes: validators.constraint_metadata.pexp_attributes, - }, - }; -}; diff --git a/ppx/lib/Form_ValidatorsType.ml b/ppx/lib/Form_ValidatorsType.ml new file mode 100644 index 00000000..86ae0227 --- /dev/null +++ b/ppx/lib/Form_ValidatorsType.ml @@ -0,0 +1,163 @@ +open Meta +open Ast +open Printer +open Ppxlib +open Ast_helper + +let field_type ~loc ~metadata (field : Scheme.field) = + Type.field + (field.name |> str ~loc) + (match field.validator with + | SyncValidator (Ok Required) + | SyncValidator (Ok (Optional (Some _))) + | SyncValidator (Error ()) -> + (match metadata with + | None -> + [%type: + ( input + , [%t field.output_type |> ItemType.unpack] + , message ) + singleValueValidator] + | Some () -> + [%type: + ( input + , [%t field.output_type |> ItemType.unpack] + , message + , metadata ) + singleValueValidatorWithMetadata]) + | SyncValidator (Ok (Optional None)) -> [%type: unit] + | AsyncValidator _ -> + (match metadata with + | None -> + [%type: + ( input + , [%t field.output_type |> ItemType.unpack] + , message + , action ) + Async.singleValueValidator] + | Some () -> + [%type: + ( input + , [%t field.output_type |> ItemType.unpack] + , message + , metadata + , action ) + Async.singleValueValidatorWithMetadata])) +;; + +let collection_type + ~loc + ~(validator : CollectionValidator.t) + ~(metadata : unit option) + (collection : Collection.t) + = + Type.field + (collection.plural |> str ~loc) + (match validator with + | Ok (Some ()) | Error () -> + (match metadata with + | None -> + [%type: + ( input + , message + , [%t + Typ.constr + (Lident (collection |> CollectionPrinter.validator_type) |> lid ~loc) + []] ) + collectionValidatorWithWholeCollectionValidator] + | Some () -> + [%type: + ( input + , message + , [%t + Typ.constr + (Lident (collection |> CollectionPrinter.validator_type) |> lid ~loc) + []] + , metadata ) + collectionValidatorWithWholeCollectionValidatorAndMetadata]) + | Ok None -> + [%type: + [%t + Typ.constr + (Lident (collection |> CollectionPrinter.validator_type) |> lid ~loc) + []] + collectionValidatorWithoutWholeCollectionValidator]) +;; + +let field_of_collection_type ~loc ~(metadata : unit option) (field : Scheme.field) = + Type.field + (field.name |> str ~loc) + (match field.validator with + | SyncValidator (Ok Required) + | SyncValidator (Ok (Optional (Some _))) + | SyncValidator (Error ()) -> + (match metadata with + | None -> + [%type: + ( input + , [%t field.output_type |> ItemType.unpack] + , message ) + valueOfCollectionValidator] + | Some () -> + [%type: + ( input + , [%t field.output_type |> ItemType.unpack] + , message + , metadata ) + valueOfCollectionValidatorWithMetadata]) + | SyncValidator (Ok (Optional None)) -> [%type: unit] + | AsyncValidator _ -> + (match metadata with + | None -> + [%type: + ( input + , [%t field.output_type |> ItemType.unpack] + , message + , action ) + Async.valueOfCollectionValidator] + | Some () -> + [%type: + ( input + , [%t field.output_type |> ItemType.unpack] + , message + , metadata + , action ) + Async.valueOfCollectionValidatorWithMetadata])) +;; + +let ast ~(scheme : Scheme.t) ~(metadata : unit option) ~loc = + let main_decl = + "validators" + |> str ~loc + |> Type.mk + ~kind: + (Ptype_record + (scheme + |> List.rev + |> List.rev_map (fun (entry : Scheme.entry) -> + match entry with + | Field field -> field |> field_type ~loc ~metadata + | Collection { collection; validator } -> + collection |> collection_type ~validator ~metadata ~loc))) + in + let collections_decls = + scheme + |> List.fold_left + (fun acc (entry : Scheme.entry) -> + match entry with + | Field _ -> acc + | Collection { collection; fields } -> + (collection + |> CollectionPrinter.validator_type + |> str ~loc + |> Type.mk + ~kind: + (Ptype_record + (fields + |> List.rev + |> List.rev_map (field_of_collection_type ~loc ~metadata)))) + :: acc) + [] + in + Str.type_ ~loc Recursive (main_decl :: collections_decls) +;; diff --git a/ppx/lib/Form_ValidatorsType.re b/ppx/lib/Form_ValidatorsType.re deleted file mode 100644 index a92f4b3e..00000000 --- a/ppx/lib/Form_ValidatorsType.re +++ /dev/null @@ -1,208 +0,0 @@ -open Meta; -open Ast; -open Printer; - -open Ppxlib; -open Ast_helper; - -let field_type = (~loc, ~metadata, field: Scheme.field) => - Type.field( - field.name |> str(~loc), - switch (field.validator) { - | SyncValidator(Ok(Required)) - | SyncValidator(Ok(Optional(Some(_)))) - | SyncValidator(Error ()) => - switch (metadata) { - | None => [%type: - singleValueValidator( - input, - [%t field.output_type |> ItemType.unpack], - message, - ) - ] - | Some () => [%type: - singleValueValidatorWithMetadata( - input, - [%t field.output_type |> ItemType.unpack], - message, - metadata, - ) - ] - } - | SyncValidator(Ok(Optional(None))) => [%type: unit] - | AsyncValidator(_) => - switch (metadata) { - | None => [%type: - Async.singleValueValidator( - input, - [%t field.output_type |> ItemType.unpack], - message, - action, - ) - ] - | Some () => [%type: - Async.singleValueValidatorWithMetadata( - input, - [%t field.output_type |> ItemType.unpack], - message, - metadata, - action, - ) - ] - } - }, - ); - -let collection_type = - ( - ~loc, - ~validator: CollectionValidator.t, - ~metadata: option(unit), - collection: Collection.t, - ) => - Type.field( - collection.plural |> str(~loc), - switch (validator) { - | Ok(Some ()) - | Error () => - switch (metadata) { - | None => [%type: - collectionValidatorWithWholeCollectionValidator( - input, - message, - [%t - Typ.constr( - Lident(collection |> CollectionPrinter.validator_type) - |> lid(~loc), - [], - ) - ], - ) - ] - | Some () => [%type: - collectionValidatorWithWholeCollectionValidatorAndMetadata( - input, - message, - [%t - Typ.constr( - Lident(collection |> CollectionPrinter.validator_type) - |> lid(~loc), - [], - ) - ], - metadata, - ) - ] - } - - | Ok(None) => [%type: - collectionValidatorWithoutWholeCollectionValidator( - [%t - Typ.constr( - Lident(collection |> CollectionPrinter.validator_type) - |> lid(~loc), - [], - ) - ], - ) - ] - }, - ); - -let field_of_collection_type = - (~loc, ~metadata: option(unit), field: Scheme.field) => - Type.field( - field.name |> str(~loc), - switch (field.validator) { - | SyncValidator(Ok(Required)) - | SyncValidator(Ok(Optional(Some(_)))) - | SyncValidator(Error ()) => - switch (metadata) { - | None => [%type: - valueOfCollectionValidator( - input, - [%t field.output_type |> ItemType.unpack], - message, - ) - ] - | Some () => [%type: - valueOfCollectionValidatorWithMetadata( - input, - [%t field.output_type |> ItemType.unpack], - message, - metadata, - ) - ] - } - - | SyncValidator(Ok(Optional(None))) => [%type: unit] - | AsyncValidator(_) => - switch (metadata) { - | None => [%type: - Async.valueOfCollectionValidator( - input, - [%t field.output_type |> ItemType.unpack], - message, - action, - ) - ] - | Some () => [%type: - Async.valueOfCollectionValidatorWithMetadata( - input, - [%t field.output_type |> ItemType.unpack], - message, - metadata, - action, - ) - ] - } - }, - ); - -let ast = (~scheme: Scheme.t, ~metadata: option(unit), ~loc) => { - let main_decl = - "validators" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - scheme - |> List.rev - |> List.rev_map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => field |> field_type(~loc, ~metadata) - | Collection({collection, validator}) => - collection |> collection_type(~validator, ~metadata, ~loc) - } - ), - ), - ); - - let collections_decls = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field(_) => acc - | Collection({collection, fields}) => [ - collection - |> CollectionPrinter.validator_type - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - fields - |> List.rev - |> List.rev_map( - field_of_collection_type(~loc, ~metadata), - ), - ), - ), - ...acc, - ] - }, - [], - ); - - Str.type_(~loc, Recursive, [main_decl, ...collections_decls]); -}; diff --git a/ppx/lib/Lib.ml b/ppx/lib/Lib.ml new file mode 100644 index 00000000..3a9a2188 --- /dev/null +++ b/ppx/lib/Lib.ml @@ -0,0 +1 @@ +"formality" |> Ppxlib.Driver.register_transformation ~extensions:[ Form.ext ] diff --git a/ppx/lib/Lib.re b/ppx/lib/Lib.re deleted file mode 100644 index cb8f380b..00000000 --- a/ppx/lib/Lib.re +++ /dev/null @@ -1 +0,0 @@ -"formality" |> Ppxlib.Driver.register_transformation(~extensions=[Form.ext]); diff --git a/ppx/lib/Meta.ml b/ppx/lib/Meta.ml new file mode 100644 index 00000000..51be6437 --- /dev/null +++ b/ppx/lib/Meta.ml @@ -0,0 +1,1862 @@ +open Ppxlib + +module ItemType = struct + module T : sig + type t + end = struct + type t = core_type + end + + type t = T.t + + external make : core_type -> t = "%identity" + external unpack : t -> core_type = "%identity" + + let rec eq (t1 : core_type) (t2 : core_type) = + match t1.ptyp_desc, t2.ptyp_desc with + | 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) = + match l1, l2 with + | 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 : core_type list) (l2 : core_type list) = + if List.length l1 = List.length l2 + then List.for_all2 (fun t1 t2 -> eq t1 t2) l1 l2 + else false + ;; + + let eq (x1 : t) (x2 : t) = eq (x1 |> unpack) (x2 |> unpack) +end + +module Collection = struct + type t = + { singular : string + ; plural : string + } +end + +module FieldDep = struct + type t = + | DepField of string + | DepFieldOfCollection of + { collection : Collection.t + ; field : string + } + + type unvalidated = + | UnvalidatedDepField of + { name : string + ; loc : Location.t + } + | UnvalidatedDepFieldOfCollection of + { collection : string + ; field : string + ; c_loc : Location.t + ; f_loc : Location.t + } +end + +module FieldOptionality = struct + type t = + | OptionType + | StringType + | OptionStringType +end + +module AsyncMode = struct + type t = + | OnChange + | OnBlur + + let default = OnChange +end + +module ValidatorsRecord = struct + type t = + { fields : fields + ; rec_flag : rec_flag + ; constraint_metadata : metadata + ; record_metadata : metadata + ; annotation : core_type + } + + and fields = (Longident.t loc * expression) list + + and metadata = + { pexp_loc : Location.t + ; pexp_loc_stack : Location.t list + ; pexp_attributes : attribute list + } +end + +module FieldValidator = struct + type t = + | SyncValidator of (sync, unit) result + | AsyncValidator of + { mode : AsyncMode.t + ; optionality : FieldOptionality.t option + } + + and sync = + | Required + | Optional of unit option +end + +module CollectionValidator = struct + type t = (unit option, unit) result +end + +module Scheme = struct + type t = entry list + + and entry = + | Field of field + | Collection of collection + + and field = + { name : string + ; input_type : ItemType.t + ; output_type : ItemType.t + ; validator : FieldValidator.t + ; deps : FieldDep.t list + } + + and collection = + { collection : Collection.t + ; fields : field list + ; validator : CollectionValidator.t + ; input_type : ItemType.t + ; output_type : ItemType.t + } + + let fields (scheme : t) = + scheme + |> List.fold_left + (fun acc entry -> + match entry with + | Field field -> field :: acc + | Collection _ -> acc) + [] + ;; + + let collections (scheme : t) = + scheme + |> List.fold_left + (fun acc entry -> + match entry with + | Field _ -> acc + | Collection collection -> collection :: acc) + [] + ;; +end + +module InputFieldData = struct + type unvalidated = + { name : string + ; typ : ItemType.t + ; async : AsyncMode.t option + ; deps : FieldDep.unvalidated list + } + + type validated = + { name : string + ; typ : ItemType.t + ; async : AsyncMode.t option + ; deps : FieldDep.t list + } + + let unvalidated ~async ~deps (field : label_declaration) : unvalidated = + { name = field.pld_name.txt; typ = field.pld_type |> ItemType.make; async; deps } + ;; + + let validated ~deps (field : unvalidated) : validated = + { name = field.name; typ = field.typ; async = field.async; deps } + ;; +end + +module InputField = struct + type unvalidated = + | UnvalidatedInputField of InputFieldData.unvalidated + | UnvalidatedInputFieldOfCollection of + { collection : Collection.t + ; field : InputFieldData.unvalidated + } + + type validated = + | ValidatedInputField of InputFieldData.validated + | ValidatedInputFieldOfCollection of + { collection : Collection.t + ; field : InputFieldData.validated + } +end + +module OutputFieldData = struct + type t = + { name : string + ; typ : ItemType.t + ; loc : Location.t + } +end + +module OutputField = struct + type t = + | OutputField of OutputFieldData.t + | OutputFieldOfCollection of + { collection : Collection.t + ; field : OutputFieldData.t + } +end + +module InputType = struct + module T : sig + type t + end = struct + type t = type_declaration + end + + type t = T.t + + external make : type_declaration -> t = "%identity" + external type_declaration : t -> type_declaration = "%identity" +end + +module OutputType = struct + module T : sig + type t + end = struct + type t = type_declaration + end + + type t = T.t + + external make : type_declaration -> t = "%identity" + external type_declaration : t -> type_declaration = "%identity" + + let default ~loc = [%stri type output = input] +end + +module MessageType = struct + let default ~loc = [%stri type message = string] +end + +module DebounceInterval = struct + let default ~loc = [%stri let debounceInterval = 700] +end + +module SubmissionErrorType = struct + let default ~loc = [%stri type submissionError = unit] +end + +module FieldOptionalityParser = struct + let parse (typ : ItemType.t) : FieldOptionality.t option = + match typ |> ItemType.unpack with + | { ptyp_desc = Ptyp_constr ({ txt = Lident "string" }, []) } -> Some StringType + | { ptyp_desc = + Ptyp_constr + ( { txt = Lident "option" } + , { ptyp_desc = Ptyp_constr ({ txt = Lident "string" }, []) } :: [] ) + } -> Some OptionStringType + | { ptyp_desc = Ptyp_constr ({ txt = Lident "option" }, _) } -> Some OptionType + | _ -> None + ;; +end + +module AsyncFieldParser = struct + type error = + | InvalidPayload of Location.t + | InvalidAsyncMode of Location.t + + let attr field = + field.pld_type.ptyp_attributes + |> List.find_opt (fun attr -> + match attr with + | { attr_name = { txt = "field.async" } } -> true + | _ -> false) + ;; + + let parse attribute = + match attribute with + | { attr_payload = PStr []; attr_loc = _ } -> Ok AsyncMode.default + | { attr_payload = + PStr + ({ pstr_desc = + Pstr_eval + ( { pexp_desc = + Pexp_record + ( ( { txt = Lident "mode" } + , { pexp_desc = + Pexp_construct ({ txt = Lident mode; loc }, None) + } ) + :: [] + , None ) + } + , _ ) + } + :: []) + ; attr_loc = _ + } -> + (match mode with + | "OnChange" -> Ok OnChange + | "OnBlur" -> Ok OnBlur + | _ -> Error (InvalidAsyncMode loc)) + | { attr_payload = PStr ({ pstr_loc } :: []) } -> Error (InvalidPayload pstr_loc) + | { attr_loc } -> Error (InvalidPayload attr_loc) + ;; + + let get field = + match field |> attr with + | None -> Ok None + | Some attr -> + (match attr |> parse with + | Ok mode -> Ok (Some mode) + | Error error -> Error error) + ;; +end + +module FieldDepsParser = struct + type error = + | DepsParseError of Location.t + | DepNotFound of FieldDep.unvalidated + | DepOfItself of [ `Field of string * Location.t ] + | DepDuplicate of FieldDep.unvalidated + + let attr field = + field.pld_type.ptyp_attributes + |> List.find_opt (fun attr -> + match attr with + | { attr_name = { txt = "field.deps" } } -> true + | _ -> false) + ;; + + let parse (attribute : attribute) : (FieldDep.unvalidated list, error) result = + match attribute with + | { attr_payload = PStr ({ pstr_desc = Pstr_eval (exp, _) } :: []); attr_loc = _ } -> + (match exp with + | { pexp_desc = Pexp_ident { txt = Lident dep; loc } } -> + Ok [ UnvalidatedDepField { name = dep; loc } ] + | { pexp_desc = + Pexp_field + ( { pexp_desc = Pexp_ident { txt = Lident collection; loc = c_loc } } + , { txt = Lident field; loc = f_loc } ) + } -> Ok [ UnvalidatedDepFieldOfCollection { collection; field; c_loc; f_loc } ] + | { pexp_desc = Pexp_tuple exps } -> + exps + |> List.fold_left + (fun (res : (FieldDep.unvalidated list, error) result) exp -> + match res, exp with + | Error error, _ -> Error error + | Ok deps, { pexp_desc = Pexp_ident { txt = Lident dep; loc } } -> + Ok (UnvalidatedDepField { name = dep; loc } :: deps) + | ( Ok deps + , { pexp_desc = + Pexp_field + ( { pexp_desc = + Pexp_ident { txt = Lident collection; loc = c_loc } + } + , { txt = Lident field; loc = f_loc } ) + } ) -> + Ok + (UnvalidatedDepFieldOfCollection { collection; field; c_loc; f_loc } + :: deps) + | Ok _, { pexp_loc } -> Error (DepsParseError pexp_loc)) + (Ok []) + | { pexp_loc } -> Error (DepsParseError pexp_loc)) + | { attr_loc } -> Error (DepsParseError attr_loc) + ;; + + let get field = + match field |> attr with + | None -> Ok [] + | Some attr -> attr |> parse + ;; +end + +module FieldCollectionParser = struct + type result = (ok, error) Stdlib.result + + and ok = + { collection : Collection.t + ; fields : InputFieldData.unvalidated list + ; input_type : ItemType.t + } + + and error = + | NotArray of Location.t + | InvalidTypeRef of Location.t + | RecordNotFound of Location.t + | NotRecord of Location.t + | InvalidAsyncField of AsyncFieldParser.error + | InvalidFieldDeps of FieldDepsParser.error + + let attr (field : label_declaration) = + field.pld_type.ptyp_attributes + |> List.find_opt (fun attr -> + match attr with + | { attr_name = { txt = "field.collection" } } -> true + | _ -> false) + ;; + + let parse ~(structure : structure) (field : label_declaration) : result = + match field.pld_type.ptyp_desc with + | Ptyp_constr ({ txt = Lident "array"; loc = arr_loc }, payload) -> + (match payload with + | [] -> Error (InvalidTypeRef arr_loc) + | ({ ptyp_desc = Ptyp_constr ({ txt = Lident typ_name }, []); ptyp_loc } as + input_type) + :: _ -> + let record_type = ref None in + structure + |> List.iter (fun (item : structure_item) -> + match item with + | { pstr_desc = Pstr_type (_rec_flag, decls) } -> + decls + |> List.iter (fun (decl : type_declaration) -> + match decl with + | { ptype_name = { txt = name } } when name = typ_name -> + (match decl.ptype_kind with + | Ptype_record fields -> record_type := Some (Ok fields) + | _ -> record_type := Some (Error (NotRecord decl.ptype_loc))) + | _ -> ()) + | _ -> ()); + (match !record_type with + | None -> Error (RecordNotFound ptyp_loc) + | Some (Error error) -> Error error + | Some (Ok fields) -> + let fields = + fields + |> List.fold_left + (fun res (field : label_declaration) -> + match res with + | Error error -> Error error + | Ok fields -> + (match + field |> AsyncFieldParser.get, field |> FieldDepsParser.get + with + | Ok async, Ok deps -> + Ok ((field |> InputFieldData.unvalidated ~async ~deps) :: fields) + | Error error, _ -> Error (InvalidAsyncField error) + | _, Error error -> Error (InvalidFieldDeps error))) + (Ok []) + in + (match fields with + | Ok fields -> + Ok + { collection = { plural = field.pld_name.txt; singular = typ_name } + ; fields + ; input_type = input_type |> ItemType.make + } + | Error error -> Error error)) + | { ptyp_loc } :: _ -> Error (InvalidTypeRef ptyp_loc)) + | _ -> Error (NotArray field.pld_loc) + ;; +end + +module FieldAttributesParser = struct + type result = (ok option, error) Stdlib.result + + and ok = + | Collection of FieldCollectionParser.ok + | AsyncDeps of + { async : AsyncMode.t option + ; deps : FieldDep.unvalidated list + } + + and error = + | Conflict of + [ `AsyncWithCollection of Location.t | `DepsWithCollection of Location.t ] + | InvalidCollectionField of FieldCollectionParser.error + | InvalidAsyncField of AsyncFieldParser.error + | InvalidFieldDeps of FieldDepsParser.error + + let parse ~(structure : structure) (field : label_declaration) = + match + ( field |> FieldCollectionParser.attr + , field |> AsyncFieldParser.attr + , field |> FieldDepsParser.attr ) + with + | Some _, None, None -> + (match field |> FieldCollectionParser.parse ~structure with + | Ok collection -> Ok (Some (Collection collection)) + | Error error -> Error (InvalidCollectionField error)) + | None, Some async_attr, Some deps_attr -> + (match async_attr |> AsyncFieldParser.parse, deps_attr |> FieldDepsParser.parse with + | Ok async, Ok deps -> Ok (Some (AsyncDeps { async = Some async; deps })) + | Error error, _ -> Error (InvalidAsyncField error) + | _, Error error -> Error (InvalidFieldDeps error)) + | None, Some async_attr, None -> + (match async_attr |> AsyncFieldParser.parse with + | Ok async -> Ok (Some (AsyncDeps { async = Some async; deps = [] })) + | Error error -> Error (InvalidAsyncField error)) + | None, None, Some deps_attr -> + (match deps_attr |> FieldDepsParser.parse with + | Ok deps -> Ok (Some (AsyncDeps { async = None; deps })) + | Error error -> Error (InvalidFieldDeps error)) + | None, None, None -> Ok None + | Some _, Some { attr_loc }, _ -> Error (Conflict (`AsyncWithCollection attr_loc)) + | Some _, _, Some { attr_loc } -> Error (Conflict (`DepsWithCollection attr_loc)) + ;; +end + +module InputTypeParser = struct + type result = (ok, error) Stdlib.result + + and ok = + { entries : unvalidated_entry list + ; type_declaration : InputType.t + } + + and unvalidated_entry = + | UnvalidatedInputField of InputFieldData.unvalidated + | UnvalidatedInputCollection of + { collection : Collection.t + ; fields : InputFieldData.unvalidated list + ; input_type : ItemType.t + } + + and validated_entry = + | ValidatedInputField of InputFieldData.validated + | ValidatedInputCollection of + { collection : Collection.t + ; fields : InputFieldData.validated list + ; input_type : ItemType.t + } + + and error = + | NotFound + | NotRecord of Location.t + | InvalidAttributes of FieldAttributesParser.error + + let parse ~decl ~structure ~loc:_ fields = + let entries = + fields + |> List.rev + |> List.fold_left + (fun res field -> + match res, field |> FieldAttributesParser.parse ~structure with + | ( Ok entries + , ((Ok (Some (Collection { collection; fields; input_type }))) [@explicit_arity + ]) ) -> + Ok + ((UnvalidatedInputCollection { collection; fields; input_type } [@explicit_arity + ]) + :: entries) + | Ok entries, Ok (Some (AsyncDeps { async; deps })) -> + Ok + (UnvalidatedInputField (field |> InputFieldData.unvalidated ~async ~deps) + :: entries) + | Ok entries, Ok None -> + Ok + ((UnvalidatedInputField + (field |> InputFieldData.unvalidated ~async:None ~deps:[]) [@explicit_arity + ]) + :: entries) + | Error error, _ -> Error error + | _, Error error -> Error (InvalidAttributes error)) + (Ok []) + in + match entries with + | Error error -> Error error + | Ok entries -> Ok { entries; type_declaration = decl |> InputType.make } + ;; + + let validate (unvalidated_entries : unvalidated_entry list) + : (validated_entry list, FieldDepsParser.error) Stdlib.result + = + let dup (deps : FieldDep.unvalidated list) (dep : FieldDep.unvalidated) = + match + deps + |> List.find_all (fun (dep' : FieldDep.unvalidated) -> + match dep, dep' with + | UnvalidatedDepField { name = dep }, UnvalidatedDepField { name = dep' } -> + dep = dep' + | ( UnvalidatedDepFieldOfCollection { collection; field } + , UnvalidatedDepFieldOfCollection { collection = collection'; field = field' } + ) -> collection = collection' && field = field' + | UnvalidatedDepField _, UnvalidatedDepFieldOfCollection _ + | UnvalidatedDepFieldOfCollection _, UnvalidatedDepField _ -> false) + |> List.length + with + | 0 | 1 -> None + | _ -> Some () + in + unvalidated_entries + |> List.fold_left + (fun (res : (validated_entry list, FieldDepsParser.error) Stdlib.result) + (unvalidated_entry : unvalidated_entry) -> + match res, unvalidated_entry with + | Error error, _ -> Error error + | Ok validated_entries, UnvalidatedInputField field -> + let deps = + field.deps + |> List.fold_left + (fun (res : (FieldDep.t list, FieldDepsParser.error) Stdlib.result) + dep -> + match res with + | Error error -> Error error + | Ok validated_deps -> + (match dep |> dup field.deps with + | Some () -> Error (FieldDepsParser.DepDuplicate dep) + | None -> + (match + unvalidated_entries + |> List.fold_left + (fun (res : + ( FieldDep.t + , FieldDepsParser.error ) + Stdlib.result + option) + entry -> + match res, dep, entry with + | (Some _ as res), _, _ -> res + | ( None + , UnvalidatedDepField dep' + , UnvalidatedInputField field' ) -> + if field.name = field'.name + && field'.name = dep'.name + then + Some + (Error + (FieldDepsParser.DepOfItself + (`Field (dep'.name, dep'.loc)) [@explicit_arity + ]) [@explicit_arity + ]) [@explicit_arity + ] + else if field'.name = dep'.name + then Some (Ok (DepField dep'.name)) + else None + | ( None + , ((UnvalidatedDepFieldOfCollection dep') [@explicit_arity + ]) + , ((UnvalidatedInputCollection entry') [@explicit_arity + ]) ) -> + if dep'.collection <> entry'.collection.singular + then None + else ( + match + entry'.fields + |> List.find_opt + (fun + (field : InputFieldData.unvalidated) + -> dep'.field = field.name) + with + | None -> + Some + (Error + (FieldDepsParser.DepNotFound dep [@explicit_arity + ]) [@explicit_arity + ]) + | Some field -> + Some + (Ok + (DepFieldOfCollection + { collection = entry'.collection + ; field = field.name + }))) + | ( None + , UnvalidatedDepField _ + , UnvalidatedInputCollection _ ) + | ( None + , UnvalidatedDepFieldOfCollection _ + , UnvalidatedInputField _ ) -> None) + None + with + | None -> Error (FieldDepsParser.DepNotFound dep) + | Some (Error error) -> Error error + | Some (Ok dep_entry) -> Ok (dep_entry :: validated_deps)))) + (Ok []) + in + (match deps with + | Error error -> Error error + | Ok deps -> + Ok + ((ValidatedInputField (field |> InputFieldData.validated ~deps) [@explicit_arity + ]) + :: validated_entries)) + | ( Ok validated_entries + , ((UnvalidatedInputCollection + { collection; fields = unvalidated_fields; input_type }) [@explicit_arity + ]) ) -> + let validated_fields = + unvalidated_fields + |> List.fold_left + (fun (res : + ( InputFieldData.validated list + , FieldDepsParser.error ) + Stdlib.result) + (field : InputFieldData.unvalidated) -> + match res with + | Error error -> Error error + | Ok validated_fields -> + let deps = + field.deps + |> List.fold_left + (fun (res : + ( FieldDep.t list + , FieldDepsParser.error ) + Stdlib.result) + dep -> + match res with + | Error error -> Error error + | Ok validated_deps -> + (match dep |> dup field.deps with + | Some () -> Error (FieldDepsParser.DepDuplicate dep) + | None -> + (match + unvalidated_entries + |> List.fold_left + (fun (res : + ( FieldDep.t + , FieldDepsParser.error ) + Stdlib.result + option) + entry -> + match res, dep, entry with + | (Some _ as res), _, _ -> res + | ( None + , ((UnvalidatedDepField dep') [@explicit_arity + ]) + , ((UnvalidatedInputField field') [@explicit_arity + ]) ) + -> + if field'.name = dep'.name + then + Some + (Ok + (DepField dep'.name [@explicit_arity + ]) [@explicit_arity + ]) [@explicit_arity + ] + else None + | ( None + , UnvalidatedDepFieldOfCollection dep' + , ((UnvalidatedInputCollection entry') [@explicit_arity + ]) + ) -> + if dep'.collection + <> entry'.collection.singular + then None + else ( + match + entry'.fields + |> List.fold_left + (fun (res : + ( FieldDep.t + , FieldDepsParser.error + ) + Stdlib.result + option) + (field : + InputFieldData + .unvalidated) -> + match res with + | Some _ -> res + | None -> + if dep'.field = field.name + then + Some + (Ok + (DepFieldOfCollection + { collection = + entry' + .collection + ; field = + field.name + } [@explicit_arity + ]) [@explicit_arity + ]) [@explicit_arity + ] + else None) + None + with + | None -> + Some + (Error + (FieldDepsParser.DepNotFound + dep)) + | Some (Error error) -> + Some (Error error) + | Some (Ok dep) -> Some (Ok dep)) + | ( None + , UnvalidatedDepField _ + , UnvalidatedInputCollection _ ) + | ( None + , UnvalidatedDepFieldOfCollection _ + , UnvalidatedInputField _ ) -> None) + None + with + | None -> + Error + (FieldDepsParser.DepNotFound dep [@explicit_arity + ]) [@explicit_arity + ] + | Some (Error error) -> Error error + | Some (Ok dep_entry) -> + Ok (dep_entry :: validated_deps)))) + (Ok []) + in + (match deps with + | Error error -> Error error + | Ok deps -> + Ok + ((field |> InputFieldData.validated ~deps) + :: validated_fields))) + (Ok []) + in + (match validated_fields with + | Error error -> Error error + | Ok validated_fields -> + Ok + ((ValidatedInputCollection + { collection; fields = validated_fields; input_type } [@explicit_arity + ]) + :: validated_entries))) + (Ok []) + ;; + + let in_deps_of (entries : validated_entry list) (field : InputField.validated) + : InputField.validated option + = + entries + |> List.fold_left + (fun res (entry : validated_entry) -> + match res, field, entry with + | Some _, _, _ -> res + | None, ValidatedInputField subject_field, ValidatedInputField entry_field -> + entry_field.deps + |> List.fold_left + (fun (res : InputField.validated option) (dep : FieldDep.t) -> + match res, dep with + | Some _, _ -> res + | None, DepField dep -> + if dep = subject_field.name + then Some (ValidatedInputField entry_field) + else None + | None, DepFieldOfCollection _ -> None) + None + | ( None + , ValidatedInputField subject_field + , ((ValidatedInputCollection + { collection = entry_collection; fields = entry_fields }) [@explicit_arity + ]) ) -> + entry_fields + |> List.fold_left + (fun (_res : InputField.validated option) + (entry_field : InputFieldData.validated) -> + entry_field.deps + |> List.fold_left + (fun (res : InputField.validated option) (dep : FieldDep.t) -> + match res, dep with + | Some _, _ -> res + | None, DepField dep -> + if dep = subject_field.name + then + Some + (ValidatedInputFieldOfCollection + { collection = entry_collection; field = entry_field }) + else None + | None, DepFieldOfCollection _ -> None) + None) + None + | ( None + , ((ValidatedInputFieldOfCollection + { collection = subject_collection; field = subject_field }) [@explicit_arity + ]) + , ValidatedInputField entry_field ) -> + entry_field.deps + |> List.fold_left + (fun (res : InputField.validated option) (dep : FieldDep.t) -> + match res, dep with + | Some _, _ -> res + | None, DepField _dep -> None + | ( None + , ((DepFieldOfCollection + { collection = dep_collection; field = dep_field }) [@explicit_arity + ]) ) -> + if dep_collection.singular = subject_collection.singular + && dep_field = subject_field.name + then Some (ValidatedInputField entry_field) + else None) + None + | ( None + , ((ValidatedInputFieldOfCollection + { collection = subject_collection; field = subject_field }) [@explicit_arity + ]) + , ((ValidatedInputCollection + { collection = entry_collection; fields = entry_fields }) [@explicit_arity + ]) ) -> + entry_fields + |> List.fold_left + (fun (_res : InputField.validated option) + (entry_field : InputFieldData.validated) -> + entry_field.deps + |> List.fold_left + (fun (res : InputField.validated option) (dep : FieldDep.t) -> + match res, dep with + | Some _, _ -> res + | None, DepField _dep -> None + | ( None + , ((DepFieldOfCollection + { collection = dep_collection; field = dep_field }) [@explicit_arity + ]) + ) -> + if subject_collection.singular = dep_collection.singular + && subject_field.name = dep_field + then + Some + (ValidatedInputFieldOfCollection + { collection = entry_collection; field = entry_field }) + else None) + None) + None) + None + ;; +end + +module OutputTypeParser = struct + type result = (ok, error) Stdlib.result + + and ok = + | NotProvided + | AliasOfInput + | Record of + { entries : entry list + ; loc : Location.t + } + + and entry = + | OutputField of OutputFieldData.t + | OutputCollection of + { collection : Collection.t + ; fields : OutputFieldData.t list + ; output_type : ItemType.t + } + + and error = + | InputNotAvailable of Location.t + | NotRecord of Location.t + | BadTypeAlias of + { alias : string + ; loc : Location.t + } + | OutputCollectionNotFound of + { input_collection : Collection.t + ; loc : Location.t + } + | InvalidCollection of collection_error + + and collection_error = + | InvalidCollectionTypeRef of Location.t + | CollectionTypeNotRecord of Location.t + | CollectionTypeNotFound of Location.t + | CollectionOutputNotArray of Location.t + + let flatten (entries : entry list) : OutputField.t list = + entries + |> List.rev + |> List.fold_left + (fun acc entry -> + match entry with + | OutputField field -> OutputField.OutputField field :: acc + | OutputCollection { collection; fields } -> + fields + |> List.rev + |> List.fold_left + (fun acc field -> + (OutputField.OutputFieldOfCollection { collection; field } [@explicit_arity + ]) + :: acc) + acc) + [] + ;; + + let parse + ~structure + ~(input_collections : Collection.t list) + ~loc + (fields : label_declaration list) + = + match input_collections with + | [] -> + Ok + (Record + { loc + ; entries = + fields + |> List.rev + |> List.fold_left + (fun acc field -> + OutputField + { name = field.pld_name.txt + ; typ = field.pld_type |> ItemType.make + ; loc = field.pld_loc + } + :: acc) + [] + }) + | _ -> + let entries = + fields + |> List.rev + |> List.fold_left + (fun acc field -> + match acc with + | Error error -> Error error + | Ok entries -> + let field_name = field.pld_name.txt in + (match + input_collections + |> List.find_opt (fun (collection : Collection.t) -> + collection.plural = field_name) + with + | None -> + Ok + (OutputField + { name = field_name + ; typ = field.pld_type |> ItemType.make + ; loc = field.pld_loc + } + :: entries) + | Some _input_collection -> + (match field.pld_type.ptyp_desc with + | Ptyp_constr ({ txt = Lident "array"; loc = arr_loc }, payload) -> + (match payload with + | [] -> Error (InvalidCollectionTypeRef arr_loc) + | ({ ptyp_desc = + ((Ptyp_constr ({ txt = Lident type_name }, [])) [@explicit_arity + ]) + ; ptyp_loc + } as output_type) + :: _ -> + let record_type = ref None in + structure + |> List.iter (fun (item : structure_item) -> + match item with + | { pstr_desc = Pstr_type (_rec_flag, decls) } -> + decls + |> List.iter (fun (decl : type_declaration) -> + match decl with + | { ptype_name = { txt = name } } when name = type_name -> + (match decl.ptype_kind with + | Ptype_record fields -> + record_type := Some (Ok fields) + | _ -> + record_type + := Some + (Error + (CollectionTypeNotRecord decl.ptype_loc [@explicit_arity + ]))) + | _ -> ()) + | _ -> ()); + (match !record_type with + | None -> Error (CollectionTypeNotFound ptyp_loc) + | Some (Error error) -> Error error + | Some (Ok fields) -> + Ok + (OutputCollection + { collection = + { plural = field_name; singular = type_name } + ; fields = + fields + |> List.rev + |> List.rev_map (fun (field : label_declaration) -> + let open OutputFieldData in + { name = field.pld_name.txt + ; typ = field.pld_type |> ItemType.make + ; loc = field.pld_loc + }) + ; output_type = output_type |> ItemType.make + } + :: entries)) + | { ptyp_loc } :: _ -> Error (InvalidCollectionTypeRef ptyp_loc)) + | _ -> Error (CollectionOutputNotArray field.pld_loc)))) + (Ok []) + in + (match entries with + | Ok entries -> Ok (Record { loc; entries }) + | Error error -> Error (InvalidCollection error)) + ;; +end + +module DebounceIntervalParser = struct + let exists (values : value_binding list) = + values + |> List.exists (function + | { pvb_pat = { ppat_desc = Ppat_var { txt = "debounceInterval" } } } -> true + | _ -> false) + ;; +end + +module ValidatorsRecordParser = struct + type result = (ValidatorsRecord.t, error) Stdlib.result + + and error = + | NotFound + | NotRecord of Location.t + | BadTypeAnnotation of Location.t + | ValidatorError of + [ `BadRequiredValidator of + InputField.validated + * [ `Some of Location.t | `None of Location.t ] + * [ `IncludedInDeps of InputField.validated + | `DifferentIO of ItemType.t * ItemType.t + ] + ] + | RecordParseError of Location.t + + let exists (values : value_binding list) = + values + |> List.exists (function + | { pvb_pat = { ppat_desc = Ppat_var { txt = "validators" } } } -> true + | _ -> false) + ;; + + let parse ~rec_flag (values : value_binding list) : result option = + values + |> List.fold_left + (fun res value -> + match res with + | Some _ -> res + | None -> + (match value with + | { pvb_pat = { ppat_desc = Ppat_var { txt = "validators" } } + ; pvb_expr = + { pexp_desc = + Pexp_constraint + ( expr + , ({ ptyp_desc = Ptyp_constr (typ, args); ptyp_loc } as + annotation) ) + ; pexp_loc = constraint_pexp_loc + ; pexp_loc_stack = constraint_pexp_loc_stack + ; pexp_attributes = constraint_pexp_attributes + } + } -> + (match typ, args with + | { txt = Lident "validators" }, [] -> + (match expr with + | { pexp_desc = Pexp_record (fields, None) + ; pexp_loc = record_pexp_loc + ; pexp_loc_stack = record_pexp_loc_stack + ; pexp_attributes = record_pexp_attributes + } -> + Some + (Ok + (let open ValidatorsRecord in + { fields + ; rec_flag + ; annotation + ; constraint_metadata = + { pexp_loc = constraint_pexp_loc + ; pexp_loc_stack = constraint_pexp_loc_stack + ; pexp_attributes = constraint_pexp_attributes + } + ; record_metadata = + { pexp_loc = record_pexp_loc + ; pexp_loc_stack = record_pexp_loc_stack + ; pexp_attributes = record_pexp_attributes + } + })) + | { pexp_loc } -> Some (Error (NotRecord pexp_loc))) + | { txt = _ }, _ -> Some (Error (BadTypeAnnotation ptyp_loc))) + | { pvb_pat = { ppat_desc = Ppat_var { txt = "validators" } } + ; pvb_expr = { pexp_loc } as expr + } -> + (match expr with + | { pexp_desc = Pexp_record (fields, None) + ; pexp_loc = loc + ; pexp_loc_stack + ; pexp_attributes + } -> + Some + (Ok + { fields + ; rec_flag + ; annotation = [%type: validators] + ; constraint_metadata = + { pexp_loc; pexp_loc_stack; pexp_attributes } + ; record_metadata = { pexp_loc; pexp_loc_stack; pexp_attributes } + }) + | { pexp_loc } -> Some (Error (NotRecord pexp_loc))) + | _ -> None)) + None + ;; + + let find_field (field : InputField.validated) (validators : ValidatorsRecord.fields) = + validators + |> List.fold_left + (fun res validator -> + match res, field, validator with + | Some _, _, _ -> res + | None, ValidatedInputField field, ({ txt = Lident key }, _) -> + (match field.name = key with + | true -> Some validator + | false -> None) + | ( None + , ValidatedInputFieldOfCollection { collection; field } + , ({ txt = Lident key }, { pexp_desc = Pexp_record (fields, None) }) ) -> + if collection.plural = key + then + fields + |> List.fold_left + (fun res entry -> + match res, entry with + | Some _, _ -> res + | ( None + , ( { txt = Lident "fields" } + , { pexp_desc = Pexp_record (fields, None) } ) ) -> + fields + |> List.find_opt (fun entry -> + match entry with + | { txt = Lident key }, _ -> key = field.name + | _ -> false) + | None, _ -> None) + None + else None + | ( None + , ((ValidatedInputFieldOfCollection { collection = _; field = _ }) [@explicit_arity + ]) + , ({ txt = _ }, _) ) -> None + | None, ValidatedInputField _, ({ txt = _ }, _) -> None) + None + ;; + + let find_collection (collection : Collection.t) (validators : ValidatorsRecord.fields) = + validators + |> List.fold_left + (fun res validator -> + match res, validator with + | Some _, _ -> res + | None, ({ txt = Lident key }, { pexp_desc = Pexp_record (fields, None) }) + when collection.plural = key -> + fields + |> List.fold_left + (fun res entry -> + match res, entry with + | Some _, _ -> res + | None, ({ txt = Lident "collection" }, exp) -> Some exp + | None, _ -> None) + None + | None, ({ txt = _ }, _) -> None) + None + ;; + + let required (field : InputField.validated) (validators : ValidatorsRecord.fields) = + match validators |> find_field field with + | Some (_, { pexp_desc = Pexp_record _ }) -> Ok () + | Some + ( _ + , { pexp_desc = + Pexp_construct ({ txt = Lident "Some" }, Some { pexp_desc = Pexp_record _ }) + ; pexp_loc + } ) -> Error (`Some pexp_loc) + | Some (_, { pexp_desc = Pexp_construct ({ txt = Lident "None" }, None); pexp_loc }) + -> Error (`None pexp_loc) + | Some _ -> Error `BadValue + | None -> Error `NotFound + ;; + + let optional (field : InputField.validated) (validators : ValidatorsRecord.fields) = + match validators |> find_field field with + | Some (_, { pexp_desc = Pexp_record _ }) -> Ok (Some ()) + | Some (_, { pexp_desc = Pexp_construct ({ txt = Lident "None" }, None) }) -> Ok None + | Some _ -> Error `BadValue + | None -> Error `NotFound + ;; + + let collection (collection : Collection.t) (validators : ValidatorsRecord.fields) = + match validators |> find_collection collection with + | Some { pexp_desc = Pexp_fun _ } -> Ok (Some ()) + | Some { pexp_desc = Pexp_construct ({ txt = Lident "None" }, None) } -> Ok None + | Some _ -> Error `BadValue + | None -> Error `NotFound + ;; +end + +module Metadata = struct + type t = + { scheme : Scheme.t + ; async : bool + ; output_type : OutputTypeParser.ok + ; validators_record : ValidatorsRecord.t + ; message_type : unit option + ; submission_error_type : unit option + ; metadata : unit option + ; debounce_interval : unit option + } + + type error = + | InputTypeParseError of InputTypeParser.error + | OutputTypeParseError of OutputTypeParser.error + | ValidatorsRecordParseError of ValidatorsRecordParser.error + | IOMismatch of io_mismatch + + and io_mismatch = + | InputFieldsNotInOutput of + { fields : InputField.validated list + ; loc : Location.t + } + | OutputFieldsNotInInput of { fields : OutputField.t list } + | Both of + { input_fields_not_in_output : InputField.validated list + ; output_fields_not_in_input : OutputField.t list + ; loc : Location.t + } + + let make (structure : structure) = + let input_parsing_result = (ref None : InputTypeParser.result option ref) in + let output_parsing_result = + (ref (Ok OutputTypeParser.NotProvided) : OutputTypeParser.result ref) + in + let validators_record_parsing_result = + (ref None : ValidatorsRecordParser.result option ref) + in + let message_type = (ref None : unit option ref) in + let submission_error_type = (ref None : unit option ref) in + let metadata = (ref None : unit option ref) in + let debounce_interval_value = (ref None : unit option ref) in + structure + |> List.iter (function + | { pstr_desc = Pstr_type (_rec_flag, decls) } -> + decls + |> List.iter (function + | { ptype_name = { txt = "input" } + ; ptype_kind = Ptype_record fields + ; ptype_loc + } as decl -> + input_parsing_result + := (Some (fields |> InputTypeParser.parse ~decl ~structure ~loc:ptype_loc) [@explicit_arity + ]) + | { ptype_name = { txt = "input" }; ptype_loc } -> + input_parsing_result := Some (Error (InputTypeParser.NotRecord ptype_loc)) + | { ptype_name = { txt = "output" } + ; ptype_kind = Ptype_record fields + ; ptype_loc + } -> + (match !input_parsing_result with + | None -> output_parsing_result := Error (InputNotAvailable ptype_loc) + | Some (Ok { entries }) -> + output_parsing_result + := fields + |> OutputTypeParser.parse + ~structure + ~loc:ptype_loc + ~input_collections: + (entries + |> List.fold_left + (fun acc (entry : InputTypeParser.unvalidated_entry) -> + match entry with + | UnvalidatedInputField _ -> acc + | ((UnvalidatedInputCollection { collection }) [@explicit_arity + ]) -> + collection :: acc) + []) + | Some (Error _) -> ()) + | { ptype_name = { txt = "output" } + ; ptype_kind = Ptype_abstract + ; ptype_loc = _ + ; ptype_manifest = + Some { ptyp_desc = Ptyp_constr ({ txt = Lident "input" }, []) } + } -> output_parsing_result := Ok AliasOfInput + | { ptype_name = { txt = "output" } + ; ptype_kind = Ptype_abstract + ; ptype_manifest = + Some { ptyp_desc = Ptyp_constr ({ txt = Lident alias; loc }, []) } + } -> + output_parsing_result := Error (OutputTypeParser.BadTypeAlias { alias; loc }) + | { ptype_name = { txt = "output" }; ptype_loc } -> + output_parsing_result := Error (OutputTypeParser.NotRecord ptype_loc) + | { ptype_name = { txt = "message" }; ptype_loc = _ } -> message_type := Some () + | { ptype_name = { txt = "metadata" }; ptype_loc = _ } -> metadata := Some () + | { ptype_name = { txt = "submissionError" }; ptype_loc = _ } -> + submission_error_type := Some () + | _ -> ()) + | { pstr_desc = Pstr_value (rec_flag, values) } -> + if values |> DebounceIntervalParser.exists then debounce_interval_value := Some (); + (match values |> ValidatorsRecordParser.parse ~rec_flag with + | Some x -> validators_record_parsing_result := Some x + | None -> ()) + | _ -> ()); + match + !input_parsing_result, !output_parsing_result, !validators_record_parsing_result + with + | Some (Error error), _, _ -> Error (InputTypeParseError error) + | None, _, _ -> Error (InputTypeParseError NotFound) + | _, Error error, _ -> Error (OutputTypeParseError error) + | _, _, None -> Error (ValidatorsRecordParseError NotFound) + | _, _, Some (Error error) -> Error (ValidatorsRecordParseError error) + | Some (Ok input_data), Ok output_result, Some (Ok validators_record) -> + (match input_data.entries |> InputTypeParser.validate with + | Error error -> + Error + (InputTypeParseError (InvalidAttributes (InvalidFieldDeps error)) [@explicit_arity + ]) [@explicit_arity + ] + | Ok validated_input_entries -> + let scheme = + ((match output_result with + | NotProvided | AliasOfInput -> + let validator + ~(field : InputField.validated) + ~(entries : InputTypeParser.validated_entry list) + ~(validators_record : ValidatorsRecord.t) + ~(async_mode : AsyncMode.t option) + ~(output_type : ItemType.t) + : (FieldValidator.t, error) result + = + match async_mode with + | None -> + (match field |> InputTypeParser.in_deps_of entries with + | Some in_deps_of_entry -> + (match + validators_record.fields |> ValidatorsRecordParser.required field + with + | Ok () -> Ok (SyncValidator (Ok Required)) + | Error (`NotFound | `BadValue) -> Ok (SyncValidator (Error ())) + | ((Error ((`Some _ as reason) | (`None _ as reason))) [@explicit_arity + ]) -> + Error + (ValidatorsRecordParseError + (ValidatorError + (`BadRequiredValidator + (field, reason, `IncludedInDeps in_deps_of_entry)) [@explicit_arity + ]))) + | None -> + (match + validators_record.fields |> ValidatorsRecordParser.optional field + with + | Ok res -> Ok (SyncValidator (Ok (Optional res))) + | Error (`NotFound | `BadValue) -> Ok (SyncValidator (Error ())))) + | Some mode -> + Ok + (AsyncValidator + { mode + ; optionality = output_type |> FieldOptionalityParser.parse + }) + in + validated_input_entries + |> List.fold_left + (fun res (entry : InputTypeParser.validated_entry) -> + match res, entry with + | Error error, _ -> Error error + | Ok scheme, ValidatedInputField field -> + let validator = + validator + ~field:(ValidatedInputField field) + ~entries:validated_input_entries + ~validators_record + ~async_mode:field.async + ~output_type:field.typ + in + (match validator with + | Ok validator -> + Ok + (Scheme.Field + { name = field.name + ; input_type = field.typ + ; output_type = field.typ + ; validator + ; deps = field.deps + } + :: scheme) + | Error error -> Error error) + | ( Ok scheme + , ((ValidatedInputCollection { collection; fields; input_type }) [@explicit_arity + ]) + ) -> + let fields = + fields + |> List.fold_left + (fun res field -> + match res with + | Error error -> Error error + | Ok fields -> + let validator = + validator + ~field: + (ValidatedInputFieldOfCollection + { collection; field }) + ~entries:validated_input_entries + ~validators_record + ~async_mode:field.async + ~output_type:field.typ + in + (match validator with + | Ok validator -> + Ok + ((let open Scheme in + { name = field.name + ; input_type = field.typ + ; output_type = field.typ + ; validator + ; deps = field.deps + }) + :: fields) + | Error error -> Error error)) + (Ok []) + in + (match fields with + | Error error -> Error error + | Ok fields -> + Ok + (Scheme.Collection + { collection + ; fields + ; input_type + ; output_type = input_type + ; validator = + (match + validators_record.fields + |> ValidatorsRecordParser.collection collection + with + | Ok res -> Ok res + | Error _ -> Error ()) + } + :: scheme))) + (Ok []) + | Record { entries = output_entries; loc = output_loc } -> + let validator + ~(input_field : InputField.validated) + ~(input_field_data : InputFieldData.validated) + ~(output_field_data : OutputFieldData.t) + ~(input_entries : InputTypeParser.validated_entry list) + ~(validators_record : ValidatorsRecord.t) + : (FieldValidator.t, error) result + = + match input_field_data.async with + | None -> + (match input_field |> InputTypeParser.in_deps_of input_entries with + | Some in_deps_of_field -> + (match + validators_record.fields + |> ValidatorsRecordParser.required input_field + with + | Ok () -> Ok (SyncValidator (Ok Required)) + | Error (`NotFound | `BadValue) -> Ok (SyncValidator (Error ())) + | ((Error ((`Some _ as reason) | (`None _ as reason))) [@explicit_arity + ]) -> + Error + (ValidatorsRecordParseError + (ValidatorError + (`BadRequiredValidator + (input_field, reason, `IncludedInDeps in_deps_of_field))))) + | None -> + if ItemType.eq input_field_data.typ output_field_data.typ + then ( + match + validators_record.fields + |> ValidatorsRecordParser.optional input_field + with + | Ok res -> Ok (SyncValidator (Ok (Optional res))) + | Error (`NotFound | `BadValue) -> Ok (SyncValidator (Error ()))) + else ( + match + validators_record.fields + |> ValidatorsRecordParser.required input_field + with + | Ok () -> Ok (SyncValidator (Ok Required)) + | Error (`NotFound | `BadValue) -> Ok (SyncValidator (Error ())) + | ((Error ((`Some _ as reason) | (`None _ as reason))) [@explicit_arity + ]) -> + Error + (ValidatorsRecordParseError + (ValidatorError + (`BadRequiredValidator + ( input_field + , reason + , `DifferentIO + (input_field_data.typ, output_field_data.typ) )) [@explicit_arity + ])))) + | Some mode -> + Ok + (AsyncValidator + { mode + ; optionality = + output_field_data.typ |> FieldOptionalityParser.parse + }) + in + let result, input_fields_not_in_output, output_fields_not_in_input = + validated_input_entries + |> List.rev + |> List.fold_left + (fun ( (result : (Scheme.t, error) result) + , (input_fields_not_in_output : InputField.validated list) + , (output_fields_not_in_input : OutputField.t list) ) + (input_entry : InputTypeParser.validated_entry) -> + match input_entry with + | ValidatedInputField input_field_data -> + let output_field_data = + output_entries + |> List.fold_left + (fun res (output_entry : OutputTypeParser.entry) -> + match res, output_entry with + | Some _, _ -> res + | None, OutputField output_field_data -> + (match + input_field_data.name = output_field_data.name + with + | true -> Some output_field_data + | false -> None) + | None, OutputCollection _ -> None) + None + in + (match result, output_field_data with + | _, None -> + ( result + , ValidatedInputField input_field_data + :: input_fields_not_in_output + , output_fields_not_in_input ) + | Error error, Some _output_field_data -> + ( Error error + , input_fields_not_in_output + , output_fields_not_in_input + |> List.filter (fun (output_field : OutputField.t) -> + match output_field with + | OutputField output_field_data -> + output_field_data.name <> input_field_data.name + | OutputFieldOfCollection _ -> true) ) + | Ok scheme, Some output_field_data -> + let validator = + validator + ~input_field:(ValidatedInputField input_field_data) + ~input_field_data + ~output_field_data + ~input_entries:validated_input_entries + ~validators_record + in + ( (match validator with + | Error error -> Error error + | Ok validator -> + Ok + (Scheme.Field + { name = input_field_data.name + ; input_type = input_field_data.typ + ; output_type = output_field_data.typ + ; validator + ; deps = input_field_data.deps + } + :: scheme)) + , input_fields_not_in_output + , output_fields_not_in_input + |> List.filter (fun (output_field : OutputField.t) -> + match output_field with + | OutputField output_field_data -> + output_field_data.name <> input_field_data.name + | OutputFieldOfCollection _ -> true) )) + | ValidatedInputCollection + { collection = input_collection + ; fields = input_fields + ; input_type = input_collection_type + } -> + let output_collection = + output_entries + |> List.fold_left + (fun res (output_entry : OutputTypeParser.entry) -> + match res, output_entry with + | Some _, _ -> res + | None, OutputField _ -> res + | ( None + , OutputCollection + { collection = output_collection + ; fields + ; output_type + } ) -> + if output_collection.plural = input_collection.plural + then Some (output_collection, fields, output_type) + else None) + None + in + (match output_collection with + | None -> + ( (Error + (OutputTypeParseError + (OutputCollectionNotFound + { input_collection; loc = output_loc } [@explicit_arity + ]) [@explicit_arity + ]) [@explicit_arity + ]) + , input_fields + |> List.fold_left + (fun (acc : InputField.validated list) field -> + (ValidatedInputFieldOfCollection + { collection = input_collection; field } [@explicit_arity + ]) + :: acc) + input_fields_not_in_output + , output_fields_not_in_input ) + | Some (_output_collection, output_fields, output_type) -> + let ( fields + , input_fields_not_in_output + , output_fields_not_in_input ) + = + input_fields + |> List.rev + |> List.fold_left + (fun ( (res : (Scheme.field list, error) result) + , (input_fields_not_in_output : + InputField.validated list) + , (output_fields_not_in_input : + OutputField.t list) ) + (input_field_data : InputFieldData.validated) -> + let output_field_data = + output_fields + |> List.find_opt + (fun + (output_field_data : OutputFieldData.t) + -> + output_field_data.name + = input_field_data.name) + in + match res, output_field_data with + | _, None -> + ( res + , ValidatedInputFieldOfCollection + { collection = input_collection + ; field = input_field_data + } + :: input_fields_not_in_output + , output_fields_not_in_input ) + | Error error, Some output_field_data -> + ( Error error + , input_fields_not_in_output + , output_fields_not_in_input + |> List.filter + (fun (output_field : OutputField.t) -> + match output_field with + | OutputField _ -> true + | ((OutputFieldOfCollection + { collection; field }) [@explicit_arity + ]) -> + not + (input_collection.plural + = collection.plural + && output_field_data.name + = field.name)) ) + | Ok fields, Some output_field_data -> + let validator = + validator + ~input_field: + (ValidatedInputFieldOfCollection + { collection = input_collection + ; field = input_field_data + }) + ~input_field_data + ~output_field_data + ~input_entries:validated_input_entries + ~validators_record + in + ( (match validator with + | Error error -> Error error + | Ok validator -> + Ok + ({ name = input_field_data.name + ; input_type = input_field_data.typ + ; output_type = output_field_data.typ + ; validator + ; deps = input_field_data.deps + } + :: fields)) + , input_fields_not_in_output + , output_fields_not_in_input + |> List.filter + (fun (output_field : OutputField.t) -> + match output_field with + | OutputField _ -> true + | ((OutputFieldOfCollection + { collection; field }) [@explicit_arity + ]) -> + not + (input_collection.plural + = collection.plural + && output_field_data.name + = field.name)) )) + ( Ok [] + , input_fields_not_in_output + , output_fields_not_in_input ) + in + (match result, fields with + | Error _error, _ -> + ( result + , input_fields_not_in_output + , output_fields_not_in_input ) + | Ok _, Error error -> + ( Error error + , input_fields_not_in_output + , output_fields_not_in_input ) + | Ok scheme, Ok fields -> + ( Ok + (Scheme.Collection + { collection = input_collection + ; fields + ; input_type = input_collection_type + ; output_type + ; validator = + (match + validators_record.fields + |> ValidatorsRecordParser.collection + input_collection + with + | Ok res -> Ok res + | Error _ -> Error ()) + } + :: scheme) + , input_fields_not_in_output + , output_fields_not_in_input )))) + (Ok [], [], output_entries |> OutputTypeParser.flatten) + in + (match input_fields_not_in_output, output_fields_not_in_input with + | [], [] -> result + | input_fields_not_in_output, [] -> + Error + (IOMismatch + (InputFieldsNotInOutput + { fields = input_fields_not_in_output; loc = output_loc } [@explicit_arity + ]) [@explicit_arity + ]) + | [], _output_entries_not_in_input -> + Error + (IOMismatch + (OutputFieldsNotInInput { fields = output_fields_not_in_input } [@explicit_arity + ])) + | input_fields_not_in_output, output_fields_not_in_input -> + Error + (IOMismatch + (Both + { input_fields_not_in_output + ; output_fields_not_in_input + ; loc = output_loc + })))) + : (Scheme.t, error) result) + in + (match scheme with + | Ok scheme -> + Ok + { scheme + ; async = + scheme + |> List.exists (fun (entry : Scheme.entry) -> + match entry with + | Field { validator = AsyncValidator _ } -> true + | Field { validator = SyncValidator _ } -> false + | Collection { fields } -> + fields + |> List.exists (fun (field : Scheme.field) -> + match field with + | { validator = AsyncValidator _ } -> true + | { validator = SyncValidator _ } -> false)) + ; output_type = output_result + ; validators_record + ; message_type = !message_type + ; submission_error_type = !submission_error_type + ; metadata = !metadata + ; debounce_interval = !debounce_interval_value + } + | Error error -> Error error)) + ;; +end diff --git a/ppx/lib/Meta.re b/ppx/lib/Meta.re deleted file mode 100644 index 8d4c816e..00000000 --- a/ppx/lib/Meta.re +++ /dev/null @@ -1,2430 +0,0 @@ -open Ppxlib; - -module ItemType = { - module T: {type t;} = { - type t = core_type; - }; - - type t = T.t; - - external make: core_type => t = "%identity"; - 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 Collection = { - type t = { - singular: string, - plural: string, - }; -}; - -module FieldDep = { - type t = - | DepField(string) - | DepFieldOfCollection({ - collection: Collection.t, - field: string, - }); - - type unvalidated = - | UnvalidatedDepField({ - name: string, - loc: Location.t, - }) - | UnvalidatedDepFieldOfCollection({ - collection: string, - field: string, - c_loc: Location.t, - f_loc: Location.t, - }); -}; - -module FieldOptionality = { - type t = - | OptionType - | StringType - | OptionStringType; -}; - -module AsyncMode = { - type t = - | OnChange - | OnBlur; - - let default = OnChange; -}; - -module ValidatorsRecord = { - type t = { - fields, - rec_flag, - constraint_metadata: metadata, - record_metadata: metadata, - annotation: core_type, - } - and fields = list((loc(Longident.t), expression)) - and metadata = { - pexp_loc: Location.t, - pexp_loc_stack: list(Location.t), - pexp_attributes: list(attribute), - }; -}; - -module FieldValidator = { - type t = - | SyncValidator(result(sync, unit)) - | AsyncValidator({ - mode: AsyncMode.t, - optionality: option(FieldOptionality.t), - }) - and sync = - | Required - | Optional(option(unit)); -}; - -module CollectionValidator = { - type t = result(option(unit), unit); -}; - -module Scheme = { - type t = list(entry) - and entry = - | Field(field) - | Collection(collection) - and field = { - name: string, - input_type: ItemType.t, - output_type: ItemType.t, - validator: FieldValidator.t, - deps: list(FieldDep.t), - } - and collection = { - collection: Collection.t, - fields: list(field), - validator: CollectionValidator.t, - input_type: ItemType.t, - output_type: ItemType.t, - }; - - let fields = (scheme: t) => - scheme - |> List.fold_left( - (acc, entry) => - switch (entry) { - | Field(field) => [field, ...acc] - | Collection(_) => acc - }, - [], - ); - - let collections = (scheme: t) => - scheme - |> List.fold_left( - (acc, entry) => - switch (entry) { - | Field(_) => acc - | Collection(collection) => [collection, ...acc] - }, - [], - ); -}; - -module InputFieldData = { - type unvalidated = { - name: string, - typ: ItemType.t, - async: option(AsyncMode.t), - deps: list(FieldDep.unvalidated), - }; - - type validated = { - name: string, - typ: ItemType.t, - async: option(AsyncMode.t), - deps: list(FieldDep.t), - }; - - let unvalidated = (~async, ~deps, field: label_declaration): unvalidated => { - name: field.pld_name.txt, - typ: field.pld_type |> ItemType.make, - async, - deps, - }; - - let validated = (~deps, field: unvalidated): validated => { - name: field.name, - typ: field.typ, - async: field.async, - deps, - }; -}; - -module InputField = { - type unvalidated = - | UnvalidatedInputField(InputFieldData.unvalidated) - | UnvalidatedInputFieldOfCollection({ - collection: Collection.t, - field: InputFieldData.unvalidated, - }); - - type validated = - | ValidatedInputField(InputFieldData.validated) - | ValidatedInputFieldOfCollection({ - collection: Collection.t, - field: InputFieldData.validated, - }); -}; - -module OutputFieldData = { - type t = { - name: string, - typ: ItemType.t, - loc: Location.t, - }; -}; - -module OutputField = { - type t = - | OutputField(OutputFieldData.t) - | OutputFieldOfCollection({ - collection: Collection.t, - field: OutputFieldData.t, - }); -}; - -module InputType = { - module T: {type t;} = { - type t = type_declaration; - }; - - type t = T.t; - external make: type_declaration => t = "%identity"; - external type_declaration: t => type_declaration = "%identity"; -}; - -module OutputType = { - module T: {type t;} = { - type t = type_declaration; - }; - - type t = T.t; - external make: type_declaration => t = "%identity"; - external type_declaration: t => type_declaration = "%identity"; - - let default = (~loc) => [%stri type output = input]; -}; - -module MessageType = { - let default = (~loc) => [%stri type message = string]; -}; - -module DebounceInterval = { - let default = (~loc) => [%stri let debounceInterval = 700]; -}; - -module SubmissionErrorType = { - let default = (~loc) => [%stri type submissionError = unit]; -}; - -module FieldOptionalityParser = { - let parse = (typ: ItemType.t): option(FieldOptionality.t) => - switch (typ |> ItemType.unpack) { - | {ptyp_desc: Ptyp_constr({txt: Lident("string")}, [])} => - Some(StringType) - | { - ptyp_desc: - Ptyp_constr( - {txt: Lident("option")}, - [{ptyp_desc: Ptyp_constr({txt: Lident("string")}, [])}], - ), - } => - Some(OptionStringType) - | {ptyp_desc: Ptyp_constr({txt: Lident("option")}, _)} => - Some(OptionType) - | _ => None - }; -}; - -module AsyncFieldParser = { - type error = - | InvalidPayload(Location.t) - | InvalidAsyncMode(Location.t); - - let attr = field => - field.pld_type.ptyp_attributes - |> List.find_opt(attr => - switch (attr) { - | {attr_name: {txt: "field.async"}} => true - | _ => false - } - ); - - let parse = attribute => { - switch (attribute) { - | {attr_payload: PStr([]), attr_loc: _} => Ok(AsyncMode.default) - | { - attr_payload: - PStr([ - { - pstr_desc: - Pstr_eval( - { - pexp_desc: - Pexp_record( - [ - ( - {txt: Lident("mode")}, - { - pexp_desc: - Pexp_construct( - {txt: Lident(mode), loc}, - None, - ), - }, - ), - ], - None, - ), - }, - _, - ), - }, - ]), - attr_loc: _, - } => - switch (mode) { - | "OnChange" => Ok(OnChange) - | "OnBlur" => Ok(OnBlur) - | _ => Error(InvalidAsyncMode(loc)) - } - | {attr_payload: PStr([{pstr_loc}])} => - Error(InvalidPayload(pstr_loc)) - | {attr_loc} => Error(InvalidPayload(attr_loc)) - }; - }; - - let get = field => - switch (field |> attr) { - | None => Ok(None) - | Some(attr) => - switch (attr |> parse) { - | Ok(mode) => Ok(Some(mode)) - | Error(error) => Error(error) - } - }; -}; - -module FieldDepsParser = { - type error = - | DepsParseError(Location.t) - | DepNotFound(FieldDep.unvalidated) - | DepOfItself([ | `Field(string, Location.t)]) - | DepDuplicate(FieldDep.unvalidated); - - let attr = field => - field.pld_type.ptyp_attributes - |> List.find_opt(attr => - switch (attr) { - | {attr_name: {txt: "field.deps"}} => true - | _ => false - } - ); - - let parse = - (attribute: attribute): result(list(FieldDep.unvalidated), error) => { - switch (attribute) { - | {attr_payload: PStr([{pstr_desc: Pstr_eval(exp, _)}]), attr_loc: _} => - switch (exp) { - | {pexp_desc: Pexp_ident({txt: Lident(dep), loc})} => - Ok([UnvalidatedDepField({name: dep, loc})]) - | { - pexp_desc: - Pexp_field( - { - pexp_desc: Pexp_ident({txt: Lident(collection), loc: c_loc}), - }, - {txt: Lident(field), loc: f_loc}, - ), - } => - Ok([ - UnvalidatedDepFieldOfCollection({collection, field, c_loc, f_loc}), - ]) - | {pexp_desc: Pexp_tuple(exps)} => - exps - |> List.fold_left( - (res: result(list(FieldDep.unvalidated), error), exp) => - switch (res, exp) { - | (Error(error), _) => Error(error) - | ( - Ok(deps), - {pexp_desc: Pexp_ident({txt: Lident(dep), loc})}, - ) => - Ok([UnvalidatedDepField({name: dep, loc}), ...deps]) - | ( - Ok(deps), - { - pexp_desc: - Pexp_field( - { - pexp_desc: - Pexp_ident({ - txt: Lident(collection), - loc: c_loc, - }), - }, - {txt: Lident(field), loc: f_loc}, - ), - }, - ) => - Ok([ - UnvalidatedDepFieldOfCollection({ - collection, - field, - c_loc, - f_loc, - }), - ...deps, - ]) - | (Ok(_), {pexp_loc}) => Error(DepsParseError(pexp_loc)) - }, - Ok([]), - ) - | {pexp_loc} => Error(DepsParseError(pexp_loc)) - } - | {attr_loc} => Error(DepsParseError(attr_loc)) - }; - }; - - let get = field => - switch (field |> attr) { - | None => Ok([]) - | Some(attr) => attr |> parse - }; -}; - -module FieldCollectionParser = { - type result = Stdlib.result(ok, error) - and ok = { - collection: Collection.t, - fields: list(InputFieldData.unvalidated), - input_type: ItemType.t, - } - and error = - | NotArray(Location.t) - | InvalidTypeRef(Location.t) - | RecordNotFound(Location.t) - | NotRecord(Location.t) - | InvalidAsyncField(AsyncFieldParser.error) - | InvalidFieldDeps(FieldDepsParser.error); - - let attr = (field: label_declaration) => - field.pld_type.ptyp_attributes - |> List.find_opt(attr => - switch (attr) { - | {attr_name: {txt: "field.collection"}} => true - | _ => false - } - ); - - let parse = (~structure: structure, field: label_declaration): result => { - switch (field.pld_type.ptyp_desc) { - | Ptyp_constr({txt: Lident("array"), loc: arr_loc}, payload) => - switch (payload) { - | [] => Error(InvalidTypeRef(arr_loc)) - | [ - {ptyp_desc: Ptyp_constr({txt: Lident(typ_name)}, []), ptyp_loc} as input_type, - ..._, - ] => - let record_type = ref(None); - structure - |> List.iter((item: structure_item) => - switch (item) { - | {pstr_desc: Pstr_type(_rec_flag, decls)} => - decls - |> List.iter((decl: type_declaration) => - switch (decl) { - | {ptype_name: {txt: name}} when name == typ_name => - switch (decl.ptype_kind) { - | Ptype_record(fields) => - record_type := Some(Ok(fields)) - | _ => - record_type := - Some(Error(NotRecord(decl.ptype_loc))) - } - | _ => () - } - ) - | _ => () - } - ); - switch (record_type^) { - | None => Error(RecordNotFound(ptyp_loc)) - | Some(Error(error)) => Error(error) - | Some(Ok(fields)) => - let fields = - fields - |> List.fold_left( - (res, field: label_declaration) => - switch (res) { - | Error(error) => Error(error) - | Ok(fields) => - switch ( - field |> AsyncFieldParser.get, - field |> FieldDepsParser.get, - ) { - | (Ok(async), Ok(deps)) => - Ok([ - field |> InputFieldData.unvalidated(~async, ~deps), - ...fields, - ]) - | (Error(error), _) => Error(InvalidAsyncField(error)) - | (_, Error(error)) => Error(InvalidFieldDeps(error)) - } - }, - Ok([]), - ); - switch (fields) { - | Ok(fields) => - Ok({ - collection: { - plural: field.pld_name.txt, - singular: typ_name, - }, - fields, - input_type: input_type |> ItemType.make, - }) - | Error(error) => Error(error) - }; - }; - | [{ptyp_loc}, ..._] => Error(InvalidTypeRef(ptyp_loc)) - } - | _ => Error(NotArray(field.pld_loc)) - }; - }; -}; - -module FieldAttributesParser = { - type result = Stdlib.result(option(ok), error) - and ok = - | Collection(FieldCollectionParser.ok) - | AsyncDeps({ - async: option(AsyncMode.t), - deps: list(FieldDep.unvalidated), - }) - and error = - | Conflict( - [ - | `AsyncWithCollection(Location.t) - | `DepsWithCollection(Location.t) - ], - ) - | InvalidCollectionField(FieldCollectionParser.error) - | InvalidAsyncField(AsyncFieldParser.error) - | InvalidFieldDeps(FieldDepsParser.error); - - let parse = (~structure: structure, field: label_declaration) => - switch ( - field |> FieldCollectionParser.attr, - field |> AsyncFieldParser.attr, - field |> FieldDepsParser.attr, - ) { - | (Some(_), None, None) => - switch (field |> FieldCollectionParser.parse(~structure)) { - | Ok(collection) => Ok(Some(Collection(collection))) - | Error(error) => Error(InvalidCollectionField(error)) - } - | (None, Some(async_attr), Some(deps_attr)) => - switch ( - async_attr |> AsyncFieldParser.parse, - deps_attr |> FieldDepsParser.parse, - ) { - | (Ok(async), Ok(deps)) => - Ok(Some(AsyncDeps({async: Some(async), deps}))) - | (Error(error), _) => Error(InvalidAsyncField(error)) - | (_, Error(error)) => Error(InvalidFieldDeps(error)) - } - | (None, Some(async_attr), None) => - switch (async_attr |> AsyncFieldParser.parse) { - | Ok(async) => Ok(Some(AsyncDeps({async: Some(async), deps: []}))) - | Error(error) => Error(InvalidAsyncField(error)) - } - | (None, None, Some(deps_attr)) => - switch (deps_attr |> FieldDepsParser.parse) { - | Ok(deps) => Ok(Some(AsyncDeps({async: None, deps}))) - | Error(error) => Error(InvalidFieldDeps(error)) - } - | (None, None, None) => Ok(None) - | (Some(_), Some({attr_loc}), _) => - Error(Conflict(`AsyncWithCollection(attr_loc))) - | (Some(_), _, Some({attr_loc})) => - Error(Conflict(`DepsWithCollection(attr_loc))) - }; -}; - -module InputTypeParser = { - type result = Stdlib.result(ok, error) - and ok = { - entries: list(unvalidated_entry), - type_declaration: InputType.t, - } - and unvalidated_entry = - | UnvalidatedInputField(InputFieldData.unvalidated) - | UnvalidatedInputCollection({ - collection: Collection.t, - fields: list(InputFieldData.unvalidated), - input_type: ItemType.t, - }) - and validated_entry = - | ValidatedInputField(InputFieldData.validated) - | ValidatedInputCollection({ - collection: Collection.t, - fields: list(InputFieldData.validated), - input_type: ItemType.t, - }) - and error = - | NotFound - | NotRecord(Location.t) - | InvalidAttributes(FieldAttributesParser.error); - - let parse = (~decl, ~structure, ~loc as _, fields) => { - let entries = - fields - |> List.rev - |> List.fold_left( - (res, field) => - switch (res, field |> FieldAttributesParser.parse(~structure)) { - | ( - Ok(entries), - Ok(Some(Collection({collection, fields, input_type}))), - ) => - Ok([ - UnvalidatedInputCollection({collection, fields, input_type}), - ...entries, - ]) - | (Ok(entries), Ok(Some(AsyncDeps({async, deps})))) => - Ok([ - UnvalidatedInputField( - field |> InputFieldData.unvalidated(~async, ~deps), - ), - ...entries, - ]) - | (Ok(entries), Ok(None)) => - Ok([ - UnvalidatedInputField( - field |> InputFieldData.unvalidated(~async=None, ~deps=[]), - ), - ...entries, - ]) - | (Error(error), _) => Error(error) - | (_, Error(error)) => Error(InvalidAttributes(error)) - }, - Ok([]), - ); - switch (entries) { - | Error(error) => Error(error) - | Ok(entries) => Ok({entries, type_declaration: decl |> InputType.make}) - }; - }; - - let validate = - (unvalidated_entries: list(unvalidated_entry)) - : Stdlib.result(list(validated_entry), FieldDepsParser.error) => { - let dup = (deps: list(FieldDep.unvalidated), dep: FieldDep.unvalidated) => - switch ( - deps - |> List.find_all((dep': FieldDep.unvalidated) => - switch (dep, dep') { - | ( - UnvalidatedDepField({name: dep}), - UnvalidatedDepField({name: dep'}), - ) => - dep == dep' - | ( - UnvalidatedDepFieldOfCollection({collection, field}), - UnvalidatedDepFieldOfCollection({ - collection: collection', - field: field', - }), - ) => - collection == collection' && field == field' - | (UnvalidatedDepField(_), UnvalidatedDepFieldOfCollection(_)) - | (UnvalidatedDepFieldOfCollection(_), UnvalidatedDepField(_)) => - false - } - ) - |> List.length - ) { - | 0 - | 1 => None - | _ => Some() - }; - - unvalidated_entries - |> List.fold_left( - ( - res: Stdlib.result(list(validated_entry), FieldDepsParser.error), - unvalidated_entry: unvalidated_entry, - ) => - switch (res, unvalidated_entry) { - | (Error(error), _) => Error(error) - | (Ok(validated_entries), UnvalidatedInputField(field)) => - let deps = - field.deps - |> List.fold_left( - ( - res: - Stdlib.result( - list(FieldDep.t), - FieldDepsParser.error, - ), - dep, - ) => - switch (res) { - | Error(error) => Error(error) - | Ok(validated_deps) => - switch (dep |> dup(field.deps)) { - | Some () => Error(FieldDepsParser.DepDuplicate(dep)) - | None => - switch ( - unvalidated_entries - |> List.fold_left( - ( - res: - option( - Stdlib.result( - FieldDep.t, - FieldDepsParser.error, - ), - ), - entry, - ) => - switch (res, dep, entry) { - | (Some(_) as res, _, _) => res - | ( - None, - UnvalidatedDepField(dep'), - UnvalidatedInputField(field'), - ) => - if (field.name == field'.name - && field'.name == dep'.name) { - Some( - Error( - FieldDepsParser.DepOfItself( - `Field((dep'.name, dep'.loc)), - ), - ), - ); - } else if (field'.name == dep'.name) { - Some(Ok(DepField(dep'.name))); - } else { - None; - } - | ( - None, - UnvalidatedDepFieldOfCollection(dep'), - UnvalidatedInputCollection(entry'), - ) => - if (dep'.collection - != entry'.collection.singular) { - None; - } else { - switch ( - entry'.fields - |> List.find_opt( - ( - field: InputFieldData.unvalidated, - ) => - dep'.field == field.name - ) - ) { - | None => - Some( - Error( - FieldDepsParser.DepNotFound(dep), - ), - ) - | Some(field) => - Some( - Ok( - DepFieldOfCollection({ - collection: entry'.collection, - field: field.name, - }), - ), - ) - }; - } - | ( - None, - UnvalidatedDepField(_), - UnvalidatedInputCollection(_), - ) - | ( - None, - UnvalidatedDepFieldOfCollection(_), - UnvalidatedInputField(_), - ) => - None - }, - None, - ) - ) { - | None => Error(FieldDepsParser.DepNotFound(dep)) - | Some(Error(error)) => Error(error) - | Some(Ok(dep_entry)) => - Ok([dep_entry, ...validated_deps]) - } - } - }, - Ok([]), - ); - switch (deps) { - | Error(error) => Error(error) - | Ok(deps) => - Ok([ - ValidatedInputField( - field |> InputFieldData.validated(~deps), - ), - ...validated_entries, - ]) - }; - | ( - Ok(validated_entries), - UnvalidatedInputCollection({ - collection, - fields: unvalidated_fields, - input_type, - }), - ) => - let validated_fields = - unvalidated_fields - |> List.fold_left( - ( - res: - Stdlib.result( - list(InputFieldData.validated), - FieldDepsParser.error, - ), - field: InputFieldData.unvalidated, - ) => - switch (res) { - | Error(error) => Error(error) - | Ok(validated_fields) => - let deps = - field.deps - |> List.fold_left( - ( - res: - Stdlib.result( - list(FieldDep.t), - FieldDepsParser.error, - ), - dep, - ) => - switch (res) { - | Error(error) => Error(error) - | Ok(validated_deps) => - switch (dep |> dup(field.deps)) { - | Some () => - Error(FieldDepsParser.DepDuplicate(dep)) - | None => - switch ( - unvalidated_entries - |> List.fold_left( - ( - res: - option( - Stdlib.result( - FieldDep.t, - FieldDepsParser.error, - ), - ), - entry, - ) => - switch (res, dep, entry) { - | (Some(_) as res, _, _) => res - | ( - None, - UnvalidatedDepField(dep'), - UnvalidatedInputField( - field', - ), - ) => - if (field'.name == dep'.name) { - Some( - Ok(DepField(dep'.name)), - ); - } else { - None; - } - | ( - None, - UnvalidatedDepFieldOfCollection( - dep', - ), - UnvalidatedInputCollection( - entry', - ), - ) => - if (dep'.collection - != entry'.collection. - singular) { - None; - } else { - switch ( - entry'.fields - |> List.fold_left( - ( - res: - option( - Stdlib.result( - FieldDep.t, - FieldDepsParser.error, - ), - ), - field: InputFieldData.unvalidated, - ) => - switch (res) { - | Some(_) => res - | None => - if (dep'.field - == field.name) { - Some( - Ok( - DepFieldOfCollection({ - collection: - entry'. - collection, - field: - field.name, - }), - ), - ); - } else { - None; - } - }, - None, - ) - ) { - | None => - Some( - Error( - FieldDepsParser.DepNotFound( - dep, - ), - ), - ) - | Some(Error(error)) => - Some(Error(error)) - | Some(Ok(dep)) => - Some(Ok(dep)) - }; - } - | ( - None, - UnvalidatedDepField(_), - UnvalidatedInputCollection( - _ - ), - ) - | ( - None, - UnvalidatedDepFieldOfCollection( - _ - ), - UnvalidatedInputField(_), - ) => - None - }, - None, - ) - ) { - | None => - Error( - FieldDepsParser.DepNotFound(dep), - ) - | Some(Error(error)) => Error(error) - | Some(Ok(dep_entry)) => - Ok([dep_entry, ...validated_deps]) - } - } - }, - Ok([]), - ); - switch (deps) { - | Error(error) => Error(error) - | Ok(deps) => - Ok([ - field |> InputFieldData.validated(~deps), - ...validated_fields, - ]) - }; - }, - Ok([]), - ); - switch (validated_fields) { - | Error(error) => Error(error) - | Ok(validated_fields) => - Ok([ - ValidatedInputCollection({ - collection, - fields: validated_fields, - input_type, - }), - ...validated_entries, - ]) - }; - }, - Ok([]), - ); - }; - - let in_deps_of = - (entries: list(validated_entry), field: InputField.validated) - : option(InputField.validated) => { - entries - |> List.fold_left( - (res, entry: validated_entry) => - switch (res, field, entry) { - | (Some(_), _, _) => res - | ( - None, - ValidatedInputField(subject_field), - ValidatedInputField(entry_field), - ) => - entry_field.deps - |> List.fold_left( - (res: option(InputField.validated), dep: FieldDep.t) => - switch (res, dep) { - | (Some(_), _) => res - | (None, DepField(dep)) => - if (dep == subject_field.name) { - Some(ValidatedInputField(entry_field)); - } else { - None; - } - | (None, DepFieldOfCollection(_)) => None - }, - None, - ) - | ( - None, - ValidatedInputField(subject_field), - ValidatedInputCollection({ - collection: entry_collection, - fields: entry_fields, - }), - ) => - entry_fields - |> List.fold_left( - ( - _res: option(InputField.validated), - entry_field: InputFieldData.validated, - ) => - entry_field.deps - |> List.fold_left( - (res: option(InputField.validated), dep: FieldDep.t) => - switch (res, dep) { - | (Some(_), _) => res - | (None, DepField(dep)) => - if (dep == subject_field.name) { - Some( - ValidatedInputFieldOfCollection({ - collection: entry_collection, - field: entry_field, - }), - ); - } else { - None; - } - | (None, DepFieldOfCollection(_)) => None - }, - None, - ), - None, - ) - | ( - None, - ValidatedInputFieldOfCollection({ - collection: subject_collection, - field: subject_field, - }), - ValidatedInputField(entry_field), - ) => - entry_field.deps - |> List.fold_left( - (res: option(InputField.validated), dep: FieldDep.t) => - switch (res, dep) { - | (Some(_), _) => res - | (None, DepField(_dep)) => None - | ( - None, - DepFieldOfCollection({ - collection: dep_collection, - field: dep_field, - }), - ) => - if (dep_collection.singular - == subject_collection.singular - && dep_field == subject_field.name) { - Some(ValidatedInputField(entry_field)); - } else { - None; - } - }, - None, - ) - | ( - None, - ValidatedInputFieldOfCollection({ - collection: subject_collection, - field: subject_field, - }), - ValidatedInputCollection({ - collection: entry_collection, - fields: entry_fields, - }), - ) => - entry_fields - |> List.fold_left( - ( - _res: option(InputField.validated), - entry_field: InputFieldData.validated, - ) => - entry_field.deps - |> List.fold_left( - (res: option(InputField.validated), dep: FieldDep.t) => - switch (res, dep) { - | (Some(_), _) => res - | (None, DepField(_dep)) => None - | ( - None, - DepFieldOfCollection({ - collection: dep_collection, - field: dep_field, - }), - ) => - if (subject_collection.singular - == dep_collection.singular - && subject_field.name == dep_field) { - Some( - ValidatedInputFieldOfCollection({ - collection: entry_collection, - field: entry_field, - }), - ); - } else { - None; - } - }, - None, - ), - None, - ) - }, - None, - ); - }; -}; - -module OutputTypeParser = { - type result = Stdlib.result(ok, error) - and ok = - | NotProvided - | AliasOfInput - | Record({ - entries: list(entry), - loc: Location.t, - }) - and entry = - | OutputField(OutputFieldData.t) - | OutputCollection({ - collection: Collection.t, - fields: list(OutputFieldData.t), - output_type: ItemType.t, - }) - and error = - | InputNotAvailable(Location.t) - | NotRecord(Location.t) - | BadTypeAlias({ - alias: string, - loc: Location.t, - }) - | OutputCollectionNotFound({ - input_collection: Collection.t, - loc: Location.t, - }) - | InvalidCollection(collection_error) - and collection_error = - | InvalidCollectionTypeRef(Location.t) - | CollectionTypeNotRecord(Location.t) - | CollectionTypeNotFound(Location.t) - | CollectionOutputNotArray(Location.t); - - let flatten = (entries: list(entry)): list(OutputField.t) => - entries - |> List.rev - |> List.fold_left( - (acc, entry) => - switch (entry) { - | OutputField(field) => [OutputField.OutputField(field), ...acc] - | OutputCollection({collection, fields}) => - fields - |> List.rev - |> List.fold_left( - (acc, field) => - [ - OutputField.OutputFieldOfCollection({collection, field}), - ...acc, - ], - acc, - ) - }, - [], - ); - - let parse = - ( - ~structure, - ~input_collections: list(Collection.t), - ~loc, - fields: list(label_declaration), - ) => - switch (input_collections) { - | [] => - Ok( - Record({ - loc, - entries: - fields - |> List.rev - |> List.fold_left( - (acc, field) => - [ - OutputField({ - name: field.pld_name.txt, - typ: field.pld_type |> ItemType.make, - loc: field.pld_loc, - }), - ...acc, - ], - [], - ), - }), - ) - | _ => - let entries = - fields - |> List.rev - |> List.fold_left( - (acc, field) => - switch (acc) { - | Error(error) => Error(error) - | Ok(entries) => - let field_name = field.pld_name.txt; - switch ( - input_collections - |> List.find_opt((collection: Collection.t) => - collection.plural == field_name - ) - ) { - | None => - Ok([ - OutputField({ - name: field_name, - typ: field.pld_type |> ItemType.make, - loc: field.pld_loc, - }), - ...entries, - ]) - | Some(_input_collection) => - switch (field.pld_type.ptyp_desc) { - | Ptyp_constr( - {txt: Lident("array"), loc: arr_loc}, - payload, - ) => - switch (payload) { - | [] => Error(InvalidCollectionTypeRef(arr_loc)) - | [ - { - ptyp_desc: - Ptyp_constr({txt: Lident(type_name)}, []), - ptyp_loc, - } as output_type, - ..._, - ] => - let record_type = ref(None); - structure - |> List.iter((item: structure_item) => - switch (item) { - | {pstr_desc: Pstr_type(_rec_flag, decls)} => - decls - |> List.iter((decl: type_declaration) => - switch (decl) { - | {ptype_name: {txt: name}} - when name == type_name => - switch (decl.ptype_kind) { - | Ptype_record(fields) => - record_type := Some(Ok(fields)) - | _ => - record_type := - Some( - Error( - CollectionTypeNotRecord( - decl.ptype_loc, - ), - ), - ) - } - | _ => () - } - ) - | _ => () - } - ); - switch (record_type^) { - | None => Error(CollectionTypeNotFound(ptyp_loc)) - | Some(Error(error)) => Error(error) - | Some(Ok(fields)) => - Ok([ - OutputCollection({ - collection: { - plural: field_name, - singular: type_name, - }, - fields: - fields - |> List.rev - |> List.rev_map((field: label_declaration) => - OutputFieldData.{ - name: field.pld_name.txt, - typ: field.pld_type |> ItemType.make, - loc: field.pld_loc, - } - ), - output_type: output_type |> ItemType.make, - }), - ...entries, - ]) - }; - | [{ptyp_loc}, ..._] => - Error(InvalidCollectionTypeRef(ptyp_loc)) - } - | _ => Error(CollectionOutputNotArray(field.pld_loc)) - } - }; - }, - Ok([]), - ); - switch (entries) { - | Ok(entries) => Ok(Record({loc, entries})) - | Error(error) => Error(InvalidCollection(error)) - }; - }; -}; - -module DebounceIntervalParser = { - let exists = (values: list(value_binding)) => - values - |> List.exists( - fun - | {pvb_pat: {ppat_desc: Ppat_var({txt: "debounceInterval"})}} => - true - | _ => false, - ); -}; - -module ValidatorsRecordParser = { - type result = Stdlib.result(ValidatorsRecord.t, error) - and error = - | NotFound - | NotRecord(Location.t) - | BadTypeAnnotation(Location.t) - | ValidatorError( - [ - | `BadRequiredValidator( - InputField.validated, - [ | `Some(Location.t) | `None(Location.t)], - [ - | `IncludedInDeps(InputField.validated) - | `DifferentIO(ItemType.t, ItemType.t) - ], - ) - ], - ) - | RecordParseError(Location.t); - - let exists = (values: list(value_binding)) => - values - |> List.exists( - fun - | {pvb_pat: {ppat_desc: Ppat_var({txt: "validators"})}} => true - | _ => false, - ); - - let parse = (~rec_flag, values: list(value_binding)): option(result) => { - values - |> List.fold_left( - (res, value) => - switch (res) { - | Some(_) => res - | None => - switch (value) { - | { - pvb_pat: {ppat_desc: Ppat_var({txt: "validators"})}, - pvb_expr: { - pexp_desc: - Pexp_constraint( - expr, - {ptyp_desc: Ptyp_constr(typ, args), ptyp_loc} as annotation, - ), - pexp_loc: constraint_pexp_loc, - pexp_loc_stack: constraint_pexp_loc_stack, - pexp_attributes: constraint_pexp_attributes, - }, - } => - switch (typ, args) { - | ({txt: Lident("validators")}, []) => - switch (expr) { - | { - pexp_desc: Pexp_record(fields, None), - pexp_loc: record_pexp_loc, - pexp_loc_stack: record_pexp_loc_stack, - pexp_attributes: record_pexp_attributes, - } => - Some( - Ok( - ValidatorsRecord.{ - fields, - rec_flag, - annotation, - constraint_metadata: { - pexp_loc: constraint_pexp_loc, - pexp_loc_stack: constraint_pexp_loc_stack, - pexp_attributes: constraint_pexp_attributes, - }, - record_metadata: { - pexp_loc: record_pexp_loc, - pexp_loc_stack: record_pexp_loc_stack, - pexp_attributes: record_pexp_attributes, - }, - }, - ), - ) - | {pexp_loc} => Some(Error(NotRecord(pexp_loc))) - } - | ({txt: _}, _) => Some(Error(BadTypeAnnotation(ptyp_loc))) - } - | { - pvb_pat: {ppat_desc: Ppat_var({txt: "validators"})}, - pvb_expr: {pexp_loc} as expr, - } => - switch (expr) { - | { - pexp_desc: Pexp_record(fields, None), - pexp_loc: loc, - pexp_loc_stack, - pexp_attributes, - } => - Some( - Ok({ - fields, - rec_flag, - annotation: [%type: validators], - constraint_metadata: { - pexp_loc, - pexp_loc_stack, - pexp_attributes, - }, - record_metadata: { - pexp_loc, - pexp_loc_stack, - pexp_attributes, - }, - }), - ) - | {pexp_loc} => Some(Error(NotRecord(pexp_loc))) - } - | _ => None - } - }, - None, - ); - }; - - let find_field = - (field: InputField.validated, validators: ValidatorsRecord.fields) => - validators - |> List.fold_left( - (res, validator) => - switch (res, field, validator) { - | (Some(_), _, _) => res - | (None, ValidatedInputField(field), ({txt: Lident(key)}, _)) => - field.name == key ? Some(validator) : None - | ( - None, - ValidatedInputFieldOfCollection({collection, field}), - ( - {txt: Lident(key)}, - {pexp_desc: Pexp_record(fields, None)}, - ), - ) => - if (collection.plural == key) { - fields - |> List.fold_left( - (res, entry) => - switch (res, entry) { - | (Some(_), _) => res - | ( - None, - ( - {txt: Lident("fields")}, - {pexp_desc: Pexp_record(fields, None)}, - ), - ) => - fields - |> List.find_opt(entry => - switch (entry) { - | ({txt: Lident(key)}, _) => key == field.name - | _ => false - } - ) - | (None, _) => None - }, - None, - ); - } else { - None; - } - | ( - None, - ValidatedInputFieldOfCollection({collection: _, field: _}), - ({txt: _}, _), - ) => - None - | (None, ValidatedInputField(_), ({txt: _}, _)) => None - }, - None, - ); - - let find_collection = - (collection: Collection.t, validators: ValidatorsRecord.fields) => - validators - |> List.fold_left( - (res, validator) => - switch (res, validator) { - | (Some(_), _) => res - | ( - None, - ( - {txt: Lident(key)}, - {pexp_desc: Pexp_record(fields, None)}, - ), - ) - when collection.plural == key => - fields - |> List.fold_left( - (res, entry) => - switch (res, entry) { - | (Some(_), _) => res - | (None, ({txt: Lident("collection")}, exp)) => - Some(exp) - | (None, _) => None - }, - None, - ) - | (None, ({txt: _}, _)) => None - }, - None, - ); - - let required = - (field: InputField.validated, validators: ValidatorsRecord.fields) => { - switch (validators |> find_field(field)) { - | Some((_, {pexp_desc: Pexp_record(_)})) => Ok() - | Some(( - _, - { - pexp_desc: - Pexp_construct( - {txt: Lident("Some")}, - Some({pexp_desc: Pexp_record(_)}), - ), - pexp_loc, - }, - )) => - Error(`Some(pexp_loc)) - | Some(( - _, - {pexp_desc: Pexp_construct({txt: Lident("None")}, None), pexp_loc}, - )) => - Error(`None(pexp_loc)) - | Some(_) => Error(`BadValue) - | None => Error(`NotFound) - }; - }; - - let optional = - (field: InputField.validated, validators: ValidatorsRecord.fields) => { - switch (validators |> find_field(field)) { - | Some((_, {pexp_desc: Pexp_record(_)})) => Ok(Some()) - | Some((_, {pexp_desc: Pexp_construct({txt: Lident("None")}, None)})) => - Ok(None) - | Some(_) => Error(`BadValue) - | None => Error(`NotFound) - }; - }; - - let collection = - (collection: Collection.t, validators: ValidatorsRecord.fields) => - switch (validators |> find_collection(collection)) { - | Some({pexp_desc: Pexp_fun(_)}) => Ok(Some()) - | Some({pexp_desc: Pexp_construct({txt: Lident("None")}, None)}) => - Ok(None) - | Some(_) => Error(`BadValue) - | None => Error(`NotFound) - }; -}; - -module Metadata = { - type t = { - scheme: Scheme.t, - async: bool, // meh, it should be variant: Sync(_) | Async(_) - output_type: OutputTypeParser.ok, - validators_record: ValidatorsRecord.t, - message_type: option(unit), - submission_error_type: option(unit), - metadata: option(unit), - debounce_interval: option(unit), - }; - - type error = - | InputTypeParseError(InputTypeParser.error) - | OutputTypeParseError(OutputTypeParser.error) - | ValidatorsRecordParseError(ValidatorsRecordParser.error) - | IOMismatch(io_mismatch) - and io_mismatch = - | InputFieldsNotInOutput({ - fields: list(InputField.validated), - loc: Location.t, - }) - | OutputFieldsNotInInput({fields: list(OutputField.t)}) - | Both({ - input_fields_not_in_output: list(InputField.validated), - output_fields_not_in_input: list(OutputField.t), - loc: Location.t, - }); - - let make = (structure: structure) => { - let input_parsing_result: ref(option(InputTypeParser.result)) = - ref(None); - let output_parsing_result: ref(OutputTypeParser.result) = - ref(Ok(OutputTypeParser.NotProvided)); - let validators_record_parsing_result: - ref(option(ValidatorsRecordParser.result)) = - ref(None); - let message_type: ref(option(unit)) = ref(None); - let submission_error_type: ref(option(unit)) = ref(None); - let metadata: ref(option(unit)) = ref(None); - let debounce_interval_value: ref(option(unit)) = 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( - fields - |> InputTypeParser.parse( - ~decl, - ~structure, - ~loc=ptype_loc, - ), - ) - | {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, - } => - switch (input_parsing_result^) { - | None => - output_parsing_result := - Error(InputNotAvailable(ptype_loc)) - | Some(Ok({entries})) => - output_parsing_result := - fields - |> OutputTypeParser.parse( - ~structure, - ~loc=ptype_loc, - ~input_collections= - entries - |> List.fold_left( - ( - acc, - entry: InputTypeParser.unvalidated_entry, - ) => - switch (entry) { - | UnvalidatedInputField(_) => acc - | UnvalidatedInputCollection({ - collection, - }) => [ - collection, - ...acc, - ] - }, - [], - ), - ) - | Some(Error(_)) => () - } - | { - ptype_name: {txt: "output"}, - ptype_kind: Ptype_abstract, - ptype_loc: _, - ptype_manifest: - Some({ - ptyp_desc: - Ptyp_constr({txt: Lident("input")}, []), - }), - } => - output_parsing_result := Ok(AliasOfInput) - | { - ptype_name: {txt: "output"}, - ptype_kind: Ptype_abstract, - ptype_manifest: - Some({ - ptyp_desc: - Ptyp_constr({txt: Lident(alias), loc}, []), - }), - } => - output_parsing_result := - Error(OutputTypeParser.BadTypeAlias({alias, loc})) - | {ptype_name: {txt: "output"}, ptype_loc} => - output_parsing_result := - Error(OutputTypeParser.NotRecord(ptype_loc)) - - // Message type - | {ptype_name: {txt: "message"}, ptype_loc: _} => - message_type := Some() - - // Metadata type - | {ptype_name: {txt: "metadata"}, ptype_loc: _} => - metadata := Some() - - // Submission error type - | {ptype_name: {txt: "submissionError"}, ptype_loc: _} => - submission_error_type := Some() - - // Rest - | _ => (), - ); - } - | {pstr_desc: Pstr_value(rec_flag, values)} => { - if (values |> DebounceIntervalParser.exists) { - debounce_interval_value := Some(); - }; - switch (values |> ValidatorsRecordParser.parse(~rec_flag)) { - | Some(x) => validators_record_parsing_result := Some(x) - | None => () - }; - } - | _ => (), - ); - - switch ( - input_parsing_result^, - output_parsing_result^, - validators_record_parsing_result^, - ) { - | (Some(Error(error)), _, _) => Error(InputTypeParseError(error)) - | (None, _, _) => Error(InputTypeParseError(NotFound)) - | (_, Error(error), _) => Error(OutputTypeParseError(error)) - | (_, _, None) => Error(ValidatorsRecordParseError(NotFound)) - | (_, _, Some(Error(error))) => - Error(ValidatorsRecordParseError(error)) - | ( - Some(Ok(input_data)), - Ok(output_result), - Some(Ok(validators_record)), - ) => - switch (input_data.entries |> InputTypeParser.validate) { - | Error(error) => - Error( - InputTypeParseError(InvalidAttributes(InvalidFieldDeps(error))), - ) - | Ok(validated_input_entries) => - let scheme: result(Scheme.t, error) = - switch (output_result) { - | NotProvided - | AliasOfInput => - let validator = - ( - ~field: InputField.validated, - ~entries: list(InputTypeParser.validated_entry), - ~validators_record: ValidatorsRecord.t, - ~async_mode: option(AsyncMode.t), - ~output_type: ItemType.t, - ) - : result(FieldValidator.t, error) => - switch (async_mode) { - | None => - switch (field |> InputTypeParser.in_deps_of(entries)) { - | Some(in_deps_of_entry) => - switch ( - validators_record.fields - |> ValidatorsRecordParser.required(field) - ) { - | Ok () => Ok(SyncValidator(Ok(Required))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - | Error(`Some(_) as reason | `None(_) as reason) => - // In this case we can give more insights (hopefully) - // on how to fix this error - Error( - ValidatorsRecordParseError( - ValidatorError( - `BadRequiredValidator(( - field, - reason, - `IncludedInDeps(in_deps_of_entry), - )), - ), - ), - ) - } - | None => - switch ( - validators_record.fields - |> ValidatorsRecordParser.optional(field) - ) { - | Ok(res) => Ok(SyncValidator(Ok(Optional(res)))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - } - } - | Some(mode) => - Ok( - AsyncValidator({ - mode, - optionality: output_type |> FieldOptionalityParser.parse, - }), - ) - }; - - validated_input_entries - |> List.fold_left( - (res, entry: InputTypeParser.validated_entry) => { - switch (res, entry) { - | (Error(error), _) => Error(error) - | (Ok(scheme), ValidatedInputField(field)) => - let validator = - validator( - ~field=ValidatedInputField(field), - ~entries=validated_input_entries, - ~validators_record, - ~async_mode=field.async, - ~output_type=field.typ, - ); - switch (validator) { - | Ok(validator) => - Ok([ - Scheme.Field({ - name: field.name, - input_type: field.typ, - output_type: field.typ, - validator, - deps: field.deps, - }), - ...scheme, - ]) - | Error(error) => Error(error) - }; - - | ( - Ok(scheme), - ValidatedInputCollection({ - collection, - fields, - input_type, - }), - ) => - let fields = - fields - |> List.fold_left( - (res, field) => - switch (res) { - | Error(error) => Error(error) - | Ok(fields) => - let validator = - validator( - ~field= - ValidatedInputFieldOfCollection({ - collection, - field, - }), - ~entries=validated_input_entries, - ~validators_record, - ~async_mode=field.async, - ~output_type=field.typ, - ); - switch (validator) { - | Ok(validator) => - Ok([ - Scheme.{ - name: field.name, - input_type: field.typ, - output_type: field.typ, - validator, - deps: field.deps, - }, - ...fields, - ]) - | Error(error) => Error(error) - }; - }, - Ok([]), - ); - switch (fields) { - | Error(error) => Error(error) - | Ok(fields) => - Ok([ - Scheme.Collection({ - collection, - fields, - input_type, - output_type: input_type, - validator: - switch ( - validators_record.fields - |> ValidatorsRecordParser.collection( - collection, - ) - ) { - | Ok(res) => Ok(res) - | Error(_) => Error() - }, - }), - ...scheme, - ]) - }; - } - }, - Ok([]), - ); - | Record({entries: output_entries, loc: output_loc}) => - let validator = - ( - ~input_field: InputField.validated, - ~input_field_data: InputFieldData.validated, - ~output_field_data: OutputFieldData.t, - ~input_entries: list(InputTypeParser.validated_entry), - ~validators_record: ValidatorsRecord.t, - ) - : result(FieldValidator.t, error) => - switch (input_field_data.async) { - | None => - switch ( - input_field |> InputTypeParser.in_deps_of(input_entries) - ) { - | Some(in_deps_of_field) => - switch ( - validators_record.fields - |> ValidatorsRecordParser.required(input_field) - ) { - | Ok () => Ok(SyncValidator(Ok(Required))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - | Error(`Some(_) as reason | `None(_) as reason) => - // In this case we can give more insights (hopefully) - // on how to fix this error - Error( - ValidatorsRecordParseError( - ValidatorError( - `BadRequiredValidator(( - input_field, - reason, - `IncludedInDeps(in_deps_of_field), - )), - ), - ), - ) - } - | None => - if (ItemType.eq(input_field_data.typ, output_field_data.typ)) { - switch ( - validators_record.fields - |> ValidatorsRecordParser.optional(input_field) - ) { - | Ok(res) => Ok(SyncValidator(Ok(Optional(res)))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - }; - } else { - switch ( - validators_record.fields - |> ValidatorsRecordParser.required(input_field) - ) { - | Ok () => Ok(SyncValidator(Ok(Required))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - | Error(`Some(_) as reason | `None(_) as reason) => - // In this case we can give more insights (hopefully) - // on how to fix this error - Error( - ValidatorsRecordParseError( - ValidatorError( - `BadRequiredValidator(( - input_field, - reason, - `DifferentIO(( - input_field_data.typ, - output_field_data.typ, - )), - )), - ), - ), - ) - }; - } - } - | Some(mode) => - Ok( - AsyncValidator({ - mode, - optionality: - output_field_data.typ |> FieldOptionalityParser.parse, - }), - ) - }; - - let ( - result, - input_fields_not_in_output, - output_fields_not_in_input, - ) = - validated_input_entries - |> List.rev - |> List.fold_left( - ( - ( - result: result(Scheme.t, error), - input_fields_not_in_output: list(InputField.validated), - output_fields_not_in_input: list(OutputField.t), - ), - input_entry: InputTypeParser.validated_entry, - ) => - switch (input_entry) { - | ValidatedInputField(input_field_data) => - let output_field_data = - output_entries - |> List.fold_left( - (res, output_entry: OutputTypeParser.entry) => - switch (res, output_entry) { - | (Some(_), _) => res - | (None, OutputField(output_field_data)) => - input_field_data.name - == output_field_data.name - ? Some(output_field_data) : None - | (None, OutputCollection(_)) => None - }, - None, - ); - switch (result, output_field_data) { - | (_, None) => ( - result, - [ - ValidatedInputField(input_field_data), - ...input_fields_not_in_output, - ], - output_fields_not_in_input, - ) - - | (Error(error), Some(_output_field_data)) => ( - Error(error), - input_fields_not_in_output, - output_fields_not_in_input - |> List.filter((output_field: OutputField.t) => - switch (output_field) { - | OutputField(output_field_data) => - output_field_data.name - != input_field_data.name - | OutputFieldOfCollection(_) => true - } - ), - ) - - | (Ok(scheme), Some(output_field_data)) => - let validator = - validator( - ~input_field= - ValidatedInputField(input_field_data), - ~input_field_data, - ~output_field_data, - ~input_entries=validated_input_entries, - ~validators_record, - ); - ( - switch (validator) { - | Error(error) => Error(error) - | Ok(validator) => - Ok([ - Scheme.Field({ - name: input_field_data.name, - input_type: input_field_data.typ, - output_type: output_field_data.typ, - validator, - deps: input_field_data.deps, - }), - ...scheme, - ]) - }, - input_fields_not_in_output, - output_fields_not_in_input - |> List.filter((output_field: OutputField.t) => - switch (output_field) { - | OutputField(output_field_data) => - output_field_data.name - != input_field_data.name - | OutputFieldOfCollection(_) => true - } - ), - ); - }; - - | ValidatedInputCollection({ - collection: input_collection, - fields: input_fields, - input_type: input_collection_type, - }) => - let output_collection = - output_entries - |> List.fold_left( - (res, output_entry: OutputTypeParser.entry) => - switch (res, output_entry) { - | (Some(_), _) => res - | (None, OutputField(_)) => res - | ( - None, - OutputCollection({ - collection: output_collection, - fields, - output_type, - }), - ) => - if (output_collection.plural - == input_collection.plural) { - Some(( - output_collection, - fields, - output_type, - )); - } else { - None; - } - }, - None, - ); - switch (output_collection) { - | None => ( - Error( - OutputTypeParseError( - OutputCollectionNotFound({ - input_collection, - loc: output_loc, - }), - ), - ), - input_fields - |> List.fold_left( - (acc: list(InputField.validated), field) => - [ - ValidatedInputFieldOfCollection({ - collection: input_collection, - field, - }), - ...acc, - ], - input_fields_not_in_output, - ), - output_fields_not_in_input, - ) - | Some(( - _output_collection, - output_fields, - output_type, - )) => - let ( - fields, - input_fields_not_in_output, - output_fields_not_in_input, - ) = - input_fields - |> List.rev - |> List.fold_left( - ( - ( - res: result(list(Scheme.field), error), - input_fields_not_in_output: - list(InputField.validated), - output_fields_not_in_input: - list(OutputField.t), - ), - input_field_data: InputFieldData.validated, - ) => { - let output_field_data = - output_fields - |> List.find_opt( - ( - output_field_data: OutputFieldData.t, - ) => - output_field_data.name - == input_field_data.name - ); - - switch (res, output_field_data) { - | (_, None) => ( - res, - [ - ValidatedInputFieldOfCollection({ - collection: input_collection, - field: input_field_data, - }), - ...input_fields_not_in_output, - ], - output_fields_not_in_input, - ) - - | (Error(error), Some(output_field_data)) => ( - Error(error), - input_fields_not_in_output, - output_fields_not_in_input - |> List.filter( - (output_field: OutputField.t) => - switch (output_field) { - | OutputField(_) => true - | OutputFieldOfCollection({ - collection, - field, - }) => - !( - input_collection.plural - == collection.plural - && output_field_data.name - == field.name - ) - } - ), - ) - | (Ok(fields), Some(output_field_data)) => - let validator = - validator( - ~input_field= - ValidatedInputFieldOfCollection({ - collection: input_collection, - field: input_field_data, - }), - ~input_field_data, - ~output_field_data, - ~input_entries=validated_input_entries, - ~validators_record, - ); - ( - switch (validator) { - | Error(error) => Error(error) - | Ok(validator) => - Ok([ - { - name: input_field_data.name, - input_type: input_field_data.typ, - output_type: output_field_data.typ, - validator, - deps: input_field_data.deps, - }, - ...fields, - ]) - }, - input_fields_not_in_output, - output_fields_not_in_input - |> List.filter( - (output_field: OutputField.t) => - switch (output_field) { - | OutputField(_) => true - | OutputFieldOfCollection({ - collection, - field, - }) => - !( - input_collection.plural - == collection.plural - && output_field_data.name - == field.name - ) - } - ), - ); - }; - }, - ( - Ok([]), - input_fields_not_in_output, - output_fields_not_in_input, - ), - ); - - switch (result, fields) { - | (Error(_error), _) => ( - result, - input_fields_not_in_output, - output_fields_not_in_input, - ) - | (Ok(_), Error(error)) => ( - Error(error), - input_fields_not_in_output, - output_fields_not_in_input, - ) - | (Ok(scheme), Ok(fields)) => ( - Ok([ - Scheme.Collection({ - collection: input_collection, - fields, - input_type: input_collection_type, - output_type, - validator: - switch ( - validators_record.fields - |> ValidatorsRecordParser.collection( - input_collection, - ) - ) { - | Ok(res) => Ok(res) - | Error(_) => Error() - }, - }), - ...scheme, - ]), - input_fields_not_in_output, - output_fields_not_in_input, - ) - }; - }; - }, - (Ok([]), [], output_entries |> OutputTypeParser.flatten), - ); - switch (input_fields_not_in_output, output_fields_not_in_input) { - | ([], []) => result - | (input_fields_not_in_output, []) => - Error( - IOMismatch( - InputFieldsNotInOutput({ - fields: input_fields_not_in_output, - loc: output_loc, - }), - ), - ) - | ([], _output_entries_not_in_input) => - Error( - IOMismatch( - OutputFieldsNotInInput({ - fields: output_fields_not_in_input, - }), - ), - ) - | (input_fields_not_in_output, output_fields_not_in_input) => - Error( - IOMismatch( - Both({ - input_fields_not_in_output, - output_fields_not_in_input, - loc: output_loc, - }), - ), - ) - }; - }; - - switch (scheme) { - | Ok(scheme) => - Ok({ - scheme, - async: - // TODO: Quick and dirty. - // Scheme.t should be wrapped in variant instead, probably. - // Let's do base implementation first, - // then look into how to redesign it better - scheme - |> List.exists((entry: Scheme.entry) => - switch (entry) { - | Field({validator: AsyncValidator(_)}) => true - | Field({validator: SyncValidator(_)}) => false - | Collection({fields}) => - fields - |> List.exists((field: Scheme.field) => - switch (field) { - | {validator: AsyncValidator(_)} => true - | {validator: SyncValidator(_)} => false - } - ) - } - ), - output_type: output_result, - validators_record, - message_type: message_type^, - submission_error_type: submission_error_type^, - metadata: metadata^, - debounce_interval: debounce_interval_value^, - }) - | Error(error) => Error(error) - }; - } - }; - }; -}; diff --git a/ppx/lib/Printer.ml b/ppx/lib/Printer.ml new file mode 100644 index 00000000..7631d8e7 --- /dev/null +++ b/ppx/lib/Printer.ml @@ -0,0 +1,79 @@ +open Meta + +module FieldPrinter = struct + let update_action ~field = "Update" ^ (field |> String.capitalize_ascii) ^ "Field" + let blur_action ~field = "Blur" ^ (field |> String.capitalize_ascii) ^ "Field" + + let apply_async_result_action ~field = + "ApplyAsyncResultFor" ^ (field |> String.capitalize_ascii) ^ "Field" + ;; + + let update_fn ~field = "update" ^ (field |> String.capitalize_ascii) + let blur_fn ~field = "blur" ^ (field |> String.capitalize_ascii) + let result_value ~field = field ^ "Result" +end + +module FieldOfCollectionPrinter = struct + let update_action ~field ~(collection : Collection.t) = + "Update" + ^ (collection.singular |> String.capitalize_ascii) + ^ (field |> String.capitalize_ascii) + ^ "Field" + ;; + + let blur_action ~field ~(collection : Collection.t) = + "Blur" + ^ (collection.singular |> String.capitalize_ascii) + ^ (field |> String.capitalize_ascii) + ^ "Field" + ;; + + let apply_async_result_action ~field ~(collection : Collection.t) = + "ApplyAsyncResultFor" + ^ (collection.singular |> String.capitalize_ascii) + ^ (field |> String.capitalize_ascii) + ^ "Field" + ;; + + let update_fn ~field ~(collection : Collection.t) = + "update" + ^ (collection.singular |> String.capitalize_ascii) + ^ (field |> String.capitalize_ascii) + ;; + + let blur_fn ~field ~(collection : Collection.t) = + "blur" + ^ (collection.singular |> String.capitalize_ascii) + ^ (field |> String.capitalize_ascii) + ;; + + let result_fn ~field ~(collection : Collection.t) = + collection.singular ^ (field |> String.capitalize_ascii) ^ "Result" + ;; +end + +module CollectionPrinter = struct + let fields_statuses_type (collection : Collection.t) = + collection.singular ^ "FieldsStatuses" + ;; + + let validator_type (collection : Collection.t) = collection.plural ^ "Validators" + + let add_action (collection : Collection.t) = + "Add" ^ (collection.singular |> String.capitalize_ascii) ^ "Entry" + ;; + + let remove_action (collection : Collection.t) = + "Remove" ^ (collection.singular |> String.capitalize_ascii) ^ "Entry" + ;; + + let add_fn (collection : Collection.t) = + "add" ^ (collection.singular |> String.capitalize_ascii) + ;; + + let remove_fn (collection : Collection.t) = + "remove" ^ (collection.singular |> String.capitalize_ascii) + ;; + + let result_value (collection : Collection.t) = collection.plural ^ "Result" +end diff --git a/ppx/lib/Printer.re b/ppx/lib/Printer.re deleted file mode 100644 index d10b34f8..00000000 --- a/ppx/lib/Printer.re +++ /dev/null @@ -1,74 +0,0 @@ -open Meta; - -module FieldPrinter = { - let update_action = (~field) => - "Update" ++ (field |> String.capitalize_ascii) ++ "Field"; - - let blur_action = (~field) => - "Blur" ++ (field |> String.capitalize_ascii) ++ "Field"; - - let apply_async_result_action = (~field) => - "ApplyAsyncResultFor" ++ (field |> String.capitalize_ascii) ++ "Field"; - - let update_fn = (~field) => "update" ++ (field |> String.capitalize_ascii); - - let blur_fn = (~field) => "blur" ++ (field |> String.capitalize_ascii); - - let result_value = (~field) => field ++ "Result"; -}; - -module FieldOfCollectionPrinter = { - let update_action = (~field, ~collection: Collection.t) => - "Update" - ++ (collection.singular |> String.capitalize_ascii) - ++ (field |> String.capitalize_ascii) - ++ "Field"; - - let blur_action = (~field, ~collection: Collection.t) => - "Blur" - ++ (collection.singular |> String.capitalize_ascii) - ++ (field |> String.capitalize_ascii) - ++ "Field"; - - let apply_async_result_action = (~field, ~collection: Collection.t) => - "ApplyAsyncResultFor" - ++ (collection.singular |> String.capitalize_ascii) - ++ (field |> String.capitalize_ascii) - ++ "Field"; - - let update_fn = (~field, ~collection: Collection.t) => - "update" - ++ (collection.singular |> String.capitalize_ascii) - ++ (field |> String.capitalize_ascii); - - let blur_fn = (~field, ~collection: Collection.t) => - "blur" - ++ (collection.singular |> String.capitalize_ascii) - ++ (field |> String.capitalize_ascii); - - let result_fn = (~field, ~collection: Collection.t) => - collection.singular ++ (field |> String.capitalize_ascii) ++ "Result"; -}; - -module CollectionPrinter = { - let fields_statuses_type = (collection: Collection.t) => - collection.singular ++ "FieldsStatuses"; - - let validator_type = (collection: Collection.t) => - collection.plural ++ "Validators"; - - let add_action = (collection: Collection.t) => - "Add" ++ (collection.singular |> String.capitalize_ascii) ++ "Entry"; - - let remove_action = (collection: Collection.t) => - "Remove" ++ (collection.singular |> String.capitalize_ascii) ++ "Entry"; - - let add_fn = (collection: Collection.t) => - "add" ++ (collection.singular |> String.capitalize_ascii); - - let remove_fn = (collection: Collection.t) => - "remove" ++ (collection.singular |> String.capitalize_ascii); - - let result_value = (collection: Collection.t) => - collection.plural ++ "Result"; -}; diff --git a/ppx/lib/Uncurried.ml b/ppx/lib/Uncurried.ml new file mode 100644 index 00000000..3968b004 --- /dev/null +++ b/ppx/lib/Uncurried.ml @@ -0,0 +1,33 @@ +open Ppxlib +open Ast_helper + +let fn ~loc ~arity fx = + let attr = + Attr.mk + { txt = "res.arity"; loc } + (PStr [ Str.eval (Exp.constant (Const.int arity)) ]) + in + Exp.construct ~attrs:[ attr ] { txt = Lident "Function$"; loc } (Some fx) +;; + +let ty ~loc ~arity t_arg = + let t_arity = + Typ.variant + ~loc + [ { prf_loc = loc + ; prf_attributes = [] + ; prf_desc = Rtag ({ txt = "Has_arity" ^ string_of_int arity; loc }, true, []) + } + ] + Closed + None + in + Typ.constr ~loc { txt = Lident "function$"; loc } [ t_arg; t_arity ] +;; + +let uapp : Parsetree.attribute = + { attr_name = { txt = "res.uapp"; loc = Location.none } + ; attr_payload = PStr [] + ; attr_loc = Location.none + } +;; diff --git a/ppx/lib/dune b/ppx/lib/dune index f8d4f34d..f50fb030 100644 --- a/ppx/lib/dune +++ b/ppx/lib/dune @@ -2,7 +2,6 @@ (name lib) (public_name re-formality-ppx.lib) (kind ppx_rewriter) - (libraries reason ppxlib) + (libraries ppxlib) (flags (:standard -w -30-9)) - (preprocess (pps ppxlib.metaquot)) -) + (preprocess (pps ppxlib.metaquot))) diff --git a/ppx/sandbox/README.md b/ppx/sandbox/README.md deleted file mode 100644 index 78006622..00000000 --- a/ppx/sandbox/README.md +++ /dev/null @@ -1,9 +0,0 @@ -# Sandbox - -Used as a sandbox for conveniently debugging test cases. - -Run the script and debug generated code of the test case using editor tooling: - -```shell -ppx/test/script/sandbox [TEST_CASE] -``` diff --git a/ppx/sandbox/bsconfig.json b/ppx/sandbox/bsconfig.json deleted file mode 100644 index b806253e..00000000 --- a/ppx/sandbox/bsconfig.json +++ /dev/null @@ -1,20 +0,0 @@ -{ - "name": "re-formality-sandbox", - "sources": ["src"], - "bs-dependencies": [ - "@rescript/react", - "re-formality" - ], - "reason": { - "react-jsx": 3 - }, - "refmt": 3, - "package-specs": { - "module": "es6", - "in-source": true - }, - "suffix": ".bs.js", - "warnings": { - "number": "+A" - } -} diff --git a/ppx/sandbox/package.json b/ppx/sandbox/package.json deleted file mode 100644 index 9482c096..00000000 --- a/ppx/sandbox/package.json +++ /dev/null @@ -1,14 +0,0 @@ -{ - "name": "re-formality-sandbox", - "version": "0.0.0", - "private": true, - "scripts": { - "start": "rescript build -with-deps -w", - "build": "rescript build -with-deps" - }, - "dependencies": { - "@rescript/react": "0.11.0", - "re-formality": "*", - "rescript": "10.1.3" - } -} diff --git a/ppx/sandbox/src/Sandbox.re b/ppx/sandbox/src/Sandbox.re deleted file mode 100644 index e69de29b..00000000 diff --git a/ppx/test/Case.ml b/ppx/test/Case.ml new file mode 100644 index 00000000..db8f2159 --- /dev/null +++ b/ppx/test/Case.ml @@ -0,0 +1,116 @@ +type result = + { actual : string * string + ; expected : string * string + } + +let testable = + let open Alcotest in + pair string string +;; + +let nothing = "" + +module Path = struct + let join xs = xs |> String.concat Filename.dir_sep + + let test_cases_dir = + let open Filename in + [ current_dir_name; "ppx"; "test"; "cases" ] |> join + ;; + + let source x = Filename.concat test_cases_dir (x ^ ".res") + let snapshot x = Filename.concat test_cases_dir (x ^ ".snapshot") + + let ppx = + let open Filename in + concat ([ current_dir_name; "_build"; "default"; "ppx"; "bin" ] |> join) "bin.exe" + ;; + + let bsc = + let open Filename in + concat ([ current_dir_name; "node_modules"; "rescript" ] |> join) "bsc" + ;; + + let rescript_react = + let open Filename in + [ current_dir_name; "node_modules"; "@rescript"; "react"; "lib"; "ocaml" ] |> join + ;; + + let re_formality = + let open Filename in + [ current_dir_name; "node_modules"; "re-formality"; "lib"; "ocaml" ] |> join + ;; +end + +module Bsc = struct + let errors = "+A" + + let cmd case = + let open Path in + bsc + ^ " -ppx " + ^ ppx + ^ " -I " + ^ re_formality + ^ " -I " + ^ rescript_react + ^ " -w " + ^ errors + ^ " -warn-error " + ^ errors + ^ " -uncurried " + ^ " -color never " + ^ " -bs-cmi-only " + ^ (case |> source) + ;; +end + +let env = + let path () = "PATH=" ^ Sys.getenv "PATH" in + let systemroot () = "SYSTEMROOT=" ^ Sys.getenv "SYSTEMROOT" in + match Sys.os_type with + | "Win32" -> [| path (); systemroot () |] + | _ -> [| path () |] +;; + +let read_from_channel channel = + let buffer = Buffer.create 1024 in + let newline = "\n" in + (try + while true do + channel |> input_line |> Buffer.add_string buffer; + newline |> Buffer.add_string buffer + done + with + | End_of_file -> ()); + buffer |> Buffer.contents +;; + +let run_bsc case = + let stdout, stdin, stderr = Unix.open_process_full (case |> Bsc.cmd) env in + let res = stdout |> read_from_channel, stderr |> read_from_channel in + Unix.close_process_full (stdout, stdin, stderr) |> ignore; + res +;; + +let diff_error_snapshot case = + let actual = case |> Bsc.cmd in + let snapshot = case |> Path.snapshot in + let cmd = + actual + ^ " 2>&1" + ^ (match Sys.os_type with + | "Win32" -> {| | sed "s|\\test\\cases\\|/test/cases/|g"|} + | _ -> "") + ^ {| | diff --ignore-blank-lines --ignore-space-change |} + ^ snapshot + ^ {| -|} + in + let stdout, stdin, stderr = Unix.open_process_full cmd env in + let res = stdout |> read_from_channel, stderr |> read_from_channel in + Unix.close_process_full (stdout, stdin, stderr) |> ignore; + res +;; + +let ok case = { actual = case |> run_bsc; expected = nothing, nothing } +let error case = { actual = case |> diff_error_snapshot; expected = nothing, nothing } diff --git a/ppx/test/Case.mli b/ppx/test/Case.mli new file mode 100644 index 00000000..07d77e0b --- /dev/null +++ b/ppx/test/Case.mli @@ -0,0 +1,8 @@ +type result = + { actual : string * string + ; expected : string * string + } + +val testable : (string * string) Alcotest.testable +val ok : string -> result +val error : string -> result diff --git a/ppx/test/Case.re b/ppx/test/Case.re deleted file mode 100644 index 4ece9983..00000000 --- a/ppx/test/Case.re +++ /dev/null @@ -1,129 +0,0 @@ -type result = { - actual: (string, string), - expected: (string, string), -}; - -let testable = Alcotest.(pair(string, string)); -let nothing = ""; - -module Path = { - let join = xs => xs |> String.concat(Filename.dir_sep); - - let test_cases_dir = - Filename.([current_dir_name, "ppx", "test", "cases"] |> join); - - let source = x => Filename.concat(test_cases_dir, x ++ ".re"); - let snapshot = x => Filename.concat(test_cases_dir, x ++ ".snapshot"); - - let ppx = - Filename.( - concat( - [current_dir_name, "_build", "default", "ppx", "bin"] |> join, - "bin.exe", - ) - ); - let bsc = - Filename.( - concat([current_dir_name, "node_modules", ".bin"] |> join, "bsc") - ); - let rescript_react = - Filename.( - [current_dir_name, "node_modules", "@rescript", "react", "lib", "ocaml"] - |> join - ); - let re_formality = - Filename.( - [current_dir_name, "node_modules", "re-formality", "lib", "ocaml"] - |> join - ); -}; - -module Bsc = { - let errors = "+A"; - - let cmd = case => - Path.( - bsc - ++ " -ppx " - ++ ppx - ++ " -I " - ++ re_formality - ++ " -I " - ++ rescript_react - ++ " -w " - ++ errors - ++ " -warn-error " - ++ errors - ++ " -color never" - ++ " -bs-cmi-only " - ++ (case |> source) - ); -}; - -let env = { - let path = () => "PATH=" ++ Sys.getenv("PATH"); - let systemroot = () => "SYSTEMROOT=" ++ Sys.getenv("SYSTEMROOT"); - switch (Sys.os_type) { - | "Win32" => [|path(), systemroot()|] - | _ => [|path()|] - }; -}; - -let read_from_channel = channel => { - let buffer = Buffer.create(1024); - let newline = "\n"; - try( - while (true) { - channel |> input_line |> Buffer.add_string(buffer); - newline |> Buffer.add_string(buffer); - } - ) { - | End_of_file => () - }; - - buffer |> Buffer.contents; -}; - -let run_bsc = case => { - let (stdout, stdin, stderr) = Unix.open_process_full(case |> Bsc.cmd, env); - - let res = (stdout |> read_from_channel, stderr |> read_from_channel); - - Unix.close_process_full((stdout, stdin, stderr)) |> ignore; - - res; -}; - -let diff_error_snapshot = case => { - let actual = case |> Bsc.cmd; - let snapshot = case |> Path.snapshot; - - let cmd = - actual - ++ " 2>&1" - ++ ( - // FIXME: It doesn't work on CI - switch (Sys.os_type) { - | "Win32" => {| | sed "s|\\test\\cases\\|/test/cases/|g"|} - | _ => "" - } - ) - ++ {| | diff --ignore-blank-lines --ignore-space-change |} - ++ snapshot - ++ {| -|}; - - let (stdout, stdin, stderr) = Unix.open_process_full(cmd, env); - - let res = (stdout |> read_from_channel, stderr |> read_from_channel); - - Unix.close_process_full((stdout, stdin, stderr)) |> ignore; - - res; -}; - -let ok = case => {actual: case |> run_bsc, expected: (nothing, nothing)}; - -let error = case => { - actual: case |> diff_error_snapshot, - expected: (nothing, nothing), -}; diff --git a/ppx/test/Case.rei b/ppx/test/Case.rei deleted file mode 100644 index a9aab96a..00000000 --- a/ppx/test/Case.rei +++ /dev/null @@ -1,9 +0,0 @@ -type result = { - actual: (string, string), - expected: (string, string), -}; - -let testable: Alcotest.testable((string, string)); - -let ok: string => result; -let error: string => result; diff --git a/ppx/test/README.md b/ppx/test/README.md index eafdd841..2c551592 100644 --- a/ppx/test/README.md +++ b/ppx/test/README.md @@ -1,27 +1,17 @@ # PPX tests These tests ensure that there are no errors/warnings during a compilation of valid forms and check proper error messages produced by PPX itself. -Before running tests: - -```shell -# Install yarn deps -yarn install - -# Install esy deps (unless you use nix) -esy install - -# Build public interface of the lib -cd ppx/sandbox -yarn rescript build -with-deps -``` +Before running tests, setup the local env. See [CONTRIBUTING](/CONTRIBUTING.md) for more info. To run tests: ```shell -# with esy -esy x test.exe +## Opam +opam exec -- dune build +opam exec -- dune exec test.exe -#with nix +## Nix +dune build dune exec test.exe ``` @@ -36,9 +26,3 @@ To write expected output for specific error case: ```shell ppx/test/script/write-error-snapshot [CASE_MODULE_NAME_WITHOUT_EXTENSION] ``` - -To write un-ppx'ed source of a test case to sandbox for debugging: - -```shell -ppx/test/script/sandbox [CASE_MODULE_NAME_WITHOUT_EXTENSION] -``` diff --git a/ppx/test/Test.ml b/ppx/test/Test.ml new file mode 100644 index 00000000..06fea8b0 --- /dev/null +++ b/ppx/test/Test.ml @@ -0,0 +1,50 @@ +let check Case.{ expected; actual } = + let open Alcotest in + check Case.testable "same string" expected actual +;; + +let ok case = Alcotest.test_case case `Quick (fun () -> case |> Case.ok |> check) +let error case = Alcotest.test_case case `Quick (fun () -> case |> Case.error |> check) + +let () = + let open Alcotest in + run + "Ppx" + [ ( "oks" + , [ "Ok__FieldWithNoValidator" + ; "Ok__FieldWithSyncValidator" + ; "Ok__FieldWithAsyncValidatorInOnChangeMode" + ; "Ok__FieldWithAsyncValidatorInOnBlurMode" + ; "Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode" + ; "Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode" + ; "Ok__FieldWithSyncValidatorAndDependentFieldAndFieldWithSyncValidator" + ; "Ok__FieldWithSyncValidatorAndTwoDependentFieldsWithSyncValidators" + ; "Ok__TwoFieldsWithNoValidators" + ; "Ok__TwoFieldsWithSyncValidators" + ; "Ok__TwoFieldsWithAsyncValidatorsInOnChangeMode" + ; "Ok__TwoFieldsWithAsyncValidatorsInOnBlurMode" + ; "Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode" + ; "Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode" + ; "Ok__FieldWithSyncValidatorAndFieldWithNoValidator" + ; "Ok__FieldWithSyncValidatorAndCollectionWithNoCollectionValidatorAndFieldWithSyncValidator" + ; "Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithSyncValidator" + ; "Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithSyncValidator" + ; "Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode" + ; "Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode" + ; "Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode" + ; "Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode" + ; "Ok__CollectionWithNoCollectionValidatorAndTwoFieldsOfCollectionWithSyncValidator" + ; "Ok__Message" + ; "Ok__SubmissionError" + ; "Ok__Metadata" + ; "Ok__Include" + ; "Ok__LargeFormWithValidators" + ] + |> List.rev + |> List.rev_map ok ) + ; ( "errors" + , [ "Error__InputNotFound"; "Error__InputNotRecord" ] + |> List.rev + |> List.rev_map error ) + ] +;; diff --git a/ppx/test/Test.re b/ppx/test/Test.re deleted file mode 100644 index 74bd9207..00000000 --- a/ppx/test/Test.re +++ /dev/null @@ -1,60 +0,0 @@ -let check = (Case.{expected, actual}) => - Alcotest.(check(Case.testable, "same string", expected, actual)); - -let ok = case => { - Alcotest.test_case(case, `Quick, () => case |> Case.ok |> check); -}; - -let error = case => { - Alcotest.test_case(case, `Quick, () => case |> Case.error |> check); -}; - -let () = - Alcotest.( - run( - "Ppx", - [ - ( - "oks", - [ - "Ok__FieldWithNoValidator", - "Ok__FieldWithSyncValidator", - "Ok__FieldWithAsyncValidatorInOnChangeMode", - "Ok__FieldWithAsyncValidatorInOnBlurMode", - "Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode", - "Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode", - "Ok__FieldWithSyncValidatorAndDependentFieldAndFieldWithSyncValidator", - "Ok__FieldWithSyncValidatorAndTwoDependentFieldsWithSyncValidators", - "Ok__TwoFieldsWithNoValidators", - "Ok__TwoFieldsWithSyncValidators", - "Ok__TwoFieldsWithAsyncValidatorsInOnChangeMode", - "Ok__TwoFieldsWithAsyncValidatorsInOnBlurMode", - "Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode", - "Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode", - "Ok__FieldWithSyncValidatorAndFieldWithNoValidator", - "Ok__FieldWithSyncValidatorAndCollectionWithNoCollectionValidatorAndFieldWithSyncValidator", - "Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithSyncValidator", - "Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithSyncValidator", - "Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode", - "Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode", - "Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode", - "Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode", - "Ok__CollectionWithNoCollectionValidatorAndTwoFieldsOfCollectionWithSyncValidator", - "Ok__Message", - "Ok__SubmissionError", - "Ok__Metadata", - "Ok__Include", - "Ok__LargeFormWithValidators", - ] - |> List.rev - |> List.rev_map(ok), - ), - ( - "errors", - ["Error__InputNotFound", "Error__InputNotRecord"] - |> List.rev - |> List.rev_map(error), - ), - ], - ) - ); diff --git a/ppx/test/cases/Error__InputNotFound.re b/ppx/test/cases/Error__InputNotFound.re deleted file mode 100644 index e2ba3e5f..00000000 --- a/ppx/test/cases/Error__InputNotFound.re +++ /dev/null @@ -1 +0,0 @@ -module Form = [%form type t]; diff --git a/ppx/test/cases/Error__InputNotFound.res b/ppx/test/cases/Error__InputNotFound.res new file mode 100644 index 00000000..7c7480ac --- /dev/null +++ b/ppx/test/cases/Error__InputNotFound.res @@ -0,0 +1 @@ +module Form = %form(type t) diff --git a/ppx/test/cases/Error__InputNotFound.snapshot b/ppx/test/cases/Error__InputNotFound.snapshot index 6a0c09b0..f464d935 100644 --- a/ppx/test/cases/Error__InputNotFound.snapshot +++ b/ppx/test/cases/Error__InputNotFound.snapshot @@ -1,8 +1,8 @@ We've found a bug for you! - ./ppx/test/cases/Error__InputNotFound.re:1:15-28 + ./ppx/test/cases/Error__InputNotFound.res:1:15-27 - 1 │ module Form = [%form type t]; + 1 │ module Form = %form(type t) 2 │ `input` type not found diff --git a/ppx/test/cases/Error__InputNotRecord.re b/ppx/test/cases/Error__InputNotRecord.re deleted file mode 100644 index 7d5a8a14..00000000 --- a/ppx/test/cases/Error__InputNotRecord.re +++ /dev/null @@ -1 +0,0 @@ -module Form = [%form type input = int]; diff --git a/ppx/test/cases/Error__InputNotRecord.res b/ppx/test/cases/Error__InputNotRecord.res new file mode 100644 index 00000000..56d4829d --- /dev/null +++ b/ppx/test/cases/Error__InputNotRecord.res @@ -0,0 +1 @@ +module Form = %form(type input = int) diff --git a/ppx/test/cases/Error__InputNotRecord.snapshot b/ppx/test/cases/Error__InputNotRecord.snapshot index 37ab3780..2873ba00 100644 --- a/ppx/test/cases/Error__InputNotRecord.snapshot +++ b/ppx/test/cases/Error__InputNotRecord.snapshot @@ -1,8 +1,8 @@ We've found a bug for you! - ./ppx/test/cases/Error__InputNotRecord.re:1:22-37 + ./ppx/test/cases/Error__InputNotRecord.res:1:21-36 - 1 │ module Form = [%form type input = int]; + 1 │ module Form = %form(type input = int) 2 │ `input` must be of record type diff --git a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.re b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.re deleted file mode 100644 index d6be8ae1..00000000 --- a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.re +++ /dev/null @@ -1,17 +0,0 @@ -module Form = [%form - type input = {authors: [@field.collection] array(author)} - and author = {name: [@field.async {mode: OnBlur}] string}; - let validators = { - authors: { - collection: _input => Ok(), - fields: { - name: { - strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).name), - validateAsync: name => Js.Promise.resolve(Ok(name)), - }, - }, - }, - } -]; diff --git a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.res b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.res new file mode 100644 index 00000000..0f3dfba8 --- /dev/null +++ b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.res @@ -0,0 +1,16 @@ +module Form = %form( + type rec input = {authors: @field.collection array} + and author = {name: @field.async({mode: OnBlur}) string} + let validators = { + authors: { + collection: _input => Ok(), + fields: { + name: { + strategy: OnSubmit, + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).name), + validateAsync: name => Js.Promise.resolve(Ok(name)), + }, + }, + }, + } +) diff --git a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.re b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.re deleted file mode 100644 index 1e979bf8..00000000 --- a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.re +++ /dev/null @@ -1,17 +0,0 @@ -module Form = [%form - type input = {authors: [@field.collection] array(author)} - and author = {name: [@field.async] string}; - let validators = { - authors: { - collection: _input => Ok(), - fields: { - name: { - strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).name), - validateAsync: name => Js.Promise.resolve(Ok(name)), - }, - }, - }, - } -]; diff --git a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.res b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.res new file mode 100644 index 00000000..aaf30dc8 --- /dev/null +++ b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.res @@ -0,0 +1,16 @@ +module Form = %form( + type rec input = {authors: @field.collection array} + and author = {name: @field.async string} + let validators = { + authors: { + collection: _input => Ok(), + fields: { + name: { + strategy: OnSubmit, + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).name), + validateAsync: name => Js.Promise.resolve(Ok(name)), + }, + }, + }, + } +) diff --git a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithSyncValidator.re b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithSyncValidator.re deleted file mode 100644 index 12794183..00000000 --- a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithSyncValidator.re +++ /dev/null @@ -1,16 +0,0 @@ -module Form = [%form - type input = {authors: [@field.collection] array(author)} - and author = {name: string}; - let validators = { - authors: { - collection: _input => Ok(), - fields: { - name: { - strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).name), - }, - }, - }, - } -]; diff --git a/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithSyncValidator.res b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithSyncValidator.res new file mode 100644 index 00000000..77740046 --- /dev/null +++ b/ppx/test/cases/Ok__CollectionWithCollectionValidatorAndFieldOfCollectionWithSyncValidator.res @@ -0,0 +1,15 @@ +module Form = %form( + type rec input = {authors: @field.collection array} + and author = {name: string} + let validators = { + authors: { + collection: _input => Ok(), + fields: { + name: { + strategy: OnSubmit, + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).name), + }, + }, + }, + } +) diff --git a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.re b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.re deleted file mode 100644 index b4bcde72..00000000 --- a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.re +++ /dev/null @@ -1,17 +0,0 @@ -module Form = [%form - type input = {authors: [@field.collection] array(author)} - and author = {name: [@field.async {mode: OnBlur}] string}; - let validators = { - authors: { - collection: None, - fields: { - name: { - strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).name), - validateAsync: name => Js.Promise.resolve(Ok(name)), - }, - }, - }, - } -]; diff --git a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.res b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.res new file mode 100644 index 00000000..f06f864a --- /dev/null +++ b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnBlurMode.res @@ -0,0 +1,16 @@ +module Form = %form( + type rec input = {authors: @field.collection array} + and author = {name: @field.async({mode: OnBlur}) string} + let validators = { + authors: { + collection: None, + fields: { + name: { + strategy: OnSubmit, + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).name), + validateAsync: name => Js.Promise.resolve(Ok(name)), + }, + }, + }, + } +) diff --git a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.re b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.re deleted file mode 100644 index 7d01662a..00000000 --- a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.re +++ /dev/null @@ -1,17 +0,0 @@ -module Form = [%form - type input = {authors: [@field.collection] array(author)} - and author = {name: [@field.async] string}; - let validators = { - authors: { - collection: None, - fields: { - name: { - strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).name), - validateAsync: name => Js.Promise.resolve(Ok(name)), - }, - }, - }, - } -]; diff --git a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.res b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.res new file mode 100644 index 00000000..467a468d --- /dev/null +++ b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithAsyncValidatorInOnChangeMode.res @@ -0,0 +1,16 @@ +module Form = %form( + type rec input = {authors: @field.collection array} + and author = {name: @field.async string} + let validators = { + authors: { + collection: None, + fields: { + name: { + strategy: OnSubmit, + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).name), + validateAsync: name => Js.Promise.resolve(Ok(name)), + }, + }, + }, + } +) diff --git a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithSyncValidator.re b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithSyncValidator.re deleted file mode 100644 index 42f4c17c..00000000 --- a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithSyncValidator.re +++ /dev/null @@ -1,16 +0,0 @@ -module Form = [%form - type input = {authors: [@field.collection] array(author)} - and author = {name: string}; - let validators = { - authors: { - collection: None, - fields: { - name: { - strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).name), - }, - }, - }, - } -]; diff --git a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithSyncValidator.res b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithSyncValidator.res new file mode 100644 index 00000000..3adb4785 --- /dev/null +++ b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndFieldOfCollectionWithSyncValidator.res @@ -0,0 +1,15 @@ +module Form = %form( + type rec input = {authors: @field.collection array} + and author = {name: string} + let validators = { + authors: { + collection: None, + fields: { + name: { + strategy: OnSubmit, + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).name), + }, + }, + }, + } +) diff --git a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndTwoFieldsOfCollectionWithSyncValidator.re b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndTwoFieldsOfCollectionWithSyncValidator.re deleted file mode 100644 index efec07ba..00000000 --- a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndTwoFieldsOfCollectionWithSyncValidator.re +++ /dev/null @@ -1,24 +0,0 @@ -module Form = [%form - type input = {authors: [@field.collection] array(author)} - and author = { - name: string, - age: int, - }; - let validators = { - authors: { - collection: None, - fields: { - name: { - strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).name), - }, - age: { - strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).age), - }, - }, - }, - } -]; diff --git a/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndTwoFieldsOfCollectionWithSyncValidator.res b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndTwoFieldsOfCollectionWithSyncValidator.res new file mode 100644 index 00000000..0de07ed4 --- /dev/null +++ b/ppx/test/cases/Ok__CollectionWithNoCollectionValidatorAndTwoFieldsOfCollectionWithSyncValidator.res @@ -0,0 +1,22 @@ +module Form = %form( + type rec input = {authors: @field.collection array} + and author = { + name: string, + age: int, + } + let validators = { + authors: { + collection: None, + fields: { + name: { + strategy: OnSubmit, + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).name), + }, + age: { + strategy: OnSubmit, + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).age), + }, + }, + }, + } +) diff --git a/ppx/test/cases/Ok__FieldWithAsyncValidatorInOnBlurMode.re b/ppx/test/cases/Ok__FieldWithAsyncValidatorInOnBlurMode.res similarity index 66% rename from ppx/test/cases/Ok__FieldWithAsyncValidatorInOnBlurMode.re rename to ppx/test/cases/Ok__FieldWithAsyncValidatorInOnBlurMode.res index 380faaf3..a23a0706 100644 --- a/ppx/test/cases/Ok__FieldWithAsyncValidatorInOnBlurMode.re +++ b/ppx/test/cases/Ok__FieldWithAsyncValidatorInOnBlurMode.res @@ -1,5 +1,5 @@ -module Form = [%form - type input = {name: [@field.async {mode: OnBlur}] string}; +module Form = %form( + type input = {name: @field.async({mode: OnBlur}) string} let validators = { name: { strategy: OnSubmit, @@ -7,4 +7,4 @@ module Form = [%form validateAsync: name => Js.Promise.resolve(Ok(name)), }, } -]; +) diff --git a/ppx/test/cases/Ok__FieldWithAsyncValidatorInOnChangeMode.re b/ppx/test/cases/Ok__FieldWithAsyncValidatorInOnChangeMode.res similarity index 70% rename from ppx/test/cases/Ok__FieldWithAsyncValidatorInOnChangeMode.re rename to ppx/test/cases/Ok__FieldWithAsyncValidatorInOnChangeMode.res index b6b65eb5..01f8d7a7 100644 --- a/ppx/test/cases/Ok__FieldWithAsyncValidatorInOnChangeMode.re +++ b/ppx/test/cases/Ok__FieldWithAsyncValidatorInOnChangeMode.res @@ -1,5 +1,5 @@ -module Form = [%form - type input = {name: [@field.async] string}; +module Form = %form( + type input = {name: @field.async string} let validators = { name: { strategy: OnSubmit, @@ -7,4 +7,4 @@ module Form = [%form validateAsync: name => Js.Promise.resolve(Ok(name)), }, } -]; +) diff --git a/ppx/test/cases/Ok__FieldWithNoValidator.re b/ppx/test/cases/Ok__FieldWithNoValidator.re deleted file mode 100644 index 801a8039..00000000 --- a/ppx/test/cases/Ok__FieldWithNoValidator.re +++ /dev/null @@ -1,4 +0,0 @@ -module Form = [%form - type input = {name: string}; - let validators = {name: None} -]; diff --git a/ppx/test/cases/Ok__FieldWithNoValidator.res b/ppx/test/cases/Ok__FieldWithNoValidator.res new file mode 100644 index 00000000..546714a7 --- /dev/null +++ b/ppx/test/cases/Ok__FieldWithNoValidator.res @@ -0,0 +1,4 @@ +module Form = %form( + type input = {name: string} + let validators = {name: None} +) diff --git a/ppx/test/cases/Ok__FieldWithSyncValidator.re b/ppx/test/cases/Ok__FieldWithSyncValidator.res similarity index 66% rename from ppx/test/cases/Ok__FieldWithSyncValidator.re rename to ppx/test/cases/Ok__FieldWithSyncValidator.res index 4a9be1f6..2aa85499 100644 --- a/ppx/test/cases/Ok__FieldWithSyncValidator.re +++ b/ppx/test/cases/Ok__FieldWithSyncValidator.res @@ -1,9 +1,9 @@ -module Form = [%form - type input = {name: string}; +module Form = %form( + type input = {name: string} let validators = { name: { strategy: OnSubmit, validate: ({name}) => Ok(name), }, } -]; +) diff --git a/ppx/test/cases/Ok__FieldWithSyncValidatorAndCollectionWithNoCollectionValidatorAndFieldWithSyncValidator.re b/ppx/test/cases/Ok__FieldWithSyncValidatorAndCollectionWithNoCollectionValidatorAndFieldWithSyncValidator.res similarity index 54% rename from ppx/test/cases/Ok__FieldWithSyncValidatorAndCollectionWithNoCollectionValidatorAndFieldWithSyncValidator.re rename to ppx/test/cases/Ok__FieldWithSyncValidatorAndCollectionWithNoCollectionValidatorAndFieldWithSyncValidator.res index 0d2abbed..7101de2f 100644 --- a/ppx/test/cases/Ok__FieldWithSyncValidatorAndCollectionWithNoCollectionValidatorAndFieldWithSyncValidator.re +++ b/ppx/test/cases/Ok__FieldWithSyncValidatorAndCollectionWithNoCollectionValidatorAndFieldWithSyncValidator.res @@ -1,9 +1,9 @@ -module Form = [%form - type input = { +module Form = %form( + type rec input = { title: string, - authors: [@field.collection] array(author), + authors: @field.collection array, } - and author = {name: string}; + and author = {name: string} let validators = { title: { strategy: OnSubmit, @@ -14,10 +14,9 @@ module Form = [%form fields: { name: { strategy: OnSubmit, - validate: ({authors, _}, ~at) => - Ok(authors->Belt.Array.getUnsafe(at).name), + validate: ({authors, _}, ~at) => Ok((authors->Belt.Array.getUnsafe(at)).name), }, }, }, } -]; +) diff --git a/ppx/test/cases/Ok__FieldWithSyncValidatorAndDependentFieldAndFieldWithSyncValidator.re b/ppx/test/cases/Ok__FieldWithSyncValidatorAndDependentFieldAndFieldWithSyncValidator.res similarity index 77% rename from ppx/test/cases/Ok__FieldWithSyncValidatorAndDependentFieldAndFieldWithSyncValidator.re rename to ppx/test/cases/Ok__FieldWithSyncValidatorAndDependentFieldAndFieldWithSyncValidator.res index c74278d0..ca1bc8e1 100644 --- a/ppx/test/cases/Ok__FieldWithSyncValidatorAndDependentFieldAndFieldWithSyncValidator.re +++ b/ppx/test/cases/Ok__FieldWithSyncValidatorAndDependentFieldAndFieldWithSyncValidator.res @@ -1,8 +1,8 @@ -module Form = [%form +module Form = %form( type input = { - name: [@field.deps age] string, + name: @field.deps(age) string, age: int, - }; + } let validators = { name: { strategy: OnSubmit, @@ -13,4 +13,4 @@ module Form = [%form validate: ({age, _}) => Ok(age), }, } -]; +) diff --git a/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.re b/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.res similarity index 78% rename from ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.re rename to ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.res index 42385a22..3aa7d85f 100644 --- a/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.re +++ b/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.res @@ -1,8 +1,8 @@ -module Form = [%form +module Form = %form( type input = { - name: [@field.async {mode: OnBlur}] string, + name: @field.async({mode: OnBlur}) string, age: int, - }; + } let validators = { name: { strategy: OnSubmit, @@ -14,4 +14,4 @@ module Form = [%form validate: ({age, _}) => Ok(age), }, } -]; +) diff --git a/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.re b/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.res similarity index 82% rename from ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.re rename to ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.res index 6f674bb0..31f9f8f3 100644 --- a/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.re +++ b/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.res @@ -1,8 +1,8 @@ -module Form = [%form +module Form = %form( type input = { - name: [@field.async] string, + name: @field.async string, age: int, - }; + } let validators = { name: { strategy: OnSubmit, @@ -14,4 +14,4 @@ module Form = [%form validate: ({age, _}) => Ok(age), }, } -]; +) diff --git a/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithNoValidator.re b/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithNoValidator.res similarity index 85% rename from ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithNoValidator.re rename to ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithNoValidator.res index 63a31cfa..4d8e4f29 100644 --- a/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithNoValidator.re +++ b/ppx/test/cases/Ok__FieldWithSyncValidatorAndFieldWithNoValidator.res @@ -1,8 +1,8 @@ -module Form = [%form +module Form = %form( type input = { name: string, age: int, - }; + } let validators = { name: { strategy: OnSubmit, @@ -10,4 +10,4 @@ module Form = [%form }, age: None, } -]; +) diff --git a/ppx/test/cases/Ok__FieldWithSyncValidatorAndTwoDependentFieldsWithSyncValidators.re b/ppx/test/cases/Ok__FieldWithSyncValidatorAndTwoDependentFieldsWithSyncValidators.res similarity index 82% rename from ppx/test/cases/Ok__FieldWithSyncValidatorAndTwoDependentFieldsWithSyncValidators.re rename to ppx/test/cases/Ok__FieldWithSyncValidatorAndTwoDependentFieldsWithSyncValidators.res index f187621f..670bab39 100644 --- a/ppx/test/cases/Ok__FieldWithSyncValidatorAndTwoDependentFieldsWithSyncValidators.re +++ b/ppx/test/cases/Ok__FieldWithSyncValidatorAndTwoDependentFieldsWithSyncValidators.res @@ -1,9 +1,9 @@ -module Form = [%form +module Form = %form( type input = { - a: [@field.deps (b, c)] string, + a: @field.deps((b, c)) string, b: string, c: string, - }; + } let validators = { a: { strategy: OnSubmit, @@ -18,4 +18,4 @@ module Form = [%form validate: ({c, _}) => Ok(c), }, } -]; +) diff --git a/ppx/test/cases/Ok__Include.re b/ppx/test/cases/Ok__Include.re deleted file mode 100644 index e22c634c..00000000 --- a/ppx/test/cases/Ok__Include.re +++ /dev/null @@ -1,9 +0,0 @@ -include [%form - type input = {name: string}; - let validators = { - name: { - strategy: OnSubmit, - validate: ({name}) => Ok(name), - }, - } - ]; diff --git a/ppx/test/cases/Ok__Include.res b/ppx/test/cases/Ok__Include.res new file mode 100644 index 00000000..b0a47de5 --- /dev/null +++ b/ppx/test/cases/Ok__Include.res @@ -0,0 +1,9 @@ +include %form( + type input = {name: string} + let validators = { + name: { + strategy: OnSubmit, + validate: ({name}) => Ok(name), + }, + } +) diff --git a/ppx/test/cases/Ok__LargeFormWithValidators.re b/ppx/test/cases/Ok__LargeFormWithValidators.res similarity index 86% rename from ppx/test/cases/Ok__LargeFormWithValidators.re rename to ppx/test/cases/Ok__LargeFormWithValidators.res index b4eb665b..c4dd191f 100644 --- a/ppx/test/cases/Ok__LargeFormWithValidators.re +++ b/ppx/test/cases/Ok__LargeFormWithValidators.res @@ -1,6 +1,5 @@ -module Form = [%form - type submissionError = - | CouldNotSubmit; +module Form = %form( + type submissionError = CouldNotSubmit type input = { booleanField1: bool, booleanField2: bool, @@ -20,7 +19,7 @@ module Form = [%form stringField2: string, stringField3: string, stringField4: string, - }; + } type output = { booleanField1: bool, booleanField2: bool, @@ -32,15 +31,15 @@ module Form = [%form intField3: int, intField4: int, intField5: int, - optionalStringField1: option(string), - optionalStringField2: option(string), + optionalStringField1: option, + optionalStringField2: option, readOnlyField1: unit, readOnlyField2: unit, stringField1: string, stringField2: string, stringField3: string, stringField4: string, - }; + } let validators = { booleanField1: None, booleanField2: None, @@ -59,7 +58,7 @@ module Form = [%form intField1: { strategy: OnFirstBlur, validate: form => - switch (form.intField1 |> int_of_string_opt) { + switch form.intField1 |> int_of_string_opt { | Some(x) => Ok(x) | None => Error("Invalid number") }, @@ -67,7 +66,7 @@ module Form = [%form intField2: { strategy: OnFirstBlur, validate: form => - switch (form.intField2 |> float_of_string_opt) { + switch form.intField2 |> float_of_string_opt { | Some(x) => Ok(x |> int_of_float) | None => Error("Invalid number") }, @@ -75,7 +74,7 @@ module Form = [%form intField3: { strategy: OnFirstBlur, validate: form => - switch (form.intField3 |> int_of_string_opt) { + switch form.intField3 |> int_of_string_opt { | Some(x) => Ok(x) | None => Error("Invalid number") }, @@ -83,7 +82,7 @@ module Form = [%form intField4: { strategy: OnFirstBlur, validate: form => - switch (form.intField4 |> float_of_string_opt) { + switch form.intField4 |> float_of_string_opt { | Some(x) => Ok(x |> int_of_float) | None => Error("Invalid number") }, @@ -91,7 +90,7 @@ module Form = [%form intField5: { strategy: OnFirstBlur, validate: foo => - switch (foo.intField5 |> float_of_string_opt) { + switch foo.intField5 |> float_of_string_opt { | Some(x) => Ok(x |> int_of_float) | None => Error("Invalid number") }, @@ -126,4 +125,4 @@ module Form = [%form validate: form => Ok(form.stringField4), }, } -]; +) diff --git a/ppx/test/cases/Ok__Message.re b/ppx/test/cases/Ok__Message.res similarity index 57% rename from ppx/test/cases/Ok__Message.re rename to ppx/test/cases/Ok__Message.res index eaa20ce3..d27144de 100644 --- a/ppx/test/cases/Ok__Message.re +++ b/ppx/test/cases/Ok__Message.res @@ -1,14 +1,14 @@ module I18n = { - type t; -}; + type t +} -module Form = [%form - type input = {name: string}; - type message = I18n.t; +module Form = %form( + type input = {name: string} + type message = I18n.t let validators = { name: { strategy: OnSubmit, validate: ({name}) => Ok(name), }, } -]; +) diff --git a/ppx/test/cases/Ok__Metadata.re b/ppx/test/cases/Ok__Metadata.re deleted file mode 100644 index ac334749..00000000 --- a/ppx/test/cases/Ok__Metadata.re +++ /dev/null @@ -1,205 +0,0 @@ -module Email: { - type t; - let (+++): (t, string) => t; -} = { - type t = string; - let (+++) = (x, y) => x ++ y; -}; - -module Form = [%form - type input = { - name: string, - emailOnChange: [@field.async] Email.t, - emailOptionOnChange: [@field.async] option(Email.t), - emailStringOnChange: [@field.async] string, - emailOptionStringOnChange: [@field.async] option(string), - emailOnBlur: [@field.async {mode: OnBlur}] Email.t, - emailOptionOnBlur: [@field.async {mode: OnBlur}] option(Email.t), - emailStringOnBlur: [@field.async {mode: OnBlur}] string, - emailOptionStringOnBlur: [@field.async {mode: OnBlur}] option(string), - users: [@field.collection] array(user), - } - and user = { - userName: string, - userEmailOnChange: [@field.async] Email.t, - userEmailOptionOnChange: [@field.async] option(Email.t), - userEmailStringOnChange: [@field.async] string, - userEmailOptionStringOnChange: [@field.async] option(string), - userEmailOnBlur: [@field.async {mode: OnBlur}] Email.t, - userEmailOptionOnBlur: [@field.async {mode: OnBlur}] option(Email.t), - userEmailStringOnBlur: [@field.async {mode: OnBlur}] string, - userEmailOptionStringOnBlur: - [@field.async {mode: OnBlur}] option(string), - }; - type metadata = string; - let validators = { - name: { - strategy: OnSubmit, - validate: ({name, _}, metadata) => Ok(name ++ metadata), - }, - emailOnChange: { - strategy: OnSubmit, - validate: ({emailOnChange, _}, metadata) => - Ok(Email.(emailOnChange +++ metadata)), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(Email.(email +++ metadata))), - }, - emailOptionOnChange: { - strategy: OnSubmit, - validate: ({emailOptionOnChange, _}, metadata) => - Ok(Email.(emailOptionOnChange->Belt.Option.map(x => x +++ metadata))), - validateAsync: (email, metadata) => - Js.Promise.resolve( - Ok(Email.(email->Belt.Option.map(x => x +++ metadata))), - ), - }, - emailStringOnChange: { - strategy: OnSubmit, - validate: ({emailStringOnChange, _}, metadata) => - Ok(emailStringOnChange ++ metadata), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(email ++ metadata)), - }, - emailOptionStringOnChange: { - strategy: OnSubmit, - validate: ({emailOptionStringOnChange, _}, metadata) => - Ok(emailOptionStringOnChange->Belt.Option.map(x => x ++ metadata)), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(email->Belt.Option.map(x => x ++ metadata))), - }, - emailOnBlur: { - strategy: OnSubmit, - validate: ({emailOnBlur, _}, metadata) => - Ok(Email.(emailOnBlur +++ metadata)), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(Email.(email +++ metadata))), - }, - emailOptionOnBlur: { - strategy: OnSubmit, - validate: ({emailOptionOnBlur, _}, metadata) => - Ok(Email.(emailOptionOnBlur->Belt.Option.map(x => x +++ metadata))), - validateAsync: (email, metadata) => - Js.Promise.resolve( - Ok(Email.(email->Belt.Option.map(x => x +++ metadata))), - ), - }, - emailStringOnBlur: { - strategy: OnSubmit, - validate: ({emailStringOnBlur, _}, metadata) => - Ok(emailStringOnBlur ++ metadata), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(email ++ metadata)), - }, - emailOptionStringOnBlur: { - strategy: OnSubmit, - validate: ({emailOptionStringOnBlur, _}, metadata) => - Ok(emailOptionStringOnBlur->Belt.Option.map(x => x ++ metadata)), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(email->Belt.Option.map(x => x ++ metadata))), - }, - users: { - collection: (_input, _metadata) => Ok(), - fields: { - userName: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok(users->Belt.Array.getUnsafe(at).userName ++ metadata), - }, - userEmailOnChange: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok( - Email.( - users->Belt.Array.getUnsafe(at).userEmailOnChange +++ metadata - ), - ), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(Email.(email +++ metadata))), - }, - userEmailOptionOnChange: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok( - Email.( - users->Belt.Array.getUnsafe(at).userEmailOptionOnChange - ->Belt.Option.map(x => x +++ metadata) - ), - ), - validateAsync: (email, metadata) => - Js.Promise.resolve( - Ok(Email.(email->Belt.Option.map(x => x +++ metadata))), - ), - }, - userEmailStringOnChange: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok( - users->Belt.Array.getUnsafe(at).userEmailStringOnChange - ++ metadata, - ), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(email ++ metadata)), - }, - userEmailOptionStringOnChange: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok( - users->Belt.Array.getUnsafe(at).userEmailOptionStringOnChange - ->Belt.Option.map(x => x ++ metadata), - ), - validateAsync: (email, metadata) => - Js.Promise.resolve( - Ok(email->Belt.Option.map(x => x ++ metadata)), - ), - }, - userEmailOnBlur: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok( - Email.( - users->Belt.Array.getUnsafe(at).userEmailOnBlur +++ metadata - ), - ), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(Email.(email +++ metadata))), - }, - userEmailOptionOnBlur: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok( - Email.( - users->Belt.Array.getUnsafe(at).userEmailOptionOnBlur - ->Belt.Option.map(x => x +++ metadata) - ), - ), - validateAsync: (email, metadata) => - Js.Promise.resolve( - Ok(Email.(email->Belt.Option.map(x => x +++ metadata))), - ), - }, - userEmailStringOnBlur: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok( - users->Belt.Array.getUnsafe(at).userEmailStringOnBlur - ++ metadata, - ), - validateAsync: (email, metadata) => - Js.Promise.resolve(Ok(email ++ metadata)), - }, - userEmailOptionStringOnBlur: { - strategy: OnSubmit, - validate: ({users, _}, ~at, ~metadata) => - Ok( - users->Belt.Array.getUnsafe(at).userEmailOptionStringOnBlur - ->Belt.Option.map(x => x ++ metadata), - ), - validateAsync: (email, metadata) => - Js.Promise.resolve( - Ok(email->Belt.Option.map(x => x ++ metadata)), - ), - }, - }, - }, - } -]; diff --git a/ppx/test/cases/Ok__Metadata.res b/ppx/test/cases/Ok__Metadata.res new file mode 100644 index 00000000..a4ebc5b2 --- /dev/null +++ b/ppx/test/cases/Ok__Metadata.res @@ -0,0 +1,227 @@ +module Email: { + type t + let \"+++": (t, string) => t +} = { + type t = string + let \"+++" = (x, y) => x ++ y +} + +module Form = %form( + type rec input = { + name: string, + emailOnChange: @field.async Email.t, + emailOptionOnChange: @field.async option, + emailStringOnChange: @field.async string, + emailOptionStringOnChange: @field.async option, + emailOnBlur: @field.async({mode: OnBlur}) Email.t, + emailOptionOnBlur: @field.async({mode: OnBlur}) option, + emailStringOnBlur: @field.async({mode: OnBlur}) string, + emailOptionStringOnBlur: @field.async({mode: OnBlur}) option, + users: @field.collection array, + } + and user = { + userName: string, + userEmailOnChange: @field.async Email.t, + userEmailOptionOnChange: @field.async option, + userEmailStringOnChange: @field.async string, + userEmailOptionStringOnChange: @field.async option, + userEmailOnBlur: @field.async({mode: OnBlur}) Email.t, + userEmailOptionOnBlur: @field.async({mode: OnBlur}) option, + userEmailStringOnBlur: @field.async({mode: OnBlur}) string, + userEmailOptionStringOnBlur: @field.async({mode: OnBlur}) option, + } + type metadata = string + let validators = { + name: { + strategy: OnSubmit, + validate: ({name, _}, metadata) => Ok(name ++ metadata), + }, + emailOnChange: { + strategy: OnSubmit, + validate: ({emailOnChange, _}, metadata) => Ok({ + open Email + \"+++"(emailOnChange, metadata) + }), + validateAsync: (email, metadata) => + Js.Promise.resolve( + Ok({ + open Email + \"+++"(email, metadata) + }), + ), + }, + emailOptionOnChange: { + strategy: OnSubmit, + validate: ({emailOptionOnChange, _}, metadata) => Ok({ + open Email + emailOptionOnChange->Belt.Option.map(x => \"+++"(x, metadata)) + }), + validateAsync: (email, metadata) => + Js.Promise.resolve( + Ok({ + open Email + email->Belt.Option.map(x => \"+++"(x, metadata)) + }), + ), + }, + emailStringOnChange: { + strategy: OnSubmit, + validate: ({emailStringOnChange, _}, metadata) => Ok(emailStringOnChange ++ metadata), + validateAsync: (email, metadata) => Js.Promise.resolve(Ok(email ++ metadata)), + }, + emailOptionStringOnChange: { + strategy: OnSubmit, + validate: ({emailOptionStringOnChange, _}, metadata) => Ok( + emailOptionStringOnChange->Belt.Option.map(x => x ++ metadata), + ), + validateAsync: (email, metadata) => + Js.Promise.resolve(Ok(email->Belt.Option.map(x => x ++ metadata))), + }, + emailOnBlur: { + strategy: OnSubmit, + validate: ({emailOnBlur, _}, metadata) => Ok({ + open Email + \"+++"(emailOnBlur, metadata) + }), + validateAsync: (email, metadata) => + Js.Promise.resolve( + Ok({ + open Email + \"+++"(email, metadata) + }), + ), + }, + emailOptionOnBlur: { + strategy: OnSubmit, + validate: ({emailOptionOnBlur, _}, metadata) => Ok({ + open Email + emailOptionOnBlur->Belt.Option.map(x => \"+++"(x, metadata)) + }), + validateAsync: (email, metadata) => + Js.Promise.resolve( + Ok({ + open Email + email->Belt.Option.map(x => \"+++"(x, metadata)) + }), + ), + }, + emailStringOnBlur: { + strategy: OnSubmit, + validate: ({emailStringOnBlur, _}, metadata) => Ok(emailStringOnBlur ++ metadata), + validateAsync: (email, metadata) => Js.Promise.resolve(Ok(email ++ metadata)), + }, + emailOptionStringOnBlur: { + strategy: OnSubmit, + validate: ({emailOptionStringOnBlur, _}, metadata) => Ok( + emailOptionStringOnBlur->Belt.Option.map(x => x ++ metadata), + ), + validateAsync: (email, metadata) => + Js.Promise.resolve(Ok(email->Belt.Option.map(x => x ++ metadata))), + }, + users: { + collection: (_input, _metadata) => Ok(), + fields: { + userName: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok( + (users->Belt.Array.getUnsafe(at)).userName ++ metadata, + ), + }, + userEmailOnChange: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok({ + open Email + \"+++"((users->Belt.Array.getUnsafe(at)).userEmailOnChange, metadata) + }), + validateAsync: (email, metadata) => + Js.Promise.resolve( + Ok({ + open Email + \"+++"(email, metadata) + }), + ), + }, + userEmailOptionOnChange: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok({ + open Email + (users->Belt.Array.getUnsafe(at)).userEmailOptionOnChange->Belt.Option.map(x => + \"+++"(x, metadata) + ) + }), + validateAsync: (email, metadata) => + Js.Promise.resolve( + Ok({ + open Email + email->Belt.Option.map(x => \"+++"(x, metadata)) + }), + ), + }, + userEmailStringOnChange: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok( + (users->Belt.Array.getUnsafe(at)).userEmailStringOnChange ++ metadata, + ), + validateAsync: (email, metadata) => Js.Promise.resolve(Ok(email ++ metadata)), + }, + userEmailOptionStringOnChange: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok( + (users->Belt.Array.getUnsafe(at)).userEmailOptionStringOnChange->Belt.Option.map(x => + x ++ metadata + ), + ), + validateAsync: (email, metadata) => + Js.Promise.resolve(Ok(email->Belt.Option.map(x => x ++ metadata))), + }, + userEmailOnBlur: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok({ + open Email + \"+++"((users->Belt.Array.getUnsafe(at)).userEmailOnBlur, metadata) + }), + validateAsync: (email, metadata) => + Js.Promise.resolve( + Ok({ + open Email + \"+++"(email, metadata) + }), + ), + }, + userEmailOptionOnBlur: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok({ + open Email + (users->Belt.Array.getUnsafe(at)).userEmailOptionOnBlur->Belt.Option.map(x => + \"+++"(x, metadata) + ) + }), + validateAsync: (email, metadata) => + Js.Promise.resolve( + Ok({ + open Email + email->Belt.Option.map(x => \"+++"(x, metadata)) + }), + ), + }, + userEmailStringOnBlur: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok( + (users->Belt.Array.getUnsafe(at)).userEmailStringOnBlur ++ metadata, + ), + validateAsync: (email, metadata) => Js.Promise.resolve(Ok(email ++ metadata)), + }, + userEmailOptionStringOnBlur: { + strategy: OnSubmit, + validate: ({users, _}, ~at, ~metadata) => Ok( + (users->Belt.Array.getUnsafe(at)).userEmailOptionStringOnBlur->Belt.Option.map(x => + x ++ metadata + ), + ), + validateAsync: (email, metadata) => + Js.Promise.resolve(Ok(email->Belt.Option.map(x => x ++ metadata))), + }, + }, + }, + } +) diff --git a/ppx/test/cases/Ok__SubmissionError.re b/ppx/test/cases/Ok__SubmissionError.res similarity index 68% rename from ppx/test/cases/Ok__SubmissionError.re rename to ppx/test/cases/Ok__SubmissionError.res index da6dd74a..d1b939e6 100644 --- a/ppx/test/cases/Ok__SubmissionError.re +++ b/ppx/test/cases/Ok__SubmissionError.res @@ -1,12 +1,12 @@ -module Form = [%form - type input = {name: string}; +module Form = %form( + type input = {name: string} type submissionError = | A - | B; + | B let validators = { name: { strategy: OnSubmit, validate: ({name}) => Ok(name), }, } -]; +) diff --git a/ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnBlurMode.re b/ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnBlurMode.res similarity index 72% rename from ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnBlurMode.re rename to ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnBlurMode.res index cc8901f8..917f5bf8 100644 --- a/ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnBlurMode.re +++ b/ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnBlurMode.res @@ -1,8 +1,8 @@ -module Form = [%form +module Form = %form( type input = { - name: [@field.async {mode: OnBlur}] string, - age: [@field.async {mode: OnBlur}] int, - }; + name: @field.async({mode: OnBlur}) string, + age: @field.async({mode: OnBlur}) int, + } let validators = { name: { strategy: OnSubmit, @@ -15,4 +15,4 @@ module Form = [%form validateAsync: age => Js.Promise.resolve(Ok(age)), }, } -]; +) diff --git a/ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnChangeMode.re b/ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnChangeMode.res similarity index 78% rename from ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnChangeMode.re rename to ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnChangeMode.res index fe9d8d8a..a32e72d3 100644 --- a/ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnChangeMode.re +++ b/ppx/test/cases/Ok__TwoFieldsWithAsyncValidatorsInOnChangeMode.res @@ -1,8 +1,8 @@ -module Form = [%form +module Form = %form( type input = { - name: [@field.async] string, - age: [@field.async] int, - }; + name: @field.async string, + age: @field.async int, + } let validators = { name: { strategy: OnSubmit, @@ -15,4 +15,4 @@ module Form = [%form validateAsync: age => Js.Promise.resolve(Ok(age)), }, } -]; +) diff --git a/ppx/test/cases/Ok__TwoFieldsWithNoValidators.re b/ppx/test/cases/Ok__TwoFieldsWithNoValidators.res similarity index 76% rename from ppx/test/cases/Ok__TwoFieldsWithNoValidators.re rename to ppx/test/cases/Ok__TwoFieldsWithNoValidators.res index 11199b92..b8e4a8fd 100644 --- a/ppx/test/cases/Ok__TwoFieldsWithNoValidators.re +++ b/ppx/test/cases/Ok__TwoFieldsWithNoValidators.res @@ -1,7 +1,7 @@ -module Form = [%form +module Form = %form( type input = { name: string, age: int, - }; + } let validators = {name: None, age: None} -]; +) diff --git a/ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.re b/ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.res similarity index 83% rename from ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.re rename to ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.res index 189e6a08..28b289e3 100644 --- a/ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.re +++ b/ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnBlurMode.res @@ -1,9 +1,9 @@ -module Form = [%form +module Form = %form( type input = { - name: [@field.async {mode: OnBlur}] string, + name: @field.async({mode: OnBlur}) string, email: string, age: int, - }; + } let validators = { name: { strategy: OnSubmit, @@ -19,4 +19,4 @@ module Form = [%form validate: ({age, _}) => Ok(age), }, } -]; +) diff --git a/ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.re b/ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.res similarity index 86% rename from ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.re rename to ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.res index a2a416ae..78485152 100644 --- a/ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.re +++ b/ppx/test/cases/Ok__TwoFieldsWithSyncValidatorAndFieldWithAsyncValidatorInOnChangeMode.res @@ -1,9 +1,9 @@ -module Form = [%form +module Form = %form( type input = { - name: [@field.async] string, + name: @field.async string, email: string, age: int, - }; + } let validators = { name: { strategy: OnSubmit, @@ -19,4 +19,4 @@ module Form = [%form validate: ({age, _}) => Ok(age), }, } -]; +) diff --git a/ppx/test/cases/Ok__TwoFieldsWithSyncValidators.re b/ppx/test/cases/Ok__TwoFieldsWithSyncValidators.res similarity index 89% rename from ppx/test/cases/Ok__TwoFieldsWithSyncValidators.re rename to ppx/test/cases/Ok__TwoFieldsWithSyncValidators.res index a84814bd..88ee7515 100644 --- a/ppx/test/cases/Ok__TwoFieldsWithSyncValidators.re +++ b/ppx/test/cases/Ok__TwoFieldsWithSyncValidators.res @@ -1,8 +1,8 @@ -module Form = [%form +module Form = %form( type input = { name: string, age: int, - }; + } let validators = { name: { strategy: OnSubmit, @@ -13,4 +13,4 @@ module Form = [%form validate: ({age, _}) => Ok(age), }, } -]; +) diff --git a/ppx/test/dune b/ppx/test/dune index 66992beb..cd0adc87 100644 --- a/ppx/test/dune +++ b/ppx/test/dune @@ -1,5 +1,4 @@ (executable - (name test) - (public_name test.exe) - (libraries alcotest str) -) + (name test) + (public_name test.exe) + (libraries alcotest str)) diff --git a/ppx/test/script/print-bsc-output b/ppx/test/script/print-bsc-output index 5b7e5667..c35903fd 100755 --- a/ppx/test/script/print-bsc-output +++ b/ppx/test/script/print-bsc-output @@ -2,4 +2,12 @@ source "ppx/test/script/var" -$BSC -ppx $PPX -I $RE_FORMALITY -I $RESCRIPT_REACT -w $ERRORS -warn-error $ERRORS -bs-cmi-only $SRC +$BSC \ + -ppx $PPX \ + -I $RE_FORMALITY \ + -I $RESCRIPT_REACT \ + -w $ERRORS \ + -warn-error $ERRORS \ + -uncurried \ + -bs-cmi-only \ + $SRC diff --git a/ppx/test/script/print-ppxed-source b/ppx/test/script/print-ppxed-source deleted file mode 100755 index 31e8ad66..00000000 --- a/ppx/test/script/print-ppxed-source +++ /dev/null @@ -1,5 +0,0 @@ -#!/bin/bash - -source "ppx/test/script/var" - -cat $SRC | $REFMT --parse re --print binary | $PPX /dev/stdin /dev/stdout | $REFMT --parse binary --interface false diff --git a/ppx/test/script/sandbox b/ppx/test/script/sandbox deleted file mode 100644 index 85e5be87..00000000 --- a/ppx/test/script/sandbox +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/bash - -ppx/test/script/print-ppxed-source $1 > ppx/sandbox/src/Sandbox.re diff --git a/ppx/test/script/var b/ppx/test/script/var index 7e7abc69..dd275b48 100644 --- a/ppx/test/script/var +++ b/ppx/test/script/var @@ -1,11 +1,10 @@ #!/bin/bash -SRC="./ppx/test/cases/$1.re" +SRC="./ppx/test/cases/$1.res" SNAPSHOT="./ppx/test/cases/$1.snapshot" PPX="./_build/default/ppx/bin/bin.exe" -BSC="$(yarn bin)/bsc" -REFMT="$(yarn bin)/bsrefmt" +BSC="./node_modules/rescript/bsc" RESCRIPT_REACT="./node_modules/@rescript/react/lib/ocaml" RE_FORMALITY="./node_modules/re-formality/lib/ocaml" diff --git a/re-formality-ppx.opam b/re-formality-ppx.opam index e69de29b..ed999573 100644 --- a/re-formality-ppx.opam +++ b/re-formality-ppx.opam @@ -0,0 +1,22 @@ +opam-version: "2.0" +name: "re-formality-ppx" +version: "4.0.0-beta.20" +synopsis: "Form validation tool for @rescript/react" +description: """ +Form validation tool for @rescript/react +""" +maintainer: "Alex Fedoseev " +authors: "Alex Fedoseev " +license: "MIT" +homepage: "https://github.com/MinimaHQ/re-formality.git" +bug-reports: "https://github.com/MinimaHQ/re-formality/issues" +dev-repo: "git+https://github.com/MinimaHQ/re-formality.git" +depends: [ + "ocaml" { = "4.14.1" } + "dune" { = "3.11.1" } + "ppxlib" { = "0.30.0" } + "alcotest" { = "1.7.0" } +] +build: [ + ["dune" "build" "-p" name "-j" jobs] +] diff --git a/scripts/build-linux-arm64.sh b/scripts/build-linux-arm64.sh deleted file mode 100755 index 6d685c11..00000000 --- a/scripts/build-linux-arm64.sh +++ /dev/null @@ -1,69 +0,0 @@ -#!/bin/bash - -set -euo pipefail - -export $(cat scripts/aws.env | xargs) - -ARCH="arm64" -PLATFORM="linux" - -BIN="$LIB-$PLATFORM-$ARCH.exe" -REMOTE_BIN="~/re-formality/$RELEASE_DIR/$BIN" -RELEASE_BIN="$RELEASE_BIN_DIR/$BIN" - -echo "" -echo "=== Preparing $PLATFORM $ARCH binary" - -echo "Creating EC2 instance" -INSTANCE_ID=$( - aws ec2 run-instances \ - --image-id ami-0f69dd1d0d03ad669 \ - --count 1 \ - --instance-type m6g.medium \ - --key-name re-formality \ - --user-data file://scripts/user-data.linux-arm64.sh \ - --tag-specifications="ResourceType=instance,Tags=[{Key=re-formality,Value=''}]" \ - | jq -r ".Instances[0].InstanceId" -) -echo "EC2 instance $INSTANCE_ID created" - -echo "Getting public IP" -while : -do - INSTANCE_IP=$( - aws ec2 describe-instances --instance-ids $INSTANCE_ID | jq -r ".Reservations[0].Instances[0].PublicIpAddress" - ) - if [ -n "$INSTANCE_IP" ]; - then - echo "Instance is available at $INSTANCE_IP" - break; - else - sleep 5; - fi -done - -echo "Waiting for the build to complete" - -sleep 300 - -USER="ubuntu" - -while : -do - if ssh -o StrictHostKeyChecking=no -q -i scripts/aws.pem $USER@$INSTANCE_IP test -f "$REMOTE_BIN"; - then - echo "Binary is ready. Downloading." - break - else - sleep 5 - fi -done - -scp -i scripts/aws.pem $USER@$INSTANCE_IP:$REMOTE_BIN $RELEASE_BIN -echo "Downloaded." - -chmod $CHMOD $RELEASE_BIN - -echo "Terminating instance." -aws ec2 terminate-instances --instance-ids $INSTANCE_ID -echo "Instance terminated." diff --git a/scripts/build-macos-arm64.sh b/scripts/build-macos-arm64.sh deleted file mode 100755 index 25110b4a..00000000 --- a/scripts/build-macos-arm64.sh +++ /dev/null @@ -1,16 +0,0 @@ -#!/bin/bash - -set -euo pipefail - -ARCH=$(uname -m) -PLATFORM=$(uname -s | tr '[:upper:]' '[:lower:]') - -echo "" -echo "=== Preparing $PLATFORM $ARCH binary" - -SOURCE_BIN="_build/default/ppx/bin/bin.exe" -RELEASE_BIN="$RELEASE_BIN_DIR/$LIB-$PLATFORM-$ARCH.exe" - -dune build -cp $SOURCE_BIN $RELEASE_BIN -chmod $CHMOD $RELEASE_BIN diff --git a/scripts/release.sh b/scripts/release.sh deleted file mode 100755 index adfc8691..00000000 --- a/scripts/release.sh +++ /dev/null @@ -1,49 +0,0 @@ -#!/bin/bash - -set -euo pipefail - -OPAM_FILE=$(basename -- "$(find *.opam)") - -export LIB="${OPAM_FILE%.*}" -export RELEASE_DIR="_release" -export RELEASE_ZIP="$RELEASE_DIR/release.zip" -export RELEASE_BIN_DIR="$RELEASE_DIR/bin" - -echo "=== Releasing $LIB" - -if [ ! -f "$RELEASE_ZIP" ]; then - echo "$RELEASE_ZIP does not exist. Download it from Github and put in $RELEASE_DIR/ dir." - exit 1 -fi - -echo "=== Unzipping release archive" -unzip -d $RELEASE_DIR $RELEASE_ZIP -rm $RELEASE_ZIP - -echo "Release tree:" -tree -a -L 2 $RELEASE_DIR - -export CHMOD=$(stat -c %a "$RELEASE_BIN_DIR/$(ls $RELEASE_BIN_DIR | head -n 1)") - -./scripts/build-macos-arm64.sh -./scripts/build-linux-arm64.sh - -echo "Release tree:" -tree -a -L 2 $RELEASE_DIR - -echo "" -echo "=== Publishing to npm" -cd $RELEASE_DIR -rm .DS_Store >/dev/null 2>&1 || true - -echo "package.json:" -cat package.json -echo "" - -npm publish -cd .. - -echo "" -echo "=== Cleaning up" -rm -rf $RELEASE_DIR/* -tree -a -L 2 $RELEASE_DIR diff --git a/scripts/user-data.linux-arm64.sh b/scripts/user-data.linux-arm64.sh deleted file mode 100644 index 858aeec7..00000000 --- a/scripts/user-data.linux-arm64.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/bash - -set -euo pipefail - -exec > >(tee /var/log/user-data.log|logger -t user-data -s 2>/dev/console) 2>&1 - -export DEBIAN_FRONTEND=noninteractive - -apt update - -sudo -u ubuntu bash -xec 'pwd; -cd ~; -curl -fsSL https://get.jetpack.io/devbox -o devbox.sh; -bash devbox.sh -f; -git clone https://github.com/shakacode/re-formality.git; -cd re-formality; -devbox shell; -devbox run build; -ARCH=arm64; -PLATFORM=linux; -OPAM_FILE=$(basename -- $(find *.opam)); -LIB="${OPAM_FILE%.*}"; -SOURCE_BIN="_build/default/ppx/bin/bin.exe"; -RELEASE_BIN="_release/$LIB-$PLATFORM-$ARCH.exe"; -mkdir -p $(dirname $RELEASE_BIN); -cp $SOURCE_BIN $RELEASE_BIN; -' diff --git a/shell.nix b/shell.nix deleted file mode 100644 index 4a7e5795..00000000 --- a/shell.nix +++ /dev/null @@ -1,20 +0,0 @@ -with import {}; -with pkgs.ocaml-ng.ocamlPackages_4_12; - -mkShell { - buildInputs = [ - ocaml - dune_3 - reason - result - findlib - ppxlib - alcotest - merlin - ocaml-lsp - nodejs - yarn - awscli2 - darwin.apple_sdk.frameworks.CoreServices - ]; -} diff --git a/specs/app/index.html b/specs/app/index.html index 6cc4b829..57ce41d9 100644 --- a/specs/app/index.html +++ b/specs/app/index.html @@ -1,12 +1,15 @@ - + + re-formality - - + + +
- - + + + diff --git a/specs/bsconfig.json b/specs/bsconfig.json deleted file mode 100644 index 62e5449d..00000000 --- a/specs/bsconfig.json +++ /dev/null @@ -1,19 +0,0 @@ -{ - "name": "re-formality-specs", - "sources": ["app"], - "bs-dependencies": [ - "@rescript/react", - "re-formality" - ], - "reason": { - "react-jsx": 3 - }, - "refmt": 3, - "bsc-flags": ["-open Belt"], - "ppx-flags": ["../_build/default/ppx/bin/bin.exe"], - "package-specs": { - "module": "es6", - "in-source": true - }, - "suffix": ".bs.js" -} diff --git a/specs/cypress.json b/specs/cypress.json index 34c3844c..b3d0b3ef 100644 --- a/specs/cypress.json +++ b/specs/cypress.json @@ -1,5 +1,5 @@ { - "baseUrl": "http://localhost:8080", + "baseUrl": "http://localhost:8085", "video": false, "integrationFolder": "tests", "screenshotsFolder": "screenshots", diff --git a/specs/package.json b/specs/package.json index a2213ea0..9696c666 100644 --- a/specs/package.json +++ b/specs/package.json @@ -3,24 +3,24 @@ "version": "0.0.0", "private": true, "scripts": { - "app:start": "parcel app/index.html --port 8080", + "app:start": "parcel app/index.html --port 8085", "res:build": "rescript build -with-deps", "res:watch": "rescript build -with-deps -w", "res:clean": "rescript clean", "cypress:open": "cypress open", "cypress:run": "cypress run", - "test": "start-server-and-test app:start http://localhost:8080 cypress:run", + "test": "start-server-and-test app:start http://localhost:8085 cypress:run", "pretest": "yarn run res:build" }, "dependencies": { - "@rescript/react": "0.11.0", + "@rescript/react": "0.12.1", "cypress": "4.5.0", "parcel": "2.8.3", "process": "0.11.10", "re-formality": "*", "react": "18.2.0", "react-dom": "18.2.0", - "rescript": "10.1.3", + "rescript": "11.0.1", "start-server-and-test": "1.11.0" } } diff --git a/specs/rescript.json b/specs/rescript.json new file mode 100644 index 00000000..bcf54f61 --- /dev/null +++ b/specs/rescript.json @@ -0,0 +1,24 @@ +{ + "name": "re-formality-specs", + "sources": [ + "app" + ], + "bs-dependencies": [ + "@rescript/react", + "re-formality" + ], + "jsx": { + "version": 4 + }, + "bsc-flags": [ + "-open Belt" + ], + "ppx-flags": [ + "../_build/default/ppx/bin/bin.exe" + ], + "package-specs": { + "module": "es6", + "in-source": true + }, + "suffix": ".res.js" +} diff --git a/windows.patch b/windows.patch new file mode 100644 index 00000000..b343d896 --- /dev/null +++ b/windows.patch @@ -0,0 +1,17 @@ +diff --git a/re-formality-ppx.opam b/re-formality-ppx.opam +index ed99957..f9516b3 100644 +--- a/re-formality-ppx.opam ++++ b/re-formality-ppx.opam +@@ -13,9 +13,9 @@ bug-reports: "https://github.com/MinimaHQ/re-formality/issues" + dev-repo: "git+https://github.com/MinimaHQ/re-formality.git" + depends: [ + "ocaml" { = "4.14.1" } +- "dune" { = "3.11.1" } +- "ppxlib" { = "0.30.0" } +- "alcotest" { = "1.7.0" } ++ "dune" { = "3.5.0" } ++ "ppxlib" { = "0.28.0" } ++ "alcotest" { = "1.6.0" } + ] + build: [ + ["dune" "build" "-p" name "-j" jobs] diff --git a/yarn.lock b/yarn.lock index c968263c..cd129936 100644 --- a/yarn.lock +++ b/yarn.lock @@ -713,10 +713,15 @@ chrome-trace-event "^1.0.2" nullthrows "^1.1.1" -"@rescript/react@0.11.0": - version "0.11.0" - resolved "https://registry.yarnpkg.com/@rescript/react/-/react-0.11.0.tgz#d2545546d823bdb8e6b59daa1790098d1666f79e" - integrity sha512-RzoAO+3cJwXE2D7yodMo4tBO2EkeDYCN/I/Sj/yRweI3S1CY1ZBOF/GMcVtjeIurJJt7KMveqQXTaRrqoGZBBg== +"@rescript/core@1.0.0": + version "1.0.0" + resolved "https://registry.yarnpkg.com/@rescript/core/-/core-1.0.0.tgz#8626f3b1c09eeb1b4788f42f754e58d3e68041c1" + integrity sha512-F5HURYYx8Kp6h1KBiri2nFwGKR16o9/XTCNl2TEWfCwqR+MTzf/lpuPuB6ajnaYytsU0kTUBIFI0DOoLgkDxSg== + +"@rescript/react@0.12.1": + version "0.12.1" + resolved "https://registry.yarnpkg.com/@rescript/react/-/react-0.12.1.tgz#7bddb957a1bc08b944c6597f28549ac410982d64" + integrity sha512-ZD7nhDr5FZgLYqRH9s4CNM+LRz/3IMuTb+LH12fd2Akk0xYkYUP+DZveB2VQUC2UohJnTf/c8yPSNsiFihVCCg== "@samverschueren/stream-to-observable@^0.3.0": version "0.3.0" @@ -2578,20 +2583,24 @@ request@^2.88.0: tunnel-agent "^0.6.0" uuid "^3.3.2" -rescript-classnames@6.0.0: - version "6.0.0" - resolved "https://registry.yarnpkg.com/rescript-classnames/-/rescript-classnames-6.0.0.tgz#e833d9fc88e0e494c2ef39862721a80ab75fae32" - integrity sha512-hfOffijzIPnULtRZW3Kf0DCfCaw9lhGaMxf81WYlREieyBS2KNMcdI/8g5uSXFj0j4Ci21xkf70EFCKjuCTqpw== +rescript-classnames@7.0.0: + version "7.0.0" + resolved "https://registry.yarnpkg.com/rescript-classnames/-/rescript-classnames-7.0.0.tgz#bf30d65fff325cdc672b8659fb1e52dc43860fa7" + integrity sha512-/VQs2a/AjcIEAUV40+mIaWuOMQGxIw50qPCX44tLl+yTMb7/7lad47+jlxRdixSTO4HsaAu8y8rA6hEfkqBCKg== + dependencies: + "@rescript/core" "1.0.0" -rescript-debounce@1.0.1: - version "1.0.1" - resolved "https://registry.yarnpkg.com/rescript-debounce/-/rescript-debounce-1.0.1.tgz#4b0d2ddae538a4cc3829daaeb77526d9bc531c42" - integrity sha512-bdClQdmKw5k1PZLilZNYiZqqqDBXdHUZ3dKqrKGuLlYdLL5dC6A/m6jyv8yemcdtgRJAwPdUVfYFf2tZ1t3eMw== +rescript-debounce@2.0.0: + version "2.0.0" + resolved "https://registry.yarnpkg.com/rescript-debounce/-/rescript-debounce-2.0.0.tgz#ca6ceecaf909b6b24eb51d6e7558878d6c278d7a" + integrity sha512-hZkvTnnGj/ppG6ZSXta9WSmDoMJmePEH3/lEWxjYVByIV9ALH9wePgyrnad6mgmP1EW6syEZhsmjXFMDJ5PrYA== + dependencies: + "@rescript/core" "1.0.0" -rescript@10.1.3: - version "10.1.3" - resolved "https://registry.yarnpkg.com/rescript/-/rescript-10.1.3.tgz#0ff208cef09ea1f8ad38efc171c4942eca72d444" - integrity sha512-5qaf63As6nkbrMRJ85kZ0ifLzKAGPOGLuoJ4zFVGZIp4oMePRt6bCKWAIX7zgbRDfRPa3jSu+EnoY2873gxaIA== +rescript@11.0.1: + version "11.0.1" + resolved "https://registry.yarnpkg.com/rescript/-/rescript-11.0.1.tgz#c74af134dc8a16d152169b2456d0720324835f54" + integrity sha512-7T4PRp/d0+CBNnY6PYKffFqo9tGZlvnZpboF/n+8SKS+JZ6VvXJO7W538VPZXf3EYx1COGAWWvkF9e/HgSAqHg== resolve-from@^4.0.0: version "4.0.0"