├── .github ├── dependabot.yml └── workflows │ └── workflow.yml ├── .gitignore ├── .ocp-indent ├── CHANGES.md ├── CLASSES.md ├── IMPLGEN.md ├── INSTALL_AND_USE.md ├── LICENSE ├── LOW_LEVEL_BINDING.md ├── Makefile ├── NAMING.md ├── PPX.md ├── README.md ├── TODO.md ├── TYPES.md ├── VALUES.md ├── dune ├── dune-project ├── examples ├── calc │ ├── calc.html │ ├── calc.ml │ └── dune ├── misc │ ├── dune │ ├── jquery.mli │ ├── js_date.mli │ ├── js_str.mli │ ├── test_jquery.html │ └── test_jquery.ml └── test │ ├── dune │ ├── main.html │ ├── main.ml │ └── test_bindings.mli ├── gen_js_api.opam ├── lib ├── dune ├── ojs.ml ├── ojs.mli ├── ojs_exn.ml ├── ojs_exn.mli ├── ojs_runtime.js └── ojs_runtime_stubs.c ├── node-test ├── bindings │ ├── arrays.mli │ ├── buffer.mli │ ├── console.mli │ ├── container.ml │ ├── container.mli │ ├── dune │ ├── errors.mli │ ├── expected │ │ ├── arrays.ml │ │ ├── buffer.ml │ │ ├── console.ml │ │ ├── errors.ml │ │ ├── fs.ml │ │ ├── global.ml │ │ ├── imports.ml │ │ ├── number.ml │ │ ├── path.ml │ │ ├── process.ml │ │ └── promise.ml │ ├── fs.mli │ ├── global.mli │ ├── imports.js │ ├── imports.mli │ ├── number.mli │ ├── path.mli │ ├── process.mli │ └── promise.mli └── test1 │ ├── dune │ ├── recursive.js │ ├── recursive.mli │ └── test.ml ├── ojs.opam ├── ojs.opam.template ├── ppx-driver ├── dune └── gen_js_api_ppx_driver.ml ├── ppx-lib ├── dune ├── gen_js_api_ppx.ml └── gen_js_api_ppx.mli ├── ppx-standalone ├── dune ├── gen_js_api.ml └── gen_js_api.mli └── ppx-test ├── binding.mli ├── binding_automatic.mli ├── binding_explicitly_automatic.mli ├── binding_manual.mli ├── dune ├── expected ├── binding.ml ├── binding_automatic.ml ├── extension.ml ├── first_class_modules.ml ├── issues.ml ├── issues_mli.ml ├── modules.ml ├── recursive_modules.ml ├── scoped.ml ├── types.ml └── union_and_enum.ml ├── extension.ml ├── first_class_modules.mli ├── issues.ml ├── issues_mli.mli ├── modules.mli ├── ppx ├── dune └── main.ml ├── recursive_modules.mli ├── scoped.mli ├── types.ml └── union_and_enum.mli /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: github-actions 4 | directory: / 5 | schedule: 6 | interval: daily 7 | -------------------------------------------------------------------------------- /.github/workflows/workflow.yml: -------------------------------------------------------------------------------- 1 | name: Builds, tests & co 2 | 3 | on: 4 | - push 5 | - pull_request 6 | 7 | permissions: read-all 8 | 9 | jobs: 10 | build: 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | os: 15 | - ubuntu-latest 16 | - macos-latest 17 | - windows-latest 18 | ocaml-compiler: 19 | - 5 20 | - 4 21 | include: 22 | - os: ubuntu-latest 23 | ocaml-compiler: "4.08" 24 | 25 | runs-on: ${{ matrix.os }} 26 | 27 | steps: 28 | - name: Checkout tree 29 | uses: actions/checkout@v4 30 | 31 | - name: Set-up Node.js 32 | uses: actions/setup-node@v4 33 | with: 34 | node-version: latest 35 | 36 | - name: Set-up OCaml 37 | uses: ocaml/setup-ocaml@v3 38 | with: 39 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 40 | 41 | - run: opam install . --deps-only --with-test 42 | 43 | - run: opam exec -- make 44 | 45 | - run: opam exec -- make test 46 | 47 | # lint-doc: 48 | # runs-on: ubuntu-latest 49 | # steps: 50 | # - name: Checkout tree 51 | # uses: actions/checkout@v4 52 | # - name: Set-up OCaml 53 | # uses: ocaml/setup-ocaml@v3 54 | # with: 55 | # ocaml-compiler: 5 56 | # - uses: ocaml/setup-ocaml/lint-doc@v3 57 | 58 | # lint-fmt: 59 | # runs-on: ubuntu-latest 60 | # steps: 61 | # - name: Checkout tree 62 | # uses: actions/checkout@v4 63 | # - name: Set-up OCaml 64 | # uses: ocaml/setup-ocaml@v3 65 | # with: 66 | # ocaml-compiler: 5 67 | # - uses: ocaml/setup-ocaml/lint-fmt@v3 68 | 69 | lint-opam: 70 | runs-on: ubuntu-latest 71 | steps: 72 | - name: Checkout tree 73 | uses: actions/checkout@v4 74 | - name: Set-up OCaml 75 | uses: ocaml/setup-ocaml@v3 76 | with: 77 | ocaml-compiler: 5 78 | - uses: ocaml/setup-ocaml/lint-opam@v3 79 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | gen_js_api.install 2 | ojs.install 3 | *.merlin 4 | _build 5 | _opam 6 | .vscode 7 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | match_clause=4 2 | strict_with=auto 3 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | Changelog 2 | ========= 3 | 4 | Version 1.1.4 5 | ------------- 6 | 7 | - GPR#176: Remove references to joo_global_object (@hhugo) 8 | - GPR#175: Support for simple module construction (@sbriais) 9 | 10 | Version 1.1.3 11 | ------------- 12 | 13 | - GPR#173: Compatibility with Wasm_of_ocaml (@vouillon) 14 | - GPR#171: Update build badge and remove unused travis config (@tmcgilchrist) 15 | 16 | 17 | Version 1.1.2 18 | ------------- 19 | 20 | - GPR#170: Make Ojs.iter_properties compatible with jsoo/effects (@vouillon) 21 | 22 | Version 1.1.1 23 | ------------- 24 | 25 | - GPR#167: Fix CI (@cannorin) 26 | - GPR#166: Support first class modules to treat type variables safely (@cannorin) 27 | 28 | Version 1.1.0 29 | ------------- 30 | 31 | - GPR#164: Switch to js_of_ocaml.4.0 (@hhugo) 32 | - GPR#165: Allow n-ary constructors in [@js.union] (@cannorin) 33 | 34 | Version 1.0.9 35 | ------------- 36 | 37 | - GPR#161: Fix broken link to VALUES.md (@joelburget) 38 | - GPR#154: Upgrade to ocaml/setup-ocaml@v2 (@smorimoto) 39 | - GPR#153: Support recursive modules (@cannorin) 40 | - GPR#152: [@@js.invoke] attribute to call the global object as a function (@cannorin) 41 | 42 | Version 1.0.8 43 | ------------- 44 | 45 | - GPR#149: Stop using OMP directly (@mlasson) 46 | - GPR#145: Add support for "newable" functions to [@@js.apply] (@cannorin) 47 | - GPR#143: Disable eta reduction for of_js and to_js of type aliases (@cannorin) 48 | - GPR#144: Disable "Spurious js.\* attribute" error for @js.dummy (@cannorin, @mlasson) 49 | - GPR#146: Fix an edge-case bug of prepare_args 50 | 51 | 52 | Version 1.0.7 53 | ------------- 54 | 55 | - GPR#140: Adds a deprecation warning the automatic heuristic is used (@mlasson) 56 | - GPR#139: Rename things for backward compatibility (@mlasson) 57 | - GPR#135: UTF-8 support for (Ojs.get/set/delete) adaptions (@mlasson) 58 | - GPR#132: Add support for indexers and "callable" objects (@cannorin) 59 | - GPR#130: Javascript -> JavaScript (@smorimoto) 60 | - GPR#129: Add GitHub Actions workflow (@smorimoto) 61 | - GPR#128: Bucklescript -> ReScript (also add genType ppx as a resource) (@ryyppy) 62 | - GPR#127: Support boolean "enum"s and boolean union discriminators (@cannorin) 63 | - GPR#125: js.custom attribute for type declaration to support custom mapping #125 (@cannorin) 64 | - GPR#123: Upgrade ppx to the ocaml 4.11 ast (@hhugo) 65 | - GPR#120: Split runtime library to own package (@rgrinberg) 66 | - GPR#118: Add ppx tests setup (@jchavarri, @mlasson) 67 | - GPR#115: Support for functors and module inclusion (@mlasson) 68 | - GPR#114: Dependency tweaks (@rgrinberg) 69 | - GPR#113: Add support for type variables (@jchavarri, @mlasson) 70 | - GPR#111: Better ppxlib integration (@hhugo) 71 | - GPR#110: Include payload in extension node (@nojb) 72 | 73 | Version 1.0.6 74 | ------------- 75 | 76 | - GPR #101: Adds travis support + use ocaml-migrate-parsetree (@mlasson) 77 | - GPR #94: Typo: correct wrong 'apply_arr' to 'apply' (@facelesspanda) 78 | - GPR #89: Update the opam file (@hhugo) 79 | - GPR #87: Switch to dune (@hhugo) 80 | - GPR #88: Fix some warnings (@hhugo) 81 | - GRP #85: Adapt to 4.08 (@nojb) 82 | 83 | Version 1.0.5 84 | ------------- 85 | 86 | - Adapt to OCaml 4.06 87 | 88 | 89 | Version 1.0.4 90 | ------------- 91 | 92 | - Adapt to OCaml 4.05. 93 | -------------------------------------------------------------------------------- /CLASSES.md: -------------------------------------------------------------------------------- 1 | Class wrapping in gen_js_api 2 | ============================ 3 | 4 | gen_js_api can bind JavaScript objects into OCaml abstract types with 5 | associated functions (to get/set property and to call methods). This 6 | form of binding is quite efficient, since the opaque OCaml values are 7 | just the underlying JavaScript objects, with no mapping or wrapping. 8 | In addition to that, gen_js_api provides ways to **wrap JavaScript 9 | objects into OCaml objects**. This adds some runtime overhead, but 10 | allows users to use standard OO syntax in OCaml and to rely on 11 | inheritance (to mimic similar hierarchy on the JS side). 12 | 13 | In addition to the runtime overhead, wrapping JS objects as OCaml 14 | objects also forces to define all methods at once. With opaque 15 | bindings, methods of a given JS "class" can be spread over multiple 16 | OCaml modules. This can be especially useful to mimic the behavior of 17 | JS library addins that extends the library's object prototype with 18 | more methods. 19 | 20 | 21 | 22 | 23 | Class wrapping 24 | -------------- 25 | 26 | An interface processed by js_of_ocaml can define an OCaml class used 27 | to wrap some JavaScript objects: 28 | 29 | ```` 30 | class my_class: Ojs.t -> 31 | object 32 | inherit Ojs.obj 33 | (* method declarations *) 34 | .... 35 | end 36 | ```` 37 | 38 | The class must inherit from `Ojs.obj` directly or indirectly. This class 39 | simply defines a `to_js` method (returning the underlying `Ojs.t` object). 40 | 41 | Such a class declaration produces in the implementation a class 42 | definition with the list of `inherit` clauses (passing the `Ojs.t` 43 | handle to each of them) and a definition for all listed methods. It 44 | also produces a standard pair of `*_to_js`/`*_of_js` functions (the 45 | `*_to_js` function calls the `to_js` method inherited from `Ojs.obj`, 46 | and `*_of_js` calls the constructor of the class). 47 | 48 | 49 | Method binding 50 | -------------- 51 | 52 | - Property getter: 53 | 54 | ```` 55 | method foo: t 56 | [@@js.get "foo"] 57 | ```` 58 | 59 | 60 | - Property setter: 61 | 62 | ```` 63 | method set_foo: t -> unit 64 | [@@js.set "foo"] 65 | ```` 66 | 67 | 68 | - Method call: 69 | 70 | ```` 71 | method f: t -> unit 72 | [@@js.call "f"] 73 | ```` 74 | 75 | As always, the names can be omitted if they correspond to the implicit 76 | naming scheme. 77 | 78 | Prior to version 1.0.7, as for value bindings, some implicit rules applied, 79 | so that `[@@js.*]` attributes could often be omitted (in particular, in 80 | all the examples above). 81 | 82 | The following rules were applied in order: 83 | 84 | - If the method is a function with one argument `t -> unit` and its 85 | name starts with `set_`, then the declaration is assumed to be a 86 | `[@@js.set]` property setter (on the property whose name is obtained 87 | by dropping the `set_` prefix). 88 | 89 | - If the method is a function, then the definition is assumed to be a 90 | `[@@js.call]` method call. 91 | 92 | - Otherwise, the method is assumed to be a `[@@js.get]` property getter. 93 | 94 | But since version 1.0.7, *this feature has been deprecated*; all method 95 | should be explicitly annotated or a preprocessor warning will be emitted. 96 | 97 | Constructors 98 | ------------ 99 | 100 | The default constructor for a class wrapper is necessarily an `Ojs.t` object 101 | (see above). (Note: it would be easy to allow such classes to take a 102 | value of an arbitrary JS-able type, but this would make it more 103 | difficult to support inheritance.) 104 | 105 | It is possible to bind to actual JS constructors declarations such as: 106 | 107 | ```` 108 | class foo: string -> my_class 109 | ```` 110 | 111 | Calling this constructor is then implemented by calling the JavaScript 112 | constructor of the same name, and wrapping the resulting object with 113 | the `my_class` wrapper. This is similar to defining: 114 | 115 | ```` 116 | val foo: string -> my_class 117 | [@@js.new] 118 | ```` 119 | 120 | but allows writing `new foo(...)` instead of `foo(...)`. 121 | 122 | A custom name can be provided with a `[@@js.new]` attribute: 123 | 124 | ```` 125 | class foo: string -> my_class 126 | [@@js.new "MyConstr"] 127 | ```` 128 | -------------------------------------------------------------------------------- /IMPLGEN.md: -------------------------------------------------------------------------------- 1 | gen_js_api: generate implementations from interfaces 2 | ==================================================== 3 | 4 | The primary operating mode for gen_js_api is to generate .ml 5 | implementation from annotated .mli interfaces. These interfaces must 6 | follow a certain shape. They describe both the JavaScript components 7 | to be imported and how they should be reflected within OCaml. 8 | 9 | Usage 10 | ----- 11 | 12 | 13 | ``` 14 | $ gen_js_api my_module.mli 15 | ``` 16 | 17 | or with findlib: 18 | 19 | ``` 20 | $ ocamlfind gen_js_api/gen_js_api my_module.mli 21 | ``` 22 | 23 | This generates my_module.ml. 24 | 25 | 26 | 27 | Supported declarations 28 | ---------------------- 29 | 30 | Interfaces processed by gen_js_api can currently contain: 31 | 32 | - [Type declarations](TYPES.md): 33 | 34 | ```` 35 | type t = ... 36 | ```` 37 | 38 | See [this page](TYPES.md) for a description of supported types. 39 | Such a type declaration produces in the implementation an identical 40 | defininition, and associated `*_to_js` and `*_of_js` functions 41 | (which can be manually exported if needed). 42 | 43 | 44 | - [Value declarations](VALUES.md): 45 | 46 | ```` 47 | val f: tyexpr 48 | ```` 49 | 50 | This produces in the implementation a definition for such a value, 51 | whose content depends on three elements: the name of the value 52 | (`f` in the example), its declared type (`tyexpr`), and possible 53 | `[@@js.xxx]` attributes attached to the declaration in the interface. 54 | 55 | See [this page](VALUES.md) for supported forms of value declarations. 56 | 57 | 58 | - Sub-modules: 59 | 60 | ```` 61 | module M : sig 62 | ... 63 | end 64 | ```` 65 | 66 | This naturally produces in the implementation a corresponding sub-module: 67 | 68 | ```` 69 | module M = struct 70 | ... 71 | end 72 | ```` 73 | 74 | - Module aliases: 75 | 76 | If a module alias is declared in the interface, like: 77 | 78 | ```ocaml 79 | module M = 80 | ``` 81 | 82 | it is directly reflected in the generated implementation without modifications. 83 | 84 | - Module inclusion: 85 | 86 | To include a module `M` in the generated implementation, simply add 87 | 88 | ```ocaml 89 | include (module type of M) 90 | ``` 91 | in the corresponding interface. 92 | 93 | - [Class declarations](CLASSES.md) 94 | 95 | 96 | 97 | Verbatim sections 98 | ----------------- 99 | 100 | A floating attribute `[@@@js.stop]` tells the tool to ignore the 101 | remaining items until the end of the current (possibly nested) 102 | signature. This can be reverted with a floating attribute 103 | `[@@@js.start]`. This system makes it possible to specify fragments 104 | of the interface that should not generate any code in the 105 | implementation. 106 | 107 | A floating `[@@@js.implem ...]` tells the tool to generate some custom 108 | code in the implementation. The payload `...` is an OCaml structure, 109 | which is processed in the same way as in [ppx mode](PPX.md). 110 | 111 | 112 | Example: 113 | 114 | ```ocaml 115 | 116 | [@@@js.stop] 117 | val foo: int -> unit 118 | [@@@js.start] 119 | 120 | [@@@js.implem 121 | 122 | val foo_internal: string -> int -> unit 123 | [@@js.global "foo"] 124 | let foo = foo_internal "" 125 | 126 | ] 127 | ``` 128 | 129 | 130 | For the common case where verbatim sections are used to create custom 131 | value bindings, a `[@@js.custom]` attribute can be applied to a `val` 132 | declaration. The effect is that the `val` declaration itself is ignored 133 | (nothing is generated in the implementation), and a structure can be 134 | provided as the payload of the attribute. The example above is equivalent 135 | to: 136 | 137 | ```ocaml 138 | val foo: int -> int 139 | [@@js.custom 140 | val foo_internal: string -> int -> unit 141 | [@@js.global "foo"] 142 | let foo = foo_internal "" 143 | ] 144 | ``` 145 | 146 | and to: 147 | 148 | ```ocaml 149 | val foo: int -> int 150 | [@@js.custom] 151 | 152 | [@@js.implem 153 | ... 154 | ] 155 | ``` 156 | -------------------------------------------------------------------------------- /INSTALL_AND_USE.md: -------------------------------------------------------------------------------- 1 | gen_js_api: installation and usage instructions 2 | =============================================== 3 | 4 | 5 | Dependencies 6 | ------------ 7 | 8 | gen_js_api does not have any external build-time dependency except 9 | the OCaml compiler (version 4.03). Of course, it will be used 10 | in conjuncion with the js_of_ocaml compiler and runtime support. 11 | 12 | 13 | Installation (with OPAM) 14 | ------------------------ 15 | 16 | ```` 17 | opam install gen_js_api 18 | ```` 19 | 20 | Or, to track the development version: 21 | 22 | ```` 23 | opam pin add gen_js_api https://github.com/LexiFi/gen_js_api.git 24 | ```` 25 | 26 | Manual installation 27 | ------------------- 28 | 29 | ```` 30 | git clone https://github.com/LexiFi/gen_js_api.git 31 | cd gen_js_api 32 | make all 33 | make install # assuming opam-installer is installed 34 | ```` 35 | 36 | Usage (with dune) 37 | ----------------- 38 | 39 | - Invoking the [standalone tool](IMPLGEN.md) (`.mli` -> `.ml` generator): 40 | 41 | ``` 42 | (rule 43 | (targets my_unit.ml) 44 | (deps my_unit.mli) 45 | (action (run %{bin:gen_js_api} %{deps}))) 46 | ``` 47 | 48 | - Compiling binding (`.mli` and generated `.ml` files), user 49 | code which rely on the `Ojs` or with the [ppx processor](PPX.md): 50 | 51 | ``` 52 | (executables 53 | (names test_jquery) 54 | (js_of_ocaml) 55 | (libraries ojs js_of_ocaml) 56 | (preprocess (pps gen_js_api.ppx)) 57 | (modes byte) 58 | ) 59 | ``` 60 | 61 | - Compiling into JavaScript: Just ask dune to build the `*.bc.js` 62 | target. (e.g. `dune build test_jquery.bc.js`) 63 | 64 | Usage (with ocamlfind) 65 | ---------------------- 66 | 67 | - Invoking the [standalone tool](IMPLGEN.md) (`.mli` -> `.ml` generator): 68 | 69 | ``` 70 | ocamlfind gen_js_api/gen_js_api my_unit.mli 71 | ``` 72 | 73 | - Compiling binding (`.mli` and generated `.ml` files) and user 74 | code which rely on the `Ojs` module: 75 | 76 | ``` 77 | ocamlfind ocamlc -package gen_js_api my_unit.mli 78 | ocamlfind ocamlc -package gen_js_api my_unit.ml 79 | ``` 80 | 81 | - Compiling with the [ppx processor](PPX.md): 82 | 83 | ``` 84 | ocamlfind ocamlc -c -package gen_js_api my_prog.ml 85 | ``` 86 | 87 | - Linking the bytecode program: 88 | 89 | ``` 90 | ocamlfind ocamlc -o my_prog -package gen_js_api -linkpkg ... 91 | ``` 92 | 93 | - Compiling into JavaScript: 94 | 95 | ``` 96 | js_of_ocaml -o my_prog.js +gen_js_api/ojs_runtime.js my_prog 97 | ``` 98 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright 2015 by LexiFi. 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining 6 | a copy of this software and associated documentation files (the 7 | "Software"), to deal in the Software without restriction, including 8 | without limitation the rights to use, copy, modify, merge, publish, 9 | distribute, sublicense, and/or sell copies of the Software, and to 10 | permit persons to whom the Software is furnished to do so, subject to 11 | the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be 14 | included in all copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 20 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 21 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 22 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /LOW_LEVEL_BINDING.md: -------------------------------------------------------------------------------- 1 | gen_js_api: low-level binding to JavaScript 2 | =========================================== 3 | 4 | The code generated by gen_js_api relies on a `Ojs` module (the runtime 5 | support library). In the same way that OCaml `Obj` module exposes 6 | (unsafe) operations to manipulate arbitrary OCaml values (after 7 | casting them to a universal type `Obj.t`), `Ojs` allows to manipulate 8 | arbitrary JavaScript values through an `Ojs.t` universal type. 9 | 10 | `Ojs` encourages to think of native JS values as being "foreign" 11 | values, even though in practice, all OCaml values are represented as 12 | JS values when the OCaml code is compiled with js_of_ocaml. In 13 | particular, `Ojs` does not expose a function allowing to cast an 14 | arbitrary OCaml value to `Ojs.t` (this can always be done with 15 | `Obj.magic`). 16 | 17 | `Ojs.t` is similar to `Js.Unsafe.any` type, but it abstracts away from 18 | specific properties of how js_of_ocaml represents OCaml values. For 19 | instance the fact, that OCaml integers are encoded directly as JS 20 | numbers is not apparent in `Ojs`, and if this property was to change, 21 | client code would be unaffected. 22 | 23 | Abstracting away from js_of_ocaml encoding would also make it easy to 24 | change the way OCaml and JS are connected (either because of changes 25 | in js_of_ocaml's encoding of OCaml values, or because an entirely 26 | different technology is used, such as an OCaml bytecode interpreter 27 | written in JavaScript or a JavaScript engine linked with native OCaml 28 | code). 29 | 30 | Note that code generated by gen_js_api doesn't depend on js_of_ocaml's 31 | standard library (`Js` module), only on js_of_ocaml's runtime system. 32 | Our local `Ojs` interface maps directly to primitives provided by 33 | js_of_ocaml's runtime. 34 | 35 | 36 | Users of gen_js_api would not use `Ojs` very often, except to define 37 | "opaque sub-types" of `Ojs.t` in order to represent JS "classes" or 38 | "interfaces": 39 | 40 | ```ocaml 41 | type t = private Ojs.t 42 | ``` 43 | 44 | Occasionnaly, it it useful to go down to `Ojs` in order to define 45 | **custom mappings** between JS and OCaml. For instance, one can 46 | define a type for association lists indexed on strings in OCaml that 47 | are mapped to JS objects: 48 | 49 | ```ocaml 50 | module Dict : sig 51 | type 'a t = (string * 'a) list 52 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 53 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 54 | end = struct 55 | type 'a t = (string * 'a) list 56 | 57 | let t_to_js ml2js l = 58 | let o = Ojs.empty_obj () in 59 | List.iter (fun (k, v) -> Ojs.set o k (ml2js v)) l; 60 | o 61 | 62 | let t_of_js js2ml o = 63 | let l = ref [] in 64 | Ojs.iter_properties o 65 | (fun k -> l := (k, js2ml (Ojs.get o k)) :: !l); 66 | !l 67 | end 68 | ``` 69 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # The package gen_js_api is released under the terms of an MIT-like license. 2 | # See the attached LICENSE file. 3 | # Copyright 2015 by LexiFi. 4 | 5 | .PHONY: all examples test test-promote clean install uninstall doc reindent publish 6 | 7 | all: 8 | dune build @install @DEFAULT 9 | 10 | examples: 11 | dune build @examples/DEFAULT 12 | 13 | doc: 14 | dune build @doc 15 | 16 | test: 17 | dune build @runtest 18 | 19 | test-promote: 20 | dune build @runtest --auto-promote 21 | 22 | clean: 23 | dune clean 24 | 25 | PREFIX := $$(opam config var prefix) 26 | 27 | install: 28 | opam-installer --prefix $(PREFIX) gen_js_api.install 29 | 30 | uninstall: 31 | opam-installer -u --prefix $(PREFIX) gen_js_api.install 32 | 33 | reindent: 34 | git ls-files *.ml *.mli | grep -v expected | xargs ocp-indent -i 35 | 36 | VERSION := $$(opam show . | grep "^version" | sort -u | sed 's/version *//') 37 | 38 | publish: all 39 | echo "Publishing v$(VERSION) ..." 40 | git tag -a v$(VERSION) 41 | git push origin v$(VERSION) 42 | opam publish 43 | 44 | 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /NAMING.md: -------------------------------------------------------------------------------- 1 | gen_js_api: default naming convention 2 | ===================================== 3 | 4 | JavaScript names corresponding to bound components can always be 5 | specified explicitly (with the use of attributes). When the naming is 6 | left implicit, a JavaScript name is automatically derived from the 7 | OCaml name by applying the following rules: 8 | 9 | 1. uppercasing every character following an underscore; 10 | 11 | 2. removing every underscore; 12 | 13 | 3. uppercasing the first character when generating object constructor names. 14 | 15 | This automatic naming convention can be partially disabled by adding 16 | an attribute `[@js.verbatim_names]` on outer structures. When the attribute 17 | `[@js.verbatim_names]` is inherited from the context, the rule 1 and 2 are 18 | disabled. 19 | 20 | For instance, 21 | 22 | ```ocaml 23 | type myType = { x_coord : int; y_coord : int [@js "Y"]} 24 | ``` 25 | 26 | is mapped to a JS record with two fields named "xCoord" and "Y" whereas 27 | 28 | ```ocaml 29 | type myType = { x_coord : int; y_coord : int [@js "Y"]} [@@js.verbatim_names] 30 | ``` 31 | 32 | is mapped to a JS record with two fields named "x_coord" and "y". 33 | -------------------------------------------------------------------------------- /PPX.md: -------------------------------------------------------------------------------- 1 | gen_js_api: ppx mode 2 | ==================== 3 | 4 | While the primary mode of operation for gen_js_api is to generate an 5 | .ml file from an annotated .mli file, it is also possible to use it as 6 | a ppx preprocessor on an .ml file directly to insert local JS bindings. 7 | 8 | The `-ppx` command-line option must be the first argument passed 9 | to gen_js_api to enable the ppx mode: 10 | 11 | ``` 12 | $ ocamlc -c -ppx "gen_js_api -ppx" my_prog.ml 13 | ``` 14 | 15 | or with findlib: 16 | 17 | ``` 18 | $ ocamlfind ocamlc -c -package gen_js_api my_prog.ml 19 | ``` 20 | 21 | 22 | Note: the ppx currently does nothing on `.mli` files. 23 | 24 | 25 | Several forms are supported: 26 | 27 | - `[%js: ]` extension as a module expression. Examples: 28 | 29 | ```` 30 | include [%js: ] 31 | 32 | module M = [%js: ] 33 | ```` 34 | 35 | The signature is processed as if it were found in an .mli file, and 36 | the resulting structure is inserted in place of the `[%js: ...]` 37 | extension. See [this page](IMPLGEN.md) for a list 38 | of declarations supported in such interfaces. 39 | 40 | - `[@@js]` attributes on type declarations. 41 | 42 | Example: 43 | 44 | ```` 45 | type t = { x : int; y : int } [@@js] 46 | ```` 47 | 48 | This generates the corresponding `*_of_js` and `*_to_js` functions. 49 | In case of a multi-type declaration, each type must be annotated 50 | with `[@@js]` (if needed). See [this page](TYPES.md) for a description 51 | of support forms of type declarations. 52 | 53 | - `[%js.to: ty]` and `[%js.of: ty]` extensions on expressions. 54 | 55 | Example: 56 | 57 | ```` 58 | let x : Ojs.t = [%js.of: int list] [ 10; 20; 30 ] 59 | ```` 60 | 61 | This form generates the mapping function associated to a JS-able type. 62 | See [this page](TYPES.md) for a description of JS-able type. 63 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | gen_js_api: easy OCaml bindings for JavaScript libraries 2 | ======================================================== 3 | 4 | [![Build Status](https://github.com/LexiFi/gen_js_api/actions/workflows/workflow.yml/badge.svg)](https://github.com/LexiFi/gen_js_api/actions/workflows/workflow.yml) 5 | 6 | Overview 7 | -------- 8 | 9 | gen_js_api aims at simplifying the creation of OCaml bindings for 10 | JavaScript libraries. It must currently be used with the [js_of_ocaml 11 | compiler](https://github.com/ocsigen/js_of_ocaml), although other ways 12 | to run OCaml code "against" JavaScript might be supported later with 13 | the same binding definitions (for instance, 14 | [Bucklescript](https://github.com/bloomberg/bucklescript), 15 | or direct embedding of a JS engine in a native OCaml application). 16 | 17 | gen_js_api is based on the following ideas: 18 | 19 | - Authors of bindings write OCaml signatures for JavaScript libraries 20 | and the tool generates the actual binding code with a combination 21 | of implicit conventions and explicit annotations. 22 | 23 | - The generated binding code takes care of translating values between 24 | OCaml and JavaScript and of dealing with JavaScript calling 25 | conventions. 26 | 27 | - All syntactic processing is done by authors of bindings: the client 28 | code is normal OCaml code and does not depend on custom syntax nor 29 | on JS-specific types. 30 | 31 | 32 | gen_js_api can be used in two complementary ways: 33 | 34 | - [Generating .ml implementations from annotated .mli interfaces](IMPLGEN.md), 35 | in order to create the code for stub libraries. 36 | 37 | - As a [ppx preprocessor on implementations](PPX.md) to define local 38 | bindings. 39 | 40 | 41 | 42 | Examples 43 | -------- 44 | 45 | The repository contains some examples of OCaml bindings to JavaScript 46 | libraries created with gen_js_api: 47 | 48 | - Very partial [bindings to jQuery](examples/misc/jquery.mli), with 49 | some [example client code](examples/misc/test_jquery.ml). 50 | 51 | - Partial bindings to JavaScript [strings and 52 | regexps](examples/misc/js_str.mli) and JavaScript 53 | [dates](examples/js_date.mli). 54 | 55 | - Some [ad hoc test](examples/test) to exercise various features. 56 | 57 | - An example of a self-contained program, a [simple 58 | calculator](examples/calc/calc.ml), implementing local .bindings 59 | 60 | Documentation 61 | ------------- 62 | 63 | - [Install and use](INSTALL_AND_USE.md) 64 | - [Low-level binding to JavaScript](LOW_LEVEL_BINDING.md) 65 | - [Using gen_js_api to generate .ml from .mli](IMPLGEN.md) 66 | - [Using gen_js_api as a ppx processor](PPX.md) 67 | - [Default naming convention](NAMING.md) 68 | - [JS-able types and type declarations](TYPES.md) 69 | - [Value bindings](VALUES.md) 70 | - [Class-wrapping bindings](CLASSES.md) 71 | - [TODO list](TODO.md) 72 | 73 | 74 | Related projects 75 | ---------------- 76 | 77 | - [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml): The compiler 78 | and runtime system on which gen_js_api relies. (Note: gen_js_api 79 | doesn't depend on js_of_ocaml's OCaml library, nor on its language 80 | extension.) 81 | 82 | - [goji](https://github.com/klakplok/goji): A DSL to describe OCaml 83 | bindings for JavaScript libraries. 84 | 85 | - [DefinitelyMaybeTyped](https://github.com/andrewray/DefinitelyMaybeTyped): 86 | A project to parse 87 | [DefinitelyTyped](https://github.com/borisyankov/DefinitelyTyped) 88 | interfaces and produce OCaml interfaces. 89 | 90 | - [ReScript](https://github.com/rescript-lang/rescript-compiler): 91 | Another compiler from OCaml to JavaScript, featuring the [genType](https://github.com/reason-association/genType) ppx for generating TS / Flow types and runtime converters. 92 | 93 | About 94 | ----- 95 | 96 | gen_js_api has been created by LexiFi for porting a web application 97 | from JavaScript to OCaml. The tool has been used in production since 98 | 2015. 99 | 100 | This gen_js_api package is licensed by LexiFi under the terms of the 101 | MIT license. 102 | 103 | See see [Changelog](CHANGES.md) 104 | 105 | Contact: alain.frisch@lexifi.com 106 | 107 | Contributors: 108 | 109 | - Alain Frisch 110 | - Sebastien Briais 111 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | TODO list for gen_js_api 2 | ======================== 3 | 4 | - Create reasonably complete bindings for JavaScript's stdlib 5 | (string, regexp), for the DOM, for jQuery, etc. 6 | 7 | - Add a safe mode, where the generated code is augmented with explicit 8 | checks (e.g. when casting a JS value to a string or integer, when 9 | accessing a property, etc). 10 | 11 | - Optimize generated code (for instance, lift calls to string_of_js on 12 | literals). 13 | 14 | - Idea: to facilitate binding and calling multiple methods at once, 15 | provide something like (jQuery example): 16 | 17 | ```ocaml 18 | val set: ?text:string -> ?hide:unit -> ?css:(string * string) -> t -> unit 19 | [@@js.multicall] 20 | ``` 21 | 22 | 23 | One can then write: 24 | 25 | ```ocaml 26 | set 27 | ~text:"Hello" 28 | ~hide:() 29 | node 30 | ``` 31 | 32 | Each provided argument yields one method call (in the order where 33 | arguments are declared, of course). This is mostly interesting when 34 | methods are used to "set" internal properties, and when the different 35 | calls commute. 36 | 37 | This could be simulated with: 38 | 39 | ```ocaml 40 | 41 | val set: ?text:string -> ?hide:unit -> ?css:(string * string) -> t -> unit 42 | [@@@js.custom 43 | val set_text: t -> string -> unit 44 | [@@js.meth "text"] 45 | 46 | let set ?text ... x = 47 | Option.iter (set_text x) text; 48 | ... 49 | ] 50 | ``` 51 | 52 | 53 | - Optional arguments on JS methods are usually at the end. But this 54 | forces to add a `unit` pseudo-argument. One could have an 55 | (optional) convention to push optional arguments at the end of the JS 56 | call even though there are not in the OCaml type. This would also 57 | work for instance methods: 58 | 59 | ```ocaml 60 | val foo: ?bla:int -> t -> int 61 | ``` 62 | 63 | instead of: 64 | 65 | ```ocaml 66 | val foo: t -> ?bla:int -> unit -> int 67 | ``` 68 | 69 | - When defining a binding to a function with `[@@js.global 70 | "foo.bar"]`, this is currently interpreted as calling this global 71 | function. One could interpret it as calling the bar method on 72 | object foo, which would have the effect of assigning `this` during 73 | the function evaluation. 74 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags (:standard)))) 4 | 5 | (deprecated_library_name 6 | (old_public_name gen_js_api) 7 | (new_public_name ojs)) 8 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | (name gen_js_api) 3 | (version 1.1.4) 4 | 5 | (maintainers "Alain Frisch ") 6 | (authors 7 | "Alain Frisch " 8 | "Sebastien Briais ") 9 | 10 | (source (github LexiFi/gen_js_api)) 11 | 12 | (generate_opam_files true) 13 | 14 | (license MIT) 15 | 16 | (package 17 | (name ojs) 18 | (synopsis "Runtime Library for gen_js_api generated libraries") 19 | (description "To be used in conjunction with gen_js_api") 20 | (depends 21 | (ocaml (>= 4.08)) 22 | (js_of_ocaml-compiler (>= 4.0.0))) 23 | ) 24 | 25 | (package 26 | (name gen_js_api) 27 | (synopsis "Easy OCaml bindings for JavaScript libraries") 28 | (description " 29 | gen_js_api aims at simplifying the creation of OCaml bindings for 30 | JavaScript libraries. Authors of bindings write OCaml signatures for 31 | JavaScript libraries and the tool generates the actual binding code 32 | with a combination of implicit conventions and explicit annotations. 33 | 34 | gen_js_api is to be used with the js_of_ocaml compiler. 35 | ") 36 | (conflicts (js_of_ocaml-compiler (< 4.0.0))) 37 | (depends 38 | (ocaml (>= 4.08)) 39 | (ppxlib (>= 0.26)) 40 | (js_of_ocaml-compiler :with-test) 41 | (ojs (= :version))) 42 | ) 43 | -------------------------------------------------------------------------------- /examples/calc/calc.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Calculator 4 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /examples/calc/calc.ml: -------------------------------------------------------------------------------- 1 | module Element = [%js: 2 | type t 3 | 4 | val t_of_js: Ojs.t -> t 5 | 6 | val append_child: t -> t -> unit [@@js.call] 7 | 8 | val set_attribute: t -> string -> string -> unit [@@js.call] 9 | 10 | val set_onclick: t -> (unit -> unit) -> unit [@@js.set] 11 | ] 12 | 13 | module Window = [%js: 14 | type t 15 | 16 | val instance: t [@@js.global "window"] 17 | 18 | val set_onload: t -> (unit -> unit) -> unit [@@js.set] 19 | ] 20 | 21 | module Document = [%js: 22 | type t 23 | 24 | val instance: t [@@js.global "document"] 25 | 26 | val create_element: t -> string -> Element.t [@@js.call] 27 | 28 | val create_text_node: t -> string -> Element.t [@@js.call] 29 | 30 | val body: t -> Element.t [@@js.get] 31 | ] 32 | 33 | let element tag children = 34 | let elt = Document.create_element Document.instance tag in 35 | List.iter (Element.append_child elt) children; 36 | elt 37 | 38 | let textnode s = Document.create_text_node Document.instance s 39 | 40 | let td ?colspan child = 41 | let elt = element "td" [child] in 42 | begin match colspan with 43 | | None -> () 44 | | Some n -> Element.set_attribute elt "colspan" (string_of_int n) 45 | end; 46 | elt 47 | 48 | let tr = element "tr" 49 | let table = element "table" 50 | let center x = element "center" [x] 51 | 52 | let button x f = 53 | let elt = element "button" [textnode x] in 54 | Element.set_attribute elt "type" "button"; 55 | Element.set_onclick elt f; 56 | elt 57 | 58 | module Engine = struct 59 | type op = Add | Sub | Mul | Div 60 | 61 | type state = 62 | { 63 | x: float; 64 | y: float; 65 | operator: op option; 66 | input: bool; 67 | equal: bool; 68 | comma: int; 69 | } 70 | 71 | let initial = { x = 0.; y = 0.; operator = None; input = false; equal = false; comma = 0 } 72 | 73 | let make_op op x y = 74 | match op with 75 | | Add -> x +. y 76 | | Sub -> x -. y 77 | | Mul -> x *. y 78 | | Div -> x /. y 79 | 80 | let of_digit d = float_of_int d 81 | let add_digit x comma d = 82 | if comma = 0 then 10. *. x +. float_of_int d, comma 83 | else x +. float_of_int d /. (10. ** (float_of_int comma)), comma + 1 84 | 85 | let input_digit ({x; y; operator = _; input; equal; comma} as state) d = 86 | let y = if equal then y else x in 87 | let x, comma = 88 | if input then add_digit x comma d 89 | else of_digit d, 0 90 | in 91 | {state with x; y; comma; input = true} 92 | 93 | let apply_comma ({input; comma; _} as state) = 94 | if comma = 0 then 95 | if input then {state with comma = 1} 96 | else {(input_digit state 0) with comma = 1} 97 | else state 98 | 99 | let apply_equal ({x; y; operator; input; equal; comma = _} as state) = 100 | match operator with 101 | | None -> {state with y = x; input = false; equal = true} 102 | | Some o -> 103 | if input && not equal then {state with x = make_op o y x; y = x; input = false; equal = true} 104 | else {state with x = make_op o x y; equal = true} 105 | 106 | let apply_op ({input; equal; _} as state) op = 107 | if input && not equal then {(apply_equal state) with operator = Some op; equal = false} 108 | else {state with operator = Some op; equal= false; input = false} 109 | 110 | let print_op ppf = function 111 | | None -> Printf.fprintf ppf " " 112 | | Some Add -> Printf.fprintf ppf "+" 113 | | Some Sub -> Printf.fprintf ppf "-" 114 | | Some Mul -> Printf.fprintf ppf "*" 115 | | Some Div -> Printf.fprintf ppf "/" 116 | 117 | let print ppf {x; y; operator; input; equal; comma} = 118 | Printf.fprintf ppf "x = %g, y = %g, op = %a, input = %b, equal = %b, comma = %d" x y print_op operator input equal comma 119 | end 120 | 121 | 122 | let widget () = 123 | let open Engine in 124 | let state = ref initial in 125 | let res, set_value = 126 | let elt = element "input" [] in 127 | Element.set_attribute elt "type" "text"; 128 | Element.set_attribute elt "readonly" ""; 129 | let set_value v = Element.set_attribute elt "value" (string_of_float v) in 130 | elt, set_value 131 | in 132 | let update st = 133 | Printf.printf "%a\n" print st; 134 | state := st; 135 | set_value !state.x 136 | in 137 | let reset() = update initial in 138 | reset(); 139 | let binop op () = update (apply_op !state op) in 140 | let equal () = update (apply_equal !state) in 141 | let comma () = update (apply_comma !state) in 142 | let figure digit = 143 | let f () = update (input_digit !state digit) in 144 | button (string_of_int digit) f 145 | in 146 | let c l = td l in 147 | let nothing () = element "div" [] in 148 | table [tr [td ~colspan:4 res]; 149 | tr (List.map c [nothing(); button "C" reset; nothing(); button "/" (binop Div)]); 150 | tr (List.map c [figure 7; figure 8; figure 9; button "*" (binop Mul)]); 151 | tr (List.map c [figure 4; figure 5; figure 6; button "-" (binop Sub)]); 152 | tr (List.map c [figure 1; figure 2; figure 3; button "+" (binop Add)]); 153 | tr (List.map c [nothing(); figure 0; button "." comma; button "=" equal])] 154 | 155 | let go () = 156 | Element.append_child (Document.body Document.instance) (center (widget())) 157 | 158 | let () = 159 | Window.set_onload Window.instance go 160 | -------------------------------------------------------------------------------- /examples/calc/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names calc) 3 | (libraries ojs) 4 | (preprocess 5 | (pps gen_js_api.ppx)) 6 | (modes js)) 7 | 8 | (rule 9 | (targets calc.js) 10 | (deps calc.bc.js) 11 | (action 12 | (run cp %{deps} %{targets}))) 13 | 14 | (alias 15 | (name DEFAULT) 16 | (deps calc.js calc.html)) 17 | -------------------------------------------------------------------------------- /examples/misc/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names test_jquery) 3 | (libraries ojs) 4 | (preprocess 5 | (pps gen_js_api.ppx)) 6 | (modes js)) 7 | 8 | (rule 9 | (targets jquery.ml) 10 | (deps jquery.mli) 11 | (action 12 | (run %{bin:gen_js_api} %{deps}))) 13 | 14 | (rule 15 | (targets js_date.ml) 16 | (deps js_date.mli) 17 | (action 18 | (run %{bin:gen_js_api} %{deps}))) 19 | 20 | (rule 21 | (targets js_str.ml) 22 | (deps js_str.mli) 23 | (action 24 | (run %{bin:gen_js_api} %{deps}))) 25 | 26 | (rule 27 | (targets test_jquery.js) 28 | (deps test_jquery.bc.js) 29 | (action 30 | (run cp %{deps} %{targets}))) 31 | 32 | (alias 33 | (name DEFAULT) 34 | (deps test_jquery.js test_jquery.html)) 35 | -------------------------------------------------------------------------------- /examples/misc/jquery.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (** Partial binding to jQuery, serving as an illustration 6 | of gen_js_api. The binding is far from complete! *) 7 | 8 | [@@@js.implem [@@@ocaml.warning "-22"]] 9 | 10 | (** {2 Sets of elements} *) 11 | 12 | type t = private Ojs.t 13 | 14 | val selector: string -> t 15 | [@@js.global "jQuery"] 16 | (** Either select a set of elements from the current document, or 17 | create a new element (if given a string such as "
". *) 18 | 19 | val wrap: Ojs.t -> t [@@js.global "jQuery"] 20 | 21 | val explode: t -> t list 22 | [@@js.custom let explode x = Ojs.list_of_js wrap x] 23 | 24 | val find: t -> string -> t list 25 | [@@js.custom 26 | val find: t -> string -> t [@@js.call "find"] 27 | 28 | let find x sel = explode (find x sel) 29 | ] 30 | 31 | 32 | val text: t -> string 33 | [@@js.call] 34 | 35 | val set_text: t -> string -> unit 36 | [@@js.call "text"] 37 | 38 | val update_text: t -> (int -> string -> string) -> unit 39 | [@@js.call "text"] 40 | 41 | val append_html: t -> string -> unit 42 | [@@js.call "append"] 43 | 44 | val append: t -> (t list [@js.variadic]) -> unit 45 | [@@js.call "append"] 46 | 47 | val prepend: t -> (t list [@js.variadic]) -> unit 48 | [@@js.call] 49 | 50 | val after: t -> t -> unit 51 | [@@js.call] 52 | 53 | val before: t -> t -> unit 54 | [@@js.call] 55 | 56 | val get_val: t -> string 57 | [@@js.call "val"] 58 | 59 | val hide: t -> unit 60 | [@@js.call] 61 | 62 | val show: t -> unit 63 | [@@js.call] 64 | 65 | val detach: t -> unit 66 | [@@js.call] 67 | 68 | val remove: t -> unit 69 | [@@js.call] 70 | 71 | val empty: t -> unit 72 | [@@js.call] 73 | 74 | val focus: t -> unit 75 | 76 | val height: t -> int [@@js.call] 77 | val set_height: t -> ([`String of string | `Int of int] [@js.union]) -> unit [@@js.call "height"] 78 | 79 | val width: t -> int [@@js.call] 80 | val set_width: t -> ([`String of string | `Int of int] [@js.union]) -> unit [@@js.call "width"] 81 | 82 | val string_value: t -> string [@@js.call "val"] 83 | val set_string_value: t -> string -> unit [@@js.call "val"] 84 | 85 | val add_class: t -> string -> unit [@@js.call] 86 | val remove_class: t -> string -> unit [@@js.call] 87 | 88 | val css: t -> string -> Ojs.t [@@js.call] 89 | 90 | val set_css_value: t -> string -> ([`String of string | `Float of float] [@js.union]) -> unit [@@js.call "css"] 91 | 92 | val set_css: t -> Ojs.t -> unit [@@js.call "css"] 93 | 94 | val clone: t -> t [@@js.call] 95 | 96 | val html: t -> string 97 | [@@js.call "html"] 98 | 99 | val set_html: t -> string -> unit 100 | [@@js.call "html"] 101 | 102 | 103 | (** {2 Properties} *) 104 | 105 | val prop: t -> string -> Ojs.t 106 | [@@js.call] 107 | 108 | val set_prop: 109 | t -> string -> 110 | ([`String of string | `Int of int | `Bool of bool | `Any of Ojs.t] [@js.union]) -> 111 | unit 112 | [@@js.call "prop"] 113 | 114 | (** {2 Data} *) 115 | 116 | val data: t -> string -> Ojs.t 117 | [@@js.call] 118 | 119 | val set_data: t -> string -> Ojs.t -> unit 120 | [@@js.call "data"] 121 | 122 | (** {2 Attributes} *) 123 | 124 | val attr: t -> string -> string option 125 | [@@js.call] 126 | 127 | val set_attr: t -> string -> string -> unit 128 | [@@js.call "attr"] 129 | 130 | val remove_attr: t -> string -> unit 131 | [@@js.call] 132 | 133 | 134 | (** {2 Animations} *) 135 | 136 | val fade_in: t -> ?duration:int -> ?finished:(unit -> unit) -> unit -> unit 137 | [@@js.call] 138 | val fade_out: t -> ?duration:int -> ?finished:(unit -> unit) -> unit -> unit 139 | [@@js.call] 140 | 141 | (** {2 Events} *) 142 | 143 | module Event : sig 144 | type t 145 | 146 | val page_x: t -> float 147 | val page_y: t -> float 148 | val type_: t -> string 149 | val target: t -> Ojs.t 150 | val which: t -> int 151 | val stop_propagation: t -> unit [@@js.call] 152 | val prevent_default: t -> unit [@@js.call] 153 | end 154 | 155 | val on: t -> string -> (Event.t -> unit) -> unit 156 | val off: t -> string -> unit 157 | 158 | val trigger: t -> string -> unit 159 | [@@js.call] 160 | 161 | val ready: (unit -> unit) -> unit 162 | [@@js.global "jQuery"] 163 | 164 | module Dialog: sig 165 | type button 166 | 167 | val button: 168 | text:string -> 169 | click:(unit -> unit) -> 170 | unit -> button 171 | [@@js.builder] 172 | 173 | type settings 174 | 175 | val settings: 176 | ?modal:bool -> 177 | ?title:string -> 178 | ?buttons:button list -> 179 | unit -> settings 180 | [@@js.builder] 181 | end 182 | 183 | module UI : sig 184 | 185 | module Datepicker : sig 186 | type settings 187 | 188 | val settings: 189 | ?date_format:string -> 190 | unit -> settings 191 | [@@js.builder] 192 | end 193 | 194 | val datepicker: t -> Datepicker.settings -> unit 195 | end 196 | 197 | val dialog: t -> ([`Dialog of Dialog.settings | `String of string] [@js.union]) -> unit 198 | 199 | (** {2 AJAX} *) 200 | 201 | module Ajax: sig 202 | type settings 203 | (** The type describing all settings of an AJAX call. *) 204 | 205 | type t 206 | (** Corresponds to jQuery's jqXHR object. *) 207 | 208 | val settings: 209 | ?async:bool -> 210 | ?cache:bool -> 211 | ?complete:(t -> string -> unit) -> 212 | ?error:(t -> string -> string -> unit) -> 213 | ?success:(Ojs.t -> string -> t -> unit) -> 214 | ?data:Ojs.t -> ?data_type:string -> 215 | ?meth:([`GET | `POST | `PUT] [@js "method"] [@js.enum]) -> 216 | ?content_type:string -> 217 | ?url:string -> 218 | unit -> settings 219 | [@@js.builder] 220 | 221 | val run: settings -> unit 222 | [@@js.global "jQuery.ajax"] 223 | 224 | val response_text: t -> string 225 | 226 | val status: t -> int 227 | end 228 | -------------------------------------------------------------------------------- /examples/misc/js_date.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (** JS dates *) 6 | 7 | (** {2 Type definitions} *) 8 | 9 | type t = private Ojs.t 10 | val t_of_js: Ojs.t -> t 11 | val t_to_js: t -> Ojs.t 12 | 13 | val now: unit -> t [@@js.new "Date"] 14 | val from_milliseconds: float -> t [@@js.new "Date"] 15 | val from_string: string -> t [@@js.new "Date"] 16 | 17 | val create: year:int -> month:int -> ?day:(int [@js.default 1]) -> ?hours:(int [@js.default 0]) -> ?minutes:(int [@js.default 0]) -> ?seconds:(int [@js.default 0]) -> ?ms:(int [@js.default 0]) -> unit -> t [@@js.new "Date"] 18 | 19 | val get_UTC_date: t -> int [@@js.call] 20 | val get_UTC_day: t -> int [@@js.call] 21 | val get_UTC_full_year: t -> int [@@js.call] 22 | val get_UTC_hours: t -> int [@@js.call] 23 | val get_UTC_milliseconds: t -> int [@@js.call] 24 | val get_UTC_minutes: t -> int [@@js.call] 25 | val get_UTC_month: t -> int [@@js.call] 26 | val get_UTC_seconds: t -> int [@@js.call] 27 | 28 | val set_UTC_date: t -> int -> unit [@@js.call] 29 | val set_UTC_full_year: t -> int -> unit [@@js.call] 30 | val set_UTC_hours: t -> int -> unit [@@js.call] 31 | val set_UTC_milliseconds: t -> int -> unit [@@js.call] 32 | val set_UTC_minutes: t -> int -> unit [@@js.call] 33 | val set_UTC_month: t -> int -> unit [@@js.call] 34 | val set_UTC_seconds: t -> int -> unit [@@js.call] 35 | 36 | val get_date: t -> int [@@js.call] 37 | val get_day: t -> int [@@js.call] 38 | val get_full_year: t -> int [@@js.call] 39 | val get_hours: t -> int [@@js.call] 40 | val get_milliseconds: t -> int [@@js.call] 41 | val get_minutes: t -> int [@@js.call] 42 | val get_month: t -> int [@@js.call] 43 | val get_seconds: t -> int [@@js.call] 44 | 45 | val set_date: t -> int -> unit [@@js.call] 46 | val set_full_year: t -> int -> unit [@@js.call] 47 | val set_hours: t -> int -> unit [@@js.call] 48 | val set_milliseconds: t -> int -> unit [@@js.call] 49 | val set_minutes: t -> int -> unit [@@js.call] 50 | val set_month: t -> int -> unit [@@js.call] 51 | val set_seconds: t -> int -> unit [@@js.call] 52 | 53 | val get_time: t -> float [@@js.call] 54 | val set_time: t -> float -> unit [@@js.call] 55 | 56 | val get_timezone_offset: t -> int [@@js.call] 57 | 58 | val to_locale_date_string: t -> string [@@js.call] 59 | val to_locale_string: t -> string [@@js.call] 60 | val to_locale_time_string: t -> string [@@js.call] 61 | 62 | val to_date_string: t -> string [@@js.call] 63 | val to_time_string: t -> string [@@js.call] 64 | 65 | val to_UTC_string: t -> string [@@js.call] 66 | 67 | val to_string: t -> string [@@js.call] 68 | -------------------------------------------------------------------------------- /examples/misc/js_str.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (** JS string and regexp objects *) 6 | 7 | (** {2 Type definitions} *) 8 | 9 | type t = private Ojs.t 10 | val t_of_js: Ojs.t -> t 11 | val t_to_js: t -> Ojs.t 12 | 13 | type regexp = private Ojs.t 14 | val regexp_of_js: Ojs.t -> regexp 15 | val regexp_to_js: regexp -> Ojs.t 16 | 17 | (** {2 Conversion between JS strings and OCaml string} *) 18 | 19 | val to_string: t -> string [@@js.cast] 20 | val of_string: string -> t [@@js.cast] 21 | 22 | (** {2 JS strings} *) 23 | 24 | val from_char_code: (int list [@js.variadic]) -> t 25 | [@@js.global "String.fromCharCode"] 26 | 27 | val char_at: t -> int -> t 28 | val char_code_at: t -> int -> int 29 | val concat: t -> (t list [@js.variadic]) -> t 30 | val index_of: t -> t -> ?start:int -> unit -> int 31 | val last_index_of: t -> t -> ?start:int -> unit -> int 32 | val length: t -> int 33 | val locale_compare: t -> t -> int 34 | val match_: t -> regexp -> t array option 35 | val replace: t -> regexp -> t -> t 36 | val search: t -> regexp -> int 37 | val slice: t -> start:int -> ?end_:int -> unit -> t 38 | val split: t -> ?separator:t -> ?limit:int -> unit -> t array 39 | val substr: t -> start:int -> ?length:int -> unit -> t 40 | val substring: t -> start:int -> ?end_:int -> unit -> t 41 | val to_locale_lower_case: t -> t [@@js.call] 42 | val to_locale_upper_case: t -> t [@@js.call] 43 | val to_lower_case: t -> t [@@js.call] 44 | val to_upper_case: t -> t [@@js.call] 45 | val trim: t -> t [@@js.call] 46 | 47 | 48 | (** {2 Regexps} *) 49 | 50 | val regexp: t -> ?global:unit -> ?ignore_case:unit -> ?multiline:unit -> unit -> regexp 51 | [@@js.custom 52 | 53 | val regexp_internal: t -> ?flags:t -> unit -> regexp [@@js.new "RegExp"] 54 | 55 | let regexp txt ?global ?ignore_case ?multiline () = 56 | let l = [] in 57 | let l = match global with Some () -> of_string "g" :: l | None -> l in 58 | let l = match ignore_case with Some () -> of_string "i" :: l | None -> l in 59 | let l = match multiline with Some () -> of_string "m" :: l | None -> l in 60 | regexp_internal txt ~flags:(concat (of_string "") l) () 61 | ] 62 | 63 | 64 | val global: regexp -> bool 65 | val ignore_case: regexp -> bool 66 | val multiline: regexp -> bool 67 | val source: regexp -> string 68 | val last_index: regexp -> int 69 | val exec: regexp -> t -> t array option 70 | val test: regexp -> t -> bool 71 | -------------------------------------------------------------------------------- /examples/misc/test_jquery.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | One 6 | Two 7 |
Blabla
8 | 9 | 10 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /examples/misc/test_jquery.ml: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (** A toy application built with jQuery *) 6 | 7 | open Jquery 8 | 9 | include [%js: 10 | val alert: string -> unit 11 | [@@js.global] 12 | ] 13 | 14 | let ( !! ) = Jquery.selector 15 | 16 | let block s ?text ?(classes = []) ?(ons = []) ?(css = []) ?(props = []) children = 17 | let element = Jquery.selector (Printf.sprintf "<%s>" s) in 18 | begin match text with 19 | | None -> () 20 | | Some text -> Jquery.set_text element text 21 | end; 22 | List.iter (fun c -> Jquery.add_class element c) classes; 23 | List.iter (fun (key, value) -> Jquery.set_css_value element key value) css; 24 | List.iter (fun (key, value) -> Jquery.set_prop element key value) props; 25 | List.iter (fun (event, f) -> Jquery.on element event f) ons; 26 | begin match children with 27 | | [] -> () 28 | | _ :: _-> Jquery.append element children 29 | end; 30 | element 31 | 32 | let ajax_test () = 33 | let open Ajax in 34 | let complete h = function 35 | | "success" -> 36 | let pre = block "pre" ~text:(response_text h) [] in 37 | hide pre; 38 | append !!"body" [pre]; 39 | fade_in pre ~duration:2000 40 | ~finished:(fun () -> 41 | fade_out pre ~finished:(fun () -> detach pre) () 42 | ) 43 | () 44 | | status -> alert (Printf.sprintf "status = %s" status) 45 | in 46 | run (settings ~meth:`GET ~url:"test_jquery.ml" ~data_type:"text" ~complete ()) 47 | 48 | 49 | let on_ready () = 50 | let main = !!"#main" in 51 | print_endline (text main); 52 | set_text main "Hello world!"; 53 | append_html main "in bold"; 54 | 55 | let elts = !!".tofill" in 56 | update_text elts (Printf.sprintf "[%i:%s]"); 57 | 58 | append main [elts; !! "XXX"]; 59 | 60 | let on_click evt = 61 | let open Event in 62 | append_html main 63 | (Printf.sprintf "
x=%f,y=%f,type=%s" 64 | (page_x evt) 65 | (page_y evt) 66 | (type_ evt) 67 | ) 68 | in 69 | on main "click" on_click; 70 | 71 | let div = block "div" [] in 72 | let input = block "input" [] in 73 | on input "input" (fun _ -> set_text div (get_val input)); 74 | append main [input; div]; 75 | 76 | let btn = 77 | block "button" ~text:"SHOW SOURCE CODE" [] 78 | ~ons:["click", (fun _ -> ajax_test ())] 79 | in 80 | append main [btn] 81 | 82 | let () = 83 | ready on_ready 84 | -------------------------------------------------------------------------------- /examples/test/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names main) 3 | (libraries ojs) 4 | (preprocess 5 | (pps gen_js_api.ppx)) 6 | (modes js)) 7 | 8 | (rule 9 | (targets test_bindings.ml) 10 | (deps test_bindings.mli) 11 | (action 12 | (run gen_js_api %{deps}))) 13 | 14 | (rule 15 | (targets main.js) 16 | (deps main.bc.js) 17 | (action 18 | (run cp %{deps} %{targets}))) 19 | 20 | (alias 21 | (name DEFAULT) 22 | (deps main.js main.html)) 23 | -------------------------------------------------------------------------------- /examples/test/main.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 |
Blabla
6 | 7 | Bla 8 | 9 | 119 | 121 | 124 | 125 | 126 | -------------------------------------------------------------------------------- /examples/test/main.ml: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (** Some ad hoc code to illustrate and test various aspects 6 | of gen_js_api *) 7 | 8 | [@@@ocaml.warning "-32-34"] 9 | 10 | open Test_bindings 11 | 12 | [@@@ocaml.warning "-22"] 13 | 14 | include 15 | [%js: 16 | val wrapper: (int -> int -> int) -> (int -> int -> int [@js.dummy]) 17 | [@@js.global "wrapper"] 18 | 19 | val caller: (unit -> int) -> int 20 | [@@js.global "caller"] 21 | 22 | val caller_unit: (unit -> unit) -> unit 23 | [@@js.global "caller"] 24 | 25 | val test_variadic: ((int list [@js.variadic]) -> int) -> unit 26 | val test_variadic2: (string -> (int list [@js.variadic]) -> int) -> unit 27 | ] 28 | 29 | module LocalBindings = [%js: 30 | type myType = { x : a; y : b [@js "Y"]} 31 | and a = int option 32 | and b = { s : string; i : int } 33 | ] 34 | 35 | 36 | let () = 37 | let s = [%js.of: int list] [10; 20; 30] in 38 | Printf.printf "%i\n%!" ([%js.to: int] (Ojs.array_get s 0)); 39 | Printf.printf "%i\n%!" ([%js.to: int] (Ojs.array_get s 1)); 40 | Printf.printf "%i\n%!" ([%js.to: int] (Ojs.array_get s 2)) 41 | 42 | let () = 43 | let sum xs = List.fold_left ( + ) 0 xs in 44 | test_variadic sum; 45 | test_variadic2 (fun msg xs -> Printf.printf "%s\n%!" msg; sum xs) 46 | 47 | include [%js: 48 | val myArray: int array 49 | [@@js] 50 | 51 | val myArray2: Ojs.t 52 | [@@js.global "myArray"] 53 | 54 | val alert_bool: bool -> unit 55 | [@@js.global "alert"] 56 | 57 | val alert_float: float -> unit 58 | [@@js.global "alert"] 59 | 60 | 61 | val test_opt_args: (?foo:int -> ?bar:int -> unit-> string) -> unit 62 | [@@js.global] 63 | ] 64 | 65 | let doc = Window.document window 66 | 67 | let elt name ?(attrs = []) ?onclick subs = 68 | let e = Document.createElement doc name in 69 | List.iter (fun (k, v) -> Element.setAttribute e k v) attrs; 70 | List.iter (Element.appendChild e) subs; 71 | begin match onclick with 72 | | Some f -> Element.set_onclick e f 73 | | None -> () 74 | end; 75 | e 76 | 77 | let txt = 78 | Document.createTextNode doc 79 | 80 | let button ?attrs s onclick = 81 | elt "button" ?attrs ~onclick [ txt s ] 82 | 83 | let div = elt "div" 84 | 85 | let () = 86 | Array.iter (Printf.printf "[%i]\n") myArray; 87 | 88 | Ojs.array_set myArray2 0 (Ojs.int_to_js 10); 89 | Ojs.array_set myArray2 1 (Ojs.array_to_js Ojs.int_to_js [| 100; 200; 300 |]); 90 | (* Ojs.array_set myArray2 1 ([%to_js: int array] [| 100; 200; 300 |]); *) 91 | 92 | (* 93 | Printf.printf "%0.2f\n" 3.1415; 94 | *) 95 | (* 96 | Document.set_title doc "MyTitle"; 97 | Document.set_title doc (Document.title doc ^ " :-)"); 98 | *) 99 | 100 | (* let main = Document.getElementById doc "main" in *) 101 | (* print_endline (Element.innerHTML main); *) 102 | (* alert (Element.innerHTML main); *) 103 | (* Element.set_innerHTML main "Blablabla"; *) 104 | 105 | 106 | let draw () = 107 | let canvas_elt = Document.getElementById doc "canvas" in 108 | let canvas = Canvas.of_element canvas_elt in 109 | let ctx = Canvas.getContext_2d canvas in 110 | Canvas.RenderingContext2D.(begin 111 | set_fillStyle ctx "rgba(0,0,255,0.1)"; 112 | fillRect ctx 30 30 50 50 113 | end); 114 | Element.set_onclick canvas_elt (fun () -> alert "XXX"); 115 | in 116 | alert_bool true; 117 | alert_float 3.1415; 118 | let f = 119 | wrapper 120 | (fun x y -> 121 | Printf.printf "IN CALLBACK, x = %i, y = %i\n%!" x y; 122 | x + y 123 | ) 124 | in 125 | Printf.printf "Result -> %i\n%!" (f 42 1); 126 | 127 | let uid = ref 0 in 128 | let f () = 129 | incr uid; 130 | Printf.printf "uid = %i\n%!" !uid; 131 | !uid 132 | in 133 | Printf.printf "Caller result -> %i, %i, %i\n%!" (caller f) (caller f) (caller f); 134 | caller_unit (fun () -> ignore (f ())); 135 | caller_unit (fun () -> ignore (f ())); 136 | caller_unit (fun () -> ignore (f ())); 137 | 138 | let alice = Person.create "Alice" Person.Foo.Foo in 139 | let bob = Person.create "Bob" Person.Foo.Bar in 140 | let charlie = Person.create "Charlie" (Person.Foo.OtherString "bla") in 141 | let eve = Person.create "Eve" (Person.Foo.OtherInt 2713) in 142 | 143 | Ojs.iter_properties (Person.cast alice) (Format.printf "%s\n%!"); 144 | 145 | let alice_obj = PersonObj.create "Alice" Person.Foo.Foo in 146 | let bob_obj = PersonObj.of_person bob in 147 | let dave_obj = new PersonObj.person "Dave" Person.Foo.Bar [1; 2; 3] in 148 | 149 | let string_of_foo = function 150 | | Person.Foo.Foo -> "foo" 151 | | Person.Foo.Bar -> "bar" 152 | | Person.Foo.OtherInt n -> Printf.sprintf "other = %d" n 153 | | Person.Foo.OtherString s -> Printf.sprintf "other = %s" s 154 | in 155 | let string_of_name_foo name foo = Printf.sprintf "%s <%s>" name (string_of_foo foo) in 156 | let string_of_person x = string_of_name_foo (Person.name x) (Person.foo x) in 157 | let string_of_person_obj x = string_of_name_foo (x # name) (x # foo) in 158 | let hack_person x = 159 | let name, foo = Person.get x () in 160 | Printf.printf "before: %s <%s>\n" name (string_of_foo foo); 161 | Person.set x ("Dave", Person.Foo.OtherString "bar"); 162 | let name, foo = Person.get x () in 163 | Printf.printf "after: %s <%s>\n" name (string_of_foo foo); 164 | in 165 | 166 | let body = Document.body doc in 167 | setTimeout (fun () -> Element.setAttribute body "bgcolor" "red") 2000; 168 | Element.appendChild body (Document.createTextNode doc "ABC"); 169 | Element.appendChild body 170 | (div ~attrs:["style", "color: blue"] [ txt "!!!!"; elt "b" [txt "XXX"]]); 171 | 172 | Element.appendChild body 173 | (div (List.map (fun x -> txt (string_of_person x)) [alice; bob; charlie; eve])); 174 | hack_person eve; 175 | Element.appendChild body 176 | (div (List.map (fun x -> txt (string_of_person x)) [alice; bob; charlie; eve])); 177 | Element.appendChild body 178 | (div (List.map (fun x -> txt (string_of_person_obj x)) [alice_obj; bob_obj; dave_obj])); 179 | 180 | let s = (new Str.str "") # concat [Str.create "Hello"; Str.create ", "; Str.create "world"; Str.create "!"] in 181 | Console.log_string console (s # to_string); 182 | 183 | Console.log_string console (Date.to_string (Date.create ~year:2015 ~month:4 ~day:10 ())); 184 | 185 | let l = Document.getElementsByClassName doc "myClass" in 186 | Array.iter 187 | (fun e -> 188 | Printf.printf "- [%s]\n" (Element.innerHTML e); (* OK *) 189 | print_string (Printf.sprintf "+ [%s]\n" (Element.innerHTML e)); (* BAD *) 190 | 191 | Element.appendChild e (button "Click!" draw); 192 | Element.appendChild e (button "XXX" (fun () -> ())); 193 | ) 194 | l; 195 | 196 | test_opt_args 197 | (fun ?(foo = 0) ?(bar = 0) () -> string_of_int foo ^ "/" ^ string_of_int bar); 198 | 199 | print_endline Person2.(to_json (mk ~children:[mk ~age:6 "Johnny"] ~age:42 "John Doe")) 200 | 201 | 202 | 203 | (* Custom mapping between association lists and JS objects *) 204 | 205 | module Dict : sig 206 | type 'a t = (string * 'a) list 207 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 208 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 209 | end = struct 210 | type 'a t = (string * 'a) list 211 | 212 | let t_to_js ml2js l = 213 | let o = Ojs.empty_obj () in 214 | List.iter (fun (k, v) -> Ojs.set_prop o (Ojs.string_to_js k) (ml2js v)) l; 215 | o 216 | 217 | let t_of_js js2ml o = 218 | let l = ref [] in 219 | Ojs.iter_properties o 220 | (fun k -> l := (k, js2ml (Ojs.get_prop o (Ojs.string_to_js k))) :: !l); 221 | !l 222 | end 223 | 224 | include [%js: 225 | val int_dict_to_json_string: int Dict.t -> string 226 | [@@js.global "JSON.stringify"] 227 | 228 | val myDict: string Dict.t 229 | [@@js.global "myDict"] 230 | 231 | val set_x: int -> unit 232 | [@@js.set "x"] 233 | 234 | val get_x: unit -> int 235 | [@@js.get "x"] 236 | ] 237 | 238 | let () = 239 | print_endline (int_dict_to_json_string ["hello", 1; "world", 2]); 240 | List.iter (fun (k, v) -> Printf.printf "%s -> %s\n%!" k v) myDict; 241 | set_x 42; 242 | print_endline (string_of_int (get_x ())) 243 | 244 | module Sum = struct 245 | include [%js: 246 | type t = 247 | | A 248 | | B of int 249 | | C of int * string 250 | | D of {age:int; name:string} 251 | [@@js.sum] 252 | 253 | val t_of_js: Ojs.t -> t 254 | val t_to_js: t -> Ojs.t 255 | ] 256 | 257 | let print = function 258 | | A -> print_endline "A" 259 | | B n -> print_endline (Format.sprintf "B %d" n) 260 | | C (n, s) -> print_endline (Format.sprintf "C (%d, %S)" n s) 261 | | D {age; name} -> print_endline (Format.sprintf "D {age = %d; name = %S}" age name) 262 | 263 | include [%js: 264 | val set_print_sum: (t -> unit) -> unit 265 | [@@js.set "print_sum"] 266 | 267 | val test_sum: unit -> unit 268 | [@@js.global "test_sum"] 269 | ] 270 | 271 | let () = 272 | set_print_sum print 273 | 274 | let () = test_sum () 275 | 276 | let () = 277 | Console.log console ([%js.of:t] A); 278 | Console.log console ([%js.of:t] (B 42)); 279 | Console.log console ([%js.of:t] (C (42, "foo"))); 280 | Console.log console ([%js.of:t] (D {age=42; name="foo"})) 281 | 282 | let () = 283 | Console3.log 1; 284 | Console3.log2 1 "two"; 285 | Console3.log3 1 "two" []; 286 | Console3.log4 1 "two" [] [|4|] 287 | 288 | let () = 289 | Console4.log (module Ojs.Int) 1; 290 | Console4.log2 (module Ojs.Int) (module Ojs.String) 1 "two"; 291 | Console4.log3 (module Ojs.Int) (module Ojs.String) (module Ojs.List(Ojs.Int)) 1 "two" [3] 292 | 293 | end 294 | 295 | include [%js: 296 | val test_flatten: ([`A | `B of int | `C of string | `D of int * string] [@js.enum]) -> unit 297 | [@@js.global "test_flatten"] 298 | ] 299 | 300 | let () = 301 | test_flatten `A; 302 | test_flatten (`B 42); 303 | test_flatten (`C "hello"); 304 | test_flatten (`D (42, "foo")) 305 | include [%js: 306 | val make_string : 'a -> string [@@js.global "String"] 307 | ] 308 | 309 | let () = 310 | Console3.log (make_string 1234); 311 | Console3.log (make_string "string"); 312 | Console3.log (make_string ["list"]); 313 | Console3.log (make_string [|"array"|]) 314 | 315 | include [%js: 316 | val test_typvars: 'a -> 'a * 'a 317 | [@@js.global "test_typvars"] 318 | ] 319 | 320 | let () = 321 | Console3.log (test_typvars `A); 322 | Console3.log (test_typvars 1234); 323 | Console3.log (test_typvars "string"); 324 | Console3.log (test_typvars ["list"]) 325 | 326 | let () = 327 | let t = Ref.make "foo" in 328 | Console3.log (Ref.current t); 329 | Ref.setCurrent t "bar"; 330 | Console3.log (Ref.current t) 331 | 332 | let () = 333 | let foo = Either.left "foo" in 334 | let foobar = Either.right ["foo"; "bar"] in 335 | let f x = Either.destruct x ~left:(fun s -> s) ~right:(String.concat "-") in 336 | Console3.log (Ojs.string_to_js (f foo)); 337 | Console3.log (Ojs.string_to_js (f foobar)) 338 | 339 | let () = 340 | let open Variants.M3 in 341 | let rec of_list = function 342 | | [] -> Empty 343 | | hd :: tl -> Cons (hd, of_list tl) 344 | in 345 | Console3.log ([%js.of: int t] (of_list [1;2;3])) 346 | -------------------------------------------------------------------------------- /examples/test/test_bindings.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (** Some ad hoc code to illustrate and test various aspects 6 | of gen_js_api *) 7 | 8 | [@@@js.implem [@@@ocaml.warning "-22"]] 9 | 10 | module Element : sig 11 | type t = private Ojs.t 12 | 13 | val appendChild: t -> t -> unit 14 | val set_innerHTML: t -> string -> unit 15 | val innerHTML: t -> string 16 | 17 | val set_onclick: t -> (unit -> unit) -> unit 18 | val setAttribute: t -> string -> string -> unit 19 | end 20 | 21 | module Canvas : sig 22 | module RenderingContext2D : sig 23 | type t = private Ojs.t 24 | 25 | val set_fillStyle: t -> string -> unit 26 | val fillRect: t -> int -> int -> int -> int -> unit 27 | end 28 | 29 | type t = private Ojs.t 30 | 31 | val of_element: Element.t -> t 32 | [@@js.cast] 33 | 34 | val getContext_2d: t -> RenderingContext2D.t 35 | [@@js.custom 36 | val get_context: t -> string -> Ojs.t 37 | [@@js.call] 38 | 39 | let getContext_2d x = 40 | get_context x "2d" 41 | ] 42 | end 43 | 44 | 45 | module Document : sig 46 | type t = private Ojs.t 47 | 48 | val set_title: t -> string -> unit 49 | val title: t -> string 50 | 51 | val getElementById: t -> string -> Element.t 52 | val getElementsByClassName: t -> string -> Element.t array 53 | 54 | val createElement: t -> string -> Element.t 55 | val createTextNode: t -> string -> Element.t 56 | 57 | val body: t -> Element.t 58 | end 59 | 60 | module Window : sig 61 | type t = private Ojs.t 62 | 63 | val t_of_js: Ojs.t -> t 64 | val t_to_js: t -> Ojs.t 65 | 66 | val document: t -> Document.t 67 | 68 | val set_onload: t -> (unit -> unit) -> unit 69 | end 70 | 71 | val window: Window.t 72 | 73 | val alert: string -> unit 74 | [@@js.global] 75 | 76 | val setTimeout: (unit -> unit) -> int -> unit 77 | 78 | module Console: sig 79 | type t = private Ojs.t 80 | 81 | val log: t -> Ojs.t -> unit 82 | 83 | val log_string: t -> string -> unit 84 | [@@js.call "log"] 85 | end 86 | 87 | val console: Console.t 88 | 89 | module Person: sig 90 | module Foo: sig 91 | type t = 92 | | Foo 93 | | Bar [@js 42] 94 | | OtherInt of int [@js.default] 95 | | OtherString of string [@js.default] 96 | [@@js.enum] 97 | end 98 | 99 | type t = private Ojs.t 100 | 101 | val create: string -> Foo.t -> t 102 | [@@js.new "Person"] 103 | 104 | val name: t -> string 105 | val foo: t -> Foo.t 106 | val get: t -> unit -> string * Foo.t 107 | [@@js.call] 108 | val set: t -> string * Foo.t -> unit 109 | [@@js.call] 110 | 111 | val cast: t -> Ojs.t [@@js.cast] 112 | end 113 | 114 | module PersonObj: sig 115 | class t: Ojs.t -> 116 | object 117 | inherit Ojs.obj 118 | method name: string 119 | method set_name: string -> unit 120 | method foo: Person.Foo.t 121 | method set_foo: Person.Foo.t -> unit 122 | method get: string * Person.Foo.t [@@js.call] 123 | method set: string * Person.Foo.t -> unit [@@js.call] 124 | end 125 | 126 | class person: string -> Person.Foo.t -> (int list [@js.variadic]) -> t 127 | 128 | val create: string -> Person.Foo.t -> t 129 | [@@js.new "Person"] 130 | 131 | val of_person: Person.t -> t 132 | [@@js.cast] 133 | end 134 | 135 | module Str: sig 136 | class t: Ojs.t -> 137 | object 138 | inherit Ojs.obj 139 | method concat: (t list [@js.variadic]) -> t 140 | method to_string: string [@@js.call] 141 | end 142 | 143 | class str: string -> t [@@js.new "String"] 144 | 145 | val create: string -> t 146 | [@@js.new "String"] 147 | end 148 | 149 | module Date: sig 150 | type t = private Ojs.t 151 | 152 | val create: year:int -> month:int -> ?day:(int[@js.default 0]) -> unit -> t [@@js.new "Date"] 153 | val to_string: t -> string [@@js.call] 154 | end 155 | 156 | module Person2: sig 157 | type t = private Ojs.t 158 | 159 | val mk: ?children:t list -> age:int -> (string[@js "name"]) -> t 160 | [@@js.builder] 161 | 162 | val to_json: t -> string 163 | [@@js.global "JSON.stringify"] 164 | end 165 | 166 | type int_or_string_or_null = 167 | | Int of int 168 | | String of string 169 | | Nothing 170 | [@@js.union] 171 | 172 | val f: ([`Int of int | `String of string | `Nothing] [@js.union]) -> unit 173 | 174 | val g: int_or_string_or_null -> unit [@@js.global] 175 | 176 | module Verb1: sig 177 | type t1 = 178 | { x_coord: int; 179 | y_coord: int; 180 | } 181 | 182 | class t2: Ojs.t -> 183 | object 184 | inherit Ojs.obj 185 | method x_coord: int 186 | method y_coord: int 187 | end 188 | end [@js.verbatim_names] 189 | 190 | module Verb2: sig 191 | type t1 = 192 | { x_coord: int; 193 | y_coord: int; 194 | } [@@js.verbatim_names] 195 | 196 | class t2: Ojs.t -> 197 | object 198 | inherit Ojs.obj 199 | method x_coord: int 200 | method y_coord: int 201 | end [@@js.verbatim_names] 202 | end 203 | 204 | module Console2: sig 205 | val log: string -> unit 206 | [@@js.global] 207 | end [@js.scope "console"] 208 | 209 | module Console3: sig 210 | val log: 'a -> unit [@@js.global "console.log"] 211 | val log2: 'a -> 'b -> unit [@@js.global "console.log"] 212 | val log3: 'a -> 'b -> 'c -> unit [@@js.global "console.log"] 213 | val log4: 'a -> 'b -> 'c -> 'd -> unit [@@js.global "console.log"] 214 | end 215 | 216 | module Console4: sig 217 | val log: (module[@js] Ojs.T with type t = 'a) -> 'a -> unit [@@js.global "console.log"] 218 | val log2: 219 | (module[@js] Ojs.T with type t = 'a) -> 220 | (module[@js] Ojs.T with type t = 'b) -> 221 | 'a -> 'b -> unit [@@js.global "console.log"] 222 | val log3: 223 | (module[@js] Ojs.T with type t = 'a) -> 224 | (module[@js] Ojs.T with type t = 'b) -> 225 | (module[@js] Ojs.T with type t = 'c) -> 226 | 'a -> 'b -> 'c -> unit [@@js.global "console.log"] 227 | end 228 | 229 | module Location: sig 230 | val hash: unit -> string 231 | val set_hash: string -> unit 232 | end [@js.scope "location"] 233 | 234 | module Location2: sig 235 | val hash: unit -> string [@@js.get] 236 | val set_hash: string -> unit [@@js.set] 237 | end [@js.scope "location"] 238 | 239 | module Location3: sig 240 | val assign: string -> unit 241 | val reload: ?force:bool -> unit -> unit 242 | val replace: string -> unit 243 | end [@js.scope "location"] 244 | 245 | module Union: sig 246 | type close_path 247 | 248 | type moveto_abs 249 | 250 | type svg_path_seg = 251 | | Unknown of Ojs.t [@js.default] 252 | | Close_path of close_path [@js 1] 253 | | Moveto_abs of moveto_abs [@js 2] 254 | [@@js.union on_field "pathSegType"] 255 | end 256 | 257 | module Ref : sig 258 | type 'value t = private Ojs.t 259 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 260 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 261 | 262 | val make: 'value -> 'value t [@@js.global "makeRef"] 263 | 264 | val current : 'value t -> 'value [@@js.get "current"] 265 | 266 | val setCurrent : 'value t -> 'value -> unit [@@js.set "current"] 267 | end 268 | 269 | module Either : sig 270 | type ('a, 'b) t 271 | val t_to_js: ('a -> Ojs.t) -> ('b -> Ojs.t) -> ('a, 'b) t -> Ojs.t 272 | val t_of_js: (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> Ojs.t -> ('a, 'b) t 273 | 274 | val left: 'a -> ('a, 'b) t [@@js.global "eitherLeft"] 275 | val right: 'b -> ('a, 'b) t [@@js.global "eitherRight"] 276 | val destruct: ('a, 'b) t -> left:('a -> 'c) -> right:('b -> 'c) -> 'c [@@js.global "eitherDestruct"] 277 | end 278 | 279 | module Alias : sig 280 | module Swap : sig 281 | type ('a, 'b) t = ('b, 'a) Either.t 282 | val t_to_js: ('a -> Ojs.t) -> ('b -> Ojs.t) -> ('a, 'b) t -> Ojs.t 283 | val t_of_js: (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> Ojs.t -> ('a, 'b) t 284 | end 285 | 286 | (* Error: Contravariant type parameter ! 287 | module E : sig 288 | type 'a t = 'a -> int 289 | end *) 290 | 291 | module Id : sig 292 | type 'a t = 'a 293 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 294 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 295 | end 296 | 297 | module Arrow : sig 298 | type 'a t = ('a -> int) -> string 299 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 300 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 301 | end 302 | 303 | module Record : sig 304 | type ('a, 'b) t = 305 | { 306 | x: 'a; 307 | y: 'b 308 | } 309 | val t_to_js: ('a -> Ojs.t) -> ('b -> Ojs.t) -> ('a, 'b) t -> Ojs.t 310 | val t_of_js: (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> Ojs.t -> ('a, 'b) t 311 | end 312 | 313 | end 314 | 315 | module Variants : sig 316 | 317 | module M1 : sig 318 | type 'a t = 319 | | X of 'a 320 | | Y of int 321 | [@@js.sum] 322 | end 323 | 324 | module M2 : sig 325 | type ('a, 'b) t = 326 | | X of 'a 327 | | Y of 'b 328 | [@@js.sum] 329 | end 330 | 331 | module M3 : sig 332 | type 'a t = 333 | | Empty 334 | | Cons of 'a * 'a t 335 | [@@js.sum] 336 | 337 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 338 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 339 | end 340 | 341 | (* Error: Contravariant type parameter ! 342 | module E : sig 343 | type 'a t = 344 | | F of ('a -> int) 345 | [@@js.sum] 346 | end 347 | *) 348 | module M4 : sig 349 | type 'a t = 350 | | F of (('a -> int) -> int) 351 | [@@js.sum] 352 | end 353 | 354 | end 355 | -------------------------------------------------------------------------------- /gen_js_api.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "1.1.4" 4 | synopsis: "Easy OCaml bindings for JavaScript libraries" 5 | description: """ 6 | 7 | gen_js_api aims at simplifying the creation of OCaml bindings for 8 | JavaScript libraries. Authors of bindings write OCaml signatures for 9 | JavaScript libraries and the tool generates the actual binding code 10 | with a combination of implicit conventions and explicit annotations. 11 | 12 | gen_js_api is to be used with the js_of_ocaml compiler. 13 | """ 14 | maintainer: ["Alain Frisch "] 15 | authors: [ 16 | "Alain Frisch " 17 | "Sebastien Briais " 18 | ] 19 | license: "MIT" 20 | homepage: "https://github.com/LexiFi/gen_js_api" 21 | bug-reports: "https://github.com/LexiFi/gen_js_api/issues" 22 | depends: [ 23 | "dune" {>= "3.0"} 24 | "ocaml" {>= "4.08"} 25 | "ppxlib" {>= "0.26"} 26 | "js_of_ocaml-compiler" {with-test} 27 | "ojs" {= version} 28 | "odoc" {with-doc} 29 | ] 30 | conflicts: [ 31 | "js_of_ocaml-compiler" {< "4.0.0"} 32 | ] 33 | build: [ 34 | ["dune" "subst"] {dev} 35 | [ 36 | "dune" 37 | "build" 38 | "-p" 39 | name 40 | "-j" 41 | jobs 42 | "@install" 43 | "@runtest" {with-test} 44 | "@doc" {with-doc} 45 | ] 46 | ] 47 | dev-repo: "git+https://github.com/LexiFi/gen_js_api.git" 48 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name ojs) 3 | (synopsis "Runtime support for gen_js_api") 4 | (libraries js_of_ocaml-compiler.runtime) 5 | (wrapped false) 6 | (foreign_stubs 7 | (language c) 8 | (names ojs_runtime_stubs)) 9 | (modes byte) 10 | (js_of_ocaml 11 | (javascript_files ojs_runtime.js))) 12 | -------------------------------------------------------------------------------- /lib/ojs.ml: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (* This module (mostly) abstracts away from js_of_ocaml encoding of 6 | OCaml values. It serves as a support library for the code generated 7 | by gen_js_api. 8 | 9 | The module could mostly be implemented on top of js_of_ocaml's Js module 10 | (and in particular Js.Unsafe), but we prefer to drop the dependency 11 | to js_of_ocaml's library and to rely only on its compiler and JS 12 | runtime code. 13 | *) 14 | 15 | 16 | type t 17 | 18 | external t_of_js: t -> t = "%identity" 19 | external t_to_js: t -> t = "%identity" 20 | 21 | external string_of_js: t -> string = "caml_js_to_string" 22 | external string_to_js: string -> t = "caml_js_from_string" 23 | 24 | external int_of_js: t -> int = "%identity" 25 | external int_to_js: int -> t = "%identity" 26 | 27 | external bool_of_js: t -> bool = "caml_js_to_bool" 28 | external bool_to_js: bool -> t = "caml_js_from_bool" 29 | 30 | external float_of_js: t -> float = "caml_js_to_float" 31 | external float_to_js: float -> t = "caml_js_from_float" 32 | 33 | external obj: (string * t) array -> t = "caml_js_object" 34 | 35 | external variable: string -> t = "caml_js_var" 36 | 37 | external get: t -> string -> t = "caml_js_get" 38 | external set: t -> string -> t -> unit = "caml_js_set" 39 | external delete: t -> string -> unit = "caml_js_delete" 40 | 41 | external get_prop: t -> t -> t = "caml_js_get" 42 | external set_prop: t -> t -> t -> unit = "caml_js_set" 43 | external delete_prop: t -> t -> unit = "caml_js_delete" 44 | 45 | external get_prop_ascii: t -> string -> t = "caml_js_get" 46 | external set_prop_ascii: t -> string -> t -> unit = "caml_js_set" 47 | external delete_prop_ascii: t -> string -> unit = "caml_js_delete" 48 | 49 | external internal_type_of: t -> t = "caml_js_typeof" 50 | let type_of x = string_of_js (internal_type_of x) 51 | 52 | external internal_instance_of: t -> t -> t = "caml_js_instanceof" 53 | let instance_of x ~constr = bool_of_js (internal_instance_of x constr) 54 | 55 | external pure_js_expr: string -> t = "caml_pure_js_expr" 56 | let null = pure_js_expr "null" 57 | let undefined = pure_js_expr "undefined" 58 | 59 | external equals: t -> t -> bool = "caml_js_equals" 60 | 61 | let global = pure_js_expr "globalThis" 62 | 63 | external new_obj: t -> t array -> t = "caml_js_new" 64 | 65 | external call: t -> string -> t array -> t = "caml_js_meth_call" 66 | external apply: t -> t array -> t = "caml_js_fun_call" 67 | 68 | let array_make n = new_obj (get_prop_ascii global "Array") [|int_to_js n|] 69 | let array_get t i = get_prop t (int_to_js i) 70 | let array_set t i x = set_prop t (int_to_js i) x 71 | 72 | let array_of_js_from f objs start = 73 | let n = int_of_js (get_prop_ascii objs "length") in 74 | Array.init (n - start) (fun i -> f (array_get objs (start + i))) 75 | 76 | let array_of_js f objs = array_of_js_from f objs 0 77 | 78 | let array_to_js f arr = 79 | let n = Array.length arr in 80 | let a = array_make n in 81 | for i = 0 to n - 1 do 82 | array_set a i (f arr.(i)) 83 | done; 84 | a 85 | 86 | let list_of_js_from f objs start = Array.to_list (array_of_js_from f objs start) 87 | 88 | let list_of_js f objs = list_of_js_from f objs 0 89 | 90 | let list_to_js f l = 91 | array_to_js f (Array.of_list l) 92 | 93 | let option_of_js f x = 94 | if equals x null then None 95 | else Some (f x) 96 | 97 | let option_to_js f = function 98 | | Some x -> f x 99 | | None -> null 100 | 101 | let unit_to_js () = undefined 102 | let unit_of_js _ = () 103 | 104 | class obj (x:t) = 105 | object 106 | method to_js = x 107 | end 108 | 109 | external fun_to_js: int -> (t -> 'a) -> t = "caml_js_wrap_callback_strict" 110 | external fun_to_js_args: (t -> 'a) -> t = "caml_ojs_wrap_fun_arguments" 111 | 112 | let has_property o x = 113 | type_of o = "object" && o != null 114 | && get_prop o (string_to_js x) != undefined 115 | 116 | external new_obj_arr: t -> t -> t = "caml_ojs_new_arr" 117 | 118 | let empty_obj () = new_obj (get_prop_ascii global "Object") [||] 119 | 120 | external iter_properties_untyped : t -> t -> unit = "caml_ojs_iterate_properties" 121 | let iter_properties x f = 122 | iter_properties_untyped x (fun_to_js 1 (fun x -> f (string_of_js x))) 123 | 124 | let apply_arr o arr = call o "apply" [| null; arr |] 125 | let call_arr o s arr = call (get_prop o (string_to_js s)) "apply" [| o; arr |] 126 | 127 | let is_null x = 128 | equals x null 129 | 130 | let obj_type x = 131 | string_of_js (call (pure_js_expr "Object.prototype.toString") "call" [|x|]) 132 | 133 | module type T = sig 134 | type js := t 135 | type t 136 | val t_to_js : t -> js 137 | val t_of_js : js -> t 138 | end 139 | 140 | (* Ojs.T instances for built-in types *) 141 | module Int = struct 142 | type t = int 143 | let t_to_js = int_to_js 144 | let t_of_js = int_of_js 145 | end 146 | module String = struct 147 | type t = string 148 | let t_to_js = string_to_js 149 | let t_of_js = string_of_js 150 | end 151 | module Bool = struct 152 | type t = bool 153 | let t_to_js = bool_to_js 154 | let t_of_js = bool_of_js 155 | end 156 | module Float = struct 157 | type t = float 158 | let t_to_js = float_to_js 159 | let t_of_js = float_of_js 160 | end 161 | module Array (A: T) = struct 162 | type t = A.t array 163 | let t_to_js = array_to_js A.t_to_js 164 | let t_of_js = array_of_js A.t_of_js 165 | end 166 | module List (A: T) = struct 167 | type t = A.t list 168 | let t_to_js = list_to_js A.t_to_js 169 | let t_of_js = list_of_js A.t_of_js 170 | end 171 | module Option (A: T) = struct 172 | type t = A.t option 173 | let t_to_js = option_to_js A.t_to_js 174 | let t_of_js = option_of_js A.t_of_js 175 | end 176 | -------------------------------------------------------------------------------- /lib/ojs.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (** Binding with JS values. *) 6 | 7 | type t 8 | (** The universal type representing arbitrary JS values. *) 9 | 10 | (** {2 Mapper for built-in types} *) 11 | 12 | external t_of_js: t -> t = "%identity" 13 | external t_to_js: t -> t = "%identity" 14 | 15 | external string_of_js: t -> string = "caml_js_to_string" 16 | external string_to_js: string -> t = "caml_js_from_string" 17 | 18 | external int_of_js: t -> int = "%identity" 19 | external int_to_js: int -> t = "%identity" 20 | 21 | external bool_of_js: t -> bool = "caml_js_to_bool" 22 | external bool_to_js: bool -> t = "caml_js_from_bool" 23 | 24 | external float_of_js: t -> float = "caml_js_to_float" 25 | external float_to_js: float -> t = "caml_js_from_float" 26 | 27 | val array_of_js: (t -> 'a) -> t -> 'a array 28 | val array_to_js: ('a -> t) -> 'a array -> t 29 | 30 | val list_of_js: (t -> 'a) -> t -> 'a list 31 | val list_to_js: ('a -> t) -> 'a list -> t 32 | 33 | val array_of_js_from: (t -> 'a) -> t -> int -> 'a array 34 | val list_of_js_from: (t -> 'a) -> t -> int -> 'a list 35 | 36 | val option_of_js: (t -> 'a) -> t -> 'a option 37 | (** Both [null] and [undefined] are mapped to [None]. *) 38 | 39 | val option_to_js: ('a -> t) -> 'a option -> t 40 | (** [None] is mapped to [null]. *) 41 | 42 | val unit_of_js: t -> unit 43 | val unit_to_js: unit -> t 44 | 45 | 46 | (** {2 Wrap OCaml functions as JS functions} *) 47 | 48 | external fun_to_js: int -> (t -> 'a) -> t = "caml_js_wrap_callback_strict" 49 | (** Wrap an OCaml function of known arity (>=1) into a JS function. 50 | Extra arguments are discarded and missing argument are filled with 51 | 'undefined'. 52 | *) 53 | 54 | external fun_to_js_args: (t -> 'a) -> t = "caml_ojs_wrap_fun_arguments" 55 | (** Wrap an OCaml function taking JS arguments as a JS array. *) 56 | 57 | 58 | (** {2 JS objects} *) 59 | 60 | external get: t -> string -> t = "caml_js_get" 61 | [@@ocaml.deprecated "Use Ojs.get_prop_ascii instead."] 62 | 63 | external set: t -> string -> t -> unit = "caml_js_set" 64 | [@@ocaml.deprecated "Use Ojs.set_prop_ascii instead."] 65 | 66 | external delete: t -> string -> unit = "caml_js_delete" 67 | [@@ocaml.deprecated "Use Ojs.delete_prop_ascii instead."] 68 | 69 | external get_prop_ascii: t -> string -> t = "caml_js_get" 70 | (** Get the property from an object (only works if the property key is a plain ascii string). *) 71 | 72 | external set_prop_ascii: t -> string -> t -> unit = "caml_js_set" 73 | (** Set an object property (only works if the property key is a plain ascii string). *) 74 | 75 | external delete_prop_ascii: t -> string -> unit = "caml_js_delete" 76 | (** Delete an object property (only works if the property key is a plain ascii string). *) 77 | 78 | external get_prop: t -> t -> t = "caml_js_get" 79 | (** Get the property from an object. *) 80 | 81 | external set_prop: t -> t -> t -> unit = "caml_js_set" 82 | (** Set an object property. *) 83 | 84 | external delete_prop: t -> t -> unit = "caml_js_delete" 85 | (** Delete an object property. *) 86 | 87 | external obj: (string * t) array -> t = "caml_js_object" 88 | 89 | val empty_obj: unit -> t 90 | 91 | val has_property: t -> string -> bool 92 | val iter_properties: t -> (string -> unit) -> unit 93 | 94 | (** {2 Calling JS functions} *) 95 | 96 | external call: t -> string -> t array -> t = "caml_js_meth_call" 97 | (** Call a method on an object (binding 'this' to the object). *) 98 | 99 | external apply: t -> t array -> t = "caml_js_fun_call" 100 | (** Call a function. *) 101 | 102 | external new_obj: t -> t array -> t = "caml_js_new" 103 | (** Call a constructor *) 104 | 105 | val call_arr: t -> string -> t -> t 106 | (** Variant of [Ojs.call] where the arguments are passed as an already 107 | built JS array. *) 108 | 109 | val apply_arr: t -> t -> t 110 | (** Variant of [Ojs.apply] where the arguments are passed as an already 111 | built JS array. *) 112 | 113 | external new_obj_arr: t -> t -> t = "caml_ojs_new_arr" 114 | (** Variant of [Ojs.new_obj] where the arguments are passed as an already 115 | built JS array. *) 116 | 117 | (** {2 Arrays} *) 118 | 119 | val array_make: int -> t 120 | val array_get: t -> int -> t 121 | val array_set: t -> int -> t -> unit 122 | 123 | (** {2 Misc} *) 124 | 125 | val global: t 126 | val null: t 127 | 128 | external variable: string -> t = "caml_js_var" 129 | 130 | val type_of: t -> string 131 | 132 | val instance_of: t -> constr:t -> bool 133 | 134 | class obj: t -> 135 | object 136 | method to_js: t 137 | end 138 | 139 | val is_null: t -> bool 140 | 141 | val obj_type: t -> string 142 | (** Returns: 143 | "[object Array]" 144 | "[object Object]" 145 | "[object Number]" 146 | "[object String]" 147 | "[object Null]" 148 | "[object Boolean]" 149 | *) 150 | 151 | module type T = 152 | sig 153 | type js := t 154 | type t 155 | val t_to_js : t -> js 156 | val t_of_js : js -> t 157 | end 158 | 159 | (* Ojs.T instances for built-in types *) 160 | module Int : T with type t = int 161 | module String : T with type t = string 162 | module Bool : T with type t = bool 163 | module Float : T with type t = float 164 | module Array (A: T) : T with type t = A.t array 165 | module List (A: T) : T with type t = A.t list 166 | module Option (A: T) : T with type t = A.t option -------------------------------------------------------------------------------- /lib/ojs_exn.ml: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | type t = Jsoo_runtime.Error.t 6 | 7 | external coerce : t -> Ojs.t = "%identity" 8 | let name x = Ojs.string_of_js (Ojs.get_prop_ascii (coerce x) "name") 9 | let message x = Ojs.string_of_js (Ojs.get_prop_ascii (coerce x) "message") 10 | let stack x = Ojs.option_of_js Ojs.string_of_js (Ojs.get_prop_ascii (coerce x) "stack") 11 | let to_string x = Ojs.string_of_js (Ojs.call (coerce x) "toString" [||]) 12 | 13 | exception Error = Jsoo_runtime.Error.Exn 14 | 15 | let () = 16 | Printexc.register_printer (function 17 | | Error x -> Some (to_string x) 18 | | _ -> None 19 | ) 20 | -------------------------------------------------------------------------------- /lib/ojs_exn.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | (** OCaml view on JS exceptions *) 6 | 7 | type t 8 | 9 | val name: t -> string 10 | val message: t -> string 11 | val stack: t -> string option 12 | val to_string: t -> string 13 | 14 | exception Error of t 15 | -------------------------------------------------------------------------------- /lib/ojs_runtime.js: -------------------------------------------------------------------------------- 1 | //Provides: caml_ojs_wrap_fun_arguments 2 | //Requires: caml_js_wrap_callback 3 | function caml_ojs_wrap_fun_arguments(f) { 4 | return function() { 5 | return caml_js_wrap_callback(f)(arguments); 6 | } 7 | } 8 | 9 | //Provides: caml_ojs_iterate_properties 10 | //Requires: caml_js_to_string 11 | function caml_ojs_iterate_properties(o, f) { 12 | var name; 13 | for(name in o) { 14 | if(o.hasOwnProperty(name)) { 15 | f(name); 16 | } 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /lib/ojs_runtime_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | void caml_ojs_wrap_fun_arguments () { 4 | fprintf(stderr, "Unimplemented JavaScript primitive caml_ojs_wrap_fun_arguments!\n"); 5 | exit(1); 6 | } 7 | void caml_ojs_iterate_properties () { 8 | fprintf(stderr, "Unimplemented JavaScript primitive caml_ojs_iterate_properties!\n"); 9 | exit(1); 10 | } 11 | -------------------------------------------------------------------------------- /node-test/bindings/arrays.mli: -------------------------------------------------------------------------------- 1 | module JsArray (E: Ojs.T): sig 2 | type t 3 | val t_to_js: t -> Ojs.t 4 | val t_of_js: Ojs.t -> t 5 | 6 | val create: unit -> t [@@js.new "Array"] 7 | val push: t -> E.t -> unit [@@js.call] 8 | val pop: t -> E.t option [@@js.call] 9 | end 10 | 11 | module UntypedArray : sig 12 | include (module type of JsArray(Ojs)) 13 | end 14 | 15 | module StringArray : sig 16 | include (module type of JsArray(Ojs.String)) 17 | 18 | val join: t -> string -> string [@@js.call] 19 | end 20 | 21 | module[@js.scope "Array"] JsArray2: sig 22 | type 'a t 23 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 24 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 25 | 26 | val create: unit -> 'a t [@@js.create] 27 | val create': (module[@js] Ojs.T with type t = 'a) -> ('a list [@js.variadic]) -> 'a t [@@js.create] 28 | 29 | val push: (module[@js] Ojs.T with type t = 'a) -> 'a t -> 'a -> unit [@@js.call] 30 | val pop: (module[@js] Ojs.T with type t = 'a) -> 'a t -> 'a option [@@js.call] 31 | 32 | val get: (module[@js] Ojs.T with type t = 'a) -> 'a t -> int -> 'a option [@@js.index_get] 33 | val set: (module[@js] Ojs.T with type t = 'a) -> 'a t -> int -> 'a -> unit [@@js.index_set] 34 | 35 | val join: string t -> string -> string [@@js.call] 36 | end -------------------------------------------------------------------------------- /node-test/bindings/buffer.mli: -------------------------------------------------------------------------------- 1 | [@@@js.scope "Buffer"] 2 | 3 | type t = private Ojs.t 4 | val t_of_js: Ojs.t -> t 5 | val t_to_js: t -> Ojs.t 6 | 7 | val alloc: int -> t[@@js.global] 8 | val from: string -> t[@@js.global] 9 | val concat: t list -> t[@@js.global] 10 | 11 | val length: t -> int [@@js.get] 12 | val get: t -> int -> int option [@@js.index_get] 13 | val set: t -> int -> int -> unit[@@js.index_set] 14 | val write: t -> string -> int[@@js.call] 15 | val slice: t -> int -> int -> t[@@js.call] 16 | val to_string: t -> string[@@js.call] 17 | val copy: t -> dst:t -> start:int -> dst_start:int -> dst_end:int -> int[@@js.call] 18 | -------------------------------------------------------------------------------- /node-test/bindings/console.mli: -------------------------------------------------------------------------------- 1 | [@@@js.scope "console"] 2 | 3 | val log: 'a -> unit [@@js.global] 4 | val error: 'a -> unit [@@js.global] 5 | 6 | module T : sig 7 | val log: (module[@js] Ojs.T with type t = 'a) -> 'a -> unit [@@js.global] 8 | val error: (module[@js] Ojs.T with type t = 'a) -> 'a -> unit [@@js.global] 9 | end -------------------------------------------------------------------------------- /node-test/bindings/container.ml: -------------------------------------------------------------------------------- 1 | module StringMap = struct 2 | include Map.Make(String) 3 | 4 | let t_to_js ml2js l = 5 | let o = Ojs.empty_obj () in 6 | iter (fun k v -> Ojs.set_prop o (Ojs.string_to_js k) (ml2js v)) l; 7 | o 8 | 9 | let t_of_js js2ml o = 10 | let l = ref empty in 11 | Ojs.iter_properties o 12 | (fun k -> l := add k (js2ml (Ojs.get_prop o (Ojs.string_to_js k))) !l); 13 | !l 14 | end 15 | -------------------------------------------------------------------------------- /node-test/bindings/container.mli: -------------------------------------------------------------------------------- 1 | module StringMap : sig 2 | include Map.S with type key = string 3 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 4 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 5 | end -------------------------------------------------------------------------------- /node-test/bindings/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name node) 3 | (synopsis "Bindings") 4 | (libraries ojs) 5 | (preprocess 6 | (pps gen_js_api.ppx)) 7 | (modes byte) 8 | (js_of_ocaml 9 | (javascript_files imports.js))) 10 | 11 | (rule 12 | (targets imports.ml) 13 | (deps imports.mli) 14 | (action 15 | (run gen_js_api %{deps}))) 16 | 17 | (rule 18 | (alias runtest) 19 | (action 20 | (diff expected/imports.ml imports.ml))) 21 | 22 | (rule 23 | (targets errors.ml) 24 | (deps errors.mli) 25 | (action 26 | (run gen_js_api %{deps}))) 27 | 28 | (rule 29 | (alias runtest) 30 | (action 31 | (diff expected/errors.ml errors.ml))) 32 | 33 | (rule 34 | (targets global.ml) 35 | (deps global.mli) 36 | (action 37 | (run gen_js_api %{deps}))) 38 | 39 | (rule 40 | (alias runtest) 41 | (action 42 | (diff expected/global.ml global.ml))) 43 | 44 | (rule 45 | (targets promise.ml) 46 | (deps promise.mli) 47 | (action 48 | (run gen_js_api %{deps}))) 49 | 50 | (rule 51 | (alias runtest) 52 | (action 53 | (diff expected/promise.ml promise.ml))) 54 | 55 | (rule 56 | (targets buffer.ml) 57 | (deps buffer.mli) 58 | (action 59 | (run gen_js_api %{deps}))) 60 | 61 | (rule 62 | (alias runtest) 63 | (action 64 | (diff expected/buffer.ml buffer.ml))) 65 | 66 | (rule 67 | (targets fs.ml) 68 | (deps fs.mli) 69 | (action 70 | (run gen_js_api %{deps}))) 71 | 72 | (rule 73 | (alias runtest) 74 | (action 75 | (diff expected/fs.ml fs.ml))) 76 | 77 | (rule 78 | (targets path.ml) 79 | (deps path.mli) 80 | (action 81 | (run gen_js_api %{deps}))) 82 | 83 | (rule 84 | (alias runtest) 85 | (action 86 | (diff expected/path.ml path.ml))) 87 | 88 | (rule 89 | (targets process.ml) 90 | (deps process.mli) 91 | (action 92 | (run gen_js_api %{deps}))) 93 | 94 | (rule 95 | (alias runtest) 96 | (action 97 | (diff expected/process.ml process.ml))) 98 | 99 | (rule 100 | (targets console.ml) 101 | (deps console.mli) 102 | (action 103 | (run gen_js_api %{deps}))) 104 | 105 | (rule 106 | (alias runtest) 107 | (action 108 | (diff expected/console.ml console.ml))) 109 | 110 | (rule 111 | (targets arrays.ml) 112 | (deps arrays.mli) 113 | (action 114 | (run gen_js_api %{deps}))) 115 | 116 | (rule 117 | (alias runtest) 118 | (action 119 | (diff expected/arrays.ml arrays.ml))) 120 | 121 | (rule 122 | (targets number.ml) 123 | (deps number.mli) 124 | (action 125 | (run gen_js_api %{deps}))) 126 | 127 | (rule 128 | (alias runtest) 129 | (action 130 | (diff expected/number.ml number.ml))) -------------------------------------------------------------------------------- /node-test/bindings/errors.mli: -------------------------------------------------------------------------------- 1 | module [@js.scope] Error : sig 2 | type t 3 | val t_to_js: t -> Ojs.t 4 | val t_of_js: Ojs.t -> t 5 | 6 | val create: string -> t [@@js.create] 7 | val stack_trace_limit: int [@@js.global] 8 | val set_stack_trace_limit: int -> unit [@@js.set] 9 | 10 | val code: t -> string [@@js.get] 11 | val message: t -> string [@@js.get] 12 | val stack: t -> string [@@js.get] 13 | end 14 | -------------------------------------------------------------------------------- /node-test/bindings/expected/arrays.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module JsArray(E:Ojs.T) = 4 | struct 5 | type t = Ojs.t 6 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 7 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 8 | let (create : unit -> t) = 9 | fun () -> 10 | t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") [||]) 11 | let (push : t -> E.t -> unit) = 12 | fun (x4 : t) -> 13 | fun (x3 : E.t) -> 14 | ignore (Ojs.call (t_to_js x4) "push" [|(E.t_to_js x3)|]) 15 | let (pop : t -> E.t option) = 16 | fun (x5 : t) -> 17 | Ojs.option_of_js E.t_of_js (Ojs.call (t_to_js x5) "pop" [||]) 18 | end 19 | module UntypedArray = struct include (JsArray)(Ojs) end 20 | module StringArray = 21 | struct 22 | include (JsArray)(Ojs.String) 23 | let (join : t -> string -> string) = 24 | fun (x8 : t) -> 25 | fun (x7 : string) -> 26 | Ojs.string_of_js 27 | (Ojs.call (t_to_js x8) "join" [|(Ojs.string_to_js x7)|]) 28 | end 29 | module JsArray2 = 30 | struct 31 | type 'a t = Ojs.t 32 | let rec t_of_js : 'a . (Ojs.t -> 'a) -> Ojs.t -> 'a t = 33 | fun (type __a) -> 34 | fun (__a_of_js : Ojs.t -> __a) -> fun (x10 : Ojs.t) -> x10 35 | and t_to_js : 'a . ('a -> Ojs.t) -> 'a t -> Ojs.t = 36 | fun (type __a) -> 37 | fun (__a_to_js : __a -> Ojs.t) -> fun (x9 : Ojs.t) -> x9 38 | let (create : unit -> 'a t) = 39 | fun () -> 40 | t_of_js Obj.magic 41 | (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") [||]) 42 | let (create' : (module Ojs.T with type t = 'a) -> 'a list -> 'a t) = 43 | fun (type a) -> 44 | fun ((module A) : (module Ojs.T with type t = a)) -> 45 | fun (x12 : a list) -> 46 | t_of_js A.t_of_js 47 | (Ojs.new_obj_arr (Ojs.get_prop_ascii Ojs.global "Array") 48 | (let x13 = 49 | Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") [||] in 50 | List.iter 51 | (fun (x14 : a) -> 52 | ignore (Ojs.call x13 "push" [|(A.t_to_js x14)|])) x12; 53 | x13)) 54 | let (push : (module Ojs.T with type t = 'a) -> 'a t -> 'a -> unit) = 55 | fun (type a) -> 56 | fun ((module A) : (module Ojs.T with type t = a)) -> 57 | fun (x17 : a t) -> 58 | fun (x16 : a) -> 59 | ignore 60 | (Ojs.call (t_to_js A.t_to_js x17) "push" [|(A.t_to_js x16)|]) 61 | let (pop : (module Ojs.T with type t = 'a) -> 'a t -> 'a option) = 62 | fun (type a) -> 63 | fun ((module A) : (module Ojs.T with type t = a)) -> 64 | fun (x19 : a t) -> 65 | Ojs.option_of_js A.t_of_js 66 | (Ojs.call (t_to_js A.t_to_js x19) "pop" [||]) 67 | let (get : (module Ojs.T with type t = 'a) -> 'a t -> int -> 'a option) = 68 | fun (type a) -> 69 | fun ((module A) : (module Ojs.T with type t = a)) -> 70 | fun (x22 : a t) -> 71 | fun (x24 : int) -> 72 | Ojs.option_of_js A.t_of_js 73 | (Ojs.array_get (t_to_js A.t_to_js x22) x24) 74 | let (set : (module Ojs.T with type t = 'a) -> 'a t -> int -> 'a -> unit) 75 | = 76 | fun (type a) -> 77 | fun ((module A) : (module Ojs.T with type t = a)) -> 78 | fun (x26 : a t) -> 79 | fun (x28 : int) -> 80 | fun (x29 : a) -> 81 | Ojs.array_set (t_to_js A.t_to_js x26) x28 (A.t_to_js x29) 82 | let (join : string t -> string -> string) = 83 | fun (x31 : string t) -> 84 | fun (x30 : string) -> 85 | Ojs.string_of_js 86 | (Ojs.call (t_to_js Ojs.string_to_js x31) "join" 87 | [|(Ojs.string_to_js x30)|]) 88 | end 89 | -------------------------------------------------------------------------------- /node-test/bindings/expected/buffer.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | type t = Ojs.t 4 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 5 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 6 | let (alloc : int -> t) = 7 | fun (x3 : int) -> 8 | t_of_js 9 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "Buffer") "alloc" 10 | [|(Ojs.int_to_js x3)|]) 11 | let (from : string -> t) = 12 | fun (x4 : string) -> 13 | t_of_js 14 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "Buffer") "from" 15 | [|(Ojs.string_to_js x4)|]) 16 | let (concat : t list -> t) = 17 | fun (x5 : t list) -> 18 | t_of_js 19 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "Buffer") "concat" 20 | [|(Ojs.list_to_js t_to_js x5)|]) 21 | let (length : t -> int) = 22 | fun (x7 : t) -> Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x7) "length") 23 | let (get : t -> int -> int option) = 24 | fun (x8 : t) -> 25 | fun (x9 : int) -> 26 | Ojs.option_of_js Ojs.int_of_js (Ojs.array_get (t_to_js x8) x9) 27 | let (set : t -> int -> int -> unit) = 28 | fun (x11 : t) -> 29 | fun (x12 : int) -> 30 | fun (x13 : int) -> Ojs.array_set (t_to_js x11) x12 (Ojs.int_to_js x13) 31 | let (write : t -> string -> int) = 32 | fun (x15 : t) -> 33 | fun (x14 : string) -> 34 | Ojs.int_of_js 35 | (Ojs.call (t_to_js x15) "write" [|(Ojs.string_to_js x14)|]) 36 | let (slice : t -> int -> int -> t) = 37 | fun (x18 : t) -> 38 | fun (x16 : int) -> 39 | fun (x17 : int) -> 40 | t_of_js 41 | (Ojs.call (t_to_js x18) "slice" 42 | [|(Ojs.int_to_js x16);(Ojs.int_to_js x17)|]) 43 | let (to_string : t -> string) = 44 | fun (x19 : t) -> Ojs.string_of_js (Ojs.call (t_to_js x19) "toString" [||]) 45 | let (copy : t -> dst:t -> start:int -> dst_start:int -> dst_end:int -> int) = 46 | fun (x24 : t) -> 47 | fun ~dst:(x20 : t) -> 48 | fun ~start:(x21 : int) -> 49 | fun ~dst_start:(x22 : int) -> 50 | fun ~dst_end:(x23 : int) -> 51 | Ojs.int_of_js 52 | (Ojs.call (t_to_js x24) "copy" 53 | [|(t_to_js x20);(Ojs.int_to_js x21);(Ojs.int_to_js x22);( 54 | Ojs.int_to_js x23)|]) 55 | -------------------------------------------------------------------------------- /node-test/bindings/expected/console.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | let (log : 'a -> unit) = 4 | fun (x1 : 'a) -> 5 | ignore 6 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" 7 | [|(Obj.magic x1)|]) 8 | let (error : 'a -> unit) = 9 | fun (x2 : 'a) -> 10 | ignore 11 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "error" 12 | [|(Obj.magic x2)|]) 13 | module T = 14 | struct 15 | let (log : (module Ojs.T with type t = 'a) -> 'a -> unit) = 16 | fun (type a) -> 17 | fun ((module A) : (module Ojs.T with type t = a)) -> 18 | fun (x3 : a) -> 19 | ignore 20 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" 21 | [|(A.t_to_js x3)|]) 22 | let (error : (module Ojs.T with type t = 'a) -> 'a -> unit) = 23 | fun (type a) -> 24 | fun ((module A) : (module Ojs.T with type t = a)) -> 25 | fun (x4 : a) -> 26 | ignore 27 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "error" 28 | [|(A.t_to_js x4)|]) 29 | end 30 | -------------------------------------------------------------------------------- /node-test/bindings/expected/errors.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module Error = 4 | struct 5 | type t = Ojs.t 6 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 7 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 8 | let (create : string -> t) = 9 | fun (x3 : string) -> 10 | t_of_js 11 | (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Error") 12 | [|(Ojs.string_to_js x3)|]) 13 | let (stack_trace_limit : int) = 14 | Ojs.int_of_js 15 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Error") 16 | "stackTraceLimit") 17 | let (set_stack_trace_limit : int -> unit) = 18 | fun (x4 : int) -> 19 | Ojs.set_prop_ascii (Ojs.get_prop_ascii Ojs.global "Error") 20 | "stackTraceLimit" (Ojs.int_to_js x4) 21 | let (code : t -> string) = 22 | fun (x5 : t) -> 23 | Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x5) "code") 24 | let (message : t -> string) = 25 | fun (x6 : t) -> 26 | Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x6) "message") 27 | let (stack : t -> string) = 28 | fun (x7 : t) -> 29 | Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x7) "stack") 30 | end 31 | -------------------------------------------------------------------------------- /node-test/bindings/expected/fs.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module Dirent = 4 | struct 5 | type t = Ojs.t 6 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 7 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 8 | let (name : t -> string) = 9 | fun (x3 : t) -> 10 | Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x3) "name") 11 | let (is_file : t -> bool) = 12 | fun (x4 : t) -> Ojs.bool_of_js (Ojs.call (t_to_js x4) "isFile" [||]) 13 | let (is_directory : t -> bool) = 14 | fun (x5 : t) -> 15 | Ojs.bool_of_js (Ojs.call (t_to_js x5) "isDirectory" [||]) 16 | end 17 | module Dir = 18 | struct 19 | type t = Ojs.t 20 | let rec t_of_js : Ojs.t -> t = fun (x7 : Ojs.t) -> x7 21 | and t_to_js : t -> Ojs.t = fun (x6 : Ojs.t) -> x6 22 | let (path : t -> string) = 23 | fun (x8 : t) -> 24 | Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x8) "path") 25 | let (close : t -> unit Promise.t) = 26 | fun (x9 : t) -> 27 | Promise.t_of_js Ojs.unit_of_js (Ojs.call (t_to_js x9) "close" [||]) 28 | let (read : t -> Dirent.t option Promise.t) = 29 | fun (x11 : t) -> 30 | Promise.t_of_js 31 | (fun (x12 : Ojs.t) -> Ojs.option_of_js Dirent.t_of_js x12) 32 | (Ojs.call (t_to_js x11) "read" [||]) 33 | end 34 | module FileHandle = 35 | struct 36 | type t = Ojs.t 37 | let rec t_of_js : Ojs.t -> t = fun (x15 : Ojs.t) -> x15 38 | and t_to_js : t -> Ojs.t = fun (x14 : Ojs.t) -> x14 39 | type read = { 40 | bytes_read: int ; 41 | buffer: Buffer.t } 42 | let rec read_of_js : Ojs.t -> read = 43 | fun (x17 : Ojs.t) -> 44 | { 45 | bytes_read = (Ojs.int_of_js (Ojs.get_prop_ascii x17 "bytesRead")); 46 | buffer = (Buffer.t_of_js (Ojs.get_prop_ascii x17 "buffer")) 47 | } 48 | and read_to_js : read -> Ojs.t = 49 | fun (x16 : read) -> 50 | Ojs.obj 51 | [|("bytesRead", (Ojs.int_to_js x16.bytes_read));("buffer", 52 | (Buffer.t_to_js 53 | x16.buffer))|] 54 | let (append_file : t -> Buffer.t -> unit Promise.t) = 55 | fun (x19 : t) -> 56 | fun (x18 : Buffer.t) -> 57 | Promise.t_of_js Ojs.unit_of_js 58 | (Ojs.call (t_to_js x19) "appendFile" [|(Buffer.t_to_js x18)|]) 59 | let (read : t -> Buffer.t -> int -> int -> int -> read Promise.t) = 60 | fun (x25 : t) -> 61 | fun (x21 : Buffer.t) -> 62 | fun (x22 : int) -> 63 | fun (x23 : int) -> 64 | fun (x24 : int) -> 65 | Promise.t_of_js read_of_js 66 | (Ojs.call (t_to_js x25) "read" 67 | [|(Buffer.t_to_js x21);(Ojs.int_to_js x22);(Ojs.int_to_js 68 | x23);( 69 | Ojs.int_to_js x24)|]) 70 | let (chmod : t -> int -> unit Promise.t) = 71 | fun (x28 : t) -> 72 | fun (x27 : int) -> 73 | Promise.t_of_js Ojs.unit_of_js 74 | (Ojs.call (t_to_js x28) "chmod" [|(Ojs.int_to_js x27)|]) 75 | let (chmown : t -> uid:int -> gid:int -> unit Promise.t) = 76 | fun (x32 : t) -> 77 | fun ~uid:(x30 : int) -> 78 | fun ~gid:(x31 : int) -> 79 | Promise.t_of_js Ojs.unit_of_js 80 | (Ojs.call (t_to_js x32) "chmown" 81 | [|(Ojs.int_to_js x30);(Ojs.int_to_js x31)|]) 82 | let (close : t -> unit Promise.t) = 83 | fun (x34 : t) -> 84 | Promise.t_of_js Ojs.unit_of_js (Ojs.call (t_to_js x34) "close" [||]) 85 | let (datasync : t -> unit Promise.t) = 86 | fun (x36 : t) -> 87 | Promise.t_of_js Ojs.unit_of_js 88 | (Ojs.call (t_to_js x36) "datasync" [||]) 89 | let (fd : t -> int) = 90 | fun (x38 : t) -> Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x38) "fd") 91 | end 92 | let (readdir : string -> string list Promise.t) = 93 | fun (x39 : string) -> 94 | Promise.t_of_js 95 | (fun (x40 : Ojs.t) -> Ojs.list_of_js Ojs.string_of_js x40) 96 | (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "readdir" 97 | [|(Ojs.string_to_js x39)|]) 98 | let (open_ : string -> flag:string -> FileHandle.t Promise.t) = 99 | fun (x42 : string) -> 100 | fun ~flag:(x43 : string) -> 101 | Promise.t_of_js FileHandle.t_of_js 102 | (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "open" 103 | [|(Ojs.string_to_js x42);(Ojs.string_to_js x43)|]) 104 | let (rmdir : string -> unit Promise.t) = 105 | fun (x45 : string) -> 106 | Promise.t_of_js Ojs.unit_of_js 107 | (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "rmdir" 108 | [|(Ojs.string_to_js x45)|]) 109 | let (rename : string -> string -> unit Promise.t) = 110 | fun (x47 : string) -> 111 | fun (x48 : string) -> 112 | Promise.t_of_js Ojs.unit_of_js 113 | (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "rename" 114 | [|(Ojs.string_to_js x47);(Ojs.string_to_js x48)|]) 115 | let (unlink : string -> unit Promise.t) = 116 | fun (x50 : string) -> 117 | Promise.t_of_js Ojs.unit_of_js 118 | (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "unlink" 119 | [|(Ojs.string_to_js x50)|]) 120 | -------------------------------------------------------------------------------- /node-test/bindings/expected/global.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | type timeout_id = Ojs.t 4 | let rec timeout_id_of_js : Ojs.t -> timeout_id = fun (x2 : Ojs.t) -> x2 5 | and timeout_id_to_js : timeout_id -> Ojs.t = fun (x1 : Ojs.t) -> x1 6 | type interval_id = Ojs.t 7 | let rec interval_id_of_js : Ojs.t -> interval_id = fun (x4 : Ojs.t) -> x4 8 | and interval_id_to_js : interval_id -> Ojs.t = fun (x3 : Ojs.t) -> x3 9 | let (set_interval : (unit -> unit) -> int -> interval_id) = 10 | fun (x5 : unit -> unit) -> 11 | fun (x6 : int) -> 12 | interval_id_of_js 13 | (Ojs.call Ojs.global "setInterval" 14 | [|(Ojs.fun_to_js 1 (fun _ -> x5 ()));(Ojs.int_to_js x6)|]) 15 | let (set_timeout : (unit -> unit) -> int -> timeout_id) = 16 | fun (x7 : unit -> unit) -> 17 | fun (x8 : int) -> 18 | timeout_id_of_js 19 | (Ojs.call Ojs.global "setTimeout" 20 | [|(Ojs.fun_to_js 1 (fun _ -> x7 ()));(Ojs.int_to_js x8)|]) 21 | let (clear_timeout : timeout_id -> unit) = 22 | fun (x9 : timeout_id) -> 23 | ignore (Ojs.call Ojs.global "clearTimeout" [|(timeout_id_to_js x9)|]) 24 | let (clear_interval : interval_id -> unit) = 25 | fun (x10 : interval_id) -> 26 | ignore (Ojs.call Ojs.global "clearInterval" [|(interval_id_to_js x10)|]) 27 | -------------------------------------------------------------------------------- /node-test/bindings/expected/imports.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | let (path : Ojs.t) = 4 | Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "__LIB__NODE__IMPORTS") 5 | "path" 6 | let (fs : Ojs.t) = 7 | Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "__LIB__NODE__IMPORTS") 8 | "fs" 9 | -------------------------------------------------------------------------------- /node-test/bindings/expected/number.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | type t = Ojs.t 4 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 5 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 6 | let (toString : t -> ?radix:int -> unit -> float) = 7 | fun (x6 : t) -> 8 | fun ?radix:(x3 : int option) -> 9 | fun () -> 10 | Ojs.float_of_js 11 | (let x7 = t_to_js x6 in 12 | Ojs.call (Ojs.get_prop_ascii x7 "toString") "apply" 13 | [|x7;((let x4 = 14 | Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") 15 | [||] in 16 | (match x3 with 17 | | Some x5 -> 18 | ignore (Ojs.call x4 "push" [|(Ojs.int_to_js x5)|]) 19 | | None -> ()); 20 | x4))|]) 21 | let (toFixed : t -> ?fractionDigits:int -> unit -> float) = 22 | fun (x11 : t) -> 23 | fun ?fractionDigits:(x8 : int option) -> 24 | fun () -> 25 | Ojs.float_of_js 26 | (let x12 = t_to_js x11 in 27 | Ojs.call (Ojs.get_prop_ascii x12 "toFixed") "apply" 28 | [|x12;((let x9 = 29 | Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") 30 | [||] in 31 | (match x8 with 32 | | Some x10 -> 33 | ignore (Ojs.call x9 "push" [|(Ojs.int_to_js x10)|]) 34 | | None -> ()); 35 | x9))|]) 36 | let (toExponential : t -> ?fractionDigits:int -> unit -> float) = 37 | fun (x16 : t) -> 38 | fun ?fractionDigits:(x13 : int option) -> 39 | fun () -> 40 | Ojs.float_of_js 41 | (let x17 = t_to_js x16 in 42 | Ojs.call (Ojs.get_prop_ascii x17 "toExponential") "apply" 43 | [|x17;((let x14 = 44 | Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") 45 | [||] in 46 | (match x13 with 47 | | Some x15 -> 48 | ignore 49 | (Ojs.call x14 "push" [|(Ojs.int_to_js x15)|]) 50 | | None -> ()); 51 | x14))|]) 52 | let (toPrecision : t -> ?precision:int -> unit -> float) = 53 | fun (x21 : t) -> 54 | fun ?precision:(x18 : int option) -> 55 | fun () -> 56 | Ojs.float_of_js 57 | (let x22 = t_to_js x21 in 58 | Ojs.call (Ojs.get_prop_ascii x22 "toPrecision") "apply" 59 | [|x22;((let x19 = 60 | Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") 61 | [||] in 62 | (match x18 with 63 | | Some x20 -> 64 | ignore 65 | (Ojs.call x19 "push" [|(Ojs.int_to_js x20)|]) 66 | | None -> ()); 67 | x19))|]) 68 | let (valueOf : t -> float) = 69 | fun (x23 : t) -> Ojs.float_of_js (Ojs.call (t_to_js x23) "valueOf" [||]) 70 | module Scoped = 71 | struct 72 | let (create : 'any -> t) = 73 | fun (x24 : 'any) -> 74 | t_of_js 75 | (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Number") 76 | [|(Obj.magic x24)|]) 77 | let (invoke : 'any -> float) = 78 | fun (x25 : 'any) -> 79 | Ojs.float_of_js 80 | (Ojs.apply (Ojs.get_prop_ascii Ojs.global "Number") 81 | [|(Obj.magic x25)|]) 82 | let (min_value : float) = 83 | Ojs.float_of_js 84 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") 85 | "MIN_VALUE") 86 | let (max_value : float) = 87 | Ojs.float_of_js 88 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") 89 | "MAX_VALUE") 90 | let (nan : float) = 91 | Ojs.float_of_js 92 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") "NaN") 93 | let (negative_infinity : float) = 94 | Ojs.float_of_js 95 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") 96 | "NEGATIVE_INFINITY") 97 | let (positive_infinity : float) = 98 | Ojs.float_of_js 99 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") 100 | "POSITIVE_INFINITY") 101 | end 102 | module Static = 103 | struct 104 | type number = t 105 | let rec number_of_js : Ojs.t -> number = fun (x27 : Ojs.t) -> t_of_js x27 106 | and number_to_js : number -> Ojs.t = fun (x26 : t) -> t_to_js x26 107 | type t = Ojs.t 108 | let rec t_of_js : Ojs.t -> t = fun (x29 : Ojs.t) -> x29 109 | and t_to_js : t -> Ojs.t = fun (x28 : Ojs.t) -> x28 110 | let (create : t -> 'any -> number) = 111 | fun (x31 : t) -> 112 | fun (x30 : 'any) -> 113 | number_of_js (Ojs.new_obj (t_to_js x31) [|(Obj.magic x30)|]) 114 | let (apply : t -> 'any -> float) = 115 | fun (x33 : t) -> 116 | fun (x32 : 'any) -> 117 | Ojs.float_of_js (Ojs.apply (t_to_js x33) [|(Obj.magic x32)|]) 118 | let (min_value : t -> float) = 119 | fun (x34 : t) -> 120 | Ojs.float_of_js (Ojs.get_prop_ascii (t_to_js x34) "MIN_VALUE") 121 | let (max_value : t -> float) = 122 | fun (x35 : t) -> 123 | Ojs.float_of_js (Ojs.get_prop_ascii (t_to_js x35) "MAX_VALUE") 124 | let (nan : t -> float) = 125 | fun (x36 : t) -> 126 | Ojs.float_of_js (Ojs.get_prop_ascii (t_to_js x36) "NaN") 127 | let (negative_infinity : t -> float) = 128 | fun (x37 : t) -> 129 | Ojs.float_of_js 130 | (Ojs.get_prop_ascii (t_to_js x37) "NEGATIVE_INFINITY") 131 | let (positive_infinity : t -> float) = 132 | fun (x38 : t) -> 133 | Ojs.float_of_js 134 | (Ojs.get_prop_ascii (t_to_js x38) "POSITIVE_INFINITY") 135 | end 136 | let (number : Static.t) = 137 | Static.t_of_js (Ojs.get_prop_ascii Ojs.global "Number") 138 | -------------------------------------------------------------------------------- /node-test/bindings/expected/path.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | let (sep : string) = Ojs.string_of_js (Ojs.get_prop_ascii Imports.path "sep") 4 | let (dirname : string -> string) = 5 | fun (x1 : string) -> 6 | Ojs.string_of_js 7 | (Ojs.call Imports.path "dirname" [|(Ojs.string_to_js x1)|]) 8 | let (extname : string -> string) = 9 | fun (x2 : string) -> 10 | Ojs.string_of_js 11 | (Ojs.call Imports.path "extname" [|(Ojs.string_to_js x2)|]) 12 | let (is_absolute : string -> bool) = 13 | fun (x3 : string) -> 14 | Ojs.bool_of_js 15 | (Ojs.call Imports.path "isAbsolute" [|(Ojs.string_to_js x3)|]) 16 | let (join : string list -> string) = 17 | fun (x4 : string list) -> 18 | Ojs.string_of_js 19 | (let x7 = Imports.path in 20 | Ojs.call (Ojs.get_prop_ascii x7 "join") "apply" 21 | [|x7;((let x5 = 22 | Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") [||] in 23 | List.iter 24 | (fun (x6 : string) -> 25 | ignore (Ojs.call x5 "push" [|(Ojs.string_to_js x6)|])) 26 | x4; 27 | x5))|]) 28 | let (normalize : string -> string) = 29 | fun (x8 : string) -> 30 | Ojs.string_of_js 31 | (Ojs.call Imports.path "normalize" [|(Ojs.string_to_js x8)|]) 32 | type parse_result = 33 | { 34 | dir: string ; 35 | root: string ; 36 | base: string ; 37 | name: string ; 38 | ext: string } 39 | let rec parse_result_of_js : Ojs.t -> parse_result = 40 | fun (x10 : Ojs.t) -> 41 | { 42 | dir = (Ojs.string_of_js (Ojs.get_prop_ascii x10 "dir")); 43 | root = (Ojs.string_of_js (Ojs.get_prop_ascii x10 "root")); 44 | base = (Ojs.string_of_js (Ojs.get_prop_ascii x10 "base")); 45 | name = (Ojs.string_of_js (Ojs.get_prop_ascii x10 "name")); 46 | ext = (Ojs.string_of_js (Ojs.get_prop_ascii x10 "ext")) 47 | } 48 | and parse_result_to_js : parse_result -> Ojs.t = 49 | fun (x9 : parse_result) -> 50 | Ojs.obj 51 | [|("dir", (Ojs.string_to_js x9.dir));("root", 52 | (Ojs.string_to_js x9.root)); 53 | ("base", (Ojs.string_to_js x9.base));("name", 54 | (Ojs.string_to_js x9.name)); 55 | ("ext", (Ojs.string_to_js x9.ext))|] 56 | let (parse : string -> parse_result) = 57 | fun (x11 : string) -> 58 | parse_result_of_js 59 | (Ojs.call Imports.path "parse" [|(Ojs.string_to_js x11)|]) 60 | -------------------------------------------------------------------------------- /node-test/bindings/expected/process.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | let (env : string Container.StringMap.t) = 4 | Container.StringMap.t_of_js Ojs.string_of_js 5 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "process") "env") 6 | let (version : string option) = 7 | Ojs.option_of_js Ojs.string_of_js 8 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "process") "version") 9 | -------------------------------------------------------------------------------- /node-test/bindings/expected/promise.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module UntypedPromise = 4 | struct 5 | type t = Ojs.t 6 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 7 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 8 | let (resolve : Ojs.t -> Ojs.t) = 9 | fun (x3 : Ojs.t) -> 10 | Ojs.call (Ojs.get_prop_ascii Ojs.global "Promise") "resolve" [|x3|] 11 | let (reject : Ojs.t -> Ojs.t) = 12 | fun (x4 : Ojs.t) -> 13 | Ojs.call (Ojs.get_prop_ascii Ojs.global "Promise") "reject" [|x4|] 14 | let (then_ : 15 | Ojs.t -> success:(Ojs.t -> Ojs.t) -> error:(Ojs.t -> Ojs.t) -> Ojs.t) = 16 | fun (x9 : Ojs.t) -> 17 | fun ~success:(x5 : Ojs.t -> Ojs.t) -> 18 | fun ~error:(x7 : Ojs.t -> Ojs.t) -> 19 | Ojs.call x9 "then" [|(Ojs.fun_to_js 1 x5);(Ojs.fun_to_js 1 x7)|] 20 | let (all : Ojs.t list -> Ojs.t) = 21 | fun (x10 : Ojs.t list) -> 22 | Ojs.call (Ojs.get_prop_ascii Ojs.global "Promise") "all" 23 | [|(Ojs.list_to_js (fun (x11 : Ojs.t) -> x11) x10)|] 24 | include 25 | struct 26 | type wrap = { 27 | content: Ojs.t } 28 | [@@@ocaml.warning "-7-32-39"] 29 | let rec wrap_of_js : Ojs.t -> wrap = 30 | fun (x13 : Ojs.t) -> 31 | { content = (Ojs.get_prop_ascii x13 "content") } 32 | and wrap_to_js : wrap -> Ojs.t = 33 | fun (x12 : wrap) -> Ojs.obj [|("content", (x12.content))|] 34 | end 35 | let is_promise o = (resolve o) == o 36 | let wrap o = if is_promise o then wrap_to_js { content = o } else o 37 | let unwrap o = 38 | if Ojs.has_property o "content" 39 | then Ojs.get_prop_ascii o "content" 40 | else o 41 | let return x = resolve (wrap x) 42 | let fail err = reject (wrap err) 43 | let bind ?(error= fail) p f = 44 | then_ p ~success:(fun x -> f (unwrap x)) 45 | ~error:(fun x -> error (unwrap x)) 46 | end 47 | type 'a t = UntypedPromise.t 48 | type error = Ojs.t 49 | let fail error = UntypedPromise.fail error 50 | let return x = UntypedPromise.return (Obj.magic x) 51 | let bind ?error p f = 52 | UntypedPromise.bind ?error p (fun x -> f (Obj.magic x)) 53 | let prod p1 p2 = 54 | bind (UntypedPromise.all [p1; p2]) 55 | (fun ojs -> 56 | match Ojs.list_of_js Ojs.t_of_js ojs with 57 | | x1::x2::[] -> return (x1, x2) 58 | | _ -> assert false) 59 | let map f p = bind p (fun x -> return (f x)) 60 | let t_to_js f p = UntypedPromise.t_to_js (map f p) 61 | let t_of_js f p = map f (UntypedPromise.t_of_js p) 62 | let (let+) p f = map f p 63 | let (and+) = prod 64 | let ( let* ) p f = bind p f 65 | let ( and* ) = prod 66 | let catch p error = bind p ~error return 67 | -------------------------------------------------------------------------------- /node-test/bindings/fs.mli: -------------------------------------------------------------------------------- 1 | [@@@js.scope (Imports.fs, "promises")] 2 | 3 | module Dirent : sig 4 | type t = Ojs.t 5 | val t_of_js: Ojs.t -> t 6 | val t_to_js: t -> Ojs.t 7 | 8 | val name: t -> string [@@js.get] 9 | val is_file: t -> bool [@@js.call] 10 | val is_directory: t -> bool [@@js.call] 11 | end 12 | 13 | module Dir : sig 14 | type t = Ojs.t 15 | val t_of_js: Ojs.t -> t 16 | val t_to_js: t -> Ojs.t 17 | 18 | 19 | val path: t -> string [@@js.get] 20 | val close: t -> unit Promise.t [@@js.call] 21 | val read:t -> Dirent.t option Promise.t [@@js.call] 22 | end 23 | 24 | module FileHandle : sig 25 | type t = Ojs.t 26 | val t_of_js: Ojs.t -> t 27 | val t_to_js: t -> Ojs.t 28 | 29 | type read = { 30 | bytes_read: int; 31 | buffer: Buffer.t; 32 | } 33 | 34 | val append_file: t -> Buffer.t -> unit Promise.t [@@js.call] 35 | val read: t -> Buffer.t -> int -> int -> int -> read Promise.t [@@js.call] 36 | val chmod: t -> int -> unit Promise.t [@@js.call] 37 | val chmown: t -> uid:int -> gid:int -> unit Promise.t [@@js.call] 38 | val close: t -> unit Promise.t [@@js.call] 39 | val datasync: t -> unit Promise.t [@@js.call] 40 | val fd: t -> int [@@js.get] 41 | end 42 | 43 | val readdir: string -> string list Promise.t [@@js.global] 44 | val open_: string -> flag:string -> FileHandle.t Promise.t [@@js.global] 45 | val rmdir: string -> unit Promise.t [@@js.global] 46 | val rename: string -> string -> unit Promise.t [@@js.global] 47 | val unlink: string -> unit Promise.t [@@js.global] 48 | -------------------------------------------------------------------------------- /node-test/bindings/global.mli: -------------------------------------------------------------------------------- 1 | type timeout_id 2 | val timeout_id_to_js: timeout_id -> Ojs.t 3 | val timeout_id_of_js: Ojs.t -> timeout_id 4 | 5 | type interval_id 6 | val interval_id_to_js: interval_id -> Ojs.t 7 | val interval_id_of_js: Ojs.t -> interval_id 8 | 9 | 10 | val set_interval: (unit -> unit) -> int -> interval_id [@@js.global] 11 | val set_timeout: (unit -> unit) -> int -> timeout_id [@@js.global] 12 | val clear_timeout: timeout_id -> unit [@@js.global] 13 | val clear_interval: interval_id -> unit [@@js.global] 14 | -------------------------------------------------------------------------------- /node-test/bindings/imports.js: -------------------------------------------------------------------------------- 1 | globalThis.__LIB__NODE__IMPORTS = { 2 | path: require('path'), 3 | fs: require('fs'), 4 | }; 5 | -------------------------------------------------------------------------------- /node-test/bindings/imports.mli: -------------------------------------------------------------------------------- 1 | [@@@js.scope "__LIB__NODE__IMPORTS"] 2 | 3 | val path: Ojs.t [@@js.global] 4 | val fs: Ojs.t [@@js.global] 5 | -------------------------------------------------------------------------------- /node-test/bindings/number.mli: -------------------------------------------------------------------------------- 1 | type t = private Ojs.t 2 | 3 | val toString: t -> ?radix:int -> unit -> float [@@js.call] 4 | val toFixed: t -> ?fractionDigits:int -> unit -> float [@@js.call] 5 | val toExponential: t -> ?fractionDigits:int -> unit -> float [@@js.call] 6 | val toPrecision: t -> ?precision:int -> unit -> float [@@js.call] 7 | val valueOf: t -> float [@@js.call] 8 | 9 | (* scoped *) 10 | 11 | module [@js.scope "Number"] Scoped : sig 12 | val create: 'any -> t [@@js.create] 13 | val invoke: 'any -> float [@@js.invoke] 14 | 15 | val min_value: float [@@js.global "MIN_VALUE"] 16 | val max_value: float [@@js.global "MAX_VALUE"] 17 | val nan: float [@@js.global "NaN"] 18 | val negative_infinity: float [@@js.global "NEGATIVE_INFINITY"] 19 | val positive_infinity: float [@@js.global "POSITIVE_INFINITY"] 20 | end 21 | 22 | (* non-scoped *) 23 | 24 | module Static : sig 25 | type number = t 26 | type t = private Ojs.t 27 | 28 | val create: t -> 'any -> number [@@js.apply_newable] 29 | val apply: t -> 'any -> float [@@js.apply] 30 | 31 | val min_value: t -> float [@@js.get "MIN_VALUE"] 32 | val max_value: t -> float [@@js.get "MAX_VALUE"] 33 | val nan: t -> float [@@js.get "NaN"] 34 | val negative_infinity: t -> float [@@js.get "NEGATIVE_INFINITY"] 35 | val positive_infinity: t -> float [@@js.get "POSITIVE_INFINITY"] 36 | end 37 | val number: Static.t [@@js.global "Number"] -------------------------------------------------------------------------------- /node-test/bindings/path.mli: -------------------------------------------------------------------------------- 1 | [@@@js.scope Imports.path] 2 | 3 | val sep: string [@@js.global] 4 | val dirname: string -> string [@@js.global] 5 | val extname: string -> string [@@js.global] 6 | val is_absolute: string -> bool [@@js.global] 7 | val join: (string list [@js.variadic]) -> string [@@js.global] 8 | val normalize: string -> string [@@js.global] 9 | 10 | type parse_result = 11 | { 12 | dir: string; 13 | root: string; 14 | base: string; 15 | name: string; 16 | ext: string 17 | } 18 | 19 | val parse: string -> parse_result [@@js.global] 20 | -------------------------------------------------------------------------------- /node-test/bindings/process.mli: -------------------------------------------------------------------------------- 1 | [@@@js.scope "process"] 2 | 3 | val env : string Container.StringMap.t [@@js.global] 4 | val version: string option [@@js.global] -------------------------------------------------------------------------------- /node-test/bindings/promise.mli: -------------------------------------------------------------------------------- 1 | module UntypedPromise : sig 2 | 3 | type t = private Ojs.t 4 | val t_to_js: t -> Ojs.t 5 | val t_of_js: Ojs.t -> t 6 | 7 | [@@@js.stop] 8 | val return: Ojs.t -> t 9 | val fail: Ojs.t -> t 10 | val bind: ?error:(Ojs.t -> t) -> t -> (Ojs.t -> t) -> t 11 | val all: Ojs.t list -> t 12 | [@@@js.start] 13 | 14 | [@@@js.implem 15 | val resolve: Ojs.t -> Ojs.t [@@js.global "Promise.resolve"] 16 | val reject: Ojs.t -> Ojs.t [@@js.global "Promise.reject"] 17 | val then_: Ojs.t -> success:(Ojs.t -> Ojs.t) -> error:(Ojs.t -> Ojs.t) -> Ojs.t [@@js.call "then"] 18 | val all: Ojs.t list -> Ojs.t [@@js.global "Promise.all"] 19 | 20 | type wrap = { content: Ojs.t }[@@js] 21 | 22 | let is_promise o = 23 | resolve o == o 24 | 25 | let wrap o = 26 | if is_promise o then 27 | wrap_to_js { content = o } 28 | else o 29 | 30 | let unwrap o = 31 | if Ojs.has_property o "content" then 32 | Ojs.get_prop_ascii o "content" 33 | else 34 | o 35 | 36 | let return x = resolve (wrap x) 37 | let fail err = reject (wrap err) 38 | let bind ?(error = fail) p f = 39 | then_ p ~success:(fun x -> f (unwrap x)) 40 | ~error:(fun x -> error (unwrap x)) 41 | 42 | ] 43 | end 44 | 45 | [@@@js.stop] 46 | type 'a t 47 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 48 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 49 | 50 | type error = Ojs.t 51 | 52 | val fail: error -> 'a t 53 | val return: 'a -> 'a t 54 | val bind: ?error:(error -> 'b t) -> 'a t -> ('a -> 'b t) -> 'b t 55 | val map: ('a -> 'b) -> 'a t -> 'b t 56 | val prod: 'a t -> 'b t -> ('a * 'b) t 57 | 58 | val ( let+ ): 'a t -> ('a -> 'b) -> 'b t 59 | val ( and+ ): 'a t -> 'b t -> ('a * 'b) t 60 | val ( let* ): 'a t -> ('a -> 'b t) -> 'b t 61 | val ( and* ): 'a t -> 'b t -> ('a * 'b) t 62 | 63 | val catch: 'a t -> (error -> 'a t) -> 'a t 64 | 65 | [@@@js.start] 66 | [@@@js.implem 67 | type 'a t = UntypedPromise.t 68 | type error = Ojs.t 69 | let fail error = UntypedPromise.fail error 70 | let return x = UntypedPromise.return (Obj.magic x) 71 | let bind ?error p f = 72 | UntypedPromise.bind ?error p 73 | (fun x -> f (Obj.magic x)) 74 | 75 | let prod p1 p2 = 76 | bind (UntypedPromise.all [p1; p2]) 77 | (fun ojs -> 78 | match Ojs.list_of_js Ojs.t_of_js ojs with 79 | | [x1; x2] -> return (x1, x2) 80 | | _ -> assert false 81 | ) 82 | let map f p = bind p (fun x -> return (f x)) 83 | let t_to_js f p = UntypedPromise.t_to_js (map f p) 84 | let t_of_js f p = map f (UntypedPromise.t_of_js p) 85 | 86 | let (let+) p f = map f p 87 | let (and+) = prod 88 | let (let*) p f = bind p f 89 | let (and*) = prod 90 | 91 | let catch p error = bind p ~error return 92 | 93 | ] 94 | -------------------------------------------------------------------------------- /node-test/test1/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (libraries ojs node) 4 | (preprocess 5 | (pps gen_js_api.ppx)) 6 | (modes js) 7 | (js_of_ocaml 8 | (javascript_files recursive.js))) 9 | 10 | (rule 11 | (targets recursive.ml) 12 | (deps recursive.mli) 13 | (action 14 | (run gen_js_api %{deps}))) 15 | 16 | (rule 17 | (alias runtest) 18 | (enabled_if %{bin-available:node}) 19 | (action 20 | (run node %{dep:./test.bc.js}))) 21 | -------------------------------------------------------------------------------- /node-test/test1/recursive.js: -------------------------------------------------------------------------------- 1 | var Foo = /*#__PURE__*/function () { 2 | "use strict"; 3 | 4 | function Foo(name) { 5 | this.name = name; 6 | } 7 | 8 | var _proto = Foo.prototype; 9 | 10 | _proto.describe = function describe() { 11 | return "Foo:".concat(this.name); 12 | }; 13 | 14 | _proto.toBar = function toBar() { 15 | return new Bar(this.name); 16 | }; 17 | 18 | return Foo; 19 | }(); 20 | 21 | var Bar = /*#__PURE__*/function () { 22 | "use strict"; 23 | 24 | function Bar(name) { 25 | this.name = name; 26 | } 27 | 28 | var _proto2 = Bar.prototype; 29 | 30 | _proto2.describe = function describe() { 31 | return "Bar:".concat(this.name); 32 | }; 33 | 34 | _proto2.toFoo = function toFoo() { 35 | return new Foo(this.name); 36 | }; 37 | 38 | return Bar; 39 | }(); 40 | 41 | globalThis.Foo = Foo 42 | globalThis.Bar = Bar 43 | -------------------------------------------------------------------------------- /node-test/test1/recursive.mli: -------------------------------------------------------------------------------- 1 | module [@js.scope "Foo"] rec Foo : sig 2 | type t = private Ojs.t 3 | val t_of_js: Ojs.t -> t 4 | val t_to_js: t -> Ojs.t 5 | val create: string -> t [@@js.create] 6 | val describe: t -> string [@@js.call "describe"] 7 | val to_bar: t -> Bar.t [@@js.call "toBar"] 8 | end 9 | 10 | and [@js.scope "Bar"] Bar : sig 11 | type t = private Ojs.t 12 | val t_of_js: Ojs.t -> t 13 | val t_to_js: t -> Ojs.t 14 | val create: string -> t [@@js.create] 15 | val describe: t -> string [@@js.call "describe"] 16 | val to_foo: t -> Foo.t [@@js.call "toFoo"] 17 | end 18 | -------------------------------------------------------------------------------- /node-test/test1/test.ml: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | [@@@ocaml.warning "-32-34"] 6 | 7 | open Node 8 | 9 | let check_node_version version = 10 | let major_version = function 11 | | Some s when String.length s > 0 && s.[0] = 'v' -> 12 | begin match 13 | String.sub s 1 (String.length s - 1) 14 | |> String.split_on_char '.' 15 | with 16 | | [] -> None 17 | | hd :: _ -> int_of_string_opt hd 18 | end 19 | | _ -> None 20 | in 21 | if Option.value ~default:(-1) (major_version Process.version) < version then 22 | begin 23 | Printf.eprintf "[WARNING] Ignoring test: it requires Node > %d; please upgrade (current version %s)" version 24 | (Option.value ~default:"???" Process.version); 25 | exit 0 26 | end 27 | 28 | let () = 29 | check_node_version 18 30 | 31 | (** Buffer **) 32 | 33 | let caml_from_set s = 34 | let len = String.length s in 35 | let buf = Buffer.alloc len in 36 | String.iteri (fun k x -> 37 | Buffer.set buf k (Char.code x) 38 | ) s; 39 | buf 40 | 41 | let caml_from_write s = 42 | let len = String.length s in 43 | let buf = Buffer.alloc len in 44 | let written = Buffer.write buf s in 45 | assert (written = len); 46 | buf 47 | 48 | let assert_equal_buffer b1 b2 = 49 | let len1 = Buffer.length b1 in 50 | let len2 = Buffer.length b2 in 51 | assert (len1 = len2); 52 | for k = 0 to len1 -1 do 53 | assert (Buffer.get b1 k = Buffer.get b2 k) 54 | done 55 | 56 | let copy src = 57 | let len = Buffer.length src in 58 | let dst = Buffer.alloc len in 59 | let written = 60 | Buffer.copy src ~dst ~start:0 ~dst_start:0 ~dst_end:len 61 | in 62 | assert (len = written); 63 | dst 64 | 65 | let () = 66 | let test = "test" in 67 | let native = Buffer.from test in 68 | let from_set = caml_from_set test in 69 | let from_write = caml_from_write test in 70 | let from_copy = copy native in 71 | assert_equal_buffer native from_set; 72 | assert_equal_buffer native from_write; 73 | assert_equal_buffer native from_copy 74 | 75 | (** Process **) 76 | 77 | let () = 78 | Container.StringMap.iter 79 | (fun key value -> 80 | assert (Sys.getenv key = value) 81 | ) 82 | Process.env 83 | 84 | let uncaught_handler p = 85 | let open Promise in 86 | catch p (fun error -> 87 | Printf.eprintf "Uncaught exception: %s\n" (Printexc.to_string (Obj.magic error)); 88 | exit 1 89 | ) 90 | 91 | (** FileSystem **) 92 | 93 | let root : unit Promise.t = 94 | let open Promise in 95 | uncaught_handler 96 | begin 97 | let* contents = Fs.readdir "." 98 | and+ contents' = Fs.readdir "." in 99 | List.iter2 (fun x y -> 100 | assert (x = y)) contents contents'; 101 | return () 102 | end 103 | 104 | (*** Index signature **) 105 | 106 | include [%js: 107 | module ArrayLike (K : Ojs.T) : sig 108 | type t = private Ojs.t 109 | val t_to_js: t -> Ojs.t 110 | val t_of_js: Ojs.t -> t 111 | 112 | val create: unit -> t [@@js.builder] 113 | val get: t -> int -> K.t option [@@js.index_get] 114 | val set: t -> int -> K.t -> unit [@@js.index_set] 115 | end 116 | 117 | module MapLike (K : Ojs.T) : sig 118 | type t = private Ojs.t 119 | val t_to_js: t -> Ojs.t 120 | val t_of_js: Ojs.t -> t 121 | 122 | val create: unit -> t [@@js.builder] 123 | val get: t -> string -> K.t option [@@js.index_get] 124 | val set: t -> string -> K.t -> unit [@@js.index_set] 125 | end 126 | 127 | module Symbol : sig 128 | type t = private Ojs.t 129 | val t_to_js: t -> Ojs.t 130 | val t_of_js: Ojs.t -> t 131 | 132 | val fresh: unit -> t [@@js.global "Symbol"] 133 | end 134 | 135 | module SymbolMap (K : Ojs.T) : sig 136 | type t = private Ojs.t 137 | val t_to_js: t -> Ojs.t 138 | val t_of_js: Ojs.t -> t 139 | 140 | val create: unit -> t [@@js.builder] 141 | val get: t -> Symbol.t -> K.t option [@@js.index_get] 142 | val set: t -> Symbol.t -> K.t -> unit [@@js.index_set] 143 | end 144 | 145 | ] 146 | 147 | let () = 148 | let module M = MapLike([%js: type t = string val t_to_js: t -> Ojs.t val t_of_js: Ojs.t -> t]) in 149 | let map_str = M.create () in 150 | M.set map_str "foo" "bar"; 151 | assert (M.get map_str "foo" = Some "bar"); 152 | M.set map_str "baz" "boo"; 153 | assert (M.get map_str "baz" = Some "boo"); 154 | 155 | let module A = ArrayLike([%js: type t = int val t_to_js: t -> Ojs.t val t_of_js: Ojs.t -> t]) in 156 | let map_int = A.create () in 157 | let len = 10 in 158 | for k = 0 to len - 1 do 159 | A.set map_int k k; 160 | assert (A.get map_int k = Some k); 161 | A.set map_int k (k * k); 162 | assert (A.get map_int k = Some (k * k)); 163 | done; 164 | 165 | let module M = SymbolMap([%js: type t = string val t_to_js: t -> Ojs.t val t_of_js: Ojs.t -> t]) in 166 | let a = Symbol.fresh () in 167 | let b = Symbol.fresh () in 168 | let map_str = M.create () in 169 | M.set map_str a "bar"; 170 | assert (M.get map_str a = Some "bar"); 171 | M.set map_str b "boo"; 172 | assert (M.get map_str b = Some "boo") 173 | 174 | 175 | (*** Function signature **) 176 | 177 | include [%js: 178 | module Concat : sig 179 | type t = private Ojs.t 180 | 181 | val t_to_js: t -> Ojs.t 182 | val t_of_js: Ojs.t -> t 183 | 184 | val apply: t -> (string list [@js.variadic]) -> string [@@js.apply] 185 | end 186 | 187 | module [@js.scope Imports.path] Path2 : sig 188 | val join: Concat.t [@@js.global "join"] 189 | end 190 | ] 191 | 192 | let () = 193 | let args = ["foo"; "bar"; "baz"] in 194 | let res1 = Path.join args in 195 | let res2 = Concat.apply Path2.join args in 196 | assert (res1 = res2); 197 | () 198 | 199 | (*** Newable function *) 200 | 201 | include [%js: 202 | module Date: sig 203 | type t = private Ojs.t 204 | val getUTCFullYear: t -> float [@@js.call "getUTCFullYear"] 205 | val getUTCMonth: t -> float [@@js.call "getUTCMonth"] 206 | val getUTCDate: t -> float [@@js.call "getUTCDate"] 207 | end 208 | 209 | module DateConstructor: sig 210 | type t = private Ojs.t 211 | val utc: 212 | t -> 213 | year:int -> month:int -> ?date:int -> 214 | ?hours:int -> ?minutes:int -> ?seconds:int -> 215 | ?ms:int -> unit -> float [@@js.call "UTC"] 216 | val new_: 217 | t -> float -> Date.t [@@js.apply_newable] 218 | end 219 | 220 | val date: DateConstructor.t [@@js.global "Date"] 221 | ] 222 | 223 | let () = 224 | let d = 225 | DateConstructor.new_ date 226 | (DateConstructor.utc date ~year:1999 ~month:11 ~date:31 ()) 227 | in 228 | assert (int_of_float (Date.getUTCFullYear d) == 1999); 229 | assert (int_of_float (Date.getUTCMonth d) == 11); 230 | assert (int_of_float (Date.getUTCDate d) == 31); 231 | () 232 | 233 | (** Arrays **) 234 | let () = 235 | let open Arrays.StringArray in 236 | let a = create () in 237 | for k = 0 to 10 do 238 | push a (string_of_int k); 239 | done; 240 | let s = join a "," in 241 | List.iteri (fun k x -> 242 | assert (string_of_int k = x) 243 | ) (String.split_on_char ',' s) 244 | 245 | (** Invoking a global object **) 246 | (** https://developer.mozilla.org/ja/docs/Web/JavaScript/Reference/Global_Objects/Number/Number **) 247 | let () = 248 | let check (a: Number.t) (b: float) = 249 | assert (Ojs.instance_of (a :> Ojs.t) ~constr:(Number.number :> Ojs.t)); 250 | assert (not (Ojs.instance_of (Ojs.float_to_js b) ~constr:(Number.number :> Ojs.t))); 251 | assert (Number.valueOf a = b); 252 | () 253 | in 254 | check (Number.Scoped.create "123") (Number.Scoped.invoke "123"); 255 | check (Number.Static.create Number.number "123") (Number.Static.apply Number.number "123"); 256 | assert (Number.Scoped.max_value = Number.Static.max_value Number.number); 257 | () 258 | 259 | (** Using recursive modules **) 260 | let () = 261 | let open Recursive in 262 | let fooA = Foo.create "A" in 263 | assert (Foo.describe fooA = "Foo:A"); 264 | let barA = Foo.to_bar fooA in 265 | assert (Bar.describe barA = "Bar:A"); 266 | let fooA' = Bar.to_foo barA in 267 | assert (Foo.describe fooA' = "Foo:A"); 268 | () 269 | 270 | (** Using first class modules **) 271 | include [%js: 272 | val to_string: (module[@js] Ojs.T with type t = 'a) -> 'a -> string [@@js.call "toString"] 273 | ] 274 | let () = 275 | let check (type a) (module A : Ojs.T with type t = a) (value: a) (expected: string) = 276 | let str = to_string (module A) value in 277 | assert (str = expected) 278 | in 279 | check (module Ojs.Int) 42 "42"; 280 | check (module Ojs.Float) 4.2 "4.2"; 281 | check (module Ojs.String) "hello" "hello"; 282 | check (module Ojs.List(Ojs.Int)) [4;2] "4,2"; 283 | check (module Ojs.List(Ojs.String)) ["hello"; "world"] "hello,world"; 284 | () 285 | let () = 286 | let open Arrays.JsArray2 in 287 | let a = create () in 288 | for k = 0 to 10 do 289 | push (module Ojs.String) a (string_of_int k); 290 | done; 291 | 292 | let sa = join a "," in 293 | List.iteri (fun k x -> 294 | assert (string_of_int k = x) 295 | ) (String.split_on_char ',' sa); 296 | 297 | let b = 298 | let orig = List.init 11 string_of_int in 299 | create' (module Ojs.String) orig 300 | in 301 | let sb = join b "," in 302 | assert (sa = sb); 303 | 304 | assert (get (module Ojs.String) a 0 = Some "0"); 305 | set (module Ojs.String) a 1 "foo"; 306 | assert (get (module Ojs.String) a 1 = Some "foo"); 307 | () 308 | -------------------------------------------------------------------------------- /ojs.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "1.1.4" 4 | synopsis: "Runtime Library for gen_js_api generated libraries" 5 | description: "To be used in conjunction with gen_js_api" 6 | maintainer: ["Alain Frisch "] 7 | authors: [ 8 | "Alain Frisch " 9 | "Sebastien Briais " 10 | ] 11 | license: "MIT" 12 | homepage: "https://github.com/LexiFi/gen_js_api" 13 | bug-reports: "https://github.com/LexiFi/gen_js_api/issues" 14 | depends: [ 15 | "dune" {>= "3.0"} 16 | "ocaml" {>= "4.08"} 17 | "js_of_ocaml-compiler" {>= "4.0.0"} 18 | "odoc" {with-doc} 19 | ] 20 | dev-repo: "git+https://github.com/LexiFi/gen_js_api.git" 21 | build: [ 22 | ["dune" "subst"] {dev} 23 | ["dune" "build" "-p" name "-j" jobs "@install" "@doc" {with-doc}] 24 | ] 25 | -------------------------------------------------------------------------------- /ojs.opam.template: -------------------------------------------------------------------------------- 1 | build: [ 2 | ["dune" "subst"] {dev} 3 | ["dune" "build" "-p" name "-j" jobs "@install" "@doc" {with-doc}] 4 | ] 5 | -------------------------------------------------------------------------------- /ppx-driver/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name gen_js_api_ppx_driver) 3 | (public_name gen_js_api.ppx) 4 | (synopsis "Syntactic support for gen_js_api") 5 | (libraries gen_js_api.lib ppxlib.ast ppxlib) 6 | (kind ppx_rewriter) 7 | (ppx_runtime_libraries ojs) 8 | (preprocess no_preprocessing)) 9 | -------------------------------------------------------------------------------- /ppx-driver/gen_js_api_ppx_driver.ml: -------------------------------------------------------------------------------- 1 | let check_attributes_with_ppxlib = false 2 | let check_locations_with_ppxlib = false 3 | 4 | let () = 5 | if check_attributes_with_ppxlib 6 | then ( 7 | Ppxlib.Driver.enable_checks (); 8 | Gen_js_api_ppx.check_attribute := false 9 | ); 10 | if check_locations_with_ppxlib 11 | then ( 12 | Ppxlib.Driver.enable_location_check () 13 | ); 14 | let mapper_for_sig = 15 | Gen_js_api_ppx.mark_attributes_as_used 16 | in 17 | let mapper_for_str = 18 | Gen_js_api_ppx.mark_attributes_as_used 19 | in 20 | let module_expr_ext = 21 | let rewriter ~loc ~path:_ si = 22 | Gen_js_api_ppx.module_expr_rewriter ~loc ~attrs:[] si 23 | in 24 | Ppxlib.Extension.declare "js" 25 | Ppxlib.Extension.Context.Module_expr 26 | Ppxlib.(Ast_pattern.psig Ast_pattern.__) 27 | rewriter 28 | |> Ppxlib.Context_free.Rule.extension 29 | in 30 | let ext_to = 31 | let rewriter ~loc ~path:_ core_type = 32 | Gen_js_api_ppx.js_to_rewriter ~loc core_type 33 | in 34 | Ppxlib.Extension.declare "js.to" 35 | Ppxlib.Extension.Context.Expression 36 | Ppxlib.(Ast_pattern.ptyp Ast_pattern.__) 37 | rewriter 38 | |> Ppxlib.Context_free.Rule.extension 39 | in 40 | let ext_of = 41 | let rewriter ~loc ~path:_ core_type = 42 | Gen_js_api_ppx.js_of_rewriter ~loc core_type 43 | in 44 | Ppxlib.Extension.declare "js.of" 45 | Ppxlib.Extension.Context.Expression 46 | Ppxlib.(Ast_pattern.ptyp Ast_pattern.__) 47 | rewriter 48 | |> Ppxlib.Context_free.Rule.extension 49 | in 50 | let attr_typ = 51 | let rewriter ~ctxt (rec_flag : Ppxlib.Asttypes.rec_flag) tdl _ = 52 | Gen_js_api_ppx.type_decl_rewriter 53 | ~loc:(Ppxlib.Expansion_context.Deriver.derived_item_loc ctxt) 54 | rec_flag tdl 55 | in 56 | Ppxlib.Context_free.Rule.attr_str_type_decl 57 | (Ppxlib.Attribute.declare "js" 58 | Ppxlib.Attribute.Context.type_declaration 59 | Ppxlib.(Ast_pattern.pstr Ast_pattern.nil) ()) 60 | rewriter 61 | in 62 | Ppxlib.Driver.register_transformation 63 | "gen_js_api" 64 | ~rules:[module_expr_ext; ext_of; ext_to; attr_typ ] 65 | ~impl:(mapper_for_str # structure) 66 | ~intf:(mapper_for_sig # signature) 67 | -------------------------------------------------------------------------------- /ppx-lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name gen_js_api_ppx) 3 | (public_name gen_js_api.lib) 4 | (libraries compiler-libs.common ppxlib) 5 | (ppx_runtime_libraries ojs) 6 | (preprocess no_preprocessing)) 7 | -------------------------------------------------------------------------------- /ppx-lib/gen_js_api_ppx.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | open Ppxlib 6 | 7 | val check_attribute : bool ref 8 | 9 | val mapper : Ast_traverse.map 10 | 11 | val module_expr_rewriter: loc:Location.t -> attrs:Ppxlib.Parsetree.attributes -> Ppxlib.Parsetree.signature -> Ppxlib.module_expr 12 | 13 | val js_of_rewriter: loc:Location.t -> core_type -> expression 14 | 15 | val js_to_rewriter: loc:Location.t -> core_type -> expression 16 | 17 | val type_decl_rewriter: loc:Location.t -> rec_flag -> type_declaration list -> structure 18 | 19 | val mark_attributes_as_used: Ast_traverse.map 20 | 21 | val standalone : unit -> unit 22 | -------------------------------------------------------------------------------- /ppx-standalone/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names gen_js_api) 3 | (public_names gen_js_api) 4 | (package gen_js_api) 5 | (libraries compiler-libs.common ppxlib gen_js_api.lib)) 6 | 7 | (install 8 | (section libexec) 9 | (package gen_js_api) 10 | (files 11 | (gen_js_api.exe as gen_js_api))) 12 | -------------------------------------------------------------------------------- /ppx-standalone/gen_js_api.ml: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | open Ppxlib 6 | 7 | let () = 8 | try 9 | Gen_js_api_ppx.standalone () 10 | with exn -> 11 | Format.eprintf "%a@." Location.report_exception exn; 12 | exit 2 13 | -------------------------------------------------------------------------------- /ppx-standalone/gen_js_api.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | 6 | (* Empty interface, to enable unused-declaration warnings. *) 7 | -------------------------------------------------------------------------------- /ppx-test/binding.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | module M : sig 5 | type t = private Ojs.t 6 | val t_to_js: t -> Ojs.t 7 | val t_of_js: Ojs.t -> t 8 | 9 | val cast: t -> string [@@js.cast] 10 | 11 | val prop_get_arg: t -> int [@@js.get "getter"] 12 | val prop_get: unit -> int [@@js.get "getter"] 13 | 14 | val global: t [@@js.global "global"] 15 | val global_arrow: int -> int [@@js.global "global"] 16 | 17 | val prop_set: t -> int -> unit [@@js.set "setter"] 18 | val prop_set_global: t -> unit [@@js.set "setter"] 19 | 20 | val method_call_global: t -> int [@@js.call "method"] 21 | val method_call_global_unit: t -> unit [@@js.call "method"] 22 | val method_call_unit: t -> unit -> int [@@js.call "method"] 23 | val method_call_args: t -> int -> int [@@js.call "method"] 24 | val method_call_unit_unit: t -> unit -> unit [@@js.call "method"] 25 | val method_call_args_unit: t -> int -> unit [@@js.call "method"] 26 | 27 | val new_thing: int -> t [@@js.new] 28 | 29 | val builder: ?x:int -> (int [@js "y"]) -> z:int -> t [@@js.builder] 30 | 31 | val index_get_int: t -> int -> string option [@@js.index_get] 32 | val index_get_string: t -> string -> string option [@@js.index_get] 33 | val index_get_generic: t -> Ojs.t -> string option [@@js.index_get] 34 | 35 | val index_set_int: t -> int -> string -> unit [@@js.index_set] 36 | val index_set_string: t -> string -> string -> unit [@@js.index_set] 37 | val index_set_generic: t -> Ojs.t -> string -> unit [@@js.index_set] 38 | end -------------------------------------------------------------------------------- /ppx-test/binding_automatic.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | [@@@js.implem [@@@warning "-22"]] 6 | 7 | module M : sig 8 | type t = private Ojs.t 9 | val t_to_js: t -> Ojs.t 10 | val t_of_js: Ojs.t -> t 11 | 12 | val prop_get_arg: t -> int 13 | val prop_get: unit -> int 14 | val set_prop: t -> int -> unit 15 | val set_global: int -> unit 16 | val new_thing_unit: unit -> t 17 | val new_thing_args: int -> t 18 | val method_call_global: t -> unit 19 | val method_call_unit: t -> unit -> int 20 | val method_call_args: t -> int -> int 21 | val method_call_unit_unit: t -> unit -> unit 22 | val method_call_args_unit: t -> int -> unit 23 | val global: t 24 | 25 | [@@@warning "-32"] 26 | val get: t -> int -> string option 27 | val set: t -> int -> string -> unit 28 | val get: t -> string -> string option 29 | val set: t -> string -> string -> unit 30 | [@@@warning "+32"] 31 | val get: t -> Ojs.t -> string option 32 | val set: t -> Ojs.t -> string -> unit 33 | end 34 | -------------------------------------------------------------------------------- /ppx-test/binding_explicitly_automatic.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | [@@@js.implem [@@@warning "-22"]] 6 | 7 | module M : sig 8 | type t = private Ojs.t 9 | val t_to_js: t -> Ojs.t 10 | val t_of_js: Ojs.t -> t 11 | 12 | val prop_get_arg: t -> int [@@js] 13 | val prop_get: unit -> int [@@js] 14 | val set_prop: t -> int -> unit [@@js] 15 | val set_global: int -> unit [@@js] 16 | val new_thing_unit: unit -> t [@@js] 17 | val new_thing_args: int -> t [@@js] 18 | val method_call_global: t -> unit [@@js] 19 | val method_call_unit: t -> unit -> int [@@js] 20 | val method_call_args: t -> int -> int [@@js] 21 | val method_call_unit_unit: t -> unit -> unit [@@js] 22 | val method_call_args_unit: t -> int -> unit [@@js] 23 | val global: t [@@js] 24 | 25 | [@@@warning "-32"] 26 | val get: t -> int -> string option [@@js] 27 | val set: t -> int -> string -> unit [@@js] 28 | val get: t -> string -> string option [@@js] 29 | val set: t -> string -> string -> unit [@@js] 30 | [@@@warning "+32"] 31 | val get: t -> Ojs.t -> string option [@@js] 32 | val set: t -> Ojs.t -> string -> unit [@@js] 33 | end -------------------------------------------------------------------------------- /ppx-test/binding_manual.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | module M : sig 5 | type t = private Ojs.t 6 | val t_to_js: t -> Ojs.t 7 | val t_of_js: Ojs.t -> t 8 | 9 | val prop_get_arg: t -> int [@@js.get "propGetArg"] 10 | val prop_get: unit -> int [@@js.get "propGet"] 11 | val set_prop: t -> int -> unit [@@js.set "prop"] 12 | val set_global: int -> unit [@@js.set "global"] 13 | val new_thing_unit: unit -> t [@@js.new "ThingUnit"] 14 | val new_thing_args: int -> t [@@js.new "ThingArgs"] 15 | val method_call_global: t -> unit [@@js.call "methodCallGlobal"] 16 | val method_call_unit: t -> unit -> int [@@js.call "methodCallUnit"] 17 | val method_call_args: t -> int -> int[@@js.call "methodCallArgs"] 18 | val method_call_unit_unit: t -> unit -> unit[@@js.call "methodCallUnitUnit"] 19 | val method_call_args_unit: t -> int -> unit[@@js.call "methodCallArgsUnit"] 20 | val global: t[@@js.global "global"] 21 | 22 | [@@@warning "-32"] 23 | val get: t -> int -> string option [@@js.index_get] 24 | val set: t -> int -> string -> unit [@@js.index_set] 25 | val get: t -> string -> string option [@@js.index_get] 26 | val set: t -> string -> string -> unit [@@js.index_set] 27 | [@@@warning "+32"] 28 | val get: t -> Ojs.t -> string option [@@js.index_get] 29 | val set: t -> Ojs.t -> string -> unit [@@js.index_set] 30 | end -------------------------------------------------------------------------------- /ppx-test/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets extension.ml.result) 3 | (deps extension.ml) 4 | (action 5 | (run ppx/main.exe --impl %{deps} -o %{targets}))) 6 | 7 | (rule 8 | (alias runtest) 9 | (package gen_js_api) 10 | (action 11 | (diff expected/extension.ml extension.ml.result))) 12 | 13 | (rule 14 | (targets issues.ml.result) 15 | (deps issues.ml) 16 | (action 17 | (run ppx/main.exe --impl %{deps} -o %{targets}))) 18 | 19 | (rule 20 | (alias runtest) 21 | (package gen_js_api) 22 | (enabled_if 23 | (>= %{ocaml_version} 4.09)) 24 | (action 25 | (diff expected/issues.ml issues.ml.result))) 26 | 27 | (rule 28 | (targets types.ml.result) 29 | (deps types.ml) 30 | (action 31 | (run ppx/main.exe --impl %{deps} -o %{targets}))) 32 | 33 | (rule 34 | (alias runtest) 35 | (package gen_js_api) 36 | (enabled_if 37 | (>= %{ocaml_version} 4.09)) 38 | (action 39 | (diff expected/types.ml types.ml.result))) 40 | 41 | (rule 42 | (targets binding_automatic.ml) 43 | (deps binding_automatic.mli) 44 | (action 45 | (run gen_js_api %{deps} -o %{targets}))) 46 | 47 | (rule 48 | (alias runtest) 49 | (package gen_js_api) 50 | (action 51 | (diff expected/binding_automatic.ml binding_automatic.ml))) 52 | 53 | (rule 54 | (targets binding_explicitly_automatic.ml) 55 | (deps binding_explicitly_automatic.mli) 56 | (action 57 | (run gen_js_api %{deps} -o %{targets}))) 58 | 59 | (rule 60 | (alias runtest) 61 | (package gen_js_api) 62 | (action 63 | (diff binding_automatic.ml binding_explicitly_automatic.ml))) 64 | 65 | (rule 66 | (targets binding_manual.ml) 67 | (deps binding_manual.mli) 68 | (action 69 | (run gen_js_api %{deps} -o %{targets}))) 70 | 71 | (rule 72 | (targets binding.ml) 73 | (deps binding.mli) 74 | (action 75 | (run gen_js_api %{deps} -o %{targets}))) 76 | 77 | (rule 78 | (alias runtest) 79 | (package gen_js_api) 80 | (action 81 | (diff expected/binding.ml binding.ml))) 82 | 83 | (rule 84 | (targets scoped.ml) 85 | (deps scoped.mli) 86 | (action 87 | (run %{bin:gen_js_api} %{deps} -o %{targets}))) 88 | 89 | (rule 90 | (alias runtest) 91 | (action 92 | (diff expected/scoped.ml scoped.ml))) 93 | 94 | (rule 95 | (targets union_and_enum.ml) 96 | (deps union_and_enum.mli) 97 | (action 98 | (run %{bin:gen_js_api} %{deps} -o %{targets}))) 99 | 100 | (rule 101 | (alias runtest) 102 | (action 103 | (diff expected/union_and_enum.ml union_and_enum.ml))) 104 | 105 | (rule 106 | (targets issues_mli.ml) 107 | (deps issues_mli.mli) 108 | (action 109 | (run gen_js_api %{deps} -o %{targets}))) 110 | 111 | (rule 112 | (alias runtest) 113 | (package gen_js_api) 114 | (action 115 | (diff expected/issues_mli.ml issues_mli.ml))) 116 | 117 | (rule 118 | (targets recursive_modules.ml) 119 | (deps recursive_modules.mli) 120 | (action 121 | (run gen_js_api %{deps} -o %{targets}))) 122 | 123 | (rule 124 | (alias runtest) 125 | (package gen_js_api) 126 | (action 127 | (diff expected/recursive_modules.ml recursive_modules.ml))) 128 | 129 | (rule 130 | (targets first_class_modules.ml) 131 | (deps first_class_modules.mli) 132 | (action 133 | (run gen_js_api %{deps} -o %{targets}))) 134 | 135 | (rule 136 | (alias runtest) 137 | (package gen_js_api) 138 | (action 139 | (diff expected/first_class_modules.ml first_class_modules.ml))) 140 | 141 | (library 142 | (name test_library) 143 | (libraries ojs) 144 | (preprocess 145 | (pps gen_js_api.ppx)) 146 | (modes byte) 147 | (modules 148 | binding_automatic binding_explicitly_automatic binding_manual binding 149 | extension first_class_modules issues_mli issues 150 | recursive_modules scoped types union_and_enum)) 151 | 152 | (rule 153 | (alias runtest) 154 | (package gen_js_api) 155 | (deps test_library.cma) 156 | (action 157 | (echo "Successfully compile test_library"))) 158 | 159 | (rule 160 | (targets modules.ml) 161 | (deps modules.mli) 162 | (action 163 | (run gen_js_api %{deps} -o %{targets}))) 164 | 165 | (rule 166 | (alias runtest) 167 | (package gen_js_api) 168 | (action 169 | (diff expected/modules.ml modules.ml))) 170 | -------------------------------------------------------------------------------- /ppx-test/expected/binding.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module M = 4 | struct 5 | type t = Ojs.t 6 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 7 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 8 | let (cast : t -> string) = fun (x3 : t) -> Ojs.string_of_js (t_to_js x3) 9 | let (prop_get_arg : t -> int) = 10 | fun (x4 : t) -> 11 | Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x4) "getter") 12 | let (prop_get : unit -> int) = 13 | fun () -> Ojs.int_of_js (Ojs.get_prop_ascii Ojs.global "getter") 14 | let (global : t) = t_of_js (Ojs.get_prop_ascii Ojs.global "global") 15 | let (global_arrow : int -> int) = 16 | fun (x5 : int) -> 17 | Ojs.int_of_js (Ojs.call Ojs.global "global" [|(Ojs.int_to_js x5)|]) 18 | let (prop_set : t -> int -> unit) = 19 | fun (x6 : t) -> 20 | fun (x7 : int) -> 21 | Ojs.set_prop_ascii (t_to_js x6) "setter" (Ojs.int_to_js x7) 22 | let (prop_set_global : t -> unit) = 23 | fun (x8 : t) -> Ojs.set_prop_ascii Ojs.global "setter" (t_to_js x8) 24 | let (method_call_global : t -> int) = 25 | fun (x9 : t) -> Ojs.int_of_js (Ojs.call (t_to_js x9) "method" [||]) 26 | let (method_call_global_unit : t -> unit) = 27 | fun (x10 : t) -> ignore (Ojs.call (t_to_js x10) "method" [||]) 28 | let (method_call_unit : t -> unit -> int) = 29 | fun (x11 : t) -> 30 | fun () -> Ojs.int_of_js (Ojs.call (t_to_js x11) "method" [||]) 31 | let (method_call_args : t -> int -> int) = 32 | fun (x13 : t) -> 33 | fun (x12 : int) -> 34 | Ojs.int_of_js 35 | (Ojs.call (t_to_js x13) "method" [|(Ojs.int_to_js x12)|]) 36 | let (method_call_unit_unit : t -> unit -> unit) = 37 | fun (x14 : t) -> 38 | fun () -> ignore (Ojs.call (t_to_js x14) "method" [||]) 39 | let (method_call_args_unit : t -> int -> unit) = 40 | fun (x16 : t) -> 41 | fun (x15 : int) -> 42 | ignore (Ojs.call (t_to_js x16) "method" [|(Ojs.int_to_js x15)|]) 43 | let (new_thing : int -> t) = 44 | fun (x17 : int) -> 45 | t_of_js 46 | (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Thing") 47 | [|(Ojs.int_to_js x17)|]) 48 | let (builder : ?x:int -> int -> z:int -> t) = 49 | fun ?x:(x18 : int option) -> 50 | fun (x19 : int) -> 51 | fun ~z:(x20 : int) -> 52 | let x21 = Ojs.empty_obj () in 53 | (match x18 with 54 | | Some x22 -> Ojs.set_prop_ascii x21 "x" (Ojs.int_to_js x22) 55 | | None -> ()); 56 | Ojs.set_prop_ascii x21 "y" (Ojs.int_to_js x19); 57 | Ojs.set_prop_ascii x21 "z" (Ojs.int_to_js x20); 58 | t_of_js x21 59 | let (index_get_int : t -> int -> string option) = 60 | fun (x23 : t) -> 61 | fun (x24 : int) -> 62 | Ojs.option_of_js Ojs.string_of_js (Ojs.array_get (t_to_js x23) x24) 63 | let (index_get_string : t -> string -> string option) = 64 | fun (x26 : t) -> 65 | fun (x27 : string) -> 66 | Ojs.option_of_js Ojs.string_of_js 67 | (Ojs.get_prop (t_to_js x26) (Ojs.string_to_js x27)) 68 | let (index_get_generic : t -> Ojs.t -> string option) = 69 | fun (x29 : t) -> 70 | fun (x30 : Ojs.t) -> 71 | Ojs.option_of_js Ojs.string_of_js (Ojs.get_prop (t_to_js x29) x30) 72 | let (index_set_int : t -> int -> string -> unit) = 73 | fun (x32 : t) -> 74 | fun (x33 : int) -> 75 | fun (x34 : string) -> 76 | Ojs.array_set (t_to_js x32) x33 (Ojs.string_to_js x34) 77 | let (index_set_string : t -> string -> string -> unit) = 78 | fun (x35 : t) -> 79 | fun (x36 : string) -> 80 | fun (x37 : string) -> 81 | Ojs.set_prop (t_to_js x35) (Ojs.string_to_js x36) 82 | (Ojs.string_to_js x37) 83 | let (index_set_generic : t -> Ojs.t -> string -> unit) = 84 | fun (x38 : t) -> 85 | fun (x39 : Ojs.t) -> 86 | fun (x40 : string) -> 87 | Ojs.set_prop (t_to_js x38) x39 (Ojs.string_to_js x40) 88 | end 89 | -------------------------------------------------------------------------------- /ppx-test/expected/binding_automatic.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | [@@@warning "-22"] 4 | module M = 5 | struct 6 | type t = Ojs.t 7 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 8 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 9 | let (prop_get_arg : t -> int) = 10 | ((fun (x3 : t) -> 11 | Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x3) "propGetArg")) 12 | [@ocaml.ppwarning 13 | "Heuristic for automatic binding is deprecated; please add the '@js.get' attribute."]) 14 | let (prop_get : unit -> int) = 15 | ((fun () -> Ojs.int_of_js (Ojs.get_prop_ascii Ojs.global "propGet")) 16 | [@ocaml.ppwarning 17 | "Heuristic for automatic binding is deprecated; please add the '@js.get' attribute."]) 18 | let (set_prop : t -> int -> unit) = 19 | ((fun (x4 : t) -> 20 | fun (x5 : int) -> 21 | Ojs.set_prop_ascii (t_to_js x4) "prop" (Ojs.int_to_js x5)) 22 | [@ocaml.ppwarning 23 | "Heuristic for automatic binding is deprecated; please add the '@js.set' attribute."]) 24 | let (set_global : int -> unit) = 25 | ((fun (x6 : int) -> 26 | Ojs.set_prop_ascii Ojs.global "global" (Ojs.int_to_js x6)) 27 | [@ocaml.ppwarning 28 | "Heuristic for automatic binding is deprecated; please add the '@js.set' attribute."]) 29 | let (new_thing_unit : unit -> t) = 30 | ((fun () -> 31 | t_of_js 32 | (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "ThingUnit") [||])) 33 | [@ocaml.ppwarning 34 | "Heuristic for automatic binding is deprecated; please add the '@js.new' attribute."]) 35 | let (new_thing_args : int -> t) = 36 | ((fun (x7 : int) -> 37 | t_of_js 38 | (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "ThingArgs") 39 | [|(Ojs.int_to_js x7)|])) 40 | [@ocaml.ppwarning 41 | "Heuristic for automatic binding is deprecated; please add the '@js.new' attribute."]) 42 | let (method_call_global : t -> unit) = 43 | ((fun (x8 : t) -> 44 | ignore (Ojs.call (t_to_js x8) "methodCallGlobal" [||])) 45 | [@ocaml.ppwarning 46 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 47 | let (method_call_unit : t -> unit -> int) = 48 | ((fun (x9 : t) -> 49 | fun () -> 50 | Ojs.int_of_js (Ojs.call (t_to_js x9) "methodCallUnit" [||])) 51 | [@ocaml.ppwarning 52 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 53 | let (method_call_args : t -> int -> int) = 54 | ((fun (x11 : t) -> 55 | fun (x10 : int) -> 56 | Ojs.int_of_js 57 | (Ojs.call (t_to_js x11) "methodCallArgs" 58 | [|(Ojs.int_to_js x10)|])) 59 | [@ocaml.ppwarning 60 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 61 | let (method_call_unit_unit : t -> unit -> unit) = 62 | ((fun (x12 : t) -> 63 | fun () -> ignore (Ojs.call (t_to_js x12) "methodCallUnitUnit" [||])) 64 | [@ocaml.ppwarning 65 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 66 | let (method_call_args_unit : t -> int -> unit) = 67 | ((fun (x14 : t) -> 68 | fun (x13 : int) -> 69 | ignore 70 | (Ojs.call (t_to_js x14) "methodCallArgsUnit" 71 | [|(Ojs.int_to_js x13)|])) 72 | [@ocaml.ppwarning 73 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 74 | let (global : t) = ((t_of_js (Ojs.get_prop_ascii Ojs.global "global")) 75 | [@ocaml.ppwarning 76 | "Heuristic for automatic binding is deprecated; please add the '@js.global' attribute."]) 77 | let (get : t -> int -> string option) = 78 | ((fun (x15 : t) -> 79 | fun (x16 : int) -> 80 | Ojs.option_of_js Ojs.string_of_js 81 | (Ojs.array_get (t_to_js x15) x16)) 82 | [@ocaml.ppwarning 83 | "Heuristic for automatic binding is deprecated; please add the '@js.index_get' attribute."]) 84 | let (set : t -> int -> string -> unit) = 85 | ((fun (x18 : t) -> 86 | fun (x19 : int) -> 87 | fun (x20 : string) -> 88 | Ojs.array_set (t_to_js x18) x19 (Ojs.string_to_js x20)) 89 | [@ocaml.ppwarning 90 | "Heuristic for automatic binding is deprecated; please add the '@js.index_set' attribute."]) 91 | let (get : t -> string -> string option) = 92 | ((fun (x21 : t) -> 93 | fun (x22 : string) -> 94 | Ojs.option_of_js Ojs.string_of_js 95 | (Ojs.get_prop (t_to_js x21) (Ojs.string_to_js x22))) 96 | [@ocaml.ppwarning 97 | "Heuristic for automatic binding is deprecated; please add the '@js.index_get' attribute."]) 98 | let (set : t -> string -> string -> unit) = 99 | ((fun (x24 : t) -> 100 | fun (x25 : string) -> 101 | fun (x26 : string) -> 102 | Ojs.set_prop (t_to_js x24) (Ojs.string_to_js x25) 103 | (Ojs.string_to_js x26)) 104 | [@ocaml.ppwarning 105 | "Heuristic for automatic binding is deprecated; please add the '@js.index_set' attribute."]) 106 | let (get : t -> Ojs.t -> string option) = 107 | ((fun (x27 : t) -> 108 | fun (x28 : Ojs.t) -> 109 | Ojs.option_of_js Ojs.string_of_js 110 | (Ojs.get_prop (t_to_js x27) x28)) 111 | [@ocaml.ppwarning 112 | "Heuristic for automatic binding is deprecated; please add the '@js.index_get' attribute."]) 113 | let (set : t -> Ojs.t -> string -> unit) = 114 | ((fun (x30 : t) -> 115 | fun (x31 : Ojs.t) -> 116 | fun (x32 : string) -> 117 | Ojs.set_prop (t_to_js x30) x31 (Ojs.string_to_js x32)) 118 | [@ocaml.ppwarning 119 | "Heuristic for automatic binding is deprecated; please add the '@js.index_set' attribute."]) 120 | end 121 | -------------------------------------------------------------------------------- /ppx-test/expected/extension.ml: -------------------------------------------------------------------------------- 1 | let _ = Ojs.int_to_js 2 | let _ = 3 | fun (x2 : int -> int) -> 4 | Ojs.fun_to_js 1 5 | (fun (x3 : Ojs.t) -> Ojs.int_to_js (x2 (Ojs.int_of_js x3))) 6 | -------------------------------------------------------------------------------- /ppx-test/expected/first_class_modules.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module Console = 4 | struct 5 | let (log : (module Ojs.T with type t = 'a) -> 'a -> unit) = 6 | fun (type a) -> 7 | fun ((module A) : (module Ojs.T with type t = a)) -> 8 | fun (x1 : a) -> 9 | ignore 10 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" 11 | [|(A.t_to_js x1)|]) 12 | let (log2 : 13 | (module Ojs.T with type t = 'a) -> 14 | (module Ojs.T with type t = 'b) -> 'a -> 'b -> unit) 15 | = 16 | fun (type a) -> 17 | fun (type b) -> 18 | fun ((module A) : (module Ojs.T with type t = a)) -> 19 | fun ((module B) : (module Ojs.T with type t = b)) -> 20 | fun (x2 : a) -> 21 | fun (x3 : b) -> 22 | ignore 23 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" 24 | [|(A.t_to_js x2);(B.t_to_js x3)|]) 25 | let (log3 : 26 | (module Ojs.T with type t = 'a) -> 27 | (module Ojs.T with type t = 'b) -> 28 | (module Ojs.T with type t = 'c) -> 'a -> 'b -> 'c -> unit) 29 | = 30 | fun (type a) -> 31 | fun (type b) -> 32 | fun (type c) -> 33 | fun ((module A) : (module Ojs.T with type t = a)) -> 34 | fun ((module B) : (module Ojs.T with type t = b)) -> 35 | fun ((module C) : (module Ojs.T with type t = c)) -> 36 | fun (x4 : a) -> 37 | fun (x5 : b) -> 38 | fun (x6 : c) -> 39 | ignore 40 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") 41 | "log" 42 | [|(A.t_to_js x4);(B.t_to_js x5);(C.t_to_js x6)|]) 43 | end 44 | module Console2 = 45 | struct 46 | type t = Ojs.t 47 | let rec t_of_js : Ojs.t -> t = fun (x8 : Ojs.t) -> x8 48 | and t_to_js : t -> Ojs.t = fun (x7 : Ojs.t) -> x7 49 | let (log : (module Ojs.T with type t = 'a) -> t -> 'a -> unit) = 50 | fun (type a) -> 51 | fun ((module A) : (module Ojs.T with type t = a)) -> 52 | fun (x10 : t) -> 53 | fun (x9 : a) -> 54 | ignore (Ojs.call (t_to_js x10) "log" [|(A.t_to_js x9)|]) 55 | let (log2 : 56 | (module Ojs.T with type t = 'a) -> 57 | (module Ojs.T with type t = 'b) -> t -> 'a -> 'b -> unit) 58 | = 59 | fun (type a) -> 60 | fun (type b) -> 61 | fun ((module A) : (module Ojs.T with type t = a)) -> 62 | fun ((module B) : (module Ojs.T with type t = b)) -> 63 | fun (x13 : t) -> 64 | fun (x11 : a) -> 65 | fun (x12 : b) -> 66 | ignore 67 | (Ojs.call (t_to_js x13) "log" 68 | [|(A.t_to_js x11);(B.t_to_js x12)|]) 69 | let (log3 : 70 | (module Ojs.T with type t = 'a) -> 71 | (module Ojs.T with type t = 'b) -> 72 | (module Ojs.T with type t = 'c) -> t -> 'a -> 'b -> 'c -> unit) 73 | = 74 | fun (type a) -> 75 | fun (type b) -> 76 | fun (type c) -> 77 | fun ((module A) : (module Ojs.T with type t = a)) -> 78 | fun ((module B) : (module Ojs.T with type t = b)) -> 79 | fun ((module C) : (module Ojs.T with type t = c)) -> 80 | fun (x17 : t) -> 81 | fun (x14 : a) -> 82 | fun (x15 : b) -> 83 | fun (x16 : c) -> 84 | ignore 85 | (Ojs.call (t_to_js x17) "log" 86 | [|(A.t_to_js x14);(B.t_to_js x15);(C.t_to_js 87 | x16)|]) 88 | end 89 | module Console3 = 90 | struct 91 | module Log = 92 | struct 93 | let (_1 : (module Ojs.T with type t = 'a) -> 'a -> unit) = 94 | fun (type a) -> 95 | fun ((module A) : (module Ojs.T with type t = a)) -> 96 | fun (x18 : a) -> 97 | Ojs.unit_of_js 98 | (Ojs.apply 99 | (Ojs.get_prop_ascii 100 | (Ojs.get_prop_ascii Ojs.global "console") "log") 101 | [|(A.t_to_js x18)|]) 102 | let (_2 : 103 | (module Ojs.T with type t = 'a) -> 104 | (module Ojs.T with type t = 'b) -> 'a -> 'b -> unit) 105 | = 106 | fun (type a) -> 107 | fun (type b) -> 108 | fun ((module A) : (module Ojs.T with type t = a)) -> 109 | fun ((module B) : (module Ojs.T with type t = b)) -> 110 | fun (x19 : a) -> 111 | fun (x20 : b) -> 112 | Ojs.unit_of_js 113 | (Ojs.apply 114 | (Ojs.get_prop_ascii 115 | (Ojs.get_prop_ascii Ojs.global "console") "log") 116 | [|(A.t_to_js x19);(B.t_to_js x20)|]) 117 | let (_3 : 118 | (module Ojs.T with type t = 'a) -> 119 | (module Ojs.T with type t = 'b) -> 120 | (module Ojs.T with type t = 'c) -> 'a -> 'b -> 'c -> unit) 121 | = 122 | fun (type a) -> 123 | fun (type b) -> 124 | fun (type c) -> 125 | fun ((module A) : (module Ojs.T with type t = a)) -> 126 | fun ((module B) : (module Ojs.T with type t = b)) -> 127 | fun ((module C) : (module Ojs.T with type t = c)) -> 128 | fun (x21 : a) -> 129 | fun (x22 : b) -> 130 | fun (x23 : c) -> 131 | Ojs.unit_of_js 132 | (Ojs.apply 133 | (Ojs.get_prop_ascii 134 | (Ojs.get_prop_ascii Ojs.global "console") 135 | "log") 136 | [|(A.t_to_js x21);(B.t_to_js x22);(C.t_to_js 137 | x23)|]) 138 | end 139 | end 140 | module Array = 141 | struct 142 | type 'a t = Ojs.t 143 | let rec t_of_js : 'a . (Ojs.t -> 'a) -> Ojs.t -> 'a t = 144 | fun (type __a) -> 145 | fun (__a_of_js : Ojs.t -> __a) -> fun (x25 : Ojs.t) -> x25 146 | and t_to_js : 'a . ('a -> Ojs.t) -> 'a t -> Ojs.t = 147 | fun (type __a) -> 148 | fun (__a_to_js : __a -> Ojs.t) -> fun (x24 : Ojs.t) -> x24 149 | let (create : (module Ojs.T with type t = 'a) -> 'a list -> 'a t) = 150 | fun (type a) -> 151 | fun ((module A) : (module Ojs.T with type t = a)) -> 152 | fun (x26 : a list) -> 153 | t_of_js A.t_of_js 154 | (Ojs.new_obj_arr (Ojs.get_prop_ascii Ojs.global "Array") 155 | (let x27 = 156 | Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") [||] in 157 | List.iter 158 | (fun (x28 : a) -> 159 | ignore (Ojs.call x27 "push" [|(A.t_to_js x28)|])) x26; 160 | x27)) 161 | let (create' : (module Ojs.T with type t = 'a) -> 'a list -> 'a t) = 162 | fun (type a) -> 163 | fun ((module A) : (module Ojs.T with type t = a)) -> 164 | fun (x30 : a list) -> 165 | t_of_js A.t_of_js 166 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "Array") "apply" 167 | [|Ojs.null;((let x31 = 168 | Ojs.new_obj 169 | (Ojs.get_prop_ascii Ojs.global "Array") 170 | [||] in 171 | List.iter 172 | (fun (x32 : a) -> 173 | ignore 174 | (Ojs.call x31 "push" [|(A.t_to_js x32)|])) 175 | x30; 176 | x31))|]) 177 | let (push : (module Ojs.T with type t = 'a) -> 'a t -> 'a -> unit) = 178 | fun (type a) -> 179 | fun ((module A) : (module Ojs.T with type t = a)) -> 180 | fun (x35 : a t) -> 181 | fun (x34 : a) -> 182 | ignore 183 | (Ojs.call (t_to_js A.t_to_js x35) "push" [|(A.t_to_js x34)|]) 184 | let (pop : (module Ojs.T with type t = 'a) -> 'a t -> 'a option) = 185 | fun (type a) -> 186 | fun ((module A) : (module Ojs.T with type t = a)) -> 187 | fun (x37 : a t) -> 188 | Ojs.option_of_js A.t_of_js 189 | (Ojs.call (t_to_js A.t_to_js x37) "pop" [||]) 190 | end 191 | -------------------------------------------------------------------------------- /ppx-test/expected/issues.ml: -------------------------------------------------------------------------------- 1 | module Issue116 : sig type t end = 2 | ((struct 3 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 4 | [@@@ocaml.warning "-7-32-39"] 5 | type t = Ojs.t 6 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 7 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 8 | end)[@merlin.hide ]) 9 | module Issue117 : 10 | sig module T : sig val log : 'a -> unit val log2 : 'a -> 'b -> unit end end 11 | = 12 | ((struct 13 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 14 | [@@@ocaml.warning "-7-32-39"] 15 | module T = 16 | struct 17 | let (log : 'a -> unit) = 18 | fun (x3 : 'a) -> 19 | ignore 20 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" 21 | [|(Obj.magic x3)|]) 22 | let (log2 : 'a -> 'b -> unit) = 23 | fun (x4 : 'a) -> 24 | fun (x5 : 'b) -> 25 | ignore 26 | (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") 27 | "jsLog2" [|(Obj.magic x4);(Obj.magic x5)|]) 28 | end 29 | end)[@merlin.hide ]) 30 | module Issue124 : 31 | sig 32 | type a 33 | and b = { 34 | a: a } 35 | type 'a dummy 36 | type 'a wrapped = 37 | | Wrapped of 'a 38 | type u = 39 | | Unknown of Ojs.t 40 | | T of t 41 | | WrappedT of t wrapped 42 | and t = [ `U of u ] dummy 43 | type ('a, 'b) base = [ `BaseA of 'a | `BaseB of 'b ] dummy 44 | and base1 = (int, string) base 45 | and base2 = (string, int) base 46 | end = 47 | ((struct 48 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 49 | [@@@ocaml.warning "-7-32-39"] 50 | type a = Ojs.t 51 | and b = { 52 | a: a } 53 | let rec a_of_js : Ojs.t -> a = fun (x7 : Ojs.t) -> x7 54 | and a_to_js : a -> Ojs.t = fun (x6 : Ojs.t) -> x6 55 | and b_of_js : Ojs.t -> b = fun js -> { a = (a_of_js js) } 56 | and b_to_js : b -> Ojs.t = fun { a } -> a_to_js a 57 | type 'a dummy = Ojs.t 58 | let rec dummy_of_js : 'a . (Ojs.t -> 'a) -> Ojs.t -> 'a dummy = 59 | fun (type __a) -> 60 | fun (__a_of_js : Ojs.t -> __a) -> fun (x9 : Ojs.t) -> x9 61 | and dummy_to_js : 'a . ('a -> Ojs.t) -> 'a dummy -> Ojs.t = 62 | fun (type __a) -> 63 | fun (__a_to_js : __a -> Ojs.t) -> fun (x8 : Ojs.t) -> x8 64 | type 'a wrapped = 65 | | Wrapped of 'a 66 | let rec wrapped_of_js : 'a . (Ojs.t -> 'a) -> Ojs.t -> 'a wrapped = 67 | let f a_of_js x = Wrapped (a_of_js x) in f 68 | and wrapped_to_js : 'a . ('a -> Ojs.t) -> 'a wrapped -> Ojs.t = 69 | let f a_to_js = function | Wrapped a -> a_to_js a in f 70 | type u = 71 | | Unknown of Ojs.t 72 | | T of t 73 | | WrappedT of t wrapped 74 | and t = [ `U of u ] dummy 75 | let rec u_of_js : Ojs.t -> u = 76 | fun (x15 : Ojs.t) -> 77 | let x16 = x15 in 78 | match Ojs.type_of (Ojs.get_prop_ascii x16 "type") with 79 | | "number" -> Unknown x16 80 | | "string" -> 81 | (match Ojs.string_of_js (Ojs.get_prop_ascii x16 "type") with 82 | | "t" -> T (t_of_js x16) 83 | | "wrapped_t" -> WrappedT (wrapped_of_js t_of_js x16) 84 | | _ -> Unknown x16) 85 | | "boolean" -> Unknown x16 86 | | _ -> Unknown x16 87 | and u_to_js : u -> Ojs.t = 88 | fun (x10 : u) -> 89 | match x10 with 90 | | Unknown x11 -> x11 91 | | T x12 -> t_to_js x12 92 | | WrappedT x13 -> wrapped_to_js t_to_js x13 93 | and t_of_js : Ojs.t -> t = Obj.magic 94 | and t_to_js : t -> Ojs.t = Obj.magic 95 | type ('a, 'b) base = [ `BaseA of 'a | `BaseB of 'b ] dummy 96 | and base1 = (int, string) base 97 | and base2 = (string, int) base 98 | let rec base_of_js : 99 | 'a 'b . (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> Ojs.t -> ('a, 'b) base = 100 | fun _ -> fun _ -> Obj.magic 101 | and base_to_js : 102 | 'a 'b . ('a -> Ojs.t) -> ('b -> Ojs.t) -> ('a, 'b) base -> Ojs.t = 103 | fun _ -> fun _ -> Obj.magic 104 | and base1_of_js : Ojs.t -> base1 = 105 | fun (x21 : Ojs.t) -> base_of_js Ojs.int_of_js Ojs.string_of_js x21 106 | and base1_to_js : base1 -> Ojs.t = 107 | fun (x18 : (int, string) base) -> 108 | base_to_js Ojs.int_to_js Ojs.string_to_js x18 109 | and base2_of_js : Ojs.t -> base2 = 110 | fun (x27 : Ojs.t) -> base_of_js Ojs.string_of_js Ojs.int_of_js x27 111 | and base2_to_js : base2 -> Ojs.t = 112 | fun (x24 : (string, int) base) -> 113 | base_to_js Ojs.string_to_js Ojs.int_to_js x24 114 | end)[@merlin.hide ]) 115 | module Issue109 : sig type t = [ `S of string | `I of int ] end = 116 | ((struct 117 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 118 | [@@@ocaml.warning "-7-32-39"] 119 | type t = [ `S of string | `I of int ] 120 | let rec t_of_js : Ojs.t -> t = 121 | fun (x35 : Ojs.t) -> 122 | let x36 = x35 in 123 | match Ojs.type_of x36 with 124 | | "number" -> (match Ojs.int_of_js x36 with | x38 -> `I x38) 125 | | "string" -> (match Ojs.string_of_js x36 with | x37 -> `S x37) 126 | | _ -> assert false 127 | and t_to_js : t -> Ojs.t = 128 | fun (x32 : [ `S of string | `I of int ]) -> 129 | match x32 with 130 | | `S x33 -> Ojs.string_to_js x33 131 | | `I x34 -> Ojs.int_to_js x34 132 | end)[@merlin.hide ]) 133 | module Issue142 : sig type t = [ `Foo ] 134 | and u = t end = 135 | ((struct 136 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 137 | [@@@ocaml.warning "-7-32-39"] 138 | type t = [ `Foo ] 139 | and u = t 140 | let rec t_of_js : Ojs.t -> t = 141 | fun (x40 : Ojs.t) -> 142 | let x41 = x40 in 143 | match Ojs.int_of_js x41 with | 42 -> `Foo | _ -> assert false 144 | and t_to_js : t -> Ojs.t = 145 | fun (x39 : [ `Foo ]) -> match x39 with | `Foo -> Ojs.int_to_js 42 146 | and u_of_js : Ojs.t -> u = fun (x43 : Ojs.t) -> t_of_js x43 147 | and u_to_js : u -> Ojs.t = fun (x42 : t) -> t_to_js x42 148 | end)[@merlin.hide ]) 149 | module Issue144 : sig type t val f : t -> args:int -> int end = 150 | ((struct 151 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 152 | [@@@ocaml.warning "-7-32-39"] 153 | type t = Ojs.t 154 | let rec t_of_js : Ojs.t -> t = fun (x45 : Ojs.t) -> x45 155 | and t_to_js : t -> Ojs.t = fun (x44 : Ojs.t) -> x44 156 | let (f : t -> args:int -> int) = 157 | fun (x46 : t) -> 158 | fun ~args:(x47 : int) -> 159 | Ojs.int_of_js 160 | (Ojs.apply (Ojs.call (t_to_js x46) "f" [||]) 161 | [|(Ojs.int_to_js x47)|]) 162 | end)[@merlin.hide ]) 163 | module Issue146 : sig val f : ?arg:[ `Foo ] -> unit -> int end = 164 | ((struct 165 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 166 | [@@@ocaml.warning "-7-32-39"] 167 | let (f : ?arg:[ `Foo ] -> unit -> int) = 168 | fun ?arg:(x48 : [ `Foo ] option) -> 169 | fun () -> 170 | Ojs.int_of_js 171 | (let x51 = Ojs.global in 172 | Ojs.call (Ojs.get_prop_ascii x51 "f") "apply" 173 | [|x51;((let x49 = 174 | Ojs.new_obj 175 | (Ojs.get_prop_ascii Ojs.global "Array") 176 | [||] in 177 | (match x48 with 178 | | Some x50 -> 179 | ignore 180 | (Ojs.call x49 "push" 181 | [|((match x50 with 182 | | `Foo -> Ojs.int_to_js 42))|]) 183 | | None -> ()); 184 | x49))|]) 185 | end)[@merlin.hide ]) 186 | module PR165 : 187 | sig 188 | module Markdown : sig type t end 189 | module ParameterInformation : 190 | sig 191 | type t 192 | val create : 193 | label:[ `String of string | `Tuple of (int * int) ] -> 194 | ?documentation:[ `String of string | `Markdown of Markdown.t ] -> 195 | unit -> t 196 | end 197 | end = 198 | ((struct 199 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 200 | [@@@ocaml.warning "-7-32-39"] 201 | module Markdown = 202 | struct 203 | type t = Ojs.t 204 | let rec t_of_js : Ojs.t -> t = fun (x53 : Ojs.t) -> x53 205 | and t_to_js : t -> Ojs.t = fun (x52 : Ojs.t) -> x52 206 | end 207 | module ParameterInformation = 208 | struct 209 | type t = Ojs.t 210 | let rec t_of_js : Ojs.t -> t = fun (x55 : Ojs.t) -> x55 211 | and t_to_js : t -> Ojs.t = fun (x54 : Ojs.t) -> x54 212 | let (create : 213 | label:[ `String of string | `Tuple of (int * int) ] -> 214 | ?documentation:[ `String of string | `Markdown of Markdown.t ] 215 | -> unit -> t) 216 | = 217 | fun ~label:(x56 : [ `String of string | `Tuple of (int * int) ]) 218 | -> 219 | fun 220 | ?documentation:(x57 : 221 | [ `String of string 222 | | `Markdown of Markdown.t ] option) 223 | -> 224 | fun () -> 225 | t_of_js 226 | (Ojs.new_obj_arr 227 | (Ojs.get_prop_ascii Ojs.global "ParameterInformation") 228 | (let x58 = 229 | Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") 230 | [||] in 231 | ignore 232 | (Ojs.call x58 "push" 233 | [|((match x56 with 234 | | `String x62 -> Ojs.string_to_js x62 235 | | `Tuple x63 -> 236 | let (x64, x65) = x63 in 237 | let x66 = Ojs.array_make 2 in 238 | (Ojs.array_set x66 0 (Ojs.int_to_js x64); 239 | Ojs.array_set x66 1 (Ojs.int_to_js x65); 240 | x66)))|]); 241 | (match x57 with 242 | | Some x59 -> 243 | ignore 244 | (Ojs.call x58 "push" 245 | [|((match x59 with 246 | | `String x60 -> Ojs.string_to_js x60 247 | | `Markdown x61 -> Markdown.t_to_js x61))|]) 248 | | None -> ()); 249 | x58)) 250 | end 251 | end)[@merlin.hide ]) 252 | -------------------------------------------------------------------------------- /ppx-test/expected/issues_mli.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module Issue144 = 4 | struct 5 | type t = Ojs.t 6 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 7 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 8 | let (f : t -> args:int -> int) = 9 | fun (x3 : t) -> 10 | fun ~args:(x4 : int) -> 11 | Ojs.int_of_js 12 | (Ojs.apply (Ojs.call (t_to_js x3) "f" [||]) 13 | [|(Ojs.int_to_js x4)|]) 14 | end 15 | -------------------------------------------------------------------------------- /ppx-test/expected/modules.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module Event = 4 | struct 5 | type t = Ojs.t 6 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 7 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 8 | end 9 | module Foo = 10 | struct 11 | module E = Event 12 | let (foo : E.t -> string -> unit) = 13 | fun (x4 : E.t) -> 14 | fun (x3 : string) -> 15 | ignore (Ojs.call (E.t_to_js x4) "foo" [|(Ojs.string_to_js x3)|]) 16 | end 17 | module Bar = 18 | struct 19 | include Event 20 | let (bar : t -> string -> unit) = 21 | fun (x6 : t) -> 22 | fun (x5 : string) -> 23 | ignore (Ojs.call (t_to_js x6) "bar" [|(Ojs.string_to_js x5)|]) 24 | end 25 | -------------------------------------------------------------------------------- /ppx-test/expected/recursive_modules.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | module rec 4 | Foo:sig 5 | type t = private Ojs.t 6 | val t_of_js : Ojs.t -> t 7 | val t_to_js : t -> Ojs.t 8 | val create : string -> t 9 | val describe : t -> string 10 | val to_bar : t -> Bar.t 11 | end = 12 | struct 13 | type t = Ojs.t 14 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 15 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 16 | let (create : string -> t) = 17 | fun (x3 : string) -> 18 | t_of_js 19 | (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Foo") 20 | [|(Ojs.string_to_js x3)|]) 21 | let (describe : t -> string) = 22 | fun (x4 : t) -> 23 | Ojs.string_of_js (Ojs.call (t_to_js x4) "describe" [||]) 24 | let (to_bar : t -> Bar.t) = 25 | fun (x5 : t) -> Bar.t_of_js (Ojs.call (t_to_js x5) "toBar" [||]) 26 | end 27 | and 28 | Bar:sig 29 | type t = private Ojs.t 30 | val t_of_js : Ojs.t -> t 31 | val t_to_js : t -> Ojs.t 32 | val create : string -> t 33 | val describe : t -> string 34 | val to_foo : t -> Foo.t 35 | end = 36 | struct 37 | type t = Ojs.t 38 | let rec t_of_js : Ojs.t -> t = fun (x7 : Ojs.t) -> x7 39 | and t_to_js : t -> Ojs.t = fun (x6 : Ojs.t) -> x6 40 | let (create : string -> t) = 41 | fun (x8 : string) -> 42 | t_of_js 43 | (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Bar") 44 | [|(Ojs.string_to_js x8)|]) 45 | let (describe : t -> string) = 46 | fun (x9 : t) -> 47 | Ojs.string_of_js (Ojs.call (t_to_js x9) "describe" [||]) 48 | let (to_foo : t -> Foo.t) = 49 | fun (x10 : t) -> Foo.t_of_js (Ojs.call (t_to_js x10) "toFoo" [||]) 50 | end 51 | -------------------------------------------------------------------------------- /ppx-test/expected/scoped.ml: -------------------------------------------------------------------------------- 1 | [@@@js.dummy "!! This code has been generated by gen_js_api !!"] 2 | [@@@ocaml.warning "-7-32-39"] 3 | [@@@warning "-22"] 4 | module M = 5 | struct 6 | type t = Ojs.t 7 | let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 8 | and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 9 | let (prop_get_arg : t -> int) = 10 | ((fun (x3 : t) -> 11 | Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x3) "propGetArg")) 12 | [@ocaml.ppwarning 13 | "Heuristic for automatic binding is deprecated; please add the '@js.get' attribute."]) 14 | let (prop_get : unit -> int) = 15 | ((fun () -> 16 | Ojs.int_of_js 17 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "scope") 18 | "propGet")) 19 | [@ocaml.ppwarning 20 | "Heuristic for automatic binding is deprecated; please add the '@js.get' attribute."]) 21 | let (set_prop : t -> int -> unit) = 22 | ((fun (x4 : t) -> 23 | fun (x5 : int) -> 24 | Ojs.set_prop_ascii (t_to_js x4) "prop" (Ojs.int_to_js x5)) 25 | [@ocaml.ppwarning 26 | "Heuristic for automatic binding is deprecated; please add the '@js.set' attribute."]) 27 | let (set_global : int -> unit) = 28 | ((fun (x6 : int) -> 29 | Ojs.set_prop_ascii (Ojs.get_prop_ascii Ojs.global "scope") "global" 30 | (Ojs.int_to_js x6)) 31 | [@ocaml.ppwarning 32 | "Heuristic for automatic binding is deprecated; please add the '@js.set' attribute."]) 33 | let (new_thing_unit : unit -> t) = 34 | ((fun () -> 35 | t_of_js 36 | (Ojs.new_obj 37 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "scope") 38 | "ThingUnit") [||])) 39 | [@ocaml.ppwarning 40 | "Heuristic for automatic binding is deprecated; please add the '@js.new' attribute."]) 41 | let (new_thing_args : int -> t) = 42 | ((fun (x7 : int) -> 43 | t_of_js 44 | (Ojs.new_obj 45 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "scope") 46 | "ThingArgs") [|(Ojs.int_to_js x7)|])) 47 | [@ocaml.ppwarning 48 | "Heuristic for automatic binding is deprecated; please add the '@js.new' attribute."]) 49 | let (method_call_global : t -> unit) = 50 | ((fun (x8 : t) -> 51 | ignore (Ojs.call (t_to_js x8) "methodCallGlobal" [||])) 52 | [@ocaml.ppwarning 53 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 54 | let (method_call_unit : t -> unit -> int) = 55 | ((fun (x9 : t) -> 56 | fun () -> 57 | Ojs.int_of_js (Ojs.call (t_to_js x9) "methodCallUnit" [||])) 58 | [@ocaml.ppwarning 59 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 60 | let (method_call_args : t -> int -> int) = 61 | ((fun (x11 : t) -> 62 | fun (x10 : int) -> 63 | Ojs.int_of_js 64 | (Ojs.call (t_to_js x11) "methodCallArgs" 65 | [|(Ojs.int_to_js x10)|])) 66 | [@ocaml.ppwarning 67 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 68 | let (method_call_unit_unit : t -> unit -> unit) = 69 | ((fun (x12 : t) -> 70 | fun () -> ignore (Ojs.call (t_to_js x12) "methodCallUnitUnit" [||])) 71 | [@ocaml.ppwarning 72 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 73 | let (method_call_args_unit : t -> int -> unit) = 74 | ((fun (x14 : t) -> 75 | fun (x13 : int) -> 76 | ignore 77 | (Ojs.call (t_to_js x14) "methodCallArgsUnit" 78 | [|(Ojs.int_to_js x13)|])) 79 | [@ocaml.ppwarning 80 | "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) 81 | let (global : t) = 82 | ((t_of_js 83 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "scope") 84 | "global")) 85 | [@ocaml.ppwarning 86 | "Heuristic for automatic binding is deprecated; please add the '@js.global' attribute."]) 87 | let (invoke : unit -> unit) = 88 | fun () -> 89 | Ojs.unit_of_js 90 | (Ojs.apply (Ojs.get_prop_ascii Ojs.global "scope") [||]) 91 | end 92 | let (d : unit -> unit) = 93 | fun () -> 94 | ignore 95 | (Ojs.call 96 | (Ojs.get_prop_ascii 97 | (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "a") "b") "c") 98 | "d" [||]) 99 | -------------------------------------------------------------------------------- /ppx-test/extension.ml: -------------------------------------------------------------------------------- 1 | 2 | let _ = [%js.of: int] 3 | let _ = [%js.of: int -> int] 4 | -------------------------------------------------------------------------------- /ppx-test/first_class_modules.mli: -------------------------------------------------------------------------------- 1 | module[@js.scope "console"] Console: sig 2 | val log: (module[@js] Ojs.T with type t = 'a) -> 'a -> unit [@@js.global "log"] 3 | val log2: 4 | (module[@js] Ojs.T with type t = 'a) -> 5 | (module[@js] Ojs.T with type t = 'b) -> 6 | 'a -> 'b -> unit [@@js.global "log"] 7 | val log3: 8 | (module[@js] Ojs.T with type t = 'a) -> 9 | (module[@js] Ojs.T with type t = 'b) -> 10 | (module[@js] Ojs.T with type t = 'c) -> 11 | 'a -> 'b -> 'c -> unit [@@js.global "log"] 12 | end 13 | 14 | module Console2: sig 15 | type t 16 | val log: (module[@js] Ojs.T with type t = 'a) -> t -> 'a -> unit [@@js.call "log"] 17 | val log2: 18 | (module[@js] Ojs.T with type t = 'a) -> 19 | (module[@js] Ojs.T with type t = 'b) -> 20 | t -> 'a -> 'b -> unit [@@js.call "log"] 21 | val log3: 22 | (module[@js] Ojs.T with type t = 'a) -> 23 | (module[@js] Ojs.T with type t = 'b) -> 24 | (module[@js] Ojs.T with type t = 'c) -> 25 | t -> 'a -> 'b -> 'c -> unit [@@js.call "log"] 26 | end 27 | 28 | module[@js.scope "console"] Console3: sig 29 | module [@js.scope "log"] Log: sig 30 | val _1: (module[@js] Ojs.T with type t = 'a) -> 'a -> unit [@@js.invoke] 31 | val _2: 32 | (module[@js] Ojs.T with type t = 'a) -> 33 | (module[@js] Ojs.T with type t = 'b) -> 34 | 'a -> 'b -> unit [@@js.invoke] 35 | val _3: 36 | (module[@js] Ojs.T with type t = 'a) -> 37 | (module[@js] Ojs.T with type t = 'b) -> 38 | (module[@js] Ojs.T with type t = 'c) -> 39 | 'a -> 'b -> 'c -> unit [@@js.invoke] 40 | end 41 | end 42 | 43 | module[@js.scope "Array"] Array: sig 44 | type 'a t 45 | val t_to_js: ('a -> Ojs.t) -> 'a t -> Ojs.t 46 | val t_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a t 47 | 48 | val create: (module[@js] Ojs.T with type t = 'a) -> ('a list [@js.variadic]) -> 'a t [@@js.create] 49 | val create': (module[@js] Ojs.T with type t = 'a) -> ('a list [@js.variadic]) -> 'a t [@@js.invoke] 50 | 51 | val push: (module[@js] Ojs.T with type t = 'a) -> 'a t -> 'a -> unit [@@js.call] 52 | val pop: (module[@js] Ojs.T with type t = 'a) -> 'a t -> 'a option [@@js.call] 53 | end -------------------------------------------------------------------------------- /ppx-test/issues.ml: -------------------------------------------------------------------------------- 1 | module Issue116 = [%js: type t] 2 | module Issue117 = [%js: 3 | module T: sig 4 | val log: 'a -> unit [@@js.global] 5 | val log2: 'a -> 'b -> unit [@@js.global "jsLog2"] 6 | end [@js.scope "console"] 7 | ] 8 | module Issue124 = [%js: 9 | type a 10 | and b = 11 | { a : a } 12 | [@@js.custom { 13 | to_js = (fun { a } -> [%js.of: a] a); 14 | of_js = (fun js -> { a = [%js.to: a] js}) 15 | }] 16 | 17 | type 'a dummy 18 | 19 | type 'a wrapped = 20 | | Wrapped of 'a 21 | [@@js.custom { 22 | to_js = ( 23 | let f a_to_js = 24 | function Wrapped a -> 25 | a_to_js a 26 | in f); 27 | of_js = ( 28 | let f a_of_js x = 29 | Wrapped (a_of_js x) 30 | in f 31 | ) 32 | }] 33 | 34 | type u = 35 | | Unknown of Ojs.t [@js.default] 36 | | T of t [@js "t"] 37 | | WrappedT of t wrapped [@js "wrapped_t"] 38 | [@@js.union on_field "type"] 39 | 40 | and t = [`U of u] dummy [@@js.custom { 41 | to_js = Obj.magic; of_js = Obj.magic 42 | }] 43 | 44 | type ('a, 'b) base = [ `BaseA of 'a | `BaseB of 'b ] dummy [@@js.custom { 45 | to_js = (fun _ _ -> Obj.magic); 46 | of_js = (fun _ _ -> Obj.magic) 47 | }] 48 | and base1 = (int, string) base 49 | and base2 = (string, int) base 50 | ] 51 | module Issue109 = [%js: 52 | type t = 53 | [ `S of string [@js.default] 54 | | `I of int [@js.default] 55 | ] [@@js.enum] 56 | ] 57 | module Issue142 = [%js: 58 | type t = [`Foo [@js 42]] [@js.enum] 59 | and u = t 60 | ] 61 | module Issue144 = [%js: 62 | type t 63 | val f: t -> (args:int -> int [@js.dummy]) [@@js.call "f"] 64 | ] 65 | module Issue146 = [%js: 66 | val f: ?arg:([`Foo [@js 42]] [@js.enum]) -> unit -> int [@@js.global "f"] 67 | ] 68 | module PR165 = [%js: 69 | module Markdown : sig 70 | type t 71 | end 72 | 73 | module [@js.scope "ParameterInformation"] ParameterInformation : sig 74 | type t 75 | val create: label:([`String of string | `Tuple of (int * int)] [@js.union]) -> ?documentation:([`String of string | `Markdown of Markdown.t] [@js.union]) -> unit -> t [@@js.create] 76 | end 77 | ] -------------------------------------------------------------------------------- /ppx-test/issues_mli.mli: -------------------------------------------------------------------------------- 1 | module Issue144: sig 2 | type t 3 | val f: t -> (args:int -> int [@js.dummy]) [@@js.call "f"] 4 | end 5 | -------------------------------------------------------------------------------- /ppx-test/modules.mli: -------------------------------------------------------------------------------- 1 | module Event: sig 2 | type t = private Ojs.t 3 | val t_to_js: t -> Ojs.t 4 | val t_of_js: Ojs.t -> t 5 | end 6 | 7 | module Foo: sig 8 | module E = Event 9 | 10 | val foo: E.t -> string -> unit [@@js.call] 11 | end 12 | 13 | module Bar: sig 14 | include (module type of Event) 15 | 16 | val bar: t -> string -> unit [@@js.call] 17 | end 18 | -------------------------------------------------------------------------------- /ppx-test/ppx/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries ppxlib gen_js_api_ppx_driver)) 4 | -------------------------------------------------------------------------------- /ppx-test/ppx/main.ml: -------------------------------------------------------------------------------- 1 | 2 | (* To run as a standalone binary, run the registered drivers *) 3 | let () = Ppxlib.Driver.standalone () 4 | -------------------------------------------------------------------------------- /ppx-test/recursive_modules.mli: -------------------------------------------------------------------------------- 1 | module [@js.scope "Foo"] rec Foo : sig 2 | type t = private Ojs.t 3 | val t_of_js: Ojs.t -> t 4 | val t_to_js: t -> Ojs.t 5 | val create: string -> t [@@js.create] 6 | val describe: t -> string [@@js.call "describe"] 7 | val to_bar: t -> Bar.t [@@js.call "toBar"] 8 | end 9 | 10 | and [@js.scope "Bar"] Bar : sig 11 | type t = private Ojs.t 12 | val t_of_js: Ojs.t -> t 13 | val t_to_js: t -> Ojs.t 14 | val create: string -> t [@@js.create] 15 | val describe: t -> string [@@js.call "describe"] 16 | val to_foo: t -> Foo.t [@@js.call "toFoo"] 17 | end 18 | -------------------------------------------------------------------------------- /ppx-test/scoped.mli: -------------------------------------------------------------------------------- 1 | (* The gen_js_api is released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright 2015 by LexiFi. *) 4 | 5 | [@@@js.implem [@@@warning "-22"]] 6 | 7 | module M : sig 8 | type t = private Ojs.t 9 | val t_to_js: t -> Ojs.t 10 | val t_of_js: Ojs.t -> t 11 | 12 | val prop_get_arg: t -> int 13 | val prop_get: unit -> int 14 | val set_prop: t -> int -> unit 15 | val set_global: int -> unit 16 | val new_thing_unit: unit -> t 17 | val new_thing_args: int -> t 18 | val method_call_global: t -> unit 19 | val method_call_unit: t -> unit -> int 20 | val method_call_args: t -> int -> int 21 | val method_call_unit_unit: t -> unit -> unit 22 | val method_call_args_unit: t -> int -> unit 23 | val global: t 24 | val invoke: unit -> unit [@@js.invoke] 25 | end[@js.scope "scope"] 26 | 27 | val d: unit -> unit [@@js.scope ("a", "b", "c")] [@@js.global] 28 | -------------------------------------------------------------------------------- /ppx-test/types.ml: -------------------------------------------------------------------------------- 1 | 2 | type 'a of_js = Ojs.t -> 'a 3 | type 'a to_js = 'a -> Ojs.t 4 | 5 | (** JS-able types *) 6 | 7 | let _ : string of_js = [%js.to: string] 8 | let _ : string to_js = [%js.of: string] 9 | 10 | let _ : int of_js = [%js.to: int] 11 | let _ : int to_js = [%js.of: int] 12 | let _ : bool of_js = [%js.to: bool] 13 | let _ : bool to_js = [%js.of: bool] 14 | let _ : float of_js = [%js.to: float] 15 | let _ : float to_js = [%js.of: float] 16 | let _ : Ojs.t of_js = [%js.to: Ojs.t] 17 | let _ : Ojs.t to_js = [%js.of: Ojs.t] 18 | let _ : (string * int) of_js = [%js.to: string * int] 19 | let _ : (string * int) to_js = [%js.of: string * int] 20 | let _ : (string * int * bool) of_js = [%js.to: string * int * bool] 21 | let _ : (string * int * bool) to_js = [%js.of: string * int * bool] 22 | let _ : (string -> int) of_js = [%js.to: string -> int] 23 | let _ : (string -> int) to_js = [%js.of: string -> int] 24 | let _ : ((string -> int) -> bool -> unit) of_js = [%js.to: (string -> int) -> bool -> unit] 25 | let _ : ((string -> int) -> bool -> unit) to_js = [%js.of: (string -> int) -> bool -> unit] 26 | let _ : (string array) of_js = [%js.to: string array] 27 | let _ : (string array) to_js = [%js.of: string array] 28 | let _ : (string list) of_js = [%js.to: string list] 29 | let _ : (string list) to_js = [%js.of: string list] 30 | let _ : (string option) of_js = [%js.to: string option] 31 | let _ : (string option) to_js = [%js.of: string option] 32 | let _ : (_ -> _) of_js = [%js.to: 'a -> 'b] 33 | let _ : (_ -> _) to_js = [%js.of: 'a -> 'b] 34 | let _ : [`foo | `bar | `Baz | `I of int | `S of string ] of_js = [%js.to: [`foo | `bar [@js 42] | `Baz | `I of int [@js.default] | `S of string[@js.default] ] [@js.enum]] 35 | let _ : [`foo | `bar | `Baz | `I of int | `S of string ] to_js = [%js.of: [`foo | `bar [@js 42] | `Baz | `I of int [@js.default] | `S of string[@js.default] ] [@js.enum]] 36 | 37 | (** Label & Options Value *) 38 | 39 | let _ : (label:int -> ?opt:int -> unit -> unit) of_js = [%js.to: label:int -> ?opt:int -> unit -> unit] 40 | let _ : (label:int -> ?opt:int -> unit -> unit) to_js = [%js.of: label:int -> ?opt:int -> unit -> unit] 41 | let _ : (label:int -> ?opt:int -> unit -> unit) of_js = [%js.to: label:int -> ?opt:int -> unit -> unit] (* js.default is ignored *) 42 | let _ : (label:int -> ?opt:int -> unit -> unit) to_js = [%js.of: label:int -> ?opt:int -> unit -> unit] (* js.default is ignored *) 43 | 44 | (** Functions *) 45 | 46 | module B = [%js: 47 | val default0: ?x:int -> unit -> unit [@@js.global] 48 | val default1: ?x:(int[@js.default 42]) -> unit -> unit [@@js.global] 49 | 50 | val builder0: unit -> Ojs.t [@@js.builder] 51 | val builder1: x:int -> Ojs.t [@@js.builder] 52 | val builder2: ?x:int -> ?y:string -> unit -> Ojs.t [@@js.builder] 53 | val builder3: x:int -> y:string -> unit -> Ojs.t [@@js.builder] 54 | val builder4: x:int -> y:string -> z:unit -> Ojs.t [@@js.builder] 55 | val builder5: ?x:int -> ?y:string -> unit -> Ojs.t [@@js.builder] 56 | val builder6: ?x:(int [@js.default 42]) -> ?y:(string [@js.default "42"]) -> ?z:int -> unit -> Ojs.t [@@js.builder] 57 | 58 | val sep: string -> (string list [@js.variadic]) -> string [@@js.global] 59 | ] 60 | 61 | 62 | (** Types Declarations *) 63 | module T = [%js: 64 | type js = private Ojs.t 65 | 66 | type abstract 67 | 68 | type alias = js 69 | 70 | type private_alias = private alias 71 | 72 | type record = { x: js; y: js } 73 | 74 | type mutable_record = { mutable x: js; y: js } 75 | 76 | type record_relabel = { x : int; y : int [@js "Y"]} 77 | 78 | type ('a, 'b) parametrized = { x : 'a; y : 'b } 79 | 80 | type 'a abs = ('a -> int) -> unit 81 | 82 | type specialized = (int, int) parametrized 83 | 84 | type enum = 85 | | Foo [@js "foo"] 86 | | Bar [@js 42] 87 | | Baz [@js 4.2] 88 | | Qux 89 | [@@js.enum] 90 | 91 | type status = 92 | | OK [@js 1] 93 | | KO [@js 2] 94 | | OO [@js 1.5] 95 | | OtherS of string [@js.default] 96 | | OtherI of int [@js.default] 97 | [@@js.enum] 98 | 99 | type poly = [`foo | `bar [@js 42] | `baz [@js 4.2] | `Qux | `I of int [@js.default] | `S of string[@js.default]] [@js.enum] 100 | 101 | type sum = 102 | | A 103 | | B of int 104 | | C of int * string 105 | | D of {age: int; name: string} 106 | | Unknown of Ojs.t [@js.default] 107 | [@@js.sum] 108 | 109 | type t = 110 | | A [@js "A"] 111 | | B of int [@js.arg "bArg"] 112 | | C of int * string [@js.arg "cArg"] 113 | | D of {age: int [@js "X"]; name: string [@js "Y"]} 114 | | E of int [@js "F"][@js.arg "fArg"] 115 | | Unknown of Ojs.t [@js.default] 116 | [@@js.sum "kind"] 117 | 118 | type union = 119 | A | B of int | C of int | D of Ojs.t [@js.default] [@@js.union] 120 | 121 | type poly_union = 122 | [`A | `B of int | `C of int | `D of Ojs.t [@js.default]] [@js.union] 123 | 124 | type discr_union = 125 | A | B of int | C of int | D of Ojs.t [@js.default] [@@js.union on_field "discr"] 126 | 127 | type discr_poly_union = 128 | [`A | `B of int | `C of int | `D of Ojs.t [@js.default]] [@js.union on_field "discr"] 129 | 130 | type discr_union_value = 131 | A [@js 0] | B of int [@js "42"] | C of int | D of Ojs.t [@js.default] [@@js.union on_field "discr"] 132 | 133 | module NestedScope0 : sig 134 | val f: string -> unit [@@js.global "outer.inner.f"] 135 | end 136 | 137 | module [@js.scope ("outer", "inner")] NestedScope1 : sig 138 | val f: string -> unit [@@js.global] 139 | end 140 | 141 | module NestedScope2 : sig 142 | val f: string -> unit [@@js.global] 143 | end [@js.scope "inner"] [@js.scope "outer"] 144 | 145 | ] 146 | -------------------------------------------------------------------------------- /ppx-test/union_and_enum.mli: -------------------------------------------------------------------------------- 1 | type enum_int = 2 | | Enum_int_0 [@js 0] 3 | | Enum_int_1 [@js 1] 4 | | Enum_int_other of int [@js.default] 5 | [@@js.enum] 6 | 7 | type enum_float = 8 | | Enum_float_0_1 [@js 0.1] 9 | | Enum_float_1_1 [@js 1.1] 10 | | Enum_float_other of float [@js.default] 11 | [@@js.enum] 12 | 13 | (* float cases should be matched first *) 14 | type enum_number_1 = 15 | | Enum_number_0 [@js 0] 16 | | Enum_number_1 [@js 1] 17 | | Enum_number_0_1 [@js 0.1] 18 | | Enum_number_1_1 [@js 1.1] 19 | | Enum_number_other of int [@js.default] 20 | [@@js.enum] 21 | 22 | (* float cases should be matched first even if the default case is float *) 23 | type enum_number_2 = 24 | | Enum_number_0 [@js 0] 25 | | Enum_number_1 [@js 1] 26 | | Enum_number_0_1 [@js 0.1] 27 | | Enum_number_1_1 [@js 1.1] 28 | | Enum_number_other of float [@js.default] 29 | [@@js.enum] 30 | 31 | type enum_string = 32 | | Enum_string_foo [@js "foo"] 33 | | Enum_string_bar [@js "bar"] 34 | | Enum_string_other of string [@js.default] 35 | [@@js.enum] 36 | 37 | (* if both true and false are expected, the boolean part of `_of_js` should not have the default case *) 38 | type enum_bool = 39 | | Enum_bool_true [@js true] 40 | | Enum_bool_false [@js false] 41 | [@@js.enum] 42 | 43 | (* otherwise, an unknown boolean value should trigger `assert false` *) 44 | type enum_bool_partial = 45 | | Enum_bool_true [@js true] 46 | [@@js.enum] 47 | 48 | (* or it should be mapped to the case with `js.default` *) 49 | type enum_bool_partial2 = 50 | | Enum_bool_true [@js true] 51 | | Enum_bool_other of bool [@js.default] 52 | [@@js.enum] 53 | 54 | (* if both true and false are expected, the boolean part of `_of_js` should not have the default case *) 55 | type enum_mixed = 56 | | Enum_int_0 [@js 0] 57 | | Enum_int_1 [@js 1] 58 | | Enum_float_0_1 [@js 0.1] 59 | | Enum_float_1_1 [@js 1.1] 60 | | Enum_number_other of int [@js.default] 61 | | Enum_string_foo [@js "foo"] 62 | | Enum_string_bar [@js "bar"] 63 | | Enum_string_other of string [@js.default] 64 | | Enum_bool_true [@js true] 65 | | Enum_bool_false [@js false] 66 | [@@js.enum] 67 | 68 | (* otherwise, an unknown boolean value should trigger `assert false` *) 69 | type enum_mixed_partial_bool = 70 | | Enum_int_0 [@js 0] 71 | | Enum_int_1 [@js 1] 72 | | Enum_float_0_1 [@js 0.1] 73 | | Enum_float_1_1 [@js 1.1] 74 | | Enum_number_other of float [@js.default] 75 | | Enum_string_foo [@js "foo"] 76 | | Enum_string_bar [@js "bar"] 77 | | Enum_string_other of string [@js.default] 78 | | Enum_bool_true [@js true] 79 | [@@js.enum] 80 | 81 | (* or it should be mapped to the case with `js.default` *) 82 | type enum_mixed_partial_bool2 = 83 | | Enum_int_0 [@js 0] 84 | | Enum_int_1 [@js 1] 85 | | Enum_float_0_1 [@js 0.1] 86 | | Enum_float_1_1 [@js 1.1] 87 | | Enum_number_other of float [@js.default] 88 | | Enum_string_foo [@js "foo"] 89 | | Enum_string_bar [@js "bar"] 90 | | Enum_string_other of string [@js.default] 91 | | Enum_bool_true [@js true] 92 | | Enum_bool_other of bool [@js.default] 93 | [@@js.enum] 94 | 95 | type dummy1 96 | type dummy2 97 | type dummy3 98 | type dummy4 99 | type dummy5 100 | type dummy6 101 | 102 | type union_int = 103 | | Union_int_0 of dummy1 [@js 0] 104 | | Union_int_1 of dummy2 [@js 1] 105 | | Unknown of Ojs.t [@js.default] 106 | [@@js.union on_field "tag"] 107 | 108 | type union_float = 109 | | Union_float_0_1 of dummy1 [@js 0.1] 110 | | Union_float_1_1 of dummy2 [@js 1.1] 111 | | Unknown of Ojs.t [@js.default] 112 | [@@js.union on_field "tag"] 113 | 114 | type union_string = 115 | | Union_string_foo of dummy3 [@js "foo"] 116 | | Union_string_bar of dummy4 [@js "bar"] 117 | | Unknown of Ojs.t [@js.default] 118 | [@@js.union on_field "tag"] 119 | 120 | (* if both true and false are expected, the boolean part of `_of_js` should not have the default case *) 121 | type union_bool = 122 | | Union_bool_true of dummy5 [@js true] 123 | | Union_bool_false of dummy6 [@js false] 124 | [@@js.union on_field "tag"] 125 | 126 | (* otherwise, an unknown boolean value should trigger `assert false` *) 127 | type union_bool_partial = 128 | | Union_bool_true of dummy5 [@js true] 129 | [@@js.union on_field "tag"] 130 | 131 | (* or it should be mapped to `Unknown` *) 132 | type union_bool_partial2 = 133 | | Union_bool_true of dummy5 [@js true] 134 | | Unknown of Ojs.t [@js.default] 135 | [@@js.union on_field "tag"] 136 | 137 | (* if both true and false are expected, the boolean part of `_of_js` should not have the default case *) 138 | type union_mixed = 139 | | Union_int_0 of dummy1 [@js 0] 140 | | Union_int_1 of dummy2 [@js 1] 141 | | Union_float_0_1 of dummy1 [@js 0.1] 142 | | Union_float_1_1 of dummy2 [@js 1.1] 143 | | Union_string_foo of dummy3 [@js "foo"] 144 | | Union_string_bar of dummy4 [@js "bar"] 145 | | Union_bool_true of dummy5 [@js true] 146 | | Union_bool_false of dummy6 [@js false] 147 | | Unknown of Ojs.t [@js.default] 148 | [@@js.union on_field "tag"] 149 | 150 | (* otherwise, an unknown boolean value should be mapped to `Unknown` *) 151 | type union_mixed_partial_bool = 152 | | Union_int_0 of dummy1 [@js 0] 153 | | Union_int_1 of dummy2 [@js 1] 154 | | Union_float_0_1 of dummy1 [@js 0.1] 155 | | Union_float_1_1 of dummy2 [@js 1.1] 156 | | Union_string_foo of dummy3 [@js "foo"] 157 | | Union_string_bar of dummy4 [@js "bar"] 158 | | Union_bool_true of dummy5 [@js true] 159 | | Unknown of Ojs.t [@js.default] 160 | [@@js.union on_field "tag"] --------------------------------------------------------------------------------