├── .github └── workflows │ ├── ppx-pr.yaml │ └── ppx-push.yaml ├── .gitignore ├── .vscode └── settings.json ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── README.md ├── bin ├── preview-ppx-watch.sh └── preview-ppx.sh ├── package.json ├── postinstall.js ├── ppx ├── ppx.cmd ├── ppx_src ├── .ocamlformat ├── bin │ ├── bin.ml │ └── dune ├── dune-project ├── package.json ├── ppx_decco.opam └── src │ ├── BatOption.ml │ ├── Codecs.ml │ ├── DecodeCases.ml │ ├── Polyvariants.ml │ ├── Ppx_decco.ml │ ├── Records.ml │ ├── Signature.ml │ ├── Structure.ml │ ├── Tuple.ml │ ├── Utils.ml │ ├── Variants.ml │ └── dune ├── rescript.json ├── src ├── Decco.res ├── Decco_Codecs.res └── Decco_types.res ├── test ├── TestUtils.res ├── __tests__ │ ├── Array.res │ ├── BeltResult.res │ ├── Bool.res │ ├── CustomCodecs.res │ ├── Default.res │ ├── DictInt.res │ ├── Falseable.res │ ├── Float.res │ ├── Int.res │ ├── JsJson.res │ ├── Key.res │ ├── Ldot.res │ ├── List.res │ ├── LongPath.res │ ├── Magic.res │ ├── OpenBelt.res │ ├── Option.res │ ├── OptionList.res │ ├── Polyvariant.res │ ├── Record.res │ ├── RecordSpreads.res │ ├── Recursion.res │ ├── SimpleVar.res │ ├── String.res │ ├── Tuple.res │ ├── Unboxed.res │ ├── Unit.res │ ├── VarTypeInsideModule.res │ └── Variant.res ├── compiler_only_tests │ ├── ParameterizedRecords.res │ └── ReadMe.md └── functors │ ├── DecOnlyFunctor.res │ ├── EncOnlyFunctor.res │ └── TestModFunctor.res └── yarn.lock /.github/workflows/ppx-pr.yaml: -------------------------------------------------------------------------------- 1 | name: PR Build 2 | on: 3 | pull_request: 4 | types: [opened, synchronize] 5 | 6 | jobs: 7 | build-ppx: 8 | name: PR Build 9 | runs-on: ubuntu-latest 10 | steps: 11 | - uses: actions/checkout@v2 12 | - name: Install OPAM and OCaml 13 | uses: ocaml/setup-ocaml@v2 14 | with: 15 | ocaml-compiler: 4.12.1 16 | - name: Install OCaml Dependencies and build 17 | run: | 18 | cd ppx_src 19 | opam install dune 20 | eval $(opam env) 21 | opam install -y . --deps-only 22 | dune build 23 | - name: Install Yarn Dependencies 24 | run: yarn 25 | - name: Build Library 26 | run: yarn build-lib 27 | - name: Run tests 28 | run: yarn test 29 | -------------------------------------------------------------------------------- /.github/workflows/ppx-push.yaml: -------------------------------------------------------------------------------- 1 | name: Release Build 2 | on: 3 | release: 4 | types: published 5 | workflow_dispatch: # This line makes the workflow runnable on demand 6 | 7 | jobs: 8 | cancel-previous-runs: 9 | name: Cancel Previous Runs 10 | runs-on: ubuntu-20.04 11 | steps: 12 | - name: Cancel Previous Runs 13 | uses: styfle/cancel-workflow-action@0.9.0 14 | with: 15 | access_token: ${{ github.token }} 16 | 17 | build: 18 | name: PPX Build Matrix 19 | strategy: 20 | matrix: 21 | os: [macos-latest, ubuntu-latest, windows-latest] 22 | runs-on: ${{ matrix.os }} 23 | steps: 24 | - uses: actions/checkout@v2 25 | with: 26 | ref: ${{ github.ref }} 27 | 28 | - name: Install OPAM and OCaml and build 29 | uses: ocaml/setup-ocaml@v2 30 | with: 31 | ocaml-compiler: 4.12.1 32 | 33 | - name: Install opam packages 34 | run: opam install . --deps-only 35 | working-directory: ppx_src 36 | 37 | - name: Build the ppx 38 | run: opam exec -- dune build 39 | working-directory: ppx_src 40 | 41 | - name: Upload Build 42 | uses: actions/upload-artifact@v2 43 | with: 44 | name: ${{ matrix.os }} 45 | path: ppx_src/_build/default/bin/bin.exe 46 | retention-days: 1 47 | 48 | npm-release: 49 | name: NPM Release 50 | runs-on: ubuntu-latest 51 | needs: 52 | - build 53 | steps: 54 | - name: Checkout 55 | uses: actions/checkout@v2 56 | with: 57 | ref: ${{ github.ref }} 58 | 59 | - name: Download Artifacts 60 | uses: actions/download-artifact@v2 61 | 62 | - name: Move / Rename Artifacts 63 | run: | 64 | mv ubuntu-latest/bin.exe ./ppx-linux.exe 65 | mv macos-latest/bin.exe ./ppx-osx.exe 66 | mv windows-latest/bin.exe ./ppx-windows.exe 67 | 68 | - uses: actions/setup-node@v1 69 | with: 70 | always-auth: true 71 | registry-url: "https://registry.npmjs.org" 72 | 73 | - env: 74 | NODE_AUTH_TOKEN: ${{ secrets.NPM_TOKEN }} 75 | run: | 76 | echo "//registry.npmjs.org/:_authToken=${{ secrets.NPM_TOKEN }}" > ~/.npmrc 77 | yarn publish --access=public 78 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | *.cmt 11 | *.cmj 12 | 13 | # ocamlbuild working directory 14 | _build/ 15 | 16 | # ocamlbuild targets 17 | *.byte 18 | *.native 19 | 20 | # oasis generated files 21 | setup.data 22 | setup.log 23 | 24 | #Node 25 | # Logs 26 | logs 27 | *.log 28 | npm-debug.log* 29 | 30 | # Runtime data 31 | pids 32 | *.pid 33 | *.seed 34 | 35 | # Directory for instrumented libs generated by jscoverage/JSCover 36 | lib-cov 37 | 38 | # Coverage directory used by tools like istanbul 39 | coverage 40 | 41 | # Grunt intermediate storage (http://gruntjs.com/creating-plugins#storing-task-files) 42 | .grunt 43 | 44 | # node-waf configuration 45 | .lock-wscript 46 | 47 | # Compiled binary addons (http://nodejs.org/api/addons.html) 48 | build/Release 49 | 50 | # Dependency directory 51 | # https://docs.npmjs.com/misc/faq#should-i-check-my-node-modules-folder-into-git 52 | node_modules 53 | 54 | # Optional npm cache directory 55 | .npm 56 | 57 | # Optional REPL history 58 | .node_repl_history 59 | 60 | .DS_Store 61 | 62 | # Bucklescript output 63 | lib/ 64 | 65 | .merlin 66 | 67 | .bsb.lock 68 | 69 | # persistent-package-linker 70 | package-links.json 71 | 72 | # tmp files 73 | /test.* 74 | /ast.txt 75 | 76 | # dune 77 | *.install 78 | 79 | _opam 80 | *.exe 81 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "ocaml.sandbox": { 3 | "kind": "opam", 4 | "switch": "${workspaceFolder:decco}" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## v1.6.0 2 | ### Added 3 | * optionFromJson now supports undefined values ([#80](https://github.com/reasonml-labs/decco/pull/80)) 4 | * OCaml 4.14 support ([#82](https://github.com/reasonml-labs/decco/pull/82)) 5 | 6 | ## v1.5.0 7 | ### Added 8 | * windows support ([#20](https://github.com/reasonml-labs/decco/pull/20)) 9 | 10 | ## v1.4.0 11 | ### Added 12 | * Support for Polyvariants ([#64](https://github.com/reasonml-labs/decco/pull/64)) 13 | * Add support for bs-platform 9 ([#67](https://github.com/reasonml-labs/decco/pull/67)) 14 | * Integrate ppxlib, allowing decco to be used with other versions of OCaml ([#68](https://github.com/reasonml-labs/decco/pull/68)) 15 | * Run Ppx_decco as a standalone ppx ([#70](https://github.com/reasonml-labs/decco/pull/70)) 16 | 17 | ### Fixed 18 | * Build error on some platforms ([#66](https://github.com/reasonml-labs/decco/pull/66)) 19 | 20 | ## v1.3.0 21 | ### Added 22 | * bs-platform@8 to peer dependency ([#58](https://github.com/reasonml-labs/decco/pull/58)) 23 | * Support for \[@unboxed\]([#60](https://github.com/reasonml-labs/decco/pull/60)) 24 | 25 | ### Fixed 26 | * Remove unnecessary postinstall hook ([#59](https://github.com/reasonml-labs/decco/pull/59)) 27 | 28 | ## v1.2.1 29 | ### Fixed 30 | * Mutual recursion ([#46](https://github.com/reasonml-labs/decco/pull/46)) 31 | 32 | ## v1.2.0 33 | ### Added 34 | * Support for Js.Dict.t ([#48](https://github.com/reasonml-labs/decco/pull/48)) 35 | 36 | ## v1.1.1 37 | ### Fixed 38 | * Generated codecs no longer emit warning 4 ([#41](https://github.com/reasonml-labs/decco/issues/41)/[#42](https://github.com/reasonml-labs/decco/pull/42)) 39 | 40 | ## v1.1.0 41 | ### Added 42 | * Added support for BuckleScript v7 43 | 44 | ### Fixed 45 | * Namespaced `Codecs.re` so as not to conflict with users' `Codecs.re` ([#25](https://github.com/reasonml-labs/decco/issues/25)/[#35](https://github.com/reasonml-labs/decco/pull/35)) 46 | 47 | ## v1.0.0 48 | ### Changed 49 | * Change package name from `@ryb73/decco` to `decco` 50 | * **BREAKING CHANGE:** Move ppx executable from `ppx/ppx_decco.sh` to `ppx` 51 | * Migration: in `bsconfig.json`, change `"ppx-flags": [ "@ryb73/decco/ppx/ppx_decco.sh" ]"` to `"ppx-flags": [ "decco/ppx" ]` 52 | 53 | ## v0.2.2 / v0.1.1 54 | ### Fixed 55 | * Fix error that occurs when Belt is open 56 | * Properly handle variant decoding case where JSON input is an empty array (previously threw an exception; now properly returns a Decco error) 57 | 58 | ## v0.2.1 59 | ### Added 60 | * Support for recursive types 61 | 62 | ## v0.2.0 63 | ### Added 64 | * **BREAKING CHANGE:** Support for `bs-platform` ^6.0.0, dropped support for ^5.0.0 65 | 66 | ## v0.1.0 67 | ### Added 68 | * `Belt.Result.t` support 69 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to this repository 2 | 3 | When contributing to this repository, please first discuss the change you wish to make via issue or any other method with the owners of this repository before making a change. 4 | 5 | ## Before you get started 6 | 7 | ### PPXs 8 | 9 | [PPXs](https://tarides.com/blog/2019-05-09-an-introduction-to-ocaml-ppx-ecosystem) are not the easiest to work with, especially if it's your first time writing one. Don't be afraid to ask for help by commenting on a related GitHub issue or in the Discord: https://discord.gg/SmsJyCdH2h. 10 | 11 | ### Developing 12 | 13 | - git clone https://github.com/reasonml-labs/decco 14 | - cd decco 15 | - yarn install 16 | - See the steps below to get ocaml set up 17 | - yarn build-ppx 18 | - # Make your changes, commits, etc 19 | - Open the PR 20 | 21 | ### Scripts 22 | 23 | In order to see what are the scripts available on the repository, run `yarn run`. It will render a list of available commands in order to build the project, build the ppx, etc. 24 | 25 | ### Editor support with ocaml-lsp 26 | 27 | > Note: Wasn't able to install ocaml-lsp-server with esy, instead can use opam. 28 | 29 | `ocaml-lsp-server` is only needed for development. 30 | 31 | You would need to have [opam](https://opam.ocaml.org) installed. 32 | 33 | - cd ppx_src; 34 | - opam switch create . 4.12.1 --deps-only # If it's the first time you create a switch it can take a while. 35 | - eval $(opam env) 36 | - opam install -y . --deps-only 37 | - Profit, this should make your editor a little more smart 38 | 39 | ### Testing 40 | 41 | Unit testing is done in ReScript and rescript-jest, lives under `test/__tests__`. 42 | 43 | ## Iterating 44 | 45 | Working on PPXs can be a real pain because you don't get to easily see the product of your work. There are some tools to help though. 46 | 47 | ### Preview PPX 48 | 49 | See the output of your PPX as ReScript code by running `yarn run preview-ppx ` 50 | 51 | **Gotcha**: This PPX'd output isn't ReScript syntax generated by the PPX. The PPX runs on the AST, which is OCaml. What you see here is the result of the transformed AST rendered back into ReScript by the compiler's formatting tool 52 | 53 | If you want to see what's really going on under the hood, read more: 54 | 55 | ### Inspect the Parsetree (AST) 56 | 57 | See a text representation of the tree you're really operating on, and the real results of your PPX by running `yarn run print-parse-tree-with-ppx ` 58 | 59 | You'll probably get compiler errors, because that's calling a private API of bsc that isn't including dependencies. But your goal here is really just to inspect the tree. 60 | 61 | ## Figure out what to write 62 | 63 | I suggest that when you're trying to get something written, you write the ReScript syntax for what you're trying to achieve, inspect its AST using the command above, and then use the same command on your PPX to see what you're actually getting. 64 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Ryan Biwer 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Decco 2 | 3 | ## Project Status 4 | 5 | Decco is lazily maintained by it users, but it's not being actively developed, since its feature set is complete enough for general production use. If you find a major bug that you need fixed, it'll probably be your job to fix it. 💪 6 | 7 | ## How do I install it? 8 | 9 | 1. Install package 10 | 11 | ``` 12 | npm i @rescript-labs/decco 13 | ``` 14 | 15 | 2. Update your `rescript.json` (or bsconfig.json if you haven't changed its name) 16 | 17 | ```json 18 | { 19 | ..., 20 | "bs-dependencies": [ "@rescript-labs/decco" ], 21 | "ppx-flags": [ "@rescript-labs/decco/ppx" ], 22 | ... 23 | } 24 | ``` 25 | 26 | Adding `decco/ppx` to `ppx-flags` will enable the PPX. Adding decco to `bs-dependencies` is required because the code generated by the PPX references the `Decco` module. 27 | 28 | ## Compatibility 29 | 30 | Decco 2.0.0 and above work with ReScript 11 in uncurried mode. If you need to use Decco with an older version of ReScript, install decco version `1.6.0` 31 | 32 | If you need to use decco with BuckleScript 5, install `@ryb73/decco` version ^0.1.0 by [following the old ReadMe here](https://github.com/reasonml-labs/decco/blob/0452fc42fa4cd4230d394c718e7f62a0384ce045/README.md). 33 | 34 | 35 | ## What is it? 36 | 37 | A Rescript PPX which generates JSON serializers and deserializers for user-defined types. 38 | 39 | Example: 40 | 41 | ```rescript 42 | /* Define types */ 43 | @decco type variant<'a> = A | B(int) | C(int, 'a); 44 | 45 | type dict = Js.Dict.t; 46 | @decco 47 | type mytype = { 48 | s: string, 49 | i: int, 50 | o: option, 51 | complex: array>>>, 52 | @decco.default(1.0) f: float, 53 | @decco.key("other_key") otherKey: string, 54 | magic: @decco.codec(Decco.Codecs.magic) dict, 55 | }; 56 | 57 | /* Use _encode to encode */ 58 | let encoded = mytype_encode({ 59 | s: "hello", 60 | i: 12, 61 | o: None, 62 | complex: [Some(list{ C(25, "bullseye") })], 63 | f: 13., 64 | otherKey: "other", 65 | magic: Js.Dict.fromArray([("key","value")]), 66 | }); 67 | 68 | Js.log(Js.Json.stringifyWithSpace(encoded, 2)); 69 | /* { 70 | "s": "hello", 71 | "i": 12, 72 | "o": null, 73 | "complex": [ [ ["C", 25, "bullseye"] ] ], 74 | "f": 13, 75 | "other_key": "other", 76 | "magic": { "key": "value" } 77 | } */ 78 | 79 | /* Use _decode to decode */ 80 | let { s, i, o, complex, f, otherKey, magic } = 81 | mytype_decode(encoded)->Belt.Result.getExn; 82 | ``` 83 | 84 | ## How do I use it? 85 | 86 | See the test folder in this repo for some examples. 87 | 88 | ## Reference 89 | 90 | ### Attributes 91 | 92 | #### @decco 93 | 94 | Applies to: type declarations, type signatures 95 | 96 | Indicates that an encoder and decoder should be generated for the given type. 97 | 98 | #### @decco.encode 99 | 100 | Applies to: type declarations, type signatures 101 | 102 | Indicates than an encoder (but no decoder) should be generated for the given type. 103 | 104 | #### @decco.decode 105 | 106 | Applies to: type declarations, type signatures 107 | 108 | Indicates than an decoder (but no encoder) should be generated for the given type. 109 | 110 | #### @decco.codec 111 | 112 | Applies to: type expressions 113 | 114 | Specifies custom encoders and decoders for the type. Note that both an encoder and decoder must be specified, even if the type expression is within a type for which @decco.encode or @decco.decode was specified. 115 | 116 | ```rescript 117 | @decco type t = @decco.codec((fancyEncoder, fancyDecoder)) fancyType; 118 | ``` 119 | 120 | #### @decco.key 121 | 122 | Applies to: record fields 123 | 124 | By default, ReScript record fields map to JS object fields of the same name. Use @decco.key to specify a custom JS field name. Useful if the JS field name is invalid as a ReScript record field name. 125 | 126 | ```rescript 127 | @decco 128 | type record = { 129 | @decco.key("other_key") otherKey: string, 130 | }; 131 | ``` 132 | 133 | #### @decco.default 134 | 135 | Applies to: record fields 136 | Default: `Js.Json.null` 137 | 138 | When decoding a record, the default value will be used for keys that are missing from the JSON object being decoded. 139 | 140 | ```rescript 141 | @decco type record = { 142 | @decco.default("def") s: string, 143 | }; 144 | 145 | let {s} = Js.Json.parseExn("{}")->record_decode->Belt.Result.getExn; 146 | Js.log(s); /* def */ 147 | ``` 148 | 149 | # Contributing 150 | 151 | Please read the [CONTRIBUTING.md](./CONTRIBUTING.md) 152 | -------------------------------------------------------------------------------- /bin/preview-ppx-watch.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | file_path=$1 4 | 5 | if [ -z "$file_path" ]; then 6 | echo "Please provide a file path as an argument to see what the PPX will do to it." 7 | exit 1 8 | fi 9 | 10 | if ! command -v viddy &>/dev/null; then 11 | echo "viddy command not found. Please install it using Homebrew:" 12 | echo "brew install viddy" 13 | exit 1 14 | fi 15 | 16 | /opt/homebrew/bin/viddy -n 1 -c -d "./node_modules/rescript/bsc -ppx ./ppx -bs-no-builtin-ppx -reprint-source $file_path" 17 | -------------------------------------------------------------------------------- /bin/preview-ppx.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | file_path=$1 4 | 5 | if [ -z "$file_path" ]; then 6 | echo "Please provide a file path as an argument to see what the PPX will do to it." 7 | exit 1 8 | fi 9 | 10 | ./node_modules/rescript/bsc -ppx ./ppx -bs-no-builtin-ppx -reprint-source $file_path 11 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "@rescript-labs/decco", 3 | "version": "2.0.4", 4 | "description": "Rescript PPX which generates JSON (de)serializers for user-defined types", 5 | "main": "index.js", 6 | "scripts": { 7 | "postinstall": "node postinstall.js", 8 | "test": "jest", 9 | "build-lib": "rescript build", 10 | "watch": "rescript build -w", 11 | "clean": "rm -rf lib && rescript clean && rm -rf ppx_src/_build", 12 | "build-ppx": "cd ppx_src && dune build", 13 | "watch-ppx": "cd ppx_src && dune build -w", 14 | "preview-ppx": "./bin/preview-ppx.sh", 15 | "preview-ppx-watch": "./bin/preview-ppx-watch.sh", 16 | "print-parse-tree": "./node_modules/rescript/bsc -dparsetree", 17 | "print-parse-tree-with-ppx": "./node_modules/rescript/bsc -dparsetree -ppx ./ppx" 18 | }, 19 | "files": [ 20 | "/rescript.json", 21 | "/postinstall.js", 22 | "/src", 23 | "/ppx", 24 | "/ppx.cmd", 25 | "/ppx-linux.exe", 26 | "/ppx-osx.exe", 27 | "/ppx-windows.exe" 28 | ], 29 | "keywords": [], 30 | "license": "MIT", 31 | "repository": { 32 | "type": "git", 33 | "url": "git@github.com:rescript-labs/decco.git" 34 | }, 35 | "_": [], 36 | "peerDependencies": { 37 | "rescript": "11" 38 | }, 39 | "devDependencies": { 40 | "@glennsl/rescript-jest": "^0.11.0", 41 | "jest": "^27.3.1", 42 | "rescript": "^11.1.0" 43 | } 44 | } 45 | -------------------------------------------------------------------------------- /postinstall.js: -------------------------------------------------------------------------------- 1 | const path = require("path"); 2 | const fs = require("fs"); 3 | 4 | const installMacLinuxBinary = (binary) => { 5 | const source = path.join(__dirname, binary); 6 | if (fs.existsSync(source)) { 7 | // mac and linux support extension-less executables 8 | // so just overwrite the shell script 9 | const target = path.join(__dirname, "ppx") 10 | fs.renameSync(source, target) 11 | 12 | // The ppx should be executable in the bundle, but just in case 13 | fs.chmodSync(target, 0777) 14 | } else { 15 | // assume we're in dev mode - nothing will break if the script 16 | // isn't overwritten, it will just be slower 17 | } 18 | } 19 | 20 | const installWindowsBinary = () => { 21 | const source = path.join(__dirname, "ppx-windows.exe") 22 | if (fs.existsSync(source)) { 23 | const target = path.join(__dirname, "ppx.exe") 24 | fs.renameSync(source, target) 25 | 26 | // windows scripts use a different file extension to executables 27 | // so we delete the script to make sure windows uses the exe now 28 | const windowsScript = path.join(__dirname, "ppx.cmd") 29 | fs.unlinkSync(windowsScript) 30 | } else { 31 | // assume we're in dev mode - nothing will break if the script 32 | // isn't overwritten, it will just be slower 33 | } 34 | } 35 | 36 | 37 | 38 | switch (process.platform) { 39 | case "linux": 40 | installMacLinuxBinary("ppx-linux.exe") 41 | break 42 | case "darwin": 43 | installMacLinuxBinary("ppx-osx.exe") 44 | break 45 | case "win32": 46 | installWindowsBinary() 47 | break 48 | default: 49 | // This won't break the installation because the `ppx` shell script remains 50 | // but that script will throw an error in this case anyway 51 | console.warn(`No release available for "${process.platform}"`) 52 | process.exit(1) 53 | } 54 | -------------------------------------------------------------------------------- /ppx: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | # Get the directory of the script to work from. 4 | DIR=$(dirname "$0") 5 | 6 | if [ -f $DIR/ppx_src/_build/default/bin/bin.exe ]; then 7 | # Use the dev build 8 | $DIR/ppx_src/_build/default/bin/bin.exe $@ 9 | elif [ "$(uname)" = "Darwin" ]; then 10 | # Run the Mac PPX 11 | $DIR/ppx-osx.exe $@ 12 | elif [ "$(expr substr $(uname -s) 1 5)" = "Linux" ]; then 13 | # Run the Linux PPX 14 | $DIR/ppx-linux.exe $@ 15 | else 16 | echo "No release available for '$(uname)'" 17 | exit 1 18 | fi 19 | -------------------------------------------------------------------------------- /ppx.cmd: -------------------------------------------------------------------------------- 1 | @echo off 2 | REM no need to branch on OS here, it will only be used on windows 3 | %~dp0\ppx-windows.exe %* -------------------------------------------------------------------------------- /ppx_src/.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = default 2 | version = 0.26.2 3 | 4 | field-space = tight-decl 5 | break-cases = toplevel 6 | module-item-spacing = preserve 7 | cases-exp-indent = 2 8 | space-around-arrays = false 9 | space-around-lists = false 10 | space-around-records = false 11 | space-around-variants = false -------------------------------------------------------------------------------- /ppx_src/bin/bin.ml: -------------------------------------------------------------------------------- 1 | let () = Ppxlib.Driver.run_as_ppx_rewriter () -------------------------------------------------------------------------------- /ppx_src/bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (package ppx_decco) 3 | (name bin) 4 | (public_name ppx_decco) 5 | (libraries ppx_decco)) 6 | -------------------------------------------------------------------------------- /ppx_src/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | -------------------------------------------------------------------------------- /ppx_src/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "ppx_decco", 3 | "version": "0.0.0", 4 | "description": "This is a hack because esy doesn't appear to support scoped packages (or I just don't get it)", 5 | "main": "index.js", 6 | "license": "MIT", 7 | "esy": { 8 | "build": "dune build -p #{self.name}", 9 | "release": { 10 | "bin": [ 11 | "Ppx_decco" 12 | ] 13 | } 14 | }, 15 | "devDependencies": { 16 | "@opam/reason": "^3.8.1", 17 | "@opam/dune": ">=2.8.4", 18 | "@opam/ppxlib": "^0.26.0", 19 | "ocaml": "4.14.x", 20 | "@opam/ocaml-lsp-server": "*" 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /ppx_src/ppx_decco.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "decco-ppx" 3 | version: "1.0.0" 4 | synopsis: "PPX for generating encoders and decoders from Rescript types" 5 | description: """ 6 | PPX for generating encoders and decoders from Rescript types 7 | """ 8 | maintainer: "Day One Team " 9 | authors: "Ryan Biwer, Murphy Randle, and others?" 10 | license: "MIT" 11 | homepage: "https://github.com/reasonml-labs/decco" 12 | bug-reports: "https://github.com/reasonml-labs/decco/issues" 13 | dev-repo: "git+https://github.com/reasonml-labs/decco.git" 14 | depends: [ 15 | "ocaml" { = "4.12.1"} 16 | "dune" { >= "2.7"} 17 | "ppxlib" { = "0.26.0"} 18 | ] 19 | build: [ 20 | ["dune" "build" "-p" name "-j" jobs] 21 | ] 22 | -------------------------------------------------------------------------------- /ppx_src/src/BatOption.ml: -------------------------------------------------------------------------------- 1 | let get = function 2 | | None -> failwith "Expected Some. got None" 3 | | Some v -> v 4 | let some v = Some v 5 | -------------------------------------------------------------------------------- /ppx_src/src/Codecs.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Ast_helper 4 | open Utils 5 | let rec parameterizeCodecs typeArgs encoderFunc decoderFunc encodeDecodeFlags = 6 | let subEncoders, subDecoders = 7 | typeArgs 8 | |> List.map (fun core_type -> generateCodecs encodeDecodeFlags core_type) 9 | |> List.split 10 | in 11 | ( (match encoderFunc with 12 | | None -> None 13 | | ((Some encoderFunc) [@explicit_arity]) -> 14 | let uncurriedApplicationAttrs = 15 | [Attr.mk {txt = "res.partial"; loc} (PStr [])] 16 | in 17 | subEncoders 18 | |> List.map (fun e -> (Asttypes.Nolabel, BatOption.get e)) 19 | |> Exp.apply ~attrs:uncurriedApplicationAttrs encoderFunc 20 | |> BatOption.some), 21 | match decoderFunc with 22 | | None -> None 23 | | ((Some decoderFunc) [@explicit_arity]) -> 24 | let uncurriedApplicationAttrs = 25 | [Attr.mk {txt = "res.partial"; loc} (PStr [])] 26 | in 27 | subDecoders 28 | |> List.map (fun e -> (Asttypes.Nolabel, BatOption.get e)) 29 | |> Exp.apply ~attrs:uncurriedApplicationAttrs decoderFunc 30 | |> BatOption.some ) 31 | 32 | (* The optional expressions that are returned from this function should be codec functions themselves. 33 | Not bindings. The receiver will invoke them with the value when it decides to. *) 34 | and generateCodecsFromTypeConstructor {doEncode; doDecode} 35 | {Location.txt = identifier; loc} = 36 | let open Longident in 37 | match identifier with 38 | | Lident "string" -> 39 | ( (match doEncode with 40 | | true -> Some [%expr Decco.stringToJson] 41 | | false -> None), 42 | match doDecode with 43 | | true -> Some [%expr Decco.stringFromJson] 44 | | false -> None ) 45 | | Lident "int" -> 46 | ( (match doEncode with 47 | | true -> Some [%expr Decco.intToJson] 48 | | false -> None), 49 | match doDecode with 50 | | true -> Some [%expr Decco.intFromJson] 51 | | false -> None ) 52 | | Lident "int64" -> 53 | ( (match doEncode with 54 | | true -> Some [%expr Decco.int64ToJson] 55 | | false -> None), 56 | match doDecode with 57 | | true -> Some [%expr Decco.int64FromJson] 58 | | false -> None ) 59 | | Lident "float" -> 60 | ( (match doEncode with 61 | | true -> Some [%expr Decco.floatToJson] 62 | | false -> None), 63 | match doDecode with 64 | | true -> Some [%expr Decco.floatFromJson] 65 | | false -> None ) 66 | | Lident "bool" -> 67 | ( (match doEncode with 68 | | true -> Some [%expr Decco.boolToJson] 69 | | false -> None), 70 | match doDecode with 71 | | true -> Some [%expr Decco.boolFromJson] 72 | | false -> None ) 73 | | Lident "unit" -> 74 | ( (match doEncode with 75 | | true -> Some [%expr Decco.unitToJson] 76 | | false -> None), 77 | match doDecode with 78 | | true -> Some [%expr Decco.unitFromJson] 79 | | false -> None ) 80 | | Lident "array" -> 81 | ( (match doEncode with 82 | | true -> Some [%expr Decco.arrayToJson] 83 | | false -> None), 84 | match doDecode with 85 | | true -> Some [%expr Decco.arrayFromJson] 86 | | false -> None ) 87 | | Lident "list" -> 88 | ( (match doEncode with 89 | | true -> Some [%expr Decco.listToJson] 90 | | false -> None), 91 | match doDecode with 92 | | true -> Some [%expr Decco.listFromJson] 93 | | false -> None ) 94 | | Lident "option" -> 95 | ( (match doEncode with 96 | | true -> Some [%expr Decco.optionToJson] 97 | | false -> None), 98 | match doDecode with 99 | | true -> Some [%expr Decco.optionFromJson] 100 | | false -> None ) 101 | | Ldot (Ldot (Lident "Belt", "Result"), "t") -> 102 | ( (match doEncode with 103 | | true -> Some [%expr Decco.resultToJson] 104 | | false -> None), 105 | match doDecode with 106 | | true -> Some [%expr Decco.resultFromJson] 107 | | false -> None ) 108 | | Ldot (Ldot (Lident "Js", "Dict"), "t") -> 109 | ( (match doEncode with 110 | | true -> Some [%expr Decco.dictToJson] 111 | | false -> None), 112 | match doDecode with 113 | | true -> Some [%expr Decco.dictFromJson] 114 | | false -> None ) 115 | | Ldot (Ldot (Lident "Js", "Json"), "t") -> 116 | ( (match doEncode with 117 | | true -> 118 | Some 119 | (Utils.wrapFunctionExpressionForUncurrying ~arity:1 120 | [%expr fun v -> v]) 121 | | false -> None), 122 | match doDecode with 123 | | true -> 124 | Some 125 | (Utils.wrapFunctionExpressionForUncurrying ~arity:1 126 | [%expr fun v -> Belt.Result.Ok v]) 127 | | false -> None ) 128 | | Lident s -> 129 | (* Lident is such an abstract name. This is when we're handling a reference to something 130 | that isn't some special syntactic construct. For example, in type blah = string, the 131 | 'string' part is a Lident. Same thing if we had `type blah = user`. The `user` part 132 | would be a Lident. *) 133 | ( (match doEncode with 134 | | true -> Some (makeIdentExpr (s ^ Utils.encoderFuncSuffix)) 135 | | false -> None), 136 | match doDecode with 137 | | true -> Some (makeIdentExpr (s ^ Utils.decoderFuncSuffix)) 138 | | false -> None ) 139 | | Ldot (left, right) -> 140 | ( (match doEncode with 141 | | true -> 142 | Some 143 | (Exp.ident (mknoloc (Ldot (left, right ^ Utils.encoderFuncSuffix)))) 144 | | false -> None), 145 | match doDecode with 146 | | true -> 147 | Some 148 | (Exp.ident (mknoloc (Ldot (left, right ^ Utils.decoderFuncSuffix)))) 149 | | false -> None ) 150 | | Lapply (_, _) -> fail loc "Lapply syntax not yet handled by decco" 151 | 152 | (* This gets called when a type declaration has a @decco.codec decorator with 153 | custom functions. *) 154 | and generateCustomCodecs attribute {doEncode; doDecode} = 155 | let expr = Utils.getExpressionFromPayload attribute in 156 | ( (match doEncode with 157 | | true -> 158 | Some 159 | [%expr 160 | let e, _ = [%e expr] in 161 | e] 162 | | false -> None), 163 | match doDecode with 164 | | true -> 165 | Some 166 | [%expr 167 | let _, d = [%e expr] in 168 | d] 169 | | false -> None ) 170 | 171 | (* This is a recursive function that operates on core types to make generators. core types 172 | might not be what you think, like strings and ints. Core types as far as the AST is 173 | concerned are, I think, basic elements of the parse tree. So this is going to be called 174 | not only with type declarations like 'type foo = string', but also with smaller parts of 175 | that declaration, like just 'string' *) 176 | and generateCodecs ({doEncode; doDecode} as encodeDecodeFlags) 177 | {ptyp_desc; ptyp_loc; ptyp_attributes} = 178 | match ptyp_desc with 179 | | Ptyp_any -> fail ptyp_loc "Can't generate codecs for `any` type" 180 | | Ptyp_arrow (_, _, _) -> 181 | fail ptyp_loc "Can't generate codecs for function type" 182 | | Ptyp_package _ -> fail ptyp_loc "Can't generate codecs for module type" 183 | | Ptyp_tuple types -> ( 184 | let compositeCodecs = List.map (generateCodecs encodeDecodeFlags) types in 185 | ( (match doEncode with 186 | | true -> 187 | Some 188 | (compositeCodecs 189 | |> List.map (fun (e, _) -> BatOption.get e) 190 | |> Tuple.generateEncoder) 191 | | false -> None), 192 | match doDecode with 193 | | true -> 194 | Some 195 | (compositeCodecs 196 | |> List.map (fun (_, d) -> BatOption.get d) 197 | |> Tuple.generateDecoder) 198 | | false -> None )) 199 | | Ptyp_var s -> 200 | (* In this branch we're handling a type variable, like 'a in option<'a> *) 201 | ( (match doEncode with 202 | | true -> Some (makeIdentExpr (encoderVarPrefix ^ s)) 203 | | false -> None), 204 | match doDecode with 205 | | true -> Some (makeIdentExpr (decoderVarPrefix ^ s)) 206 | | false -> None ) 207 | | Ptyp_constr (constr, typeArgs) -> ( 208 | (* Here we're handling a type constructor. This might be a type constructor with 209 | a name, like `type blah = string`, or it might be a nameless type constructor, 210 | like `string`, or `pizza`. When you read "constructor" here, don't think 211 | of only a type definition, but think of any time a type is mentioned at all, 212 | syntactically, mentioning a type is "constructing" that type. *) 213 | let customCodec = getAttributeByName ptyp_attributes "decco.codec" in 214 | let encode, decode = 215 | match customCodec with 216 | (* Shortcut! We're handling a type where the user has specified their own 217 | codec functions. Just return their settings instead of generating more 218 | of our own. *) 219 | | Ok (Some attribute) -> generateCustomCodecs attribute encodeDecodeFlags 220 | (* Hey! 👉 This is the most common branch. We're going to go generate codecs here based 221 | on the type constructor we're handling 👈 *) 222 | | Ok None -> generateCodecsFromTypeConstructor encodeDecodeFlags constr 223 | (* Arg, we couldn't even see if there was a custom codec to handle because 224 | of some unexpected error. *) 225 | | Error s -> fail ptyp_loc s 226 | in 227 | match List.length typeArgs = 0 with 228 | | true -> 229 | (* We've got a simple type here with no parameters! Just return the functions 230 | generated above *) 231 | (encode, decode) 232 | | false -> 233 | (* Looks like there are some params for this type. Let's handle 234 | those now. *) 235 | parameterizeCodecs typeArgs encode decode encodeDecodeFlags) 236 | | _ -> fail ptyp_loc "This syntax is not yet handled by decco" -------------------------------------------------------------------------------- /ppx_src/src/DecodeCases.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Ast_helper 4 | open Utils 5 | let generateErrorCase numArgs i _ = 6 | { 7 | pc_lhs = 8 | Array.init numArgs (fun which -> 9 | match which == i with 10 | | true -> [%pat? Belt.Result.Error (e : Decco.decodeError)] 11 | | false -> [%pat? _]) 12 | |> Array.to_list |> tupleOrSingleton Pat.tuple; 13 | pc_guard = None; 14 | pc_rhs = 15 | [%expr Belt.Result.Error {e with path = [%e indexConst i] ^ e.path}]; 16 | } -------------------------------------------------------------------------------- /ppx_src/src/Polyvariants.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Ast_helper 4 | open Utils 5 | let getArgsFromPolyvars ~loc coreTypes = 6 | match coreTypes with 7 | | [] -> [] 8 | | coreType :: [] -> ( 9 | match coreType.ptyp_desc with 10 | | ((Ptyp_tuple coreTypes) [@explicit_arity]) -> coreTypes 11 | | _ -> [coreType]) 12 | | _ -> 13 | fail loc 14 | "This error shoudn't happen, means that the AST of your polyvariant is \ 15 | wrong" 16 | let generateEncoderCase encodeDecodeFlags unboxed row = 17 | match row with 18 | | ((Rtag ({txt = name; loc}, _attributes, coreTypes)) [@explicit_arity]) -> 19 | let constructorExpr = 20 | Exp.constant (Pconst_string (name, Location.none, None) [@explicit_arity]) 21 | in 22 | let args = getArgsFromPolyvars ~loc coreTypes in 23 | let lhsVars = 24 | match args with 25 | | [] -> None 26 | | _ :: [] -> Some (Pat.var (mknoloc "v0")) [@explicit_arity] 27 | | _ -> 28 | args 29 | |> List.mapi (fun i _ -> mkloc ("v" ^ string_of_int i) loc |> Pat.var) 30 | |> Pat.tuple 31 | |> fun v -> (Some v [@explicit_arity]) 32 | in 33 | let rhsList = 34 | args 35 | |> List.map (Codecs.generateCodecs encodeDecodeFlags) 36 | |> List.map (fun (encoder, _) -> BatOption.get encoder) 37 | |> List.mapi (fun i e -> 38 | Exp.apply ~loc e 39 | [(Asttypes.Nolabel, makeIdentExpr ("v" ^ string_of_int i))]) 40 | |> List.append [[%expr Js.Json.string [%e constructorExpr]]] 41 | in 42 | { 43 | pc_lhs = Pat.variant name lhsVars; 44 | pc_guard = None; 45 | pc_rhs = 46 | (match unboxed with 47 | | true -> List.tl rhsList |> List.hd 48 | | false -> [%expr Js.Json.array [%e rhsList |> Exp.array]]); 49 | } 50 | | ((Rinherit arg) [@explicit_arity]) -> 51 | fail arg.ptyp_loc "This syntax is not yet implemented by decco" 52 | let generateDecodeSuccessCase numArgs constructorName = 53 | { 54 | pc_lhs = 55 | Array.init numArgs (fun i -> 56 | mknoloc ("v" ^ string_of_int i) |> Pat.var |> fun p -> 57 | [%pat? ((Belt.Result.Ok [%p p]) [@explicit_arity])]) 58 | |> Array.to_list |> tupleOrSingleton Pat.tuple; 59 | pc_guard = None; 60 | pc_rhs = 61 | ( Array.init numArgs (fun i -> makeIdentExpr ("v" ^ string_of_int i)) 62 | |> Array.to_list |> tupleOrSingleton Exp.tuple 63 | |> fun v -> 64 | (Some v [@explicit_arity]) |> Exp.variant constructorName |> fun e -> 65 | [%expr Belt.Result.Ok [%e e] [@explicit_arity]] ); 66 | } 67 | let generateArgDecoder encodeDecodeFlags args constructorName = 68 | let numArgs = List.length args in 69 | args 70 | |> List.mapi (DecodeCases.generateErrorCase numArgs) 71 | |> List.append [generateDecodeSuccessCase numArgs constructorName] 72 | |> Exp.match_ 73 | (args 74 | |> List.map (Codecs.generateCodecs encodeDecodeFlags) 75 | |> List.mapi (fun i (_, decoder) -> 76 | Exp.apply (BatOption.get decoder) 77 | [ 78 | ( Asttypes.Nolabel, 79 | let idx = 80 | (Pconst_integer (string_of_int (i + 1), None) 81 | [@explicit_arity]) 82 | |> Exp.constant 83 | in 84 | [%expr Belt.Array.getExn jsonArr [%e idx]] ); 85 | ]) 86 | |> tupleOrSingleton Exp.tuple) 87 | let generateDecoderCase encodeDecodeFlags row = 88 | match row with 89 | | ((Rtag ({txt; loc}, _, coreTypes)) [@explicit_arity]) -> 90 | let args = getArgsFromPolyvars ~loc coreTypes in 91 | let argLen = 92 | (Pconst_integer (string_of_int (List.length args + 1), None) 93 | [@explicit_arity]) 94 | |> Exp.constant 95 | in 96 | let decoded = 97 | match args with 98 | | [] -> 99 | let resultantExp = Exp.variant txt None in 100 | [%expr Belt.Result.Ok [%e resultantExp] [@explicit_arity]] 101 | | _ -> generateArgDecoder encodeDecodeFlags args txt 102 | in 103 | { 104 | pc_lhs = 105 | ( (Pconst_string (txt, Location.none, None) [@explicit_arity]) 106 | |> Pat.constant 107 | |> fun v -> 108 | (Some v [@explicit_arity]) |> Pat.construct (lid "Js.Json.JSONString") 109 | ); 110 | pc_guard = None; 111 | pc_rhs = 112 | [%expr 113 | match Js.Array.length tagged != [%e argLen] with 114 | | true -> 115 | Decco.error "Invalid number of arguments to polyvariant constructor" 116 | v 117 | | false -> [%e decoded]]; 118 | } 119 | | ((Rinherit coreType) [@explicit_arity]) -> 120 | fail coreType.ptyp_loc "This syntax is not yet implemented by decco" 121 | let generateUnboxedDecode encodeDecodeFlags row = 122 | match row with 123 | | ((Rtag ({txt; loc}, _, args)) [@explicit_arity]) -> ( 124 | match args with 125 | | a :: [] -> ( 126 | let _, d = Codecs.generateCodecs encodeDecodeFlags a in 127 | match d with 128 | | ((Some d) [@explicit_arity]) -> 129 | let constructor = 130 | Exp.construct (lid txt) (Some [%expr v] [@explicit_arity]) 131 | in 132 | (Some 133 | [%expr 134 | fun v -> ([%e d] v |. Belt.Result.mapU) (fun v -> [%e constructor])] 135 | [@explicit_arity]) 136 | | None -> None) 137 | | _ -> fail loc "Expected exactly one type argument") 138 | | ((Rinherit coreType) [@explicit_arity]) -> 139 | fail coreType.ptyp_loc "This syntax is not yet implemented by decco" 140 | let generateCodecs ({doEncode; doDecode} as encodeDecodeFlags) rowFields unboxed 141 | = 142 | let encoder = 143 | match doEncode with 144 | | true -> 145 | List.map (generateEncoderCase encodeDecodeFlags unboxed) rowFields 146 | |> Exp.match_ [%expr v] 147 | |> Exp.fun_ Asttypes.Nolabel None [%pat? v] 148 | |> BatOption.some 149 | | false -> None 150 | in 151 | let decoderDefaultCase = 152 | { 153 | pc_lhs = [%pat? _]; 154 | pc_guard = None; 155 | pc_rhs = 156 | [%expr 157 | Decco.error "Invalid polyvariant constructor" 158 | (Belt.Array.getExn jsonArr 0)]; 159 | } 160 | in 161 | let decoder = 162 | match not doDecode with 163 | | true -> None 164 | | false -> ( 165 | match unboxed with 166 | | true -> generateUnboxedDecode encodeDecodeFlags (List.hd rowFields) 167 | | false -> 168 | let decoderSwitch = 169 | rowFields |> List.map (generateDecoderCase encodeDecodeFlags) 170 | |> fun l -> 171 | l @ [decoderDefaultCase] 172 | |> Exp.match_ [%expr Belt.Array.getExn tagged 0] 173 | in 174 | (Some 175 | [%expr 176 | fun v -> 177 | match Js.Json.classify v with 178 | | ((Js.Json.JSONArray [||]) [@explicit_arity]) -> 179 | Decco.error "Expected polyvariant, found empty array" v 180 | | ((Js.Json.JSONArray jsonArr) [@explicit_arity]) -> 181 | let tagged = Js.Array.map Js.Json.classify jsonArr in 182 | [%e decoderSwitch] 183 | | _ -> Decco.error "Not a polyvariant" v] 184 | [@explicit_arity])) 185 | in 186 | (encoder, decoder) -------------------------------------------------------------------------------- /ppx_src/src/Ppx_decco.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | class mapper = 3 | object (self) 4 | inherit Ast_traverse.map 5 | method! signature signature = 6 | signature |> List.map (Signature.mapSignatureItem self) |> List.concat 7 | method! structure structure = 8 | structure |> List.map (Structure.mapStructureItem self) |> List.concat 9 | end 10 | let structure_mapper s = (new mapper)#structure s 11 | let signature_mapper s = (new mapper)#signature s;; 12 | Ppxlib.Driver.register_transformation ~preprocess_impl:structure_mapper 13 | ~preprocess_intf:signature_mapper "decco" 14 | -------------------------------------------------------------------------------- /ppx_src/src/Records.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Ast_helper 4 | open Utils 5 | 6 | type parsedRecordFieldDeclaration = { 7 | name: string; 8 | (* If this field was a spread, this is the name that comes after the three dots *) 9 | spreadName: string option; 10 | key: expression; 11 | field: expression; 12 | codecs: expression option * expression option; 13 | default: expression option; 14 | } 15 | 16 | let makeArrayOfJsonFieldsFromParsedFieldDeclarations parsedFields = 17 | parsedFields 18 | |> List.map (fun {key; field; codecs = encoder, _} -> 19 | [%expr [%e key], [%e BatOption.get encoder] [%e field]]) 20 | |> Exp.array 21 | 22 | let wrapInSpreadEncoders parsedFields baseExpr = 23 | let spreadExprs = 24 | List.filter_map 25 | (fun {name; codecs} -> 26 | match (name, codecs) with 27 | | "...", (Some otherEncoder, _) -> 28 | (* We've encountered a spread operator here. At this point, we 29 | want to call the encode function for the name of the thing 30 | that's being spread, and then produce an expression that will 31 | merge another object over the encoded spread object. 32 | 33 | Make sure to use the text 'valueToEncode' here. It should match the value defined in 34 | generateEncoder below. There's a comment there about why we don't pass this name in 35 | as a parameter. *) 36 | let otherEncoderLident = 37 | [%expr [%e otherEncoder] (Obj.magic valueToEncode)] 38 | in 39 | Some [%expr Decco.unsafeMergeObjectsCurried [%e otherEncoderLident]] 40 | | _, _ -> None) 41 | parsedFields 42 | in 43 | List.fold_right 44 | (fun spreadExpr acc -> [%expr [%e spreadExpr] [%e acc]]) 45 | spreadExprs baseExpr 46 | 47 | let generateEncoder parsedFields unboxed (rootRecordTypeInfo : typeInfo) = 48 | (* If we've got a record with a spread type in it, we'll need to omit the spread 49 | from the generated fields, and handle its encoding differently. *) 50 | let parsedFieldsWithoutSpread = 51 | List.filter (fun {name} -> name <> "...") parsedFields 52 | in 53 | let constrainedFunctionArgsPattern = 54 | (* Make sure you use the specific name 'valueToEncode' here, becuase it's also 55 | used above when calling the encoder for a spread. Instead of passing in a 56 | variable with the name, I'm writing the name directly in the quoted expression, 57 | because expression quotes don't support dropping strings in, and I'd have to 58 | do more construction of things by hand with Ast_helper. *) 59 | Ast_helper.Pat.constraint_ 60 | [%pat? valueToEncode] 61 | (Utils.typeNameAndParamsToTypeDeclaration rootRecordTypeInfo) 62 | in 63 | match unboxed with 64 | | true -> 65 | (* In unboxed mode, we aren't going to handle spreading at all, since unboxeding 66 | is only supported on records with one field anyway. *) 67 | let {codecs; field} = List.hd parsedFieldsWithoutSpread in 68 | let e, _ = codecs in 69 | Exp.fun_ Asttypes.Nolabel None constrainedFunctionArgsPattern 70 | [%expr [%e BatOption.get e] [%e field]] 71 | | false -> 72 | [%expr 73 | Js.Json.object_ 74 | (Js.Dict.fromArray 75 | [%e 76 | makeArrayOfJsonFieldsFromParsedFieldDeclarations 77 | parsedFieldsWithoutSpread])] 78 | |> wrapInSpreadEncoders parsedFields 79 | (* This is where the final encoder function is constructed. If 80 | you need to do something with the parameters, this is the place. *) 81 | |> Exp.fun_ Asttypes.Nolabel None constrainedFunctionArgsPattern 82 | 83 | let generateDictGet {key; codecs = _, decoder; default} = 84 | let decoder = BatOption.get decoder in 85 | match default with 86 | | Some default -> 87 | [%expr 88 | ((Js.Dict.get dict [%e key] |. Belt.Option.mapU) [%e decoder] 89 | |. Belt.Option.getWithDefault) 90 | (Belt.Result.Ok [%e default])] 91 | | None -> 92 | [%expr 93 | (Js.Dict.get dict [%e key] |. Belt.Option.getWithDefault) Js.Json.null 94 | |> [%e decoder]] 95 | 96 | let generateDictGets decls = 97 | decls |> List.map generateDictGet |> tupleOrSingleton Exp.tuple 98 | 99 | let generateErrorCase {key; spreadName} = 100 | let finalKey = 101 | match spreadName with 102 | | Some spreadName -> 103 | Exp.constant (Pconst_string ("..." ^ spreadName, Location.none, None)) 104 | | None -> key 105 | in 106 | { 107 | pc_lhs = [%pat? Belt.Result.Error (e : Decco.decodeError)]; 108 | pc_guard = None; 109 | pc_rhs = 110 | [%expr Belt.Result.Error {e with path = "." ^ [%e finalKey] ^ e.path}]; 111 | } 112 | 113 | let generateFinalRecordExpr allFieldDeclarations = 114 | let fieldDeclarationsWithoutSpread = 115 | List.filter (fun {name} -> name <> "...") allFieldDeclarations 116 | in 117 | (* If there's a spread on the record, it gets passed as an optional expression as the last argument 118 | to the record constructor. I don't know why, but there you go. *) 119 | let spreadExpressions = 120 | List.filter_map 121 | (fun {name; spreadName} -> 122 | match (name, spreadName) with 123 | | "...", Some spreadName -> 124 | (* We found a spread! But the type system won't be happy 125 | if we spread it directly because smaller types still can't 126 | be spread insto larger types. We'll have to use Object.magic *) 127 | Some (Exp.ident (lid spreadName)) 128 | | _ -> None) 129 | allFieldDeclarations 130 | in 131 | let rootObject = 132 | List.fold_right 133 | (fun {name} acc -> 134 | [%expr 135 | Decco.unsafeAddFieldToObject 136 | [%e Exp.constant (Ast_helper.Const.string name)] 137 | [%e makeIdentExpr name] [%e acc]]) 138 | fieldDeclarationsWithoutSpread [%expr Js.Dict.empty ()] 139 | in 140 | let mergedWithSpreads = 141 | List.fold_right 142 | (fun spreadExpr acc -> 143 | [%expr Decco.unsafeMergeObjects [%e spreadExpr] [%e acc]]) 144 | spreadExpressions rootObject 145 | in 146 | [%expr Belt.Result.Ok (Obj.magic [%e mergedWithSpreads])] 147 | 148 | let generateSuccessCase {name; spreadName} successExpr = 149 | let actualNameToUseForOkayPayload = 150 | match (name, spreadName) with 151 | | "...", Some spreadName -> spreadName 152 | | _ -> name 153 | in 154 | { 155 | pc_lhs = 156 | ( mknoloc actualNameToUseForOkayPayload |> Pat.var |> fun p -> 157 | [%pat? Belt.Result.Ok [%p p]] ); 158 | pc_guard = None; 159 | pc_rhs = successExpr; 160 | } 161 | 162 | (* Recursively generates an expression containing nested switches, first 163 | decoding the first record items, then (if successful) the second, etc. *) 164 | let rec generateNestedSwitchesRecurse allDecls remainingDecls = 165 | let current, successExpr = 166 | match remainingDecls with 167 | | [] -> failwith "Decco internal error: [] not expected" 168 | | last :: [] -> (last, generateFinalRecordExpr allDecls) 169 | | first :: tail -> (first, generateNestedSwitchesRecurse allDecls tail) 170 | in 171 | (* Normally the expression we'll switch on is getting a value from Js.Dict, 172 | but in the case of a spread operator, ..., we're going to call the decoder 173 | for that field instead *) 174 | let switchExpression = 175 | match current with 176 | | {name = "..."; codecs = _, decoder} -> 177 | [%expr [%e BatOption.get decoder] v] 178 | | _ -> generateDictGet current 179 | in 180 | [generateErrorCase current] 181 | |> List.append [generateSuccessCase current successExpr] 182 | |> Exp.match_ switchExpression 183 | 184 | let generateNestedSwitches decls = generateNestedSwitchesRecurse decls decls 185 | 186 | let generateDecoder decls unboxed = 187 | match unboxed with 188 | | true -> 189 | let fieldDeclarationsWithoutSpread = 190 | List.filter (fun {name} -> name <> "...") decls 191 | in 192 | let {codecs; name} = List.hd fieldDeclarationsWithoutSpread in 193 | let _, d = codecs in 194 | let recordExpr = 195 | [(lid name, makeIdentExpr "v")] |> fun __x -> Exp.record __x None 196 | in 197 | [%expr 198 | fun v -> 199 | ([%e BatOption.get d] v |. Belt.Result.mapU) (fun v -> [%e recordExpr])] 200 | | false -> 201 | [%expr 202 | fun v -> 203 | match Js.Json.classify v with 204 | | Js.Json.JSONObject dict -> [%e generateNestedSwitches decls] 205 | | _ -> Decco.error "Not an object" v] 206 | 207 | let parseRecordField encodeDecodeFlags 208 | {pld_name = {txt}; pld_loc; pld_type; pld_attributes} = 209 | let default = 210 | match getAttributeByName pld_attributes "decco.default" with 211 | | Ok (Some attribute) -> Some (getExpressionFromPayload attribute) 212 | | Ok None -> None 213 | | Error s -> fail pld_loc s 214 | in 215 | let key = 216 | match getAttributeByName pld_attributes "decco.key" with 217 | | Ok (Some attribute) -> getExpressionFromPayload attribute 218 | | Ok None -> Exp.constant (Pconst_string (txt, Location.none, None)) 219 | | Error s -> fail pld_loc s 220 | in 221 | let rec getSpreadNameFromLident (longident : Longident.t) = 222 | (* The spread name can be a Lident: ...t, or any number of modules in the form of Ldot: X.Y.t. 223 | In the case of Lapply we fail, because Rescript only supports spreading records into each other anyway.*) 224 | match longident with 225 | | Lident spreadName -> spreadName 226 | | Ldot (otherLident, b) -> 227 | String.lowercase_ascii (getSpreadNameFromLident otherLident) ^ b 228 | | Lapply _ -> 229 | fail pld_loc 230 | "Tried to handle a spread operator that spread the result of a \ 231 | function call (Lapply). But we only support spreading records into \ 232 | each other" 233 | in 234 | let spreadName = 235 | match (txt, pld_type) with 236 | | "...", {ptyp_desc = Ptyp_constr ({txt = lident}, _)} -> 237 | Some (getSpreadNameFromLident lident) 238 | | _ -> None 239 | in 240 | { 241 | name = txt; 242 | spreadName; 243 | key; 244 | field = Exp.field [%expr valueToEncode] (lid txt); 245 | codecs = Codecs.generateCodecs encodeDecodeFlags pld_type; 246 | default; 247 | } 248 | 249 | let generateCodecs ({doEncode; doDecode} as encodeDecodeFlags) 250 | recordFieldDeclarations unboxed (rootRecordTypeInfo : typeInfo) = 251 | let parsedFieldDeclarations = 252 | List.map (parseRecordField encodeDecodeFlags) recordFieldDeclarations 253 | in 254 | ( (match doEncode with 255 | | true -> 256 | Some (generateEncoder parsedFieldDeclarations unboxed rootRecordTypeInfo) 257 | | false -> None), 258 | match doDecode with 259 | | true -> Some (generateDecoder parsedFieldDeclarations unboxed) 260 | | false -> None ) 261 | -------------------------------------------------------------------------------- /ppx_src/src/Signature.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Utils 4 | 5 | let rec addEncoderParams paramNames resultType = 6 | match paramNames with 7 | | [] -> resultType 8 | | hd :: tl -> 9 | [%type: ([%t Ast_helper.Typ.var hd] -> Js.Json.t) -> [%t resultType]] 10 | |> addEncoderParams tl 11 | 12 | let makeResultType valueType = 13 | [%type: ([%t valueType], Decco.decodeError) Belt.Result.t] 14 | 15 | let rec addDecoderParams paramNames resultType = 16 | match paramNames with 17 | | [] -> resultType 18 | | hd :: tl -> 19 | let decoderParam = 20 | [%type: Js.Json.t -> [%t makeResultType (Ast_helper.Typ.var hd)]] 21 | in 22 | [%type: [%t decoderParam] -> [%t resultType]] |> addDecoderParams tl 23 | 24 | let generateSigDecls {doEncode; doDecode} typeName paramNames = 25 | let encoderPat = typeName ^ Utils.encoderFuncSuffix in 26 | let decoderPat = typeName ^ Utils.decoderFuncSuffix in 27 | let valueType = 28 | paramNames 29 | |> List.map Ast_helper.Typ.var 30 | |> Ast_helper.Typ.constr (lid typeName) 31 | in 32 | let decls = [] in 33 | let encoderDecls = 34 | match doEncode with 35 | | true -> 36 | [ 37 | Utils.wrapFunctionTypeSignatureForUncurrying 38 | ~arity:(List.length paramNames + 1) 39 | ([%type: [%t valueType] -> Js.Json.t] 40 | |> addEncoderParams (List.rev paramNames)) 41 | |> Ast_helper.Val.mk (mknoloc encoderPat) 42 | |> Ast_helper.Sig.value; 43 | ] 44 | | false -> [] 45 | in 46 | let decoderDecls = 47 | match doDecode with 48 | | true -> 49 | [ 50 | Utils.wrapFunctionTypeSignatureForUncurrying 51 | ~arity:(List.length paramNames + 1) 52 | ([%type: Js.Json.t -> [%t makeResultType valueType]] 53 | |> addDecoderParams (List.rev paramNames)) 54 | |> Ast_helper.Val.mk (mknoloc decoderPat) 55 | |> Ast_helper.Sig.value; 56 | ] 57 | | false -> [] 58 | in 59 | List.concat [decls; encoderDecls; decoderDecls] 60 | 61 | let mapTypeDecl decl = 62 | let {ptype_attributes; ptype_name = {txt = typeName}; ptype_params; ptype_loc} 63 | = 64 | decl 65 | in 66 | match makeEncodeDecodeFlagsFromDecoratorAttributes ptype_attributes with 67 | | Error s -> fail ptype_loc s 68 | | Ok None -> [] 69 | | Ok (Some encodeDecodeFlags) -> 70 | generateSigDecls encodeDecodeFlags typeName (getParamNames ptype_params) 71 | 72 | let mapSignatureItem mapper ({psig_desc} as signatureItem) = 73 | match psig_desc with 74 | | ((Psig_type (_, decls)) [@explicit_arity]) -> 75 | let generatedSigItems = decls |> List.map mapTypeDecl |> List.concat in 76 | mapper#signature_item signatureItem :: generatedSigItems 77 | | _ -> [mapper#signature_item signatureItem] -------------------------------------------------------------------------------- /ppx_src/src/Structure.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Ast_helper 4 | open Utils 5 | 6 | let jsJsonTypeDecl = Typ.constr (lid "Js.Json.t") [] 7 | 8 | let buildRightHandSideOfEqualSignForCodecDeclarations (paramNames : label list) 9 | (codecGutsExpression : expression) (typeInfo : typeInfo) (isEncoder : bool) 10 | = 11 | (* If we're dealing with an encoder, we need to specify the exact type that 12 | will be fed to this function. If it's a decoder, we're always taking in 13 | JSON *) 14 | let incomingType = 15 | if isEncoder then typeNameAndParamsToTypeDeclaration typeInfo 16 | else jsJsonTypeDecl 17 | in 18 | let returnType = 19 | if isEncoder then jsJsonTypeDecl 20 | else 21 | Ast_helper.Typ.constr (lid "Belt.Result.t") 22 | [ 23 | typeNameAndParamsToTypeDeclaration typeInfo; 24 | Utils.labelToCoreType "Decco.decodeError"; 25 | ] 26 | in 27 | (* This is the node that specifies the arguments coming in to the function *) 28 | let basePattern = 29 | Ast_helper.Pat.constraint_ 30 | (Ast_helper.Pat.var (mknoloc "value")) 31 | incomingType 32 | in 33 | let codecGutsWithReturnType = 34 | Ast_helper.Exp.constraint_ [%expr [%e codecGutsExpression] value] returnType 35 | in 36 | (* The base expression is what you'd think of as the "codec function". Takes json, returns a type, and vice-versa 37 | but below we handle parameterized types by wrapping the base expression in new functions for every parameter. 38 | In OCaml, this is the same concept as having a function with an argument for each parameter. But not in Rescript, 39 | so down at the bottom we wrap the whole darn thing in a special expression that tells Rescript to use the same 40 | arity as the number of incoming params, thus building an uncurried function. *) 41 | let baseExpression = 42 | Exp.fun_ Asttypes.Nolabel None basePattern codecGutsWithReturnType 43 | in 44 | let wholeCodecExpr = 45 | List.fold_right 46 | (fun s acc -> 47 | let pat = Pat.var (mknoloc s) in 48 | Exp.fun_ Asttypes.Nolabel None pat acc) 49 | paramNames baseExpression 50 | in 51 | let arity = List.length paramNames + 1 in 52 | (* Set an attribute with the arity matching the param count on the 53 | outermost invocation so that we generate a function that's uncurried, 54 | expecting all of its arguments at once. *) 55 | Utils.wrapFunctionExpressionForUncurrying ~arity wholeCodecExpr 56 | 57 | (* This is where the value bindings get made for the codec functions 58 | but it isn't where the codec functions themselves are generated. Those 59 | get passed in. This is the outermost layer of the t_encode and t_decode functions *) 60 | let generateCodecDecls (typeInfo : typeInfo) (encoder, decoder) = 61 | let encoderPat = 62 | Pat.var (mknoloc (typeInfo.typeName ^ Utils.encoderFuncSuffix)) 63 | in 64 | let encoderParamNames = 65 | List.map (fun s -> encoderVarPrefix ^ s) typeInfo.typeParams 66 | in 67 | let decoderPat = 68 | Pat.var (mknoloc (typeInfo.typeName ^ Utils.decoderFuncSuffix)) 69 | in 70 | let decoderParamNames = 71 | List.map (fun s -> decoderVarPrefix ^ s) typeInfo.typeParams 72 | in 73 | let encoderBindings = 74 | match encoder with 75 | | None -> [] 76 | | Some encoder -> 77 | [ 78 | Vb.mk 79 | ~attrs:[attrWarning [%expr "-39"]] 80 | encoderPat 81 | (buildRightHandSideOfEqualSignForCodecDeclarations encoderParamNames 82 | encoder typeInfo true); 83 | ] 84 | in 85 | let decoderBindings = 86 | match decoder with 87 | | None -> [] 88 | | Some decoder -> 89 | [ 90 | Vb.mk 91 | ~attrs:[attrWarning [%expr "-4"]; attrWarning [%expr "-39"]] 92 | decoderPat 93 | (buildRightHandSideOfEqualSignForCodecDeclarations decoderParamNames 94 | decoder typeInfo false); 95 | ] 96 | in 97 | [] @ encoderBindings @ decoderBindings 98 | 99 | (* mapTypeDecl is where we know we're working with a type definition. We don't know 100 | whether it's a decco type yet though. We may end up doing nothing here. Or we may 101 | end up generating codec functions that get returned to the caller. *) 102 | let mapTypeDecl decl = 103 | let { 104 | ptype_attributes; 105 | ptype_name = {txt = typeName}; 106 | ptype_manifest; 107 | ptype_params; 108 | ptype_loc; 109 | ptype_kind; 110 | } = 111 | decl 112 | in 113 | let isUnboxed = 114 | match Utils.getAttributeByName ptype_attributes "unboxed" with 115 | | Ok (Some _) -> true 116 | | _ -> false 117 | in 118 | match makeEncodeDecodeFlagsFromDecoratorAttributes ptype_attributes with 119 | | Ok None -> [] 120 | | Ok (Some encodeDecodeFlags) -> ( 121 | let typeInfo = {typeName; typeParams = getParamNames ptype_params} in 122 | (* Here we call the code to generate the codecs and build their 123 | value bindings (the let t_decode = ... part). We have various different 124 | types to handle, so there's a switch. Most simple cases are covered in 125 | Codecs.generateCodecs, but there are some cases that get handled in their 126 | own modules. Probably for the sake of breaking up complex code. 127 | Why aren't those cases just handled in Codecs.generateCodecs? I'm not sure, 128 | I could probably find out by snooping around longer though. *) 129 | match (ptype_manifest, ptype_kind) with 130 | | None, Ptype_abstract -> 131 | fail ptype_loc "Can't generate codecs for unspecified type" 132 | | Some {ptyp_desc = Ptyp_variant (rowFields, _, _)}, Ptype_abstract -> 133 | let rowFieldsDec = List.map (fun row -> row.prf_desc) rowFields in 134 | generateCodecDecls typeInfo 135 | (Polyvariants.generateCodecs encodeDecodeFlags rowFieldsDec isUnboxed) 136 | | Some manifest, _ -> 137 | generateCodecDecls typeInfo 138 | (Codecs.generateCodecs encodeDecodeFlags manifest) 139 | | None, Ptype_variant decls -> 140 | generateCodecDecls typeInfo 141 | (Variants.generateCodecs encodeDecodeFlags decls isUnboxed) 142 | | None, Ptype_record decls -> 143 | generateCodecDecls typeInfo 144 | (Records.generateCodecs encodeDecodeFlags decls isUnboxed typeInfo) 145 | | _ -> fail ptype_loc "This type is not handled by decco") 146 | | Error s -> fail ptype_loc s 147 | 148 | (* This is where we map over the AST, figure out if we need to generate 149 | values from a type or not, and stick those new values back into the 150 | generated code. *) 151 | let mapStructureItem mapper ({pstr_desc} as structureItem) = 152 | match pstr_desc with 153 | | Pstr_type (recFlag, decls) -> 154 | (* If we've gotten into this branch, we're working with a type declaration 155 | and we want to potentially generate new values (codecs) based on 156 | the type. *) 157 | let valueBindings = decls |> List.map mapTypeDecl |> List.concat in 158 | let existingItem = [mapper#structure_item structureItem] in 159 | let newItems = 160 | match List.length valueBindings > 0 with 161 | | true -> [Str.value recFlag valueBindings] 162 | | false -> [] 163 | in 164 | existingItem @ newItems 165 | | _ -> 166 | (* We've found some other structure item that isn't a type. Ignore it! *) 167 | [mapper#structure_item structureItem] -------------------------------------------------------------------------------- /ppx_src/src/Tuple.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Ast_helper 4 | open Utils 5 | let generateEncoder compositeEncoders = 6 | let arrExp = 7 | compositeEncoders 8 | |> List.mapi (fun i e -> 9 | let vExp = Exp.ident (lid ("v" ^ string_of_int i)) in 10 | [%expr [%e e] [%e vExp]]) 11 | |> Exp.array 12 | in 13 | let deconstructorPattern = 14 | compositeEncoders 15 | |> List.mapi (fun i _ -> Pat.var (mknoloc ("v" ^ string_of_int i))) 16 | |> Pat.tuple 17 | in 18 | Utils.wrapFunctionExpressionForUncurrying ~arity:1 19 | [%expr fun [%p deconstructorPattern] -> Js.Json.array [%e arrExp]] 20 | let generateDecodeSuccessCase numArgs = 21 | { 22 | pc_lhs = 23 | Array.init numArgs (fun i -> 24 | mknoloc ("v" ^ string_of_int i) |> Pat.var |> fun p -> 25 | [%pat? Belt.Result.Ok [%p p]]) 26 | |> Array.to_list |> tupleOrSingleton Pat.tuple; 27 | pc_guard = None; 28 | pc_rhs = 29 | ( Array.init numArgs (fun i -> makeIdentExpr ("v" ^ string_of_int i)) 30 | |> Array.to_list |> Exp.tuple 31 | |> fun e -> [%expr Belt.Result.Ok [%e e]] ); 32 | } 33 | 34 | let generateDecodeSwitch compositeDecoders = 35 | let decodeExpr = 36 | compositeDecoders 37 | |> List.mapi (fun i d -> 38 | let ident = makeIdentExpr ("v" ^ string_of_int i) in 39 | [%expr [%e d] [%e ident]]) 40 | |> Exp.tuple 41 | in 42 | compositeDecoders 43 | |> List.mapi (DecodeCases.generateErrorCase (List.length compositeDecoders)) 44 | |> List.append [generateDecodeSuccessCase (List.length compositeDecoders)] 45 | |> Exp.match_ decodeExpr 46 | let generateDecoder compositeDecoders = 47 | let matchArrPattern = 48 | compositeDecoders 49 | |> List.mapi (fun i _ -> Pat.var (mknoloc ("v" ^ string_of_int i))) 50 | |> Pat.array 51 | in 52 | let matchPattern = [%pat? Js.Json.JSONArray [%p matchArrPattern]] in 53 | let outerSwitch = 54 | Exp.match_ [%expr Js.Json.classify json] 55 | [ 56 | Exp.case matchPattern (generateDecodeSwitch compositeDecoders); 57 | Exp.case 58 | [%pat? Js.Json.JSONArray _] 59 | [%expr Decco.error "Incorrect cardinality" json]; 60 | Exp.case [%pat? _] [%expr Decco.error "Not a tuple" json]; 61 | ] 62 | in 63 | Utils.wrapFunctionExpressionForUncurrying ~arity:1 64 | [%expr fun json -> [%e outerSwitch]] 65 | -------------------------------------------------------------------------------- /ppx_src/src/Utils.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Ast_helper 4 | 5 | let decoratorLabel = "decco" 6 | let decoratorDecodeLabel = decoratorLabel ^ ".decode" 7 | let decoratorEncodeLabel = decoratorLabel ^ ".encode" 8 | let encoderFuncSuffix = "_encode" 9 | let decoderFuncSuffix = "_decode" 10 | let encoderVarPrefix = "encoder_" 11 | let decoderVarPrefix = "decoder_" 12 | 13 | let loc = !default_loc 14 | 15 | let fail loc message = Location.raise_errorf ~loc "%s" message 16 | 17 | let longidentParse = Longident.parse [@@ocaml.warning "-3"] 18 | 19 | let mkloc txt loc = {Location.txt; loc} 20 | 21 | let mknoloc txt = mkloc txt Location.none 22 | 23 | let lid ?(loc = Location.none) s = mkloc (Longident.parse s) loc 24 | 25 | (* Turn a label into an identifier, where an identifier is something like 26 | x, or M.x: https://v2.ocaml.org/releases/5.1/api/compilerlibref/Parsetree.html#1_Corelanguage 27 | *) 28 | let makeIdentExpr s = Exp.ident (mknoloc (longidentParse s)) 29 | 30 | let tupleOrSingleton tuple l = 31 | match List.length l > 1 with 32 | | true -> tuple l 33 | | false -> List.hd l 34 | 35 | let getAttributeByName attributes name = 36 | let filtered = 37 | attributes |> List.filter (fun {attr_name = {Location.txt}} -> txt = name) 38 | in 39 | match filtered with 40 | | [] -> Ok None [@explicit_arity] 41 | | attribute :: [] -> Ok (Some attribute [@explicit_arity]) [@explicit_arity] 42 | | _ -> 43 | Error ("Too many occurrences of \"" ^ name ^ "\" attribute") 44 | [@explicit_arity] 45 | 46 | type encodeDecodeFlags = {doEncode: bool; doDecode: bool} 47 | 48 | let makeEncodeDecodeFlagsFromDecoratorAttributes attributes = 49 | match getAttributeByName attributes decoratorLabel with 50 | | Ok None -> ( 51 | (* This is the case where there's no @decco decorator found. We'll go ahead 52 | and check for encode/decode-specific versions instead *) 53 | match 54 | ( getAttributeByName attributes decoratorDecodeLabel, 55 | getAttributeByName attributes decoratorEncodeLabel ) 56 | with 57 | | Ok (Some _), Ok (Some _) -> Ok (Some {doEncode = true; doDecode = true}) 58 | | Ok (Some _), Ok None -> Ok (Some {doEncode = false; doDecode = true}) 59 | | Ok None, Ok (Some _) -> Ok (Some {doEncode = true; doDecode = false}) 60 | | Ok None, Ok None -> Ok None 61 | | (Error _ as e), _ -> e 62 | | _, (Error _ as e) -> e) 63 | | Ok (Some _) -> 64 | (* This is the case where the @decco decorator was found, which means we generate both *) 65 | Ok (Some {doEncode = true; doDecode = true}) 66 | | Error _ as e -> e 67 | 68 | let getExpressionFromPayload {attr_name = {loc}; attr_payload = payload} = 69 | match payload with 70 | | ((PStr ({pstr_desc} :: [])) [@explicit_arity]) -> ( 71 | match pstr_desc with 72 | | ((Pstr_eval (expr, _)) [@explicit_arity]) -> expr 73 | | _ -> fail loc "Expected expression as attribute payload") 74 | | _ -> fail loc "Expected expression as attribute payload" 75 | 76 | let getParamNames params = 77 | params 78 | |> List.map (fun ({ptyp_desc; ptyp_loc}, _) -> 79 | match ptyp_desc with 80 | | ((Ptyp_var s) [@explicit_arity]) -> s 81 | | _ -> 82 | fail ptyp_loc "Unhandled param type" |> fun v -> 83 | (Location.Error v [@explicit_arity]) |> raise) 84 | 85 | let indexConst i = 86 | (Pconst_string ("[" ^ string_of_int i ^ "]", Location.none, None) 87 | [@explicit_arity]) 88 | |> Exp.constant 89 | 90 | let rec isIdentifierUsedInCoreType typeName {ptyp_desc; ptyp_loc} = 91 | match ptyp_desc with 92 | | ((Ptyp_arrow (_, _, _)) [@explicit_arity]) -> 93 | fail ptyp_loc "Can't generate codecs for function type" 94 | | Ptyp_any -> fail ptyp_loc "Can't generate codecs for `any` type" 95 | | Ptyp_package _ -> fail ptyp_loc "Can't generate codecs for module type" 96 | | ((Ptyp_variant (_, _, _)) [@explicit_arity]) -> 97 | fail ptyp_loc "Unexpected Ptyp_variant" 98 | | Ptyp_var _ -> false 99 | | ((Ptyp_tuple childTypes) [@explicit_arity]) -> 100 | List.exists (isIdentifierUsedInCoreType typeName) childTypes 101 | | ((Ptyp_constr ({txt}, childTypes)) [@explicit_arity]) -> ( 102 | match txt = (Lident typeName [@explicit_arity]) with 103 | | true -> true 104 | | false -> List.exists (isIdentifierUsedInCoreType typeName) childTypes) 105 | | _ -> fail ptyp_loc "This syntax is not yet handled by decco" 106 | 107 | let attrWarning expr = 108 | { 109 | attr_name = mkloc "ocaml.warning" loc; 110 | attr_payload = 111 | PStr 112 | [{pstr_desc = Pstr_eval (expr, []) [@explicit_arity]; pstr_loc = loc}] 113 | [@explicit_arity]; 114 | attr_loc = loc; 115 | } 116 | 117 | (* The following function comes from https://github.com/green-labs/ppx_spice/pull/49/files#diff-25e55eeac0911adb8041a5ee5c0a5fb5291bc174eea8711c3694c51bf6a219aaR127 118 | And are also under the MIT license, Copyright (c) 2021 Greenlabs *) 119 | let wrapFunctionExpressionForUncurrying ?(loc = Location.none) ~arity e = 120 | let attr_arity = 121 | Attr.mk {txt = "res.arity"; loc} 122 | (PStr [Str.eval (Exp.constant (Const.int arity))]) 123 | in 124 | Exp.construct ~attrs:[attr_arity] {txt = Lident "Function$"; loc} (Some e) 125 | (* End function from Spice *) 126 | 127 | let wrapFunctionTypeSignatureForUncurrying ?(loc = Location.none) ~arity 128 | typeExpression = 129 | let arityType : core_type = 130 | Ast_helper.Typ.variant 131 | [Ast_helper.Rf.tag {txt = "Has_arity" ^ string_of_int arity; loc} true []] 132 | Closed None 133 | in 134 | Ast_helper.Typ.constr (lid "function$") [typeExpression; arityType] 135 | 136 | let print_strings strings = 137 | let formatted = String.concat "; " strings in 138 | Printf.printf "[%s]\n" formatted 139 | 140 | let labelToCoreType label = Ast_helper.Typ.constr (lid label) [] 141 | 142 | type typeInfo = {typeName: label; typeParams: label list} 143 | 144 | let typeNameAndParamsToTypeDeclaration ({typeName; typeParams} : typeInfo) = 145 | Typ.constr (lid typeName) (List.map (fun s -> Typ.var s) typeParams) -------------------------------------------------------------------------------- /ppx_src/src/Variants.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Parsetree 3 | open Ast_helper 4 | open Utils 5 | let generateEncoderCase encodeDecodeFlags unboxed 6 | {pcd_name = {txt = name}; pcd_args; pcd_loc} = 7 | match pcd_args with 8 | | ((Pcstr_tuple args) [@explicit_arity]) -> 9 | let constructorExpr = 10 | Exp.constant (Pconst_string (name, Location.none, None) [@explicit_arity]) 11 | in 12 | let lhsVars = 13 | match args with 14 | | [] -> None 15 | | _ :: [] -> Some (Pat.var (mknoloc "v0")) [@explicit_arity] 16 | | _ -> 17 | args 18 | |> List.mapi (fun i _ -> 19 | mkloc ("v" ^ string_of_int i) pcd_loc |> Pat.var) 20 | |> Pat.tuple 21 | |> fun v -> (Some v [@explicit_arity]) 22 | in 23 | let rhsList = 24 | args 25 | |> List.map (Codecs.generateCodecs encodeDecodeFlags) 26 | |> List.map (fun (encoder, _) -> BatOption.get encoder) 27 | |> List.mapi (fun i e -> 28 | Exp.apply ~loc:pcd_loc e 29 | [(Asttypes.Nolabel, makeIdentExpr ("v" ^ string_of_int i))]) 30 | |> List.append [[%expr Js.Json.string [%e constructorExpr]]] 31 | in 32 | { 33 | pc_lhs = Pat.construct (lid name) lhsVars; 34 | pc_guard = None; 35 | pc_rhs = 36 | (match unboxed with 37 | | true -> List.tl rhsList |> List.hd 38 | | false -> [%expr Js.Json.array [%e rhsList |> Exp.array]]); 39 | } 40 | | Pcstr_record _ -> fail pcd_loc "This syntax is not yet implemented by decco" 41 | 42 | let generateDecodeSuccessCase numArgs constructorName = 43 | { 44 | pc_lhs = 45 | Array.init numArgs (fun i -> 46 | mknoloc ("v" ^ string_of_int i) |> Pat.var |> fun p -> 47 | [%pat? ((Belt.Result.Ok [%p p]) [@explicit_arity])]) 48 | |> Array.to_list |> tupleOrSingleton Pat.tuple; 49 | pc_guard = None; 50 | pc_rhs = 51 | ( Array.init numArgs (fun i -> makeIdentExpr ("v" ^ string_of_int i)) 52 | |> Array.to_list |> tupleOrSingleton Exp.tuple 53 | |> fun v -> 54 | (Some v [@explicit_arity]) |> Exp.construct (lid constructorName) 55 | |> fun e -> [%expr Belt.Result.Ok [%e e] [@explicit_arity]] ); 56 | } 57 | 58 | let generateArgDecoder encodeDecodeFlags args constructorName = 59 | let numArgs = List.length args in 60 | args 61 | |> List.mapi (DecodeCases.generateErrorCase numArgs) 62 | |> List.append [generateDecodeSuccessCase numArgs constructorName] 63 | |> Exp.match_ 64 | (args 65 | |> List.map (Codecs.generateCodecs encodeDecodeFlags) 66 | |> List.mapi (fun i (_, decoder) -> 67 | Exp.apply (BatOption.get decoder) 68 | [ 69 | ( Asttypes.Nolabel, 70 | let idx = 71 | (Pconst_integer (string_of_int (i + 1), None) 72 | [@explicit_arity]) 73 | |> Exp.constant 74 | in 75 | [%expr Belt.Array.getExn jsonArr [%e idx]] ); 76 | ]) 77 | |> tupleOrSingleton Exp.tuple) 78 | 79 | let generateDecoderCase encodeDecodeFlags 80 | {pcd_name = {txt = name}; pcd_args; pcd_loc} = 81 | match pcd_args with 82 | | ((Pcstr_tuple args) [@explicit_arity]) -> 83 | let argLen = 84 | (Pconst_integer (string_of_int (List.length args + 1), None) 85 | [@explicit_arity]) 86 | |> Exp.constant 87 | in 88 | let decoded = 89 | match args with 90 | | [] -> 91 | let ident = lid name in 92 | [%expr Belt.Result.Ok [%e Exp.construct ident None] [@explicit_arity]] 93 | | _ -> generateArgDecoder encodeDecodeFlags args name 94 | in 95 | { 96 | pc_lhs = 97 | ( (Pconst_string (name, Location.none, None) [@explicit_arity]) 98 | |> Pat.constant 99 | |> fun v -> 100 | (Some v [@explicit_arity]) |> Pat.construct (lid "Js.Json.JSONString") 101 | ); 102 | pc_guard = None; 103 | pc_rhs = 104 | [%expr 105 | match Js.Array.length tagged != [%e argLen] with 106 | | true -> 107 | Decco.error "Invalid number of arguments to variant constructor" v 108 | | false -> [%e decoded]]; 109 | } 110 | | Pcstr_record _ -> fail pcd_loc "This syntax is not yet implemented by decco" 111 | 112 | let generateUnboxedDecode encodeDecodeFlags 113 | {pcd_name = {txt = name}; pcd_args; pcd_loc} = 114 | match pcd_args with 115 | | ((Pcstr_tuple args) [@explicit_arity]) -> ( 116 | match args with 117 | | a :: [] -> ( 118 | let _, d = Codecs.generateCodecs encodeDecodeFlags a in 119 | match d with 120 | | ((Some d) [@explicit_arity]) -> 121 | let constructor = 122 | Exp.construct (lid name) (Some [%expr v] [@explicit_arity]) 123 | in 124 | (Some 125 | [%expr 126 | fun v -> ([%e d] v |. Belt.Result.mapU) (fun v -> [%e constructor])] 127 | [@explicit_arity]) 128 | | None -> None) 129 | | _ -> fail pcd_loc "Expected exactly one type argument") 130 | | Pcstr_record _ -> fail pcd_loc "This syntax is not yet implemented by decco" 131 | 132 | let generateCodecs ({doEncode; doDecode} as encodeDecodeFlags) constrDecls 133 | unboxed = 134 | let encoder = 135 | match doEncode with 136 | | true -> 137 | List.map (generateEncoderCase encodeDecodeFlags unboxed) constrDecls 138 | |> Exp.match_ [%expr v] 139 | |> (fun e -> 140 | Utils.wrapFunctionExpressionForUncurrying ~arity:1 141 | (Exp.fun_ Asttypes.Nolabel None [%pat? v] e)) 142 | |> BatOption.some 143 | | false -> None 144 | in 145 | let decoderDefaultCase = 146 | { 147 | pc_lhs = [%pat? _]; 148 | pc_guard = None; 149 | pc_rhs = 150 | [%expr 151 | Decco.error "Invalid variant constructor" 152 | (Belt.Array.getExn jsonArr 0)]; 153 | } 154 | in 155 | let decoder = 156 | match not doDecode with 157 | | true -> None 158 | | false -> ( 159 | match unboxed with 160 | | true -> generateUnboxedDecode encodeDecodeFlags (List.hd constrDecls) 161 | | false -> 162 | let decoderSwitch = 163 | List.map (generateDecoderCase encodeDecodeFlags) constrDecls 164 | |> fun l -> 165 | l @ [decoderDefaultCase] 166 | |> Exp.match_ [%expr Belt.Array.getExn tagged 0] 167 | in 168 | (Some 169 | [%expr 170 | fun v -> 171 | match Js.Json.classify v with 172 | | ((Js.Json.JSONArray [||]) [@explicit_arity]) -> 173 | Decco.error "Expected variant, found empty array" v 174 | | ((Js.Json.JSONArray jsonArr) [@explicit_arity]) -> 175 | let tagged = Js.Array.map Js.Json.classify jsonArr in 176 | [%e decoderSwitch] 177 | | _ -> Decco.error "Not a variant" v] 178 | [@explicit_arity])) 179 | in 180 | (encoder, decoder) -------------------------------------------------------------------------------- /ppx_src/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_decco) 3 | (public_name ppx_decco) 4 | (kind ppx_rewriter) 5 | (libraries ppxlib) 6 | (preprocess 7 | (pps ppxlib.metaquot)) 8 | (flags 9 | (:standard -w -9 -w -26 -w -27)) 10 | ; 9 = labels not bound in record pattern 11 | ) 12 | -------------------------------------------------------------------------------- /rescript.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "@rescript-labs/decco", 3 | "bs-dev-dependencies": ["@glennsl/rescript-jest"], 4 | "sources": [ 5 | { 6 | "dir": "src", 7 | "public": ["Decco"] 8 | }, 9 | { 10 | "dir": "test", 11 | "type": "dev", 12 | "subdirs": true 13 | } 14 | ], 15 | "ppx-flags": ["./ppx"], 16 | "warnings": { 17 | "number": "+A-9-40-42" 18 | }, 19 | "bsc-flags": ["-bs-super-errors"] 20 | } 21 | -------------------------------------------------------------------------------- /src/Decco.res: -------------------------------------------------------------------------------- 1 | include Decco_types 2 | 3 | let error = (~path=?, message, value) => { 4 | let path = switch path { 5 | | None => "" 6 | | Some(s) => s 7 | } 8 | Belt.Result.Error({path, message, value}) 9 | } 10 | 11 | let stringToJson = s => Js.Json.string(s) 12 | let stringFromJson = j => 13 | switch Js.Json.decodeString(j) { 14 | | Some(s) => Belt.Result.Ok(s) 15 | | None => Belt.Result.Error({path: "", message: "Not a string", value: j}) 16 | } 17 | 18 | let intToJson = i => Js.Json.number(float_of_int(i)) 19 | let intFromJson = j => 20 | switch Js.Json.decodeNumber(j) { 21 | | Some(f) => 22 | float_of_int(Js.Math.floor(f)) == f 23 | ? Belt.Result.Ok(Js.Math.floor(f)) 24 | : Belt.Result.Error({path: "", message: "Not an integer", value: j}) 25 | 26 | | _ => Belt.Result.Error({path: "", message: "Not a number", value: j}) 27 | } 28 | 29 | let int64ToJson = i => Js.Json.number(Int64.float_of_bits(i)) 30 | 31 | let int64FromJson = j => 32 | switch Js.Json.decodeNumber(j) { 33 | | Some(n) => Belt.Result.Ok(Int64.bits_of_float(n)) 34 | | None => error("Not a number", j) 35 | } 36 | 37 | let int64ToJsonUnsafe = i => Js.Json.number(Int64.to_float(i)) 38 | 39 | let int64FromJsonUnsafe = j => 40 | switch Js.Json.decodeNumber(j) { 41 | | Some(n) => Belt.Result.Ok(Int64.of_float(n)) 42 | | None => error("Not a number", j) 43 | } 44 | 45 | let floatToJson = v => Js.Json.number(v) 46 | let floatFromJson = j => 47 | switch Js.Json.decodeNumber(j) { 48 | | Some(f) => Belt.Result.Ok(f) 49 | | None => Belt.Result.Error({path: "", message: "Not a number", value: j}) 50 | } 51 | 52 | let boolToJson = v => Js.Json.boolean(v) 53 | let boolFromJson = j => 54 | switch Js.Json.decodeBoolean(j) { 55 | | Some(b) => Belt.Result.Ok(b) 56 | | None => Belt.Result.Error({path: "", message: "Not a boolean", value: j}) 57 | } 58 | 59 | let unitToJson = () => Js.Json.number(0.0) 60 | let unitFromJson = _ => Belt.Result.Ok() 61 | 62 | let arrayToJson = (encoder, arr) => Js.Json.array(Js.Array.map(encoder, arr)) 63 | 64 | let arrayFromJson = (decoder, json) => 65 | switch Js.Json.decodeArray(json) { 66 | | Some(arr) => Js.Array.reducei((acc, jsonI, i) => 67 | switch (acc, decoder(jsonI)) { 68 | | (Belt.Result.Error(_), _) => acc 69 | 70 | | (_, Belt.Result.Error({path} as error)) => 71 | Belt.Result.Error({...error, path: "[" ++ (string_of_int(i) ++ ("]" ++ path))}) 72 | 73 | | (Belt.Result.Ok(prev), Belt.Result.Ok(newVal)) => 74 | Belt.Result.Ok(Js.Array.concat([newVal], prev)) 75 | } 76 | , Belt.Result.Ok([]), arr) 77 | 78 | | None => Belt.Result.Error({path: "", message: "Not an array", value: json}) 79 | } 80 | 81 | let listToJson = (encoder, list) => arrayToJson(encoder, Array.of_list(list)) 82 | 83 | let listFromJson = (decoder, json) => 84 | (Belt.Result.mapU(_, x => Array.to_list(x)))(arrayFromJson(decoder, json)) 85 | 86 | let optionToJson = (encoder, opt) => 87 | switch opt { 88 | | Some(x) => encoder(x) 89 | | None => Js.Json.null 90 | } 91 | 92 | let optionFromJson = (decoder, json) => 93 | switch Js.Null_undefined.toOption(Js.Null_undefined.return(json)) { 94 | | None => Belt.Result.Ok(None) 95 | | Some(json) => (Belt.Result.mapU(_, v => Some(v)))(decoder(json)) 96 | } 97 | 98 | let resultToJson = (okEncoder, errorEncoder, result) => 99 | Js.Json.array( 100 | switch result { 101 | | Belt.Result.Ok(v) => [Js.Json.string("Ok"), okEncoder(v)] 102 | | Belt.Result.Error(e) => [Js.Json.string("Error"), errorEncoder(e)] 103 | }, 104 | ) 105 | 106 | let resultFromJson = (okDecoder, errorDecoder, json) => 107 | switch Js.Json.decodeArray(json) { 108 | | Some([variantConstructorId, payload]) => 109 | switch Js.Json.decodeString(variantConstructorId) { 110 | | Some("Ok") => okDecoder(payload)->Belt.Result.mapU(v => Belt.Result.Ok(v)) 111 | 112 | | Some("Error") => 113 | switch errorDecoder(payload) { 114 | | Belt.Result.Ok(v) => Belt.Result.Ok(Belt.Result.Error(v)) 115 | | Belt.Result.Error(e) => Belt.Result.Error(e) 116 | } 117 | 118 | | Some(_) => error("Expected either \"Ok\" or \"Error\"", variantConstructorId) 119 | | None => error("Not a string", variantConstructorId) 120 | } 121 | | Some(_) => error("Expected exactly 2 values in array", json) 122 | | None => error("Not an array", json) 123 | } 124 | 125 | let dictToJson = (encoder, dict) => dict->Js.Dict.map(a => encoder(a), _)->Js.Json.object_ 126 | 127 | let dictFromJson = (decoder, json) => 128 | switch Js.Json.decodeObject(json) { 129 | | Some(dict) => 130 | dict 131 | ->Js.Dict.entries 132 | ->Belt.Array.reduce(Ok(Js.Dict.empty()), (acc, (key, value)) => 133 | switch (acc, decoder(value)) { 134 | | (Error(_), _) => acc 135 | 136 | | (_, Error({path} as error)) => Error({...error, path: "." ++ (key ++ path)}) 137 | 138 | | (Ok(prev), Ok(newVal)) => 139 | let () = prev->Js.Dict.set(key, newVal) 140 | Ok(prev) 141 | } 142 | ) 143 | | None => Error({path: "", message: "Not a dict", value: json}) 144 | } 145 | 146 | /** 147 | * Merges two javascript objects together. If there are any duplicate keys, the value from the second object will be used. 148 | * This function is type-unsafe and should be used with caution. It's here to be used by generated decoder 149 | * functions for records that use spreads in their types, and these functions are careful only to pass in 150 | * objects and not other kinds of values. 151 | */ 152 | let unsafeMergeObjectsCurried = (a: 'a) => (b: 'b): 'c => { 153 | Js.Obj.assign(a->Obj.magic, b->Obj.magic)->Obj.magic 154 | } 155 | let unsafeMergeObjects = (a: 'a, b: 'b): 'c => { 156 | unsafeMergeObjectsCurried(a)(b) 157 | } 158 | 159 | /** 160 | * Adds a field to a javascript object. This function is type-unsafe and should be used with caution. It's here to be used by 161 | * generated decoder functions for records that use spreads in their types, and these functions are careful only to pass in 162 | * objects and not other kinds of values. 163 | */ 164 | let unsafeAddFieldToObject = (key: string, value: 'b, obj: 'a): 'c => { 165 | let dict = Obj.magic(obj) 166 | Js.Dict.set(dict, key, value) 167 | Obj.magic(dict) 168 | } 169 | 170 | module Codecs = { 171 | include Decco_Codecs 172 | let string = (stringToJson, stringFromJson) 173 | let int = (intToJson, intFromJson) 174 | let int64Unsafe = (int64ToJsonUnsafe, int64FromJsonUnsafe) 175 | let float = (floatToJson, floatFromJson) 176 | let bool = (boolToJson, boolFromJson) 177 | let array = (arrayToJson, arrayFromJson) 178 | let list = (listToJson, listFromJson) 179 | let option = (optionToJson, optionFromJson) 180 | let unit = (unitToJson, unitFromJson) 181 | } 182 | -------------------------------------------------------------------------------- /src/Decco_Codecs.res: -------------------------------------------------------------------------------- 1 | let falseableEncode = (encoder, opt) => 2 | switch opt { 3 | | None => Js.Json.boolean(false) 4 | | Some(v) => encoder(v) 5 | } 6 | let falseableDecode = (decoder, json) => 7 | switch Js.Json.decodeBoolean(json) { 8 | | Some(false) => Belt.Result.Ok(None) 9 | | _ => (Belt.Result.mapU(_, v => Some(v)))(decoder(json)) 10 | } 11 | let falseable = (falseableEncode, falseableDecode) 12 | 13 | let magicDecode: Decco_types.decoder<'a> = j => Belt.Result.Ok(Obj.magic(j)) 14 | let magic: Decco_types.codec<'a> = (x => Obj.magic(x), magicDecode) 15 | -------------------------------------------------------------------------------- /src/Decco_types.res: -------------------------------------------------------------------------------- 1 | type decodeError = { 2 | path: string, 3 | message: string, 4 | value: Js.Json.t, 5 | } 6 | 7 | type result<'a> = Belt.Result.t<'a, decodeError> 8 | type decoder<'a> = Js.Json.t => result<'a> 9 | type encoder<'a> = 'a => Js.Json.t 10 | type codec<'a> = (encoder<'a>, decoder<'a>) 11 | -------------------------------------------------------------------------------- /test/TestUtils.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | 4 | let testBadDecode = (name, decode, json, expectedError) => 5 | test(name, () => 6 | switch decode(json) { 7 | | Belt.Result.Error(e) => expect(expectedError)->toEqual(e) 8 | | Ok(_) => failwith("Decode erroneously succeeded") 9 | } 10 | ) 11 | 12 | let testGoodDecode = (name, decode, json, expected) => 13 | test(name, () => 14 | switch decode(json) { 15 | | Belt.Result.Ok(actual) => expect(expected)->toEqual(actual) 16 | | Belt.Result.Error({Decco.path: path, message}) => 17 | failwith(`Decode error: ${message} (${path})`) 18 | } 19 | ) 20 | 21 | let testEncode = (name, value, encode, expected: string) => 22 | test(name, () => expect(expected)->toBe(Js.Json.stringify(encode(value)))) 23 | -------------------------------------------------------------------------------- /test/__tests__/Array.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type s = string 5 | @decco type a<'a> = array<'a> 6 | 7 | describe("array", () => { 8 | testEncode("a_encode", ["10", "20"], a_encode(s_encode, ...), `["10","20"]`) 9 | 10 | describe("a_decode", () => { 11 | let json = Js.Json.array(Js.Array.map(Js.Json.string, ["10", "20"])) 12 | testGoodDecode("good", a_decode(s_decode, ...), json, ["10", "20"]) 13 | 14 | describe( 15 | "bad", 16 | () => { 17 | testBadDecode( 18 | "non-array", 19 | a_decode(s_decode, ...), 20 | Js.Json.number(12.), 21 | { 22 | message: "Not an array", 23 | path: "", 24 | value: Js.Json.number(12.), 25 | }, 26 | ) 27 | 28 | testBadDecode( 29 | "failed elem", 30 | a_decode(s_decode, ...), 31 | Js.Json.array([Js.Json.string("str"), Js.Json.number(123.)]), 32 | { 33 | message: "Not a string", 34 | path: "[1]", 35 | value: Js.Json.number(123.), 36 | }, 37 | ) 38 | }, 39 | ) 40 | }) 41 | }) 42 | -------------------------------------------------------------------------------- /test/__tests__/BeltResult.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type i = int 5 | @decco type s = string 6 | @decco type r<'v, 'e> = Belt.Result.t<'v, 'e> 7 | 8 | describe("result", () => { 9 | let enc = r_encode(s_encode, i_encode, ...) 10 | let dec = r_decode(s_decode, i_decode, ...) 11 | 12 | describe("r_encode", () => { 13 | testEncode("ok", Belt.Result.Ok("oaky"), enc, `["Ok","oaky"]`) 14 | testEncode("error", Belt.Result.Error(404), enc, `["Error",404]`) 15 | }) 16 | 17 | describe("r_decode", () => { 18 | describe( 19 | "good", 20 | () => { 21 | let json = Js.Json.parseExn("[\"Ok\",\"yess\"]") 22 | testGoodDecode("ok", dec, json, Ok("yess")) 23 | 24 | let json = Js.Json.parseExn("[\"Error\",911]") 25 | testGoodDecode("error", dec, json, Error(911)) 26 | }, 27 | ) 28 | 29 | describe( 30 | "bad", 31 | () => { 32 | let json = Js.Json.number(12.) 33 | testBadDecode( 34 | "not an array", 35 | dec, 36 | json, 37 | { 38 | path: "", 39 | message: "Not an array", 40 | value: json, 41 | }, 42 | ) 43 | 44 | let json = Js.Json.parseExn("[]") 45 | testBadDecode( 46 | "length != 2", 47 | dec, 48 | json, 49 | { 50 | path: "", 51 | message: "Expected exactly 2 values in array", 52 | value: json, 53 | }, 54 | ) 55 | 56 | let json = Js.Json.parseExn("[0,1]") 57 | testBadDecode( 58 | "constructor not a string", 59 | dec, 60 | json, 61 | { 62 | path: "", 63 | message: "Not a string", 64 | value: Js.Json.number(0.), 65 | }, 66 | ) 67 | 68 | let json = Js.Json.parseExn("[\"bad\",1]") 69 | testBadDecode( 70 | "unrecognized constructor", 71 | dec, 72 | json, 73 | { 74 | path: "", 75 | message: "Expected either \"Ok\" or \"Error\"", 76 | value: Js.Json.string("bad"), 77 | }, 78 | ) 79 | 80 | let json = Js.Json.parseExn("[\"Ok\",1]") 81 | testBadDecode( 82 | "bad Ok decode", 83 | dec, 84 | json, 85 | { 86 | path: "", 87 | message: "Not a string", 88 | value: Js.Json.number(1.), 89 | }, 90 | ) 91 | 92 | let json = Js.Json.parseExn("[\"Error\",null]") 93 | testBadDecode( 94 | "bad Error decode", 95 | dec, 96 | json, 97 | { 98 | path: "", 99 | message: "Not a number", 100 | value: Js.Json.null, 101 | }, 102 | ) 103 | }, 104 | ) 105 | }) 106 | }) 107 | -------------------------------------------------------------------------------- /test/__tests__/Bool.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type b = bool 6 | 7 | describe("bool", () => { 8 | test("b_encode", () => expect(Js.Json.JSONTrue)->toBe(Js.Json.classify(b_encode(true)))) 9 | 10 | describe("b_decode", () => { 11 | testGoodDecode("good", b_decode, Js.Json.boolean(false), false) 12 | 13 | testBadDecode( 14 | "bad", 15 | b_decode, 16 | Js.Json.string("12."), 17 | { 18 | path: "", 19 | message: "Not a boolean", 20 | value: Js.Json.string("12."), 21 | }, 22 | ) 23 | }) 24 | }) 25 | -------------------------------------------------------------------------------- /test/__tests__/CustomCodecs.res: -------------------------------------------------------------------------------- 1 | // Let's do a codec that represents numbers as ints at the type level, and strings at runtime 2 | // This can be found in the real world in cases like query strings in URLs 3 | 4 | open Jest 5 | open Expect 6 | 7 | let intToStr = (i: int) => i->string_of_int->Decco.stringToJson 8 | let intFromStr = (s: Js.Json.t) => s->Decco.stringFromJson->Belt.Result.mapU(int_of_string) 9 | 10 | @decco type intAsStr = @decco.codec((intToStr, intFromStr)) int 11 | 12 | describe("CustomCodecs", () => { 13 | test("should encode", () => { 14 | let x: intAsStr = 42 15 | 16 | let encoded = x->intAsStr_encode 17 | expect(encoded)->toBe("42"->Decco.stringToJson) 18 | }) 19 | 20 | test("should decode", () => { 21 | let encoded = "42"->Decco.stringToJson 22 | let decoded = intAsStr_decode(encoded) 23 | expect(decoded)->toEqual(Ok(42)) 24 | }) 25 | }) 26 | -------------------------------------------------------------------------------- /test/__tests__/Default.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | 4 | @decco 5 | type record = {@decco.default("default") s: string} 6 | 7 | describe("Decco @decco.default", () => { 8 | test("should use default value when key is missing", () => { 9 | let json = Js.Json.parseExn("{}") 10 | let decoded = record_decode(json) 11 | 12 | switch decoded { 13 | | Belt.Result.Ok(record) => expect(record.s)->toEqual("default") 14 | | Belt.Result.Error(_) => fail("Decoding failed") 15 | } 16 | }) 17 | }) 18 | -------------------------------------------------------------------------------- /test/__tests__/DictInt.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type d<'a> = Js.Dict.t<'a> 5 | @decco type dictInt = d 6 | 7 | describe("dictInt", () => { 8 | testEncode( 9 | "dictInt_encode", 10 | Js.Dict.fromArray([("foo", 1), ("bar", 2)]), 11 | dictInt_encode, 12 | `{"foo":1,"bar":2}`, 13 | ) 14 | 15 | describe("dictInt_decode", () => { 16 | let json = Js.Json.parseExn(`{"foo":1,"bar":2}`) 17 | testGoodDecode("good", dictInt_decode, json, Js.Dict.fromArray([("foo", 1), ("bar", 2)])) 18 | 19 | describe( 20 | "bad", 21 | () => { 22 | let badDict = Js.Json.parseExn(`{"foo":1,"bar":"baz"}`) 23 | testBadDecode( 24 | "mixed types", 25 | dictInt_decode, 26 | badDict, 27 | { 28 | path: ".bar", 29 | message: "Not a number", 30 | value: Js.Json.string("baz"), 31 | }, 32 | ) 33 | }, 34 | ) 35 | }) 36 | }) 37 | -------------------------------------------------------------------------------- /test/__tests__/Falseable.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type s = string 6 | @decco type falseable<'a> = @decco.codec(Decco.Codecs.falseable) option<'a> 7 | 8 | describe("falseable", () => { 9 | describe("falseable_encode", () => { 10 | test( 11 | "none", 12 | () => expect(Js.Json.JSONFalse)->toBe(Js.Json.classify(falseable_encode(s_encode, None))), 13 | ) 14 | 15 | test( 16 | "some", 17 | () => { 18 | let v = Some("yeah") 19 | let json = falseable_encode(s_encode, v) 20 | 21 | @ocaml.warning("-4") 22 | switch Js.Json.classify(json) { 23 | | Js.Json.JSONString(v2) => expect("yeah")->toBe(v2) 24 | | _ => failwith("Not a JSONString") 25 | } 26 | }, 27 | ) 28 | }) 29 | 30 | describe("falseable_decode", () => { 31 | describe( 32 | "good", 33 | () => { 34 | testGoodDecode("false", falseable_decode(s_decode, ...), Js.Json.boolean(false), None) 35 | testGoodDecode( 36 | "non-false", 37 | falseable_decode(s_decode, ...), 38 | Js.Json.string("heyy"), 39 | Some("heyy"), 40 | ) 41 | }, 42 | ) 43 | 44 | testBadDecode( 45 | "bad", 46 | falseable_decode(s_decode, ...), 47 | Js.Json.null, 48 | { 49 | path: "", 50 | message: "Not a string", 51 | value: Js.Json.null, 52 | }, 53 | ) 54 | }) 55 | }) 56 | -------------------------------------------------------------------------------- /test/__tests__/Float.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type f = float 6 | 7 | describe("float", () => { 8 | test("f_encode", () => { 9 | let v = 1. 10 | let json = f_encode(v) 11 | 12 | @ocaml.warning("-4") 13 | switch Js.Json.classify(json) { 14 | | Js.Json.JSONNumber(v2) => expect(v)->toBe(v2) 15 | | _ => failwith("Not a JSONNumber") 16 | } 17 | }) 18 | 19 | describe("f_decode", () => { 20 | testGoodDecode("good", f_decode, Js.Json.number(12.), 12.) 21 | 22 | testBadDecode( 23 | "bad", 24 | f_decode, 25 | Js.Json.string("12."), 26 | { 27 | path: "", 28 | message: "Not a number", 29 | value: Js.Json.string("12."), 30 | }, 31 | ) 32 | }) 33 | }) 34 | -------------------------------------------------------------------------------- /test/__tests__/Int.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type i = int 6 | 7 | describe("int", () => { 8 | test("i_encode", () => { 9 | let i = 24 10 | let json = i_encode(i) 11 | 12 | @ocaml.warning("-4") 13 | switch Js.Json.classify(json) { 14 | | Js.Json.JSONNumber(i2) => expect(float_of_int(i))->toBe(i2) 15 | | _ => failwith("Not a JSONNumber") 16 | } 17 | }) 18 | 19 | describe("i_decode", () => { 20 | testGoodDecode("good", i_decode, Js.Json.number(414.), 414) 21 | 22 | describe( 23 | "bad", 24 | () => { 25 | let json = Js.Json.string("12.") 26 | testBadDecode( 27 | "not a number", 28 | i_decode, 29 | json, 30 | { 31 | path: "", 32 | message: "Not a number", 33 | value: json, 34 | }, 35 | ) 36 | 37 | let json = Js.Json.number(5.1) 38 | testBadDecode( 39 | "not an int", 40 | i_decode, 41 | json, 42 | { 43 | path: "", 44 | message: "Not an integer", 45 | value: json, 46 | }, 47 | ) 48 | }, 49 | ) 50 | }) 51 | }) 52 | -------------------------------------------------------------------------------- /test/__tests__/JsJson.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type j = Js.Json.t 6 | 7 | describe("Js.Json.t", () => { 8 | test("j_encode", () => { 9 | let v = Js.Json.string("jay") 10 | let json = j_encode(v) 11 | expect(json)->toBe(v) 12 | }) 13 | 14 | let json = Js.Json.number(12.) 15 | testGoodDecode("j_decode", j_decode, json, json) 16 | }) 17 | -------------------------------------------------------------------------------- /test/__tests__/Key.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | 4 | @decco 5 | type record = {@decco.key("customKey") s: string} 6 | 7 | describe("Decco @decco.key", () => { 8 | test("should decode value from custom key", () => { 9 | let json = Js.Json.parseExn(`{"customKey": "value"}`) 10 | let decoded = record_decode(json) 11 | 12 | switch decoded { 13 | | Belt.Result.Ok(record) => expect(record.s)->toEqual("value") 14 | | Belt.Result.Error(_) => fail("Decoding failed") 15 | } 16 | }) 17 | }) 18 | -------------------------------------------------------------------------------- /test/__tests__/Ldot.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | open TestModFunctor 5 | 6 | describe("Ldot", () => { 7 | test("dependentOnTestMod_encode", () => { 8 | let s = TestMod.mkT("yeah") 9 | let json = dependentOnTestMod_encode(s) 10 | 11 | @ocaml.warning("-4") 12 | switch Js.Json.classify(json) { 13 | | Js.Json.JSONString(s2) => expect(s)->toBe(TestMod.mkT(s2)) 14 | | _ => failwith("Not a JSONString") 15 | } 16 | }) 17 | 18 | describe("dependentOnTestMod_decode", () => { 19 | testGoodDecode("good", dependentOnTestMod_decode, Js.Json.string("heyy"), TestMod.mkT("heyy")) 20 | 21 | testBadDecode( 22 | "bad", 23 | dependentOnTestMod_decode, 24 | Js.Json.number(12.), 25 | { 26 | path: "", 27 | message: "Not a string", 28 | value: Js.Json.number(12.), 29 | }, 30 | ) 31 | }) 32 | }) 33 | -------------------------------------------------------------------------------- /test/__tests__/List.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type s = string 5 | @decco type l<'a> = list<'a> 6 | 7 | describe("list", () => { 8 | testEncode("l_encode", list{"10", "20"}, l_encode(s_encode, ...), `["10","20"]`) 9 | 10 | describe("l_decode", () => { 11 | let json = Js.Json.array(Js.Array.map(Js.Json.string, ["10", "20"])) 12 | testGoodDecode("good", l_decode(s_decode, ...), json, list{"10", "20"}) 13 | 14 | describe( 15 | "bad", 16 | () => { 17 | testBadDecode( 18 | "non-array", 19 | l_decode(s_decode, ...), 20 | Js.Json.number(12.), 21 | { 22 | message: "Not an array", 23 | path: "", 24 | value: Js.Json.number(12.), 25 | }, 26 | ) 27 | 28 | testBadDecode( 29 | "failed elem", 30 | l_decode(s_decode, ...), 31 | Js.Json.array([Js.Json.string("str"), Js.Json.number(123.)]), 32 | { 33 | message: "Not a string", 34 | path: "[1]", 35 | value: Js.Json.number(123.), 36 | }, 37 | ) 38 | }, 39 | ) 40 | }) 41 | }) 42 | -------------------------------------------------------------------------------- /test/__tests__/LongPath.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type bigV = V(array>>) 6 | @decco type bigR = {bigV: bigV} 7 | 8 | describe("long path", () => { 9 | test("good", () => { 10 | let v = {bigV: V([Some(list{"yes"})])} 11 | let decoded = bigR_decode(bigR_encode(v)) 12 | switch decoded { 13 | | Belt.Result.Error(_) => failwith("Decode failure") 14 | | Belt.Result.Ok(actual) => expect(actual->Js.Json.stringifyAny)->toBe(v->Js.Json.stringifyAny) 15 | } 16 | }) 17 | 18 | describe("bad", () => { 19 | let json = Js.Json.parseExn(`{"bigV":["V",[null,["","",1]]]}`) 20 | testBadDecode( 21 | "bad", 22 | bigR_decode, 23 | json, 24 | { 25 | path: ".bigV[0][1][2]", 26 | message: "Not a string", 27 | value: Js.Json.number(1.), 28 | }, 29 | ) 30 | }) 31 | }) 32 | -------------------------------------------------------------------------------- /test/__tests__/Magic.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type magic = @decco.codec(Decco.Codecs.magic) int 5 | 6 | describe("magic", () => { 7 | let i = 24 8 | testGoodDecode("", magic_decode, magic_encode(i), i) 9 | }) 10 | -------------------------------------------------------------------------------- /test/__tests__/OpenBelt.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @warning("-33") 5 | open Belt 6 | 7 | open Decco 8 | 9 | @decco type variant = A | B(int) | C(int, string) 10 | 11 | describe("variant", () => { 12 | describe("variant_encode", () => { 13 | testEncode("A", A, variant_encode, `["A"]`) 14 | testEncode("B", B(5), variant_encode, `["B",5]`) 15 | testEncode("C", C(7, "8"), variant_encode, `["C",7,"8"]`) 16 | }) 17 | 18 | describe("variant_decode", () => { 19 | describe( 20 | "good", 21 | () => { 22 | let json = Js.Json.parseExn(`["A"]`) 23 | testGoodDecode("A", variant_decode, json, A) 24 | let json = Js.Json.parseExn(`["B",5]`) 25 | testGoodDecode("B", variant_decode, json, B(5)) 26 | let json = Js.Json.parseExn(`["C",7,"8"]`) 27 | testGoodDecode("C", variant_decode, json, C(7, "8")) 28 | }, 29 | ) 30 | 31 | describe( 32 | "bad", 33 | () => { 34 | testBadDecode( 35 | "non-variant", 36 | variant_decode, 37 | Js.Json.number(12.), 38 | { 39 | path: "", 40 | message: "Not a variant", 41 | value: Js.Json.number(12.), 42 | }, 43 | ) 44 | 45 | let json = Js.Json.parseExn(`["D"]`) 46 | testBadDecode( 47 | "bad constructor", 48 | variant_decode, 49 | json, 50 | { 51 | path: "", 52 | message: "Invalid variant constructor", 53 | value: Js.Json.string("D"), 54 | }, 55 | ) 56 | 57 | let json = Js.Json.parseExn(`["A",1]`) 58 | testBadDecode( 59 | "too many arguments", 60 | variant_decode, 61 | json, 62 | { 63 | path: "", 64 | message: "Invalid number of arguments to variant constructor", 65 | value: json, 66 | }, 67 | ) 68 | 69 | let json = Js.Json.parseExn(`[]`) 70 | testBadDecode( 71 | "no arguments", 72 | variant_decode, 73 | json, 74 | { 75 | path: "", 76 | message: "Expected variant, found empty array", 77 | value: json, 78 | }, 79 | ) 80 | 81 | let json = Js.Json.parseExn(`["B"]`) 82 | testBadDecode( 83 | "not enough arguments", 84 | variant_decode, 85 | json, 86 | { 87 | path: "", 88 | message: "Invalid number of arguments to variant constructor", 89 | value: json, 90 | }, 91 | ) 92 | 93 | let json = Js.Json.parseExn(`["B","oh"]`) 94 | testBadDecode( 95 | "invalid argument", 96 | variant_decode, 97 | json, 98 | { 99 | path: "[0]", 100 | message: "Not a number", 101 | value: Js.Json.string("oh"), 102 | }, 103 | ) 104 | }, 105 | ) 106 | }) 107 | }) 108 | -------------------------------------------------------------------------------- /test/__tests__/Option.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type s = string 6 | @decco type o<'a> = option<'a> 7 | 8 | describe("option", () => { 9 | describe("o_encode", () => { 10 | test("none", () => expect(Js.Json.classify(o_encode(s_encode, None)))->toBe(Js.Json.JSONNull)) 11 | 12 | test( 13 | "some", 14 | () => { 15 | let v = Some("yeah") 16 | let json = o_encode(s_encode, v) 17 | 18 | @ocaml.warning("-4") 19 | switch Js.Json.classify(json) { 20 | | Js.Json.JSONString(v2) => expect(v2)->toBe("yeah") 21 | | _ => failwith("Not a JSONString") 22 | } 23 | }, 24 | ) 25 | }) 26 | 27 | describe("o_decode", () => { 28 | describe( 29 | "good", 30 | () => { 31 | testGoodDecode("null", o_decode(s_decode, ...), Js.Json.null, None) 32 | testGoodDecode("undefined", o_decode(s_decode, ...), %raw(`undefined`), None) 33 | testGoodDecode("non-null", o_decode(s_decode, ...), Js.Json.string("heyy"), Some("heyy")) 34 | }, 35 | ) 36 | 37 | testBadDecode( 38 | "bad", 39 | o_decode(s_decode, ...), 40 | Js.Json.number(12.), 41 | { 42 | path: "", 43 | message: "Not a string", 44 | value: Js.Json.number(12.), 45 | }, 46 | ) 47 | }) 48 | }) 49 | -------------------------------------------------------------------------------- /test/__tests__/OptionList.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type s = string 5 | @decco type l<'a> = list<'a> 6 | @decco type o<'a> = option<'a> 7 | @decco type optionList = l> 8 | 9 | describe("optionList", () => { 10 | testEncode( 11 | "optionList_encode", 12 | list{Some("a"), None, Some("b")}, 13 | optionList_encode, 14 | `["a",null,"b"]`, 15 | ) 16 | 17 | describe("optionList_decode", () => { 18 | let json = Js.Json.parseExn(`["a",null,"b"]`) 19 | testGoodDecode("good", optionList_decode, json, list{Some("a"), None, Some("b")}) 20 | 21 | describe( 22 | "bad", 23 | () => { 24 | testBadDecode( 25 | "non-array", 26 | optionList_decode, 27 | Js.Json.number(12.), 28 | { 29 | path: "", 30 | message: "Not an array", 31 | value: Js.Json.number(12.), 32 | }, 33 | ) 34 | 35 | let json = Js.Json.parseExn(`[null, 3]`) 36 | testBadDecode( 37 | "non-string", 38 | optionList_decode, 39 | json, 40 | { 41 | path: "[1]", 42 | message: "Not a string", 43 | value: Js.Json.number(3.), 44 | }, 45 | ) 46 | }, 47 | ) 48 | }) 49 | }) 50 | -------------------------------------------------------------------------------- /test/__tests__/Polyvariant.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type s = string 5 | @decco type i = int 6 | @decco type polyvariant = [#A | #B(i) | #C(i, s)] 7 | 8 | describe("polyvariant", () => { 9 | describe("polyvariant_encode", () => { 10 | testEncode("A", #A, polyvariant_encode, `["A"]`) 11 | testEncode("B", #B(5), polyvariant_encode, `["B",5]`) 12 | testEncode("C", #C(7, "8"), polyvariant_encode, `["C",7,"8"]`) 13 | }) 14 | 15 | describe("polyvariant_decode", () => { 16 | describe( 17 | "good", 18 | () => { 19 | let json = Js.Json.parseExn(`["A"]`) 20 | testGoodDecode("A", polyvariant_decode, json, #A) 21 | let json = Js.Json.parseExn(`["B",5]`) 22 | testGoodDecode("B", polyvariant_decode, json, #B(5)) 23 | let json = Js.Json.parseExn(`["C",7,"8"]`) 24 | testGoodDecode("C", polyvariant_decode, json, #C(7, "8")) 25 | }, 26 | ) 27 | describe( 28 | "bad", 29 | () => { 30 | testBadDecode( 31 | "non-polyvariant", 32 | polyvariant_decode, 33 | Js.Json.number(12.), 34 | {path: "", message: "Not a polyvariant", value: Js.Json.number(12.)}, 35 | ) 36 | 37 | let json = Js.Json.parseExn(`["D"]`) 38 | testBadDecode( 39 | "bad constructor", 40 | polyvariant_decode, 41 | json, 42 | { 43 | path: "", 44 | message: "Invalid polyvariant constructor", 45 | value: Js.Json.string("D"), 46 | }, 47 | ) 48 | 49 | let json = Js.Json.parseExn(`["A",1]`) 50 | testBadDecode( 51 | "too many arguments", 52 | polyvariant_decode, 53 | json, 54 | { 55 | path: "", 56 | message: "Invalid number of arguments to polyvariant constructor", 57 | value: json, 58 | }, 59 | ) 60 | 61 | let json = Js.Json.parseExn(`[]`) 62 | testBadDecode( 63 | "no arguments", 64 | polyvariant_decode, 65 | json, 66 | { 67 | path: "", 68 | message: "Expected polyvariant, found empty array", 69 | value: json, 70 | }, 71 | ) 72 | 73 | let json = Js.Json.parseExn(`["B"]`) 74 | testBadDecode( 75 | "not enough arguments", 76 | polyvariant_decode, 77 | json, 78 | { 79 | path: "", 80 | message: "Invalid number of arguments to polyvariant constructor", 81 | value: json, 82 | }, 83 | ) 84 | 85 | let json = Js.Json.parseExn(`["B","oh"]`) 86 | testBadDecode( 87 | "invalid argument", 88 | polyvariant_decode, 89 | json, 90 | {path: "[0]", message: "Not a number", value: Js.Json.string("oh")}, 91 | ) 92 | }, 93 | ) 94 | }) 95 | }) 96 | -------------------------------------------------------------------------------- /test/__tests__/Record.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type s = string 5 | @decco type i = int 6 | @decco type o<'a> = option<'a> 7 | @decco 8 | type record = { 9 | hey: s, 10 | opt: option, 11 | o: o, 12 | @decco.default(1.0) f: float, 13 | @decco.key("other_key") otherKey: string, 14 | } 15 | 16 | describe("record", () => { 17 | testEncode( 18 | "record_encode", 19 | {hey: "hey", opt: Some(100), o: Some(99), f: 1.5, otherKey: "!"}, 20 | record_encode, 21 | `{"hey":"hey","opt":100,"o":99,"f":1.5,"other_key":"!"}`, 22 | ) 23 | 24 | describe("record_decode", () => { 25 | describe( 26 | "good", 27 | () => { 28 | let json = Js.Json.parseExn(`{"hey":"hey","opt":100,"o":99,"f":1.5,"other_key":"!"}`) 29 | testGoodDecode( 30 | "base case", 31 | record_decode, 32 | json, 33 | {hey: "hey", opt: Some(100), o: Some(99), f: 1.5, otherKey: "!"}, 34 | ) 35 | 36 | let json = Js.Json.parseExn(`{"hey":"hey","other_key":"!"}`) 37 | testGoodDecode( 38 | "missing optional", 39 | record_decode, 40 | json, 41 | {hey: "hey", opt: None, o: None, f: 1.0, otherKey: "!"}, 42 | ) 43 | 44 | let json: Js.Json.t = %raw(`{"hey":"hey","other_key":"!","opt": undefined}`) 45 | testGoodDecode( 46 | "optional field set to undefined", 47 | record_decode, 48 | json, 49 | {hey: "hey", opt: None, o: None, f: 1.0, otherKey: "!"}, 50 | ) 51 | }, 52 | ) 53 | 54 | describe( 55 | "bad", 56 | () => { 57 | testBadDecode( 58 | "non-object", 59 | record_decode, 60 | Js.Json.number(12.), 61 | { 62 | path: "", 63 | message: "Not an object", 64 | value: Js.Json.number(12.), 65 | }, 66 | ) 67 | 68 | let json = Js.Json.parseExn(`{"ya":100}`) 69 | testBadDecode( 70 | "missing field", 71 | record_decode, 72 | json, 73 | { 74 | path: ".hey", 75 | message: "Not a string", 76 | value: Js.Json.null, 77 | }, 78 | ) 79 | 80 | let json = Js.Json.parseExn(`{"hey":9,"ya":10}`) 81 | testBadDecode( 82 | "invalid field type", 83 | record_decode, 84 | json, 85 | { 86 | path: ".hey", 87 | message: "Not a string", 88 | value: Js.Json.number(9.), 89 | }, 90 | ) 91 | }, 92 | ) 93 | }) 94 | }) 95 | -------------------------------------------------------------------------------- /test/__tests__/RecordSpreads.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | 4 | module A = { 5 | @decco 6 | type t = {first_name: string} 7 | @decco 8 | type b = {last_name: string} 9 | module Nested = { 10 | @decco 11 | type t = {pizza: string} 12 | } 13 | } 14 | 15 | @decco 16 | type t = { 17 | ...A.t, 18 | ...A.b, 19 | ...A.Nested.t, 20 | age: int, 21 | } 22 | 23 | describe("record spreading", () => { 24 | test("should encode", () => { 25 | let v: t = { 26 | first_name: "bob", 27 | last_name: "pizza", 28 | age: 3, 29 | pizza: "pie", 30 | } 31 | 32 | let encoded = t_encode(v) 33 | 34 | expect(Js.Json.stringify(encoded))->toBe( 35 | {"first_name": "bob", "last_name": "pizza", "pizza": "pie", "age": 3} 36 | ->Obj.magic 37 | ->Js.Json.stringify, 38 | ) 39 | }) 40 | 41 | test("should decode", () => { 42 | let json = Js.Json.parseExn(`{"first_name":"bob","last_name":"pizza","age":3, "pizza": "pie"}`) 43 | let decoded = t_decode(json) 44 | 45 | expect(decoded->Belt.Result.mapU(x => (x.first_name, x.last_name, x.age, x.pizza)))->toEqual( 46 | Ok(("bob", "pizza", 3, "pie")), 47 | ) 48 | }) 49 | }) 50 | -------------------------------------------------------------------------------- /test/__tests__/Recursion.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | module type Rec = { 5 | @decco type rec basic = Basic(basic) | End 6 | @decco type rec nested = Nested(option) 7 | @decco type rec tuple = Tuple((int, tuple)) | End 8 | @decco type rec record = {r: option} 9 | } 10 | 11 | module Rec: Rec = { 12 | @decco type rec basic = Basic(basic) | End 13 | @decco type rec nested = Nested(option) 14 | @decco type rec tuple = Tuple((int, tuple)) | End 15 | @decco type rec record = {r: option} 16 | } 17 | 18 | module MutuallyRec = { 19 | @decco 20 | type rec inttree = 21 | | Empty 22 | | Node(node) 23 | @decco 24 | and node = { 25 | value: int, 26 | left: inttree, 27 | right: inttree, 28 | } 29 | } 30 | 31 | @decco type nonRecVariant = int 32 | @decco type nonRecRecord = int 33 | 34 | module type NonRec = { 35 | @decco type nonRecVariant = Var(nonRecVariant) 36 | @decco type nonRecRecord = {num: nonRecRecord} 37 | } 38 | 39 | module NonRec: NonRec = { 40 | @decco type nonRecVariant = Var(nonRecVariant) 41 | @decco type nonRecRecord = {num: nonRecRecord} 42 | } 43 | 44 | describe("variant", () => { 45 | describe("basic", () => { 46 | let v = Rec.Basic(Basic(End)) 47 | let jsonStr = `["Basic",["Basic",["End"]]]` 48 | 49 | testEncode("encode", v, Rec.basic_encode, jsonStr) 50 | testGoodDecode("decode", Rec.basic_decode, Js.Json.parseExn(jsonStr), v) 51 | }) 52 | 53 | describe("nested", () => { 54 | let v = Rec.Nested(Some(Nested(None))) 55 | let jsonStr = `["Nested",["Nested",null]]` 56 | 57 | testEncode("encode", v, Rec.nested_encode, jsonStr) 58 | testGoodDecode("decode", Rec.nested_decode, Js.Json.parseExn(jsonStr), v) 59 | }) 60 | 61 | describe("tuple", () => { 62 | let v = Rec.Tuple((0, Tuple((1, End)))) 63 | let jsonStr = `["Tuple",[0,["Tuple",[1,["End"]]]]]` 64 | 65 | testEncode("encode", v, Rec.tuple_encode, jsonStr) 66 | testGoodDecode("decode", Rec.tuple_decode, Js.Json.parseExn(jsonStr), v) 67 | }) 68 | 69 | describe("nonrec", () => { 70 | let v = NonRec.Var(5) 71 | let jsonStr = `["Var",5]` 72 | 73 | testEncode("encode", v, NonRec.nonRecVariant_encode, jsonStr) 74 | testGoodDecode("decode", NonRec.nonRecVariant_decode, Js.Json.parseExn(jsonStr), v) 75 | }) 76 | }) 77 | 78 | describe("record", () => { 79 | describe("rec", () => { 80 | let v = {Rec.r: Some({r: None})} 81 | let jsonStr = `{"r":{"r":null}}` 82 | 83 | testEncode("encode", v, Rec.record_encode, jsonStr) 84 | testGoodDecode("decode", Rec.record_decode, Js.Json.parseExn(jsonStr), v) 85 | }) 86 | 87 | describe("nonrec", () => { 88 | let v = {NonRec.num: 72} 89 | let jsonStr = `{"num":72}` 90 | 91 | testEncode("encode", v, NonRec.nonRecRecord_encode, jsonStr) 92 | testGoodDecode("decode", NonRec.nonRecRecord_decode, Js.Json.parseExn(jsonStr), v) 93 | }) 94 | }) 95 | 96 | describe("mutually recursive", () => { 97 | describe("basic", () => { 98 | let v = MutuallyRec.Node({ 99 | value: 0, 100 | left: Empty, 101 | right: Empty, 102 | }) 103 | let jsonStr = `["Node",{"value":0,"left":["Empty"],"right":["Empty"]}]` 104 | 105 | testEncode("encode", v, MutuallyRec.inttree_encode, jsonStr) 106 | testGoodDecode("decode", MutuallyRec.inttree_decode, Js.Json.parseExn(jsonStr), v) 107 | }) 108 | 109 | describe("nested", () => { 110 | let v = MutuallyRec.Node({ 111 | value: 0, 112 | left: Node({ 113 | value: 1, 114 | left: Empty, 115 | right: Empty, 116 | }), 117 | right: Node({ 118 | value: 2, 119 | left: Empty, 120 | right: Empty, 121 | }), 122 | }) 123 | let jsonStr = `["Node",{"value":0,"left":["Node",{"value":1,"left":["Empty"],"right":["Empty"]}],"right":["Node",{"value":2,"left":["Empty"],"right":["Empty"]}]}]` 124 | 125 | testEncode("encode", v, MutuallyRec.inttree_encode, jsonStr) 126 | testGoodDecode("decode", MutuallyRec.inttree_decode, Js.Json.parseExn(jsonStr), v) 127 | }) 128 | }) 129 | -------------------------------------------------------------------------------- /test/__tests__/SimpleVar.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type s = string 6 | @decco type simpleVar<'a> = 'a 7 | 8 | describe("simpleVar", () => { 9 | test("simpleVar_encode", () => { 10 | let v: simpleVar = "yeah" 11 | let json = simpleVar_encode(s_encode, v) 12 | 13 | @ocaml.warning("-4") 14 | switch Js.Json.classify(json) { 15 | | Js.Json.JSONString(v2) => expect(v2)->toBe("yeah") 16 | | _ => failwith("Not a JSONString") 17 | } 18 | }) 19 | 20 | describe("simpleVar_decode", () => { 21 | testGoodDecode("good", simpleVar_decode(s_decode, ...), Js.Json.string("yeah"), "yeah") 22 | 23 | testBadDecode( 24 | "bad", 25 | simpleVar_decode(s_decode, ...), 26 | Js.Json.number(12.), 27 | { 28 | path: "", 29 | message: "Not a string", 30 | value: Js.Json.number(12.), 31 | }, 32 | ) 33 | }) 34 | }) 35 | -------------------------------------------------------------------------------- /test/__tests__/String.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type s = string 6 | 7 | describe("string", () => { 8 | test("s_encode", () => { 9 | let s = "yeah" 10 | let json = s_encode(s) 11 | 12 | @ocaml.warning("-4") 13 | switch Js.Json.classify(json) { 14 | | Js.Json.JSONString(s2) => expect(s2)->toBe(s) 15 | | _ => failwith("Not a JSONString") 16 | } 17 | }) 18 | 19 | describe("s_decode", () => { 20 | testGoodDecode("good", s_decode, Js.Json.string("heyy"), "heyy") 21 | 22 | testBadDecode( 23 | "bad", 24 | s_decode, 25 | Js.Json.number(12.), 26 | { 27 | path: "", 28 | message: "Not a string", 29 | value: Js.Json.number(12.), 30 | }, 31 | ) 32 | }) 33 | }) 34 | -------------------------------------------------------------------------------- /test/__tests__/Tuple.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type t = (int, string) 5 | 6 | describe("tuple", () => { 7 | testEncode("t_encode", (10, "ten"), t_encode, `[10,"ten"]`) 8 | 9 | describe("t_decode", () => { 10 | let json = Js.Json.parseExn(`[10,"ten"]`) 11 | testGoodDecode("good", t_decode, json, (10, "ten")) 12 | 13 | describe( 14 | "bad", 15 | () => { 16 | let json = Js.Json.number(12.) 17 | testBadDecode( 18 | "non-array", 19 | t_decode, 20 | json, 21 | { 22 | path: "", 23 | message: "Not a tuple", 24 | value: json, 25 | }, 26 | ) 27 | 28 | let json = Js.Json.parseExn(`[10]`) 29 | testBadDecode( 30 | "non-string", 31 | t_decode, 32 | json, 33 | { 34 | path: "", 35 | message: "Incorrect cardinality", 36 | value: json, 37 | }, 38 | ) 39 | 40 | let json = Js.Json.parseExn(`[10,10]`) 41 | testBadDecode( 42 | "non-string", 43 | t_decode, 44 | json, 45 | { 46 | path: "[1]", 47 | message: "Not a string", 48 | value: Js.Json.number(10.), 49 | }, 50 | ) 51 | }, 52 | ) 53 | }) 54 | }) 55 | -------------------------------------------------------------------------------- /test/__tests__/Unboxed.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @unboxed @decco 5 | type v = V(string) 6 | @unboxed @decco 7 | type r = {r: int} 8 | 9 | describe("unboxed", () => { 10 | describe("variant", () => { 11 | let v = V("xyz") 12 | let jsonStr = `"xyz"` 13 | 14 | testEncode("encode", v, v_encode, jsonStr) 15 | testGoodDecode("decode", v_decode, Js.Json.parseExn(jsonStr), v) 16 | }) 17 | 18 | describe("record", () => { 19 | let v = {r: 101} 20 | let jsonStr = `101` 21 | 22 | testEncode("encode", v, r_encode, jsonStr) 23 | testGoodDecode("decode", r_decode, Js.Json.parseExn(jsonStr), v) 24 | }) 25 | }) 26 | -------------------------------------------------------------------------------- /test/__tests__/Unit.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open Expect 3 | open TestUtils 4 | 5 | @decco type u = unit 6 | 7 | describe("unit", () => { 8 | test("u_encode", () => { 9 | let json = u_encode() 10 | 11 | @ocaml.warning("-4") 12 | switch Js.Json.classify(json) { 13 | | Js.Json.JSONNumber(n) => expect(n)->toBe(0.) 14 | | _ => failwith("Not a JSONNumber") 15 | } 16 | }) 17 | 18 | testGoodDecode("u_decode", u_decode, Js.Json.number(0.), ()) 19 | }) 20 | -------------------------------------------------------------------------------- /test/__tests__/VarTypeInsideModule.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | open TestModFunctor 4 | 5 | describe("TestMod.varType", () => { 6 | testEncode( 7 | "varType_encode", 8 | TestMod.mkVarType(5, "yay"), 9 | TestMod.varType_encode(Decco.intToJson, Decco.stringToJson, ...), 10 | `[5,"yay"]`, 11 | ) 12 | 13 | let json = Js.Json.parseExn(`[5,"yay"]`) 14 | testGoodDecode( 15 | "varType_decode", 16 | TestMod.varType_decode(Decco.intFromJson, Decco.stringFromJson, ...), 17 | json, 18 | TestMod.mkVarType(5, "yay"), 19 | ) 20 | }) 21 | -------------------------------------------------------------------------------- /test/__tests__/Variant.res: -------------------------------------------------------------------------------- 1 | open Jest 2 | open TestUtils 3 | 4 | @decco type i = int 5 | @decco type s = string 6 | @decco type variant = A | B(i) | C(i, s) 7 | 8 | describe("variant", () => { 9 | describe("variant_encode", () => { 10 | testEncode("A", A, variant_encode, `["A"]`) 11 | testEncode("B", B(5), variant_encode, `["B",5]`) 12 | testEncode("C", C(7, "8"), variant_encode, `["C",7,"8"]`) 13 | }) 14 | 15 | describe("variant_decode", () => { 16 | describe( 17 | "good", 18 | () => { 19 | let json = Js.Json.parseExn(`["A"]`) 20 | testGoodDecode("A", variant_decode, json, A) 21 | let json = Js.Json.parseExn(`["B",5]`) 22 | testGoodDecode("B", variant_decode, json, B(5)) 23 | let json = Js.Json.parseExn(`["C",7,"8"]`) 24 | testGoodDecode("C", variant_decode, json, C(7, "8")) 25 | }, 26 | ) 27 | 28 | describe( 29 | "bad", 30 | () => { 31 | testBadDecode( 32 | "non-variant", 33 | variant_decode, 34 | Js.Json.number(12.), 35 | { 36 | path: "", 37 | message: "Not a variant", 38 | value: Js.Json.number(12.), 39 | }, 40 | ) 41 | 42 | let json = Js.Json.parseExn(`["D"]`) 43 | testBadDecode( 44 | "bad constructor", 45 | variant_decode, 46 | json, 47 | { 48 | path: "", 49 | message: "Invalid variant constructor", 50 | value: Js.Json.string("D"), 51 | }, 52 | ) 53 | 54 | let json = Js.Json.parseExn(`["A",1]`) 55 | testBadDecode( 56 | "too many arguments", 57 | variant_decode, 58 | json, 59 | { 60 | path: "", 61 | message: "Invalid number of arguments to variant constructor", 62 | value: json, 63 | }, 64 | ) 65 | 66 | let json = Js.Json.parseExn(`[]`) 67 | testBadDecode( 68 | "no arguments", 69 | variant_decode, 70 | json, 71 | { 72 | path: "", 73 | message: "Expected variant, found empty array", 74 | value: json, 75 | }, 76 | ) 77 | 78 | let json = Js.Json.parseExn(`["B"]`) 79 | testBadDecode( 80 | "not enough arguments", 81 | variant_decode, 82 | json, 83 | { 84 | path: "", 85 | message: "Invalid number of arguments to variant constructor", 86 | value: json, 87 | }, 88 | ) 89 | 90 | let json = Js.Json.parseExn(`["B","oh"]`) 91 | testBadDecode( 92 | "invalid argument", 93 | variant_decode, 94 | json, 95 | { 96 | path: "[0]", 97 | message: "Not a number", 98 | value: Js.Json.string("oh"), 99 | }, 100 | ) 101 | }, 102 | ) 103 | }) 104 | }) 105 | -------------------------------------------------------------------------------- /test/compiler_only_tests/ParameterizedRecords.res: -------------------------------------------------------------------------------- 1 | // At one point we had a regression where 2 | // the PPX failed to generate the type parameters 3 | // for the type of the decoder when using a parameterized 4 | // record. This test ensures that the issue is fixed. 5 | @decco 6 | type t<'param> = {blob: 'param} 7 | -------------------------------------------------------------------------------- /test/compiler_only_tests/ReadMe.md: -------------------------------------------------------------------------------- 1 | This directory just contains rescript files that will be typechecked when `rescript build` runs. They don't run jest tests. But if they have a compiler error, they should fail the build. 2 | -------------------------------------------------------------------------------- /test/functors/DecOnlyFunctor.res: -------------------------------------------------------------------------------- 1 | module type DecOnly = { 2 | @decco.decode type t 3 | } 4 | module DecOnly: DecOnly = { 5 | let t_encode = 1 6 | @decco.decode type t = int 7 | ignore(t_encode + 1) 8 | } 9 | -------------------------------------------------------------------------------- /test/functors/EncOnlyFunctor.res: -------------------------------------------------------------------------------- 1 | module type EncOnly = { 2 | @decco.encode type t 3 | } 4 | module EncOnly: EncOnly = { 5 | let t_decode = 1 6 | @decco.encode type t = int 7 | ignore(t_decode + 1) 8 | @@ocaml.doc(" this won't typecheck if t_decode is generated ") 9 | } 10 | -------------------------------------------------------------------------------- /test/functors/TestModFunctor.res: -------------------------------------------------------------------------------- 1 | module type TestMod = { 2 | @decco type t 3 | @decco type varType<'a, 'b> 4 | 5 | let mkT: string => t 6 | let mkVarType: ('a, 'b) => varType<'a, 'b> 7 | } 8 | 9 | module TestMod: TestMod = { 10 | @decco type t = string 11 | @decco type varType<'a, 'b> = ('a, 'b) 12 | 13 | let mkT = (s: string): t => s 14 | let mkVarType = (a, b) => (a, b) 15 | } 16 | 17 | @decco type dependentOnTestMod = TestMod.t 18 | --------------------------------------------------------------------------------