Repository: aantron/repromise Branch: master Commit: ffe995c431c7 Files: 37 Total size: 132.4 KB Directory structure: gitextract_cmd8tl4j/ ├── .github/ │ └── FUNDING.yml ├── .gitignore ├── .travis.yml ├── LICENSE.md ├── README.md ├── bsconfig.json ├── dune ├── dune-project ├── package.json ├── promise.opam ├── src/ │ ├── js/ │ │ ├── promise.re │ │ └── promise.rei │ └── native/ │ ├── dune │ ├── mutableList.re │ ├── mutableList.rei │ ├── promise.re │ ├── promise.rei │ └── release.sh └── test/ ├── bundle/ │ ├── control.re │ ├── size.sh │ └── uses_promise.re ├── dune ├── framework/ │ ├── dune │ ├── framework.re │ ├── framework.rei │ ├── js/ │ │ └── run.re │ └── native/ │ ├── dune │ └── run.re ├── isoresult/ │ ├── js/ │ │ └── isoresult.re │ └── native/ │ ├── dune │ └── isoresult.re ├── js/ │ ├── benchmark.re │ └── test_ffi.re ├── native/ │ ├── dune │ └── test_ffi.re ├── test_main.re └── test_promise.re ================================================ FILE CONTENTS ================================================ ================================================ FILE: .github/FUNDING.yml ================================================ github: aantron ================================================ FILE: .gitignore ================================================ node_modules/ lib/ package-lock.json _build .merlin .bsb.lock *.install esy.lock scratch/ .vscode/ _opam/ *.coverage _coverage/ _esy/ .DS_Store doc/website/build doc/website/i18n/* test/bundle/*.js test/bundle/*.js.gz promise-* _release ================================================ FILE: .travis.yml ================================================ language: generic dist: bionic jobs: include: - env: BUILD_SYSTEM=esy before_install: - '[ "$TRAVIS_EVENT_TYPE" != cron ] || rm -rf ./node_modules ~/.esy' install: - '[ ! -f ./node_modules/.bin/esy ] || ESY_CACHED=yes' - '[ "$ESY_CACHED" == yes ] || npm install --no-save esy' - '[ "$ESY_CACHED" != yes ] || SKIP_UPDATE=--skip-repository-update' - export PATH="$(pwd)/node_modules/.bin:$PATH" - esy install $SKIP_UPDATE -P ./promise.opam script: - esy -P ./promise.opam dune build test/test_main.exe - esy -P ./promise.opam dune exec test/test_main.exe before_cache: - npm cache clean --force - rm -rf node_modules/.cache/_esy - env: BUILD_SYSTEM=npm before_install: - '[ "$TRAVIS_EVENT_TYPE" != cron ] || rm -rf ./node_modules' install: - 'npx which bsb || npm install' script: - npm run test - bash test/bundle/size.sh - pushd .. - git clone https://github.com/aantron/promise-example-bsb.git - cd promise-example-bsb - npm install - npm run test - cd .. - git clone https://github.com/aantron/promise-example-binding.git - cd promise-example-binding - npm install - npm run test - popd - pwd before_cache: - ./node_modules/.bin/bsb -clean-world - npm cache clean --force - env: BUILD_SYSTEM=opam before_install: - '[ "$TRAVIS_EVENT_TYPE" != cron ] || rm -rf ~/.opam' install: - VERSION=2.0.6 - OPAM=opam-$VERSION-x86_64-linux - wget https://github.com/ocaml/opam/releases/download/$VERSION/$OPAM - sudo mv $OPAM /usr/local/bin/opam - sudo chmod a+x /usr/local/bin/opam - opam init -ya --compiler=4.02.3 --disable-sandboxing - eval `opam env` - ocaml -version - opam install -y --deps-only . script: - dune exec test/test_main.exe # - BISECT_ENABLE=yes dune exec test/test_main.exe # - bisect-ppx-report send-to Coveralls - opam lint before_cache: - opam clean fast_finish: true cache: directories: - $HOME/.esy - $HOME/.opam - node_modules notifications: email: on_success: always on_failure: always ================================================ FILE: LICENSE.md ================================================ Copyright 2018-2020 Anton Bachin Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ================================================ FILE: README.md ================================================ # Promise     [![NPM link][npm-img]][npm] [![Travis status][travis-img]][travis] [![Coverage][coveralls-img]][coveralls] [npm]: https://www.npmjs.com/package/reason-promise [npm-img]: https://img.shields.io/npm/v/reason-promise [travis]: https://travis-ci.org/aantron/promise/branches [travis-img]: https://img.shields.io/travis/aantron/promise/master.svg?label=travis [coveralls]: https://coveralls.io/github/aantron/promise?branch=master [coveralls-img]: https://img.shields.io/coveralls/aantron/promise/master.svg A lightweight, type-safe binding to JS promises: ```rescript Js.log(Promise.resolved("Hello")); /* Promise { 'Hello' } */ Promise.resolved("Hello") ->Promise.map(s => s ++ " world!") ->Promise.get(s => Js.log(s)); /* Hello world! */ ``` As you can see on the first line, `Promise.t` maps directly to familiar JS promises from your JS runtime. That means... - You can use `reason-promise` directly to [write JS bindings](#Bindings). - All JS tooling for promises immediately works with `reason-promise`. - Even if you do something exotic, like switch out the promise implementation at the JS level, for, say, better stack traces, `reason-promise` still binds to it!
There is only one exception to the rule that `Promise.t` maps directly to JS promises: when there is a promise nested inside another promise. JS [breaks the type safety](#JSPromiseFlattening) of promises in a misguided attempt to disallow nesting. [`reason-promise` instead emulates it in a way that makes promises type-safe again](#TypeSafety). This is in contrast to BuckleScript's built-in `Js.Promise`, which directly exposes the JS behavior, and so is not type-safe.
In addition: - `reason-promise` offers a clean functional API, which replaces rejection with [helpers for `Result` and `Option`](#Errors). - `reason-promise` is tiny. It weighs in at about [1K bundled][bundle-size]. - `reason-promise` also has a full, standalone [pure-OCaml implementation][native], which passes all the same tests. It can be used for native code or in JS. [bundle-size]: https://travis-ci.org/github/aantron/promise/jobs/700562910#L210 [native]: https://github.com/aantron/promise/tree/master/src/native
## Tutorial - [**Installing**](#Installing) - [**Getting started**](#GettingStarted) - [**Creating new promises**](#Creating) - [**Getting values from promises**](#Values) - [**Transforming promises**](#Transforming) - [**Tracing**](#Tracing) - [**Concurrent combinations**](#Combining) - [**Handling errors with `Result`**](#Errors) - [**Advanced: Rejection**](#Rejection) - [**Advanced: Bindings**](#Bindings) - [**Discussion: Why JS promises are unsafe**](#JSPromiseFlattening) - [**Discussion: How `reason-promise` makes promises type-safe**](#TypeSafety)
### Installing ``` npm install reason-promise ``` Then, add `reason-promise` to your `bsconfig.json`: ```json { "bs-dependencies": [ "reason-promise" ] } ```
### Getting started To quickly get a project for pasting the code examples, clone the [example repo][example-repo]. The code is in `main.re`. ``` git clone https://github.com/aantron/promise-example-bsb cd promise-example-bsb npm install npm run test # To run each example. ``` There it also an example repo with [a trivial binding to parts of node-fetch][example-binding]. While reading the tutorial, it can be useful to glance at the [type signatures][rei] of the functions from time to time. They provide a neat summary of what each function does and what it expects from its callback.
### Creating new promises The most basic function for creating a new promise is [`Promise.pending`][pending]: ```rescript let (p, resolve) = Promise.pending() Js.log(p) /* Promise { } */ ``` The second value returned, `resolve`, is a function for resolving the promise: ```rescript let (p, resolve) = Promise.pending() resolve("Hello") Js.log(p) /* Promise { 'Hello' } */ ``` [`Promise.resolved`][resolved] is a helper that returns an already-resolved promise: ```rescript let p = Promise.resolved("Hello") Js.log(p) /* Promise { 'Hello' } */ ``` ...and [`Promise.exec`][exec] is for wrapping functions that take callbacks: ```rescript @bs.val external setTimeout: (unit => unit, int) => unit = "setTimeout" let p = Promise.exec(resolve => setTimeout(resolve, 1000)) Js.log(p) /* Promise { } */ /* Program then waits for one second before exiting. */ ```
### Getting values from promises To do something once a promise is resolved, use [`Promise.get`][get]: ```rescript let (p, resolve) = Promise.pending() p->Promise.get(s => Js.log(s)) resolve("Hello") /* Prints "Hello". */ ```
### Transforming promises Use [`Promise.map`][map] to transform the value inside a promise: ```rescript let (p, resolve) = Promise.pending() p ->Promise.map(s => s ++ " world") ->Promise.get(s => Js.log(s)) resolve("Hello") /* Hello world */ ``` To be precise, `Promise.map` creates a *new* promise with the transformed value. If the function you are using to transform the value also returns a promise, use [`Promise.flatMap`][flatMap] instead of `Promise.map`. `Promise.flatMap` will flatten the nested promise.
### Tracing If you have a chain of promise operations, and you'd like to inspect the value in the middle of the chain, use [`Promise.tap`][tap]: ```rescript let (p, resolve) = Promise.pending() p ->Promise.tap(s => Js.log("Value is now: " ++ s)) ->Promise.map(s => s ++ " world") ->Promise.tap(s => Js.log("Value is now: " ++ s)) ->Promise.get(s => Js.log(s)) resolve("Hello") /* Value is now: Hello Value is now: Hello world Hello world */ ```
### Concurrent combinations [`Promise.race`][race] waits for *one* of the promises passed to it to resolve: ```rescript @bs.val external setTimeout: (unit => unit, int) => unit = "setTimeout" let one_second = Promise.exec(resolve => setTimeout(resolve, 1000)) let five_seconds = Promise.exec(resolve => setTimeout(resolve, 5000)) Promise.race([one_second, five_seconds]) ->Promise.get(() => { Js.log("Hello") exit(0) }) /* Prints "Hello" after one second. */ ``` [`Promise.all`][all] instead waits for *all* of the promises passed to it, concurrently: ```rescript @bs.val external setTimeout: (unit => unit, int) => unit = "setTimeout" let one_second = Promise.exec(resolve => setTimeout(resolve, 1000)) let five_seconds = Promise.exec(resolve => setTimeout(resolve, 5000)) Promise.all([one_second, five_seconds]) ->Promise.get(_ => { Js.log("Hello") exit(0) }) /* Prints "Hello" after five seconds. */ ``` For convenience, there are several variants of `Promise.all`: - [`Promise.all2`][all2] - [`Promise.all3`][all3] - [`Promise.all4`][all4] - [`Promise.all5`][all5] - [`Promise.all6`][all6] - [`Promise.allArray`][allArray]
### Handling errors with `Result` Promises that can fail are represented using the standard library's [`Result`][Result], and its constructors `Ok` and `Error`: ```rescript open Belt.Result Promise.resolved(Ok("Hello")) ->Promise.getOk(s => Js.log(s)) /* Hello */ ``` [`Promise.getOk`][getOk] waits for `p` to have a value, and runs its function only if that value is `Ok(_)`. If you instead resolve the promise with `Error(_)`, there will be no output: ```rescript open Belt.Result Promise.resolved(Error("Failed")) ->Promise.getOk(s => Js.log(s)) /* Program just exits. */ ``` You can wait for either kind of value by calling [`Promise.getOk`][getOk] and [`Promise.getError`][getError]: ```rescript open Belt.Result let () = { let p = Promise.resolved(Error("Failed")) p->Promise.getOk(s => Js.log(s)) p->Promise.getError(s => Js.log("Error: " ++ s)) } /* Error: Failed */ ``` ...or respond to all outcomes using the ordinary [`Promise.get`][get]: ```rescript open Belt.Result Promise.resolved(Error("Failed")) ->Promise.get(result => switch result { | Ok(s) => Js.log(s) | Error(s) => Js.log("Error: " ++ s) }) /* Error: Failed */ ``` The full set of functions for handling results is: - [`Promise.getOk`][getOk] - [`Promise.tapOk`][tapOk] - [`Promise.mapOk`][mapOk] - [`Promise.flatMapOk`][flatMapOk] - [`Promise.getError`][getError] - [`Promise.tapError`][tapError] - [`Promise.mapError`][mapError] - [`Promise.flatMapError`][flatMapError] There are also similar functions for working with [`Option`][Option]: - [`Promise.getSome`][getSome] - [`Promise.tapSome`][tapSome] - [`Promise.mapSome`][mapSome] - [`Promise.flatMapSome`][flatMapSome] In addition, there is also a set of variants of `Promise.all` for results, which propagate any `Error(_)` as soon as it is received: - [`Promise.allOk`][allOk] - [`Promise.allOk2`][allOk2] - [`Promise.allOk3`][allOk3] - [`Promise.allOk4`][allOk4] - [`Promise.allOk5`][allOk5] - [`Promise.allOk6`][allOk6] - [`Promise.allOkArray`][allOkArray] If you'd like instead to fully wait for all the promises to resolve with either `Ok(_)` or `Error(_)`, you can use the ordinary `Promise.all` and its variants.
### Advanced: Rejection As you can see from [Handling errors](#Errors), `Promise` doesn't use rejection for errors — but JavaScript promises do. In order to support bindings to JavaScript libraries, which often return promises that can be rejected, `Promise` provides the [`Promise.Js`][Promise.Js] helper module. `Promise.Js` works the same way as `Promise`. It similarly has: - [`Promise.Js.get`][Js.get] - [`Promise.Js.tap`][Js.tap] - [`Promise.Js.map`][Js.map] - [`Promise.Js.flatMap`][Js.flatMap] However, because `Promise.Js` uses JS rejection for error handling rather than `Result` or `Option`, - There are no helpers for `Result` and `Option`. - There is [`Promise.Js.catch`][Js.catch] for handling rejection. - There is [`Promise.Js.rejected`][Js.rejected] for creating an already-rejected promise. Underneath, `Promise` and `Promise.Js` have the same implementation: ```rescript type Promise.t('a) = Promise.Js.t('a, never) ``` That is, `Promise` is really `Promise.Js` that has no rejection type, and no exposed helpers for rejection. There are several helpers for converting between `Promise` and `Promise.Js`: - [`Promise.Js.relax`][Js.relax] - [`Promise.Js.toResult`][Js.toResult] - [`Promise.Js.fromResult`][Js.fromResult] [`Promise.Js.catch`][Js.catch] can also perform a conversion to `Promise`, if you simply convert a rejection to a resolution. In the next example, note the final line is no longer using `Promise.Js`, but `Promise`: ```rescript Promise.Js.rejected("Failed") ->Promise.Js.catch(s => Promise.resolved("Error: " ++ s)) ->Promise.get(s => Js.log(s)) /* Error: Failed */ ``` There are also two functions for converting between `Promise.Js` and the current promise binding in the BuckleScript standard libarary, `Js.Promise`: - [`Promise.Js.fromBsPromise`][Js.fromBsPromise] - [`Promise.Js.toBsPromise`][Js.toBsPromise] Because both libraries are bindings for the same exact kind of value, these are both no-op identity functions that only change the type.
### Advanced: Bindings Refer to the [example node-fetch binding repo][example-binding]. When you want to bind a JS function that *returns* a promise, you can use `Promise` directly in its return value: ```rescript /* A mock JS library. */ %%bs.raw(` function delay(value, milliseconds) { return new Promise(function(resolve) { setTimeout(function() { resolve(value); }, milliseconds) }); }`) /* Our binding. */ @bs.val external delay: ('a, int) => Promise.t('a) = "delay" /* Usage. */ delay("Hello", 1000) ->Promise.get(s => Js.log(s)) /* Prints "Hello" after one second. */ ``` If the promise can be rejected, you should use `Promise.Js` instead, and [convert to `Promise`](#Rejection) as quickly as possible, with intelligent handling of rejection. Here is one way to do that: ```rescript /* Mock JS library. */ %%bs.raw(` function delayReject(value, milliseconds) { return new Promise(function(resolve, reject) { setTimeout(function() { reject(value); }, milliseconds) }); }`) /* Binding. */ @bs.val external delayRejectRaw: ('a, int) => Promise.Js.t(_, 'a) = "delayReject" let delayReject = (value, milliseconds) => delayRejectRaw(value, milliseconds) ->Promise.Js.toResult /* Usage. */ delayReject("Hello", 1000) ->Promise.getError(s => Js.log(s)) /* Prints "Hello" after one second. */ ``` Note that this binding has two steps: there is a raw binding, and then an extra wrapper that converts rejections into `Result`s. If the potential rejections are messy, this is a good place to insert additional logic for converting them to nice ReScript values :) When *passing* a promise to JS, it is generally safe to use `Promise` rather than `Promise.Js`: ```rescript /* Mock JS library. */ %%bs.raw(` function log(p) { p.then(function (v) { console.log(v); }); }`) /* Binding. */ @bs.val external log: Promise.t('a) => unit = "log" /* Usage. */ log(Promise.resolved("Hello")) /* Hello */ ```
### Discussion: Why JS promises are unsafe The JS function [`Promise.resolve`][Promise.resolve] has a special case, which is triggered when you try to resolve a promise with another, nested promise. Unfortunately, this special case makes it impossible to assign `Promise.resolve` a consistent type in ReScript (and most type systems). Here are the details. The code will use [`Js.Promise.resolve`][Js.Promise.resolve], BuckleScript's direct binding to JS's `Promise.resolve`. `Js.Promise.resolve` takes a value, and creates a promise containing that value: ```rescript Js.log(Js.Promise.resolve(1)) /* Promise { 1 } */ Js.log(Js.Promise.resolve("foo")) /* Promise { 'foo' } */ ``` So, we should give it the type ```rescript Js.Promise.resolve: 'a => Js.Promise.t('a) ``` and, indeed, that's the type it [has][Js.Promise.resolve] in BuckleScript. Following the pattern, we would *expect*: ```rescript let nestedPromise = Js.Promise.resolve(1) Js.log(Js.Promise.resolve(nestedPromise)) /* Promise { Promise { 1 } } */ ``` But that's not what happens! Instead, the output is just ```rescript /* Promise { 1 } */ ``` The nested promise is missing! But the type system, following the pattern, still thinks that this resulting value has type ```rescript Js.Promise.t(Js.Promise.t(int)) ``` i.e., the type of the value we were (reasonably) expecting. When you pass `nestedPromise` to `Js.Promise.resolve`, JS unwraps `nestedPromise`, violating the type! There is no easy way to encode such special casing in the type system — especially since JS does it not only to nested promises, but to any would-be nested object that has a `.then` method. The result is, if your program executes something like this, it will have ordinary values in places where it expects another level of promises. For example, if you do ```rescript let nestedPromise = Js.Promise.resolve(1); Js.Promise.resolve(nestedPromise) ->Js.Promise.then_(p => /* ... */) ``` you would *expect* `p` in the callback to be a promise containing `1`, and the type of `p` is indeed `Js.Promise.t(int)`. Instead, however, `p` is just the bare value `1`. That means the callback will cause a runtime error as soon as it tries to use promise functions on the `1`. Worse, you might store `p` in a data structure, and the runtime error will occur at a very distant place in the code. The type system is supposed to prevent such errors! That's part of the point of using ReScript. The same special casing occurs throughout the JS `Promise` API — for example, when you return a promise from the callback of `then_`. This means that *most* of the JS `Promise` functions can't be assigned a correct type and directly, safely be used from ReScript.
### Discussion: How `reason-promise` makes promises type-safe The [previous section](#JSPromiseFlattening) shows that JS promise functions are broken. An important observation is that it is only the *functions* that are broken — the promise *data structure* is not. That means that to make JS promises type-safe, we can keep the existing JS data structure, and just provide safe replacement functions to use with it in ReScript. This is good news for interop :) To fix the functions, only the [special-case flattening](#JSPromiseFlattening) has to be undone. So, when you call `reason-promise`'s [`Promise.resolved(value)`][resolved], it checks whether `value` is a promise or not, and... - If `value` *is not* a promise, `reason-promise` just passes it to JS's [`Promise.resolve`][Promise.resolve], because JS will do the right thing. - If `value` *is* a promise, it's not safe to simply pass it to JS, because it will trigger the special-casing. So, `reason-promise` boxes the nested promise: ```rescript let nestedPromise = Promise.resolved(1) Js.log(Promise.resolved(nestedPromise)) /* Promise { PromiseBox { Promise { 1 } } } */ ``` This box, of course, is not a promise, so inserting it in the middle is enough to suppress the special-casing. Whenever you try to take the value out of this resulting structure (for example, by calling [`Promise.get`][get] on it), `reason-promise` transparently unboxes the `PromiseBox` and passes the nested promise to your callback — as your callback would expect. This conditional boxing and unboxing is done throughout `reason-promise`. It only happens for nested promises, and anything else with a `.then` method. For all other values, `reason-promise` behaves, internally, exactly like JS `Promise` (though with a cleaner outer API). This is enough to make promises type-safe. This is a simple scheme, but `reason-promise` includes a very thorough [test suite][tests] to be extra sure that it always manages the boxing correctly. This conditional boxing is similar to how unboxed optionals are implemented in BuckleScript. Optionals are almost always unboxed, but when BuckleScript isn't sure that the unboxing will be safe, it inserts a runtime check that boxes some values, while still keeping most values unboxed. [example-repo]: https://github.com/aantron/promise-example-bsb [example-binding]: https://github.com/aantron/promise-example-binding [rei]: https://github.com/aantron/promise/blob/c68b1feefdd5efc0397ba92f392d6cc47233f161/src/js/promise.rei#L15 [Result]: https://bucklescript.github.io/bucklescript/api/Belt.Result.html [Option]: https://bucklescript.github.io/bucklescript/api/Belt.Option.html [tests]: https://github.com/aantron/promise/tree/master/test [pending]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L20-L22 [resolved]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L24-L26 [exec]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L28-L30 [get]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L35-L37 [map]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L43-L45 [flatMap]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L47-L49 [tap]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L39-L41 [race]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L123-L125 [all]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L127-L129 [all2]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L135-L137 [all3]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L139-L141 [all4]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L143-L145 [all5]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L147-L149 [all6]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L151-L158 [allArray]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L131-L133 [getOk]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L57-L59 [getError]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L73-L75 [tapOk]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L61-L63 [tapError]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L77-L79 [mapOk]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L65-L67 [mapError]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L81-L83 [flatMapOk]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L69-L71 [flatMapError]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L85-L87 [getSome]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L104-L106 [tapSome]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L108-L110 [mapSome]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L112-L114 [flatMapSome]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L116-L118 [allOk]: https://github.com/aantron/promise/blob/8142b0c4cb5e88e0241c3a6926fdf096b1b96935/src/js/promise.rei#L160-L162 [allOk2]: https://github.com/aantron/promise/blob/8142b0c4cb5e88e0241c3a6926fdf096b1b96935/src/js/promise.rei#L168-L170 [allOk3]: https://github.com/aantron/promise/blob/8142b0c4cb5e88e0241c3a6926fdf096b1b96935/src/js/promise.rei#L172-L176 [allOk4]: https://github.com/aantron/promise/blob/8142b0c4cb5e88e0241c3a6926fdf096b1b96935/src/js/promise.rei#L178-L183 [allOk5]: https://github.com/aantron/promise/blob/8142b0c4cb5e88e0241c3a6926fdf096b1b96935/src/js/promise.rei#L185-L191 [allOk6]: https://github.com/aantron/promise/blob/8142b0c4cb5e88e0241c3a6926fdf096b1b96935/src/js/promise.rei#L193-L200 [allOkArray]: https://github.com/aantron/promise/blob/8142b0c4cb5e88e0241c3a6926fdf096b1b96935/src/js/promise.rei#L164-L166 [Promise.Js]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L163 [Js.get]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L180-L182 [Js.tap]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L184-L186 [Js.map]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L188-L190 [Js.flatMap]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L192-L194 [Js.catch]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L197-L199 [Js.rejected]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L175-L177 [Js.relax]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L211-L213 [Js.toResult]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L215-L217 [Js.fromResult]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L219-L221 [Js.fromBsPromise]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L223-L225 [Js.toBsPromise]: https://github.com/aantron/promise/blob/51001f911ff31ecf51a633fba9f782769a2726c9/src/js/promise.rei#L227-L229 [Promise.resolve]: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Promise/resolve [Js.Promise.Resolve]: https://bucklescript.github.io/bucklescript/api/Js.Promise.html#VALresolve ================================================ FILE: bsconfig.json ================================================ { "name": "reason-promise", "refmt": 3, "sources": [ "src/js", { "dir": "test", "type": "dev", "subdirs": [ "framework/js", "framework", "isoresult/js", "js", "bundle" ] } ] } ================================================ FILE: dune ================================================ (ignored_subdirs (doc esy.lock lib node_modules)) ================================================ FILE: dune-project ================================================ (lang dune 1.0) ================================================ FILE: package.json ================================================ { "name": "reason-promise", "version": "1.1.5", "description": "Light and type-safe binding to JS promises", "keywords": [ "BuckleScript", "reason", "promise", "async" ], "homepage": "https://github.com/aantron/promise", "license": "MIT", "repository": { "type": "git", "url": "git+https://github.com/aantron/promise.git" }, "bugs": { "url": "https://github.com/aantron/promise/issues" }, "author": { "name": "Anton Bachin", "email": "antonbachin@yahoo.com", "url": "https://github.com/aantron" }, "devDependencies": { "bs-platform": ">= 7.3.1", "webpack": "^4.0.0", "webpack-cli": "^3.0.0" }, "scripts": { "build": "bsb -make-world", "watch": "bsb -w -make-world", "clean": "bsb -clean-world && rm -rf lib promise-* *.tar.gz *.tgz _release", "very-clean": "rm -rf node_modules _esy _opam package-lock.json", "test": "bsb -make-world && node lib/js/test/test_main.js", "benchmark": "bsb -make-world && node lib/js/test/js/benchmark.js" }, "files": [ "src/js/promise.rei", "src/js/promise.re", "bsconfig.json" ] } ================================================ FILE: promise.opam ================================================ opam-version: "2.0" synopsis: "Native implementation of a JS promise binding" version: "1.1.5" license: "MIT" homepage: "https://github.com/aantron/promise" doc: "https://github.com/aantron/promise" bug-reports: "https://github.com/aantron/promise/issues" authors: "Anton Bachin " maintainer: "Anton Bachin " dev-repo: "git+https://github.com/aantron/promise.git" depends: [ "dune" "ocaml" "reason" {build & >= "3.3.2"} "result" ] build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "exec" "test/test_main.exe" "-p" name "-j" jobs] {with-test} ] ================================================ FILE: src/js/promise.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ type rejectable(+'a, +'e); type never; type promise(+'a) = rejectable('a, never); type t(+'a) = promise('a); let onUnhandledException = ref(exn => { prerr_endline("Unhandled exception in promise callback:"); Js.Console.error(exn); }); [%%bs.raw {| function PromiseBox(p) { this.nested = p; }; function unbox(value) { if (value instanceof PromiseBox) return value.nested; else return value; } function box(value) { if (value != null && typeof value.then === 'function') return new PromiseBox(value); else return value; } function make(executor) { return new Promise(function (resolve, reject) { var boxingResolve = function(value) { resolve(box(value)); }; executor(boxingResolve, reject); }); }; function resolved(value) { return Promise.resolve(box(value)); }; function then(promise, callback) { return promise.then(function (value) { try { return callback(unbox(value)); } catch (exception) { onUnhandledException.contents(exception); return new Promise(function() {}); } }); }; function catch_(promise, callback) { var safeCallback = function (error) { try { return callback(error); } catch (exception) { onUnhandledException.contents(exception); return new Promise(function() {}); } }; return promise.catch(safeCallback); }; |}]; /* Compatibility with BukleScript < 6. */ type result('a, 'e) = Belt.Result.t('a, 'e) = Ok('a) | Error('e); module Js_ = { type t('a, 'e) = rejectable('a, 'e); external relax: promise('a) => rejectable('a, _) = "%identity"; [@bs.val] external jsNew: (('a => unit) => ('e => unit) => unit) => rejectable('a, 'e) = "make"; let pending = () => { let resolve = ref(ignore); let reject = ref(ignore); let p = jsNew((resolve', reject') => { resolve := resolve'; reject := reject'; }); (p, resolve^, reject^); }; [@bs.val] external resolved: 'a => rejectable('a, _) = "resolved"; [@bs.val] external flatMap: (rejectable('a, 'e), 'a => rejectable('b, 'e)) => rejectable('b, 'e) = "then"; let map = (promise, callback) => flatMap(promise, v => resolved(callback(v))); let get = (promise, callback) => ignore(map(promise, callback)); let tap = (promise, callback) => map(promise, v => { callback(v); v }); [@bs.scope "Promise"] [@bs.val] external rejected: 'e => rejectable(_, 'e) = "reject"; [@bs.val] external catch: (rejectable('a, 'e), 'e => rejectable('a, 'e2)) => rejectable('a, 'e2) = "catch_"; [@bs.val] external unbox: 'a => 'a = "unbox"; [@bs.scope "Promise"] [@bs.val] external jsAll: 'a => 'b = "all"; let allArray = promises => map(jsAll(promises), promises => Belt.Array.map(promises, unbox)); let all = promises => map(allArray(Belt.List.toArray(promises)), Belt.List.fromArray); let all2 = (p1, p2) => jsAll((p1, p2)); let all3 = (p1, p2, p3) => jsAll((p1, p2, p3)); let all4 = (p1, p2, p3, p4) => jsAll((p1, p2, p3, p4)); let all5 = (p1, p2, p3, p4, p5) => jsAll((p1, p2, p3, p4, p5)); let all6 = (p1, p2, p3, p4, p5, p6) => jsAll((p1, p2, p3, p4, p5, p6)); [@bs.scope "Promise"] [@bs.val] external jsRace: array(rejectable('a, 'e)) => rejectable('a, 'e) = "race"; let race = promises => if (promises == []) { raise(Invalid_argument("Promise.race([]) would be pending forever")); } else { jsRace(Belt.List.toArray(promises)); }; let toResult = promise => catch(map(promise, v => Ok(v)), e => resolved(Error(e))); let fromResult = promise => flatMap(relax(promise), fun | Ok(v) => resolved(v) | Error(e) => rejected(e)); external fromBsPromise: Js.Promise.t('a) => rejectable('a, Js.Promise.error) = "%identity"; external toBsPromise: rejectable('a, _) => Js.Promise.t('a) = "%identity"; }; let pending = () => { let (p, resolve, _) = Js_.pending(); (p, resolve); }; let exec = executor => { let (p, resolve) = pending(); executor(resolve); p; }; let resolved = Js_.resolved; let flatMap = Js_.flatMap; let map = Js_.map; let get = Js_.get; let tap = Js_.tap; let all = Js_.all; let all2 = Js_.all2; let all3 = Js_.all3; let all4 = Js_.all4; let all5 = Js_.all5; let all6 = Js_.all6; let allArray = Js_.allArray; let race = Js_.race; let flatMapOk = (promise, callback) => flatMap(promise, result => switch (result) { | Ok(v) => callback(v) | Error(_) as error => resolved(error) }); let flatMapError = (promise, callback) => flatMap(promise, result => switch (result) { | Ok(_) as ok => resolved(ok) | Error(e) => callback(e) }); let mapOk = (promise, callback) => map(promise, result => switch (result) { | Ok(v) => Ok(callback(v)) | Error(_) as error => error }); let mapError = (promise, callback) => map(promise, result => switch (result) { | Ok(_) as ok => ok | Error(e) => Error(callback(e)) }); let getOk = (promise, callback) => get(promise, result => switch (result) { | Ok(v) => callback(v) | Error(_) => () }); let getError = (promise, callback) => get(promise, result => switch (result) { | Ok(_) => () | Error(e) => callback(e) }); let tapOk = (promise, callback) => { getOk(promise, callback); promise; }; let tapError = (promise, callback) => { getError(promise, callback); promise; }; let allOkArray = promises => { let promiseCount = Belt.Array.length(promises); if (promiseCount == 0) { resolved(Ok([||])); } else { let resultValues = Belt.Array.make(promiseCount, None); let resultCount = ref(0); let (resultPromise, resolve) = pending(); let (callbackRemover, removeCallbacks) = pending(); promises->Belt.Array.forEachWithIndex((index, promise) => /* Because callbacks are added to the user's promises through calls to the JS runtime's Promise.race, this function leaks memory if and only if the JS runtime's Promise functions leak memory. In particular, if one of the promises resolves with Error(_), the callbacks on the other promises should be removed. If not done, and long-pending promises are repeatedly passed to allOk in a loop, they will gradually accumulate huge lists of stale callbacks. This is also true of Promise.race, so we rely on the quality of the runtime's Promise.race implementation to proactively remove these callbacks. */ race([promise, callbackRemover]) |> wrapped => get(wrapped, result => switch (result) { | Ok(v) => resultValues->Belt.Array.setExn(index, Some(v)); incr(resultCount); if (resultCount^ >= promiseCount) { resultValues->Belt.Array.map(v => switch (v) { | Some(v) => v | None => assert(false) }) |> values => resolve(Ok(values)) }; | Error(e) => resolve(Error(e)); removeCallbacks(Error(e)); })); resultPromise }; }; let allOk = promises => mapOk(allOkArray(Belt.List.toArray(promises)), Belt.List.fromArray); let unsafeAllOkArray = Obj.magic(allOkArray); let allOk2 = (p1, p2) => unsafeAllOkArray((p1, p2)); let allOk3 = (p1, p2, p3) => unsafeAllOkArray((p1, p2, p3)); let allOk4 = (p1, p2, p3, p4) => unsafeAllOkArray((p1, p2, p3, p4)); let allOk5 = (p1, p2, p3, p4, p5) => unsafeAllOkArray((p1, p2, p3, p4, p5)); let allOk6 = (p1, p2, p3, p4, p5, p6) => unsafeAllOkArray((p1, p2, p3, p4, p5, p6)); module Operators = { let (>|=) = mapOk; let (>>=) = flatMapOk; }; let flatMapSome = (promise, callback) => flatMap(promise, option => switch (option) { | Some(v) => callback(v) | None => resolved(None) }); let mapSome = (promise, callback) => map(promise, option => switch (option) { | Some(v) => Some(callback(v)) | None => None }); let getSome = (promise, callback) => get(promise, option => switch (option) { | Some(v) => callback(v) | None => () }); let tapSome = (promise, callback) => { getSome(promise, callback); promise; }; module PipeFirst = { }; module Js = Js_; ================================================ FILE: src/js/promise.rei ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ /* Internal type names; don't use these. Instead, use Promise.t and Promise.Js.t from outside this library. */ type rejectable(+'a, +'e); /* Internal; use Promise.Js.t. */ type never; type promise(+'a) = rejectable('a, never); /* Internal; use Promise.t. */ /* The main, public promise type (Promise.t). */ type t(+'a) = promise('a); /* Making promises. */ let pending: unit => (promise('a), 'a => unit); let resolved: 'a => promise('a); let exec: (('a => unit) => unit) => promise('a); /* Using promises. */ let get: (promise('a), 'a => unit) => unit; let tap: (promise('a), 'a => unit) => promise('a); let map: (promise('a), 'a => 'b) => promise('b); let flatMap: (promise('a), 'a => promise('b)) => promise('b); /* Compatibility with BuckleScript < 6. */ type result('a, 'e) = Belt.Result.t('a, 'e); /* Results. */ let getOk: (promise(result('a, 'e)), 'a => unit) => unit; let tapOk: (promise(result('a, 'e)), 'a => unit) => promise(result('a, 'e)); let mapOk: (promise(result('a, 'e)), 'a => 'b) => promise(result('b, 'e)); let flatMapOk: (promise(result('a, 'e)), 'a => promise(result('b, 'e))) => promise(result('b, 'e)); let getError: (promise(result('a, 'e)), 'e => unit) => unit; let tapError: (promise(result('a, 'e)), 'e => unit) => promise(result('a, 'e)); let mapError: (promise(result('a, 'e)), 'e => 'e2) => promise(result('a, 'e2)); let flatMapError: (promise(result('a, 'e)), 'e => promise(result('a, 'e2))) => promise(result('a, 'e2)); module Operators: { [@ocaml.deprecated "Use bs-let"] let (>|=): (promise(result('a, 'e)), 'a => 'b) => promise(result('b, 'e)); [@ocaml.deprecated "Use bs-let"] let (>>=): (promise(result('a, 'e)), 'a => promise(result('b, 'e))) => promise(result('b, 'e)); }; /* Options. */ let getSome: (promise(option('a)), 'a => unit) => unit; let tapSome: (promise(option('a)), 'a => unit) => promise(option('a)); let mapSome: (promise(option('a)), 'a => 'b) => promise(option('b)); let flatMapSome: (promise(option('a)), 'a => promise(option('b))) => promise(option('b)); /* Combining promises. */ let race: list(promise('a)) => promise('a); let all: list(promise('a)) => promise(list('a)); let allArray: array(promise('a)) => promise(array('a)); let all2: (promise('a), promise('b)) => promise(('a, 'b)); let all3: (promise('a), promise('b), promise('c)) => promise(('a, 'b, 'c)); let all4: (promise('a), promise('b), promise('c), promise('d)) => promise(('a, 'b, 'c, 'd)); let all5: (promise('a), promise('b), promise('c), promise('d), promise('e)) => promise(('a, 'b, 'c, 'd, 'e)); let all6: (promise('a), promise('b), promise('c), promise('d), promise('e), promise('f)) => promise(('a, 'b, 'c, 'd, 'e, 'f)); let allOk: list(promise(result('a, 'e))) => promise(result(list('a), 'e)); let allOkArray: array(promise(result('a, 'e))) => promise(result(array('a), 'e)); let allOk2: (promise(result('a, 'err)), promise(result('b, 'err))) => promise(result(('a, 'b), 'err)); let allOk3: (promise(result('a, 'err)), promise(result('b, 'err)), promise(result('c, 'err))) => promise(result(('a, 'b, 'c), 'err)); let allOk4: (promise(result('a, 'err)), promise(result('b, 'err)), promise(result('c, 'err)), promise(result('d, 'err))) => promise(result(('a, 'b, 'c, 'd), 'err)); let allOk5: (promise(result('a, 'err)), promise(result('b, 'err)), promise(result('c, 'err)), promise(result('d, 'err)), promise(result('e, 'err))) => promise(result(('a, 'b, 'c, 'd, 'e), 'err)); let allOk6: (promise(result('a, 'err)), promise(result('b, 'err)), promise(result('c, 'err)), promise(result('d, 'err)), promise(result('e, 'err)), promise(result('f, 'err))) => promise(result(('a, 'b, 'c, 'd, 'e, 'f), 'err)); /* For writing bindings. */ module Js: { type t(+'a, +'e) = rejectable('a, 'e); /* Making. */ let pending: unit => (rejectable('a, 'e), 'a => unit, 'e => unit); let resolved: 'a => rejectable('a, 'e); let rejected: 'e => rejectable('a, 'e); /* Handling fulfillment. */ let get: (rejectable('a, 'e), 'a => unit) => unit; let tap: (rejectable('a, 'e), 'a => unit) => rejectable('a, 'e); let map: (rejectable('a, 'e), 'a => 'b) => rejectable('b, 'e); let flatMap: (rejectable('a, 'e), 'a => rejectable('b, 'e)) => rejectable('b, 'e); /* Handling rejection. */ let catch: (rejectable('a, 'e), 'e => rejectable('a, 'e2)) => rejectable('a, 'e2); /* Combining. */ let all: list(rejectable('a, 'e)) => rejectable(list('a), 'e); let race: list(rejectable('a, 'e)) => rejectable('a, 'e); /* Conversions. */ let relax: promise('a) => rejectable('a, 'e); let toResult: rejectable('a, 'e) => promise(result('a, 'e)); let fromResult: promise(result('a, 'e)) => rejectable('a, 'e); let fromBsPromise: Js.Promise.t('a) => rejectable('a, Js.Promise.error); let toBsPromise: rejectable('a, _) => Js.Promise.t('a); }; module PipeFirst: { }; let onUnhandledException: ref(exn => unit); ================================================ FILE: src/native/dune ================================================ (library (name promise) (public_name promise) (libraries result) (flags (:standard -w +A))) ================================================ FILE: src/native/mutableList.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ type node('a) = { mutable previous: option(node('a)), mutable next: option(node('a)), content: 'a, }; type listEnds('a) = { mutable first: node('a), mutable last: node('a), }; type list('a) = ref([ | `Empty | `NonEmpty(listEnds('a)) ]); let create = () => ref(`Empty); let isEmpty = list => list^ == `Empty; let append = (list, value) => switch (list^) { | `Empty => let node = { previous: None, next: None, content: value, }; list := `NonEmpty({first: node, last: node}); node; | `NonEmpty(ends) => let node = { previous: Some(ends.last), next: None, content: value, }; ends.last.next = Some(node); ends.last = node; node; }; let concatenate = (list1, list2) => switch (list2^) { | `Empty => /* If the second list is empty, we can just return the first list, because it already has the correct final structure, and there is nothing to do. */ () | `NonEmpty(list2Ends) => switch (list1^) { | `Empty => /* If the second list is non-empty, but the first list is empty, we need to change the end-of-list references in the first list to point to the structure of the second list. This is because the caller depends on the first list having the correct structure after the call. */ list1 := list2^; | `NonEmpty(list1Ends) => /* Otherwise, we have to splice the ending nodes of the two lists. */ list1Ends.last.next = Some(list2Ends.first); list2Ends.first.previous = Some(list1Ends.last); list1Ends.last = list2Ends.last; } }; let iter = (callback, list) => switch (list^) { | `Empty => () | `NonEmpty(ends) => let rec loop = node => { callback(node.content); switch (node.next) { | None => (); | Some(nextNode) => loop(nextNode); }; }; loop(ends.first); }; let remove = (list, node) => { /* This function is difficult enough to implement and use that it is probably time to switch representations for callback lists soon. */ switch (list^) { | `Empty => () | `NonEmpty(ends) => switch (node.previous) { | None => if (ends.first === node) { switch (node.next) { | None => list := `Empty | Some(secondNode) => ends.first = secondNode } } | Some(previousNode) => previousNode.next = node.next }; switch (node.next) { | None => if (ends.last === node) { switch (node.previous) { | None => list := `Empty | Some(secondToLastNode) => ends.last = secondToLastNode } } | Some(nextNode) => nextNode.previous = node.previous }; }; node.previous = None; node.next = None; }; ================================================ FILE: src/native/mutableList.rei ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ /* Mutable doubly-linked lists, like in a typical imperative language. These are used for callback lists, because reason-promise needs fast append and fast deletion of any node in the list, when the reference to the target node is already be held by the deleting code. */ type list('a); type node('a); let create: unit => list('a); let isEmpty: list(_) => bool; let append: (list('a), 'a) => node('a); let iter: ('a => unit, list('a)) => unit; let remove: (list('a), node('a)) => unit; /* Concatenates list1 and list2. Afterwards, the reference list1 has a correct internal list structure, and the reference list2 should not be used anymore. */ let concatenate: (list('a), list('a)) => unit; ================================================ FILE: src/native/promise.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ type callbacks('a, 'e) = { onResolve: MutableList.list('a => unit), onReject: MutableList.list('e => unit), }; type rejectable('a, 'e) = ref([ | `Fulfilled('a) | `Rejected('e) | `Pending(callbacks('a, 'e)) | `Merged(rejectable('a, 'e)) ]); type never; type promise('a) = rejectable('a, never); type t('a) = promise('a); /* The `Merged constructor and this function, underlying, are used to avoid a memory leak that arises when flatMap is called on promises in a loop. See the description in the associated test "promise loop memory leak". The rest of this comment is based on that description. The solution to the memory leak is to merge nested promises created on the second and subsequent iterations of loops into the outer promise created on the first iteration. This is performed by the internal helper makePromiseBehaveAs, below. When promises are merged, the callback lists of the nested promise are merged into the callback lists of the outer promise, and afterwards the nested promise object becomes just a proxy that refers to the outer promise. As a result, most internal operations on promises have to first call underlying, in order to find the true merged (outer) promise on which operations should be performed, rather than working directly on proxies. */ let rec underlying = p => switch p^ { | `Fulfilled(_) | `Rejected(_) | `Pending(_) => p; | `Merged(p') => let p'' = underlying(p'); if (p'' !== p') { p := `Merged(p'') }; p''; }; let onUnhandledException = ref(exn => { prerr_endline("Unhandled exception in promise callback:"); prerr_endline(Printexc.to_string(exn)); Printexc.print_backtrace(stderr); }); module ReadyCallbacks = { let callbacks: ref(MutableList.list(unit => unit)) = ref(MutableList.create()); let callbacksPending = () => !MutableList.isEmpty(callbacks^); let defer = (callback, value) => MutableList.append(callbacks^, () => callback(value)) |> ignore; let deferMultiple = (newCallbacks, value) => newCallbacks |> MutableList.iter(callback => defer(callback, value)); type snapshot = MutableList.list(unit => unit); let snapshot = () => { let theSnapshot = callbacks^; callbacks := MutableList.create(); theSnapshot; }; let isEmpty = snapshot => MutableList.isEmpty(snapshot); let call = snapshot => snapshot |> MutableList.iter(callback => callback()); }; let newInternal = () => ref(`Pending({ onResolve: MutableList.create(), onReject: MutableList.create() })); let resolveInternal = p => value => switch (underlying(p))^ { | `Fulfilled(_) | `Rejected(_) => () | `Pending(callbacks) => ReadyCallbacks.deferMultiple(callbacks.onResolve, value); p := `Fulfilled(value); | `Merged(_) => /* This case is impossible, because we called underyling on the promise, above. */ assert(false); }; let rejectInternal = p => error => switch (underlying(p))^ { | `Fulfilled(_) | `Rejected(_) => () | `Pending(callbacks) => ReadyCallbacks.deferMultiple(callbacks.onReject, error); p := `Rejected(error); | `Merged(_) => /* This case is impossible, because we called underyling on the promise, above. */ assert(false); }; let resolved = value => ref(`Fulfilled(value)); let rejected = error => ref(`Rejected(error)); let makePromiseBehaveAs = (outerPromise, nestedPromise) => { let underlyingNested = underlying(nestedPromise); switch underlyingNested^ { | `Fulfilled(value) => resolveInternal(outerPromise, value); | `Rejected(error) => rejectInternal(outerPromise, error); | `Pending(callbacks) => let underlyingOuter = underlying(outerPromise); switch underlyingOuter^ { | `Fulfilled(_) | `Rejected(_) => /* These two cases are impossible, because if makePromiseBehaveAs is called, flatMap or catch_ called the callback that was passed to it, so the outer promise is still pending. It is this function which resolves the outer promise. */ assert(false); | `Pending(outerCallbacks) => MutableList.concatenate(outerCallbacks.onResolve, callbacks.onResolve); MutableList.concatenate(outerCallbacks.onReject, callbacks.onReject); underlyingNested := `Merged(underlyingOuter); | `Merged(_) => /* This case is impossible, because we called underlying above. */ assert(false); }; | `Merged(_) => /* Impossible because we are working on the underlying promise. */ assert(false); }; }; let flatMap = (promise, callback) => { let outerPromise = newInternal(); let onResolve = value => switch (callback(value)) { | exception exn => ignore(onUnhandledException^(exn)); | nestedPromise => makePromiseBehaveAs(outerPromise, nestedPromise); }; switch (underlying(promise))^ { | `Fulfilled(value) => ReadyCallbacks.defer(onResolve, value); | `Rejected(error) => rejectInternal(outerPromise, error) | `Pending(callbacks) => MutableList.append(callbacks.onResolve, onResolve) |> ignore; MutableList.append(callbacks.onReject, rejectInternal(outerPromise)) |> ignore; | `Merged(_) => /* This case is impossible, cause of the call to underlying above. */ assert(false); }; outerPromise; }; let map = (promise, mapper) => flatMap(promise, value => resolved(mapper(value))); let get = (promise, callback) => ignore(map(promise, callback)); let tap = (promise, callback) => { get(promise, callback); promise; }; let catch = (promise, callback) => { let outerPromise = newInternal(); let onReject = error => switch (callback(error)) { | exception exn => ignore(onUnhandledException^(exn)); | nestedPromise => makePromiseBehaveAs(outerPromise, nestedPromise); }; switch (underlying(promise))^ { | `Fulfilled(value) => resolveInternal(outerPromise, value); | `Rejected(error) => ReadyCallbacks.defer(onReject, error); | `Pending(callbacks) => MutableList.append(callbacks.onResolve, resolveInternal(outerPromise)) |> ignore; MutableList.append(callbacks.onReject, onReject) |> ignore; | `Merged(_) => /* This case is impossible, because of the call to underlying above. */ assert(false); }; outerPromise; }; /* Promise.all and Promise.race have to remove callbacks in some circumstances; see test/native/test_ffi.re for details. */ module CallbackRemovers = { let empty = () => ref([]); let call = removers => { removers^ |> List.iter(remover => remover()); removers := []; }; let add = (removers, promise, whichList, callbackNode) => { let remover = () => switch (underlying(promise))^ { | `Pending(callbacks) => MutableList.remove(whichList(callbacks), callbackNode); | _ => (); }; removers := [remover, ...removers^]; }; }; let all = promises => { let callbackRemovers = CallbackRemovers.empty(); let finalPromise = newInternal(); let unresolvedPromiseCount = ref(List.length(promises)); let results = ref([]); let onResolve = (cell, value) => { cell := Some(value); unresolvedPromiseCount := unresolvedPromiseCount^ - 1; if (unresolvedPromiseCount^ == 0) { results^ |> List.map(cell => switch cell^ { | None => assert(false) | Some(value) => value }) |> resolveInternal(finalPromise); }; }; let rejectFinalPromise = error => { CallbackRemovers.call(callbackRemovers); rejectInternal(finalPromise, error); }; results := promises |> List.map(promise => { let cell = ref(None); switch (underlying(promise))^ { | `Fulfilled(value) => /* It's very important to defer here instead of resolving the final promise immediately. Doing the latter will cause the callback removal mechanism to forget about removing callbacks which will be added later in the iteration over the promise list. It is possible to resolve immediately but then the code has to be changed, probably to perform two passes over the promise list. */ ReadyCallbacks.defer(onResolve(cell), value); | `Rejected(error) => ReadyCallbacks.defer(rejectFinalPromise, error); | `Pending(callbacks) => let callbackNode = MutableList.append(callbacks.onResolve, onResolve(cell)); CallbackRemovers.add( callbackRemovers, promise, callbacks => callbacks.onResolve, callbackNode); let callbackNode = MutableList.append(callbacks.onReject, rejectFinalPromise); CallbackRemovers.add( callbackRemovers, promise, callbacks => callbacks.onReject, callbackNode); | `Merged(_) => /* Impossible because of the call to underlying above. */ assert(false); }; cell; }); finalPromise; }; let allArray = promises => map(all(Array.to_list(promises)), Array.of_list); /* Not a "legitimate" implementation. To get a legitimate one, the tricky parts of "all," above, should be factoed out. */ let all2 = (p1, p2) => { let promises = [Obj.magic(p1), Obj.magic(p2)]; map(all(promises), fun | [v1, v2] => (Obj.magic(v1), Obj.magic(v2)) | _ => assert(false)); }; let all3 = (p1, p2, p3) => { let promises = [Obj.magic(p1), Obj.magic(p2), Obj.magic(p3)]; map(all(promises), fun | [v1, v2, v3] => (Obj.magic(v1), Obj.magic(v2), Obj.magic(v3)) | _ => assert(false)); }; let all4 = (p1, p2, p3, p4) => { let promises = [Obj.magic(p1), Obj.magic(p2), Obj.magic(p3), Obj.magic(p4)]; map(all(promises), fun | [v1, v2, v3, v4] => (Obj.magic(v1), Obj.magic(v2), Obj.magic(v3), Obj.magic(v4)) | _ => assert(false)); }; let all5 = (p1, p2, p3, p4, p5) => { let promises = [Obj.magic(p1), Obj.magic(p2), Obj.magic(p3), Obj.magic(p4), Obj.magic(p5)]; map(all(promises), fun | [v1, v2, v3, v4, v5] => (Obj.magic(v1), Obj.magic(v2), Obj.magic(v3), Obj.magic(v4), Obj.magic(v5)) | _ => assert(false)); }; let all6 = (p1, p2, p3, p4, p5, p6) => { let promises = [ Obj.magic(p1), Obj.magic(p2), Obj.magic(p3), Obj.magic(p4), Obj.magic(p5), Obj.magic(p6) ]; map(all(promises), fun | [v1, v2, v3, v4, v5, v6] => ( Obj.magic(v1), Obj.magic(v2), Obj.magic(v3), Obj.magic(v4), Obj.magic(v5), Obj.magic(v6) ) | _ => assert(false)); }; let race = promises => { if (promises == []) { raise(Invalid_argument("Promise.race([]) would be pending forever")); }; let callbackRemovers = CallbackRemovers.empty(); let finalPromise = newInternal(); let resolveFinalPromise = value => { CallbackRemovers.call(callbackRemovers); resolveInternal(finalPromise, value); }; let rejectFinalPromise = error => { CallbackRemovers.call(callbackRemovers); rejectInternal(finalPromise, error); }; promises |> List.iter(promise => switch (underlying(promise))^ { | `Fulfilled(value) => ReadyCallbacks.defer(resolveFinalPromise, value); | `Rejected(error) => ReadyCallbacks.defer(rejectFinalPromise, error); | `Pending(callbacks) => let callbackNode = MutableList.append(callbacks.onResolve, resolveFinalPromise); CallbackRemovers.add( callbackRemovers, promise, callbacks => callbacks.onResolve, callbackNode); let callbackNode = MutableList.append(callbacks.onReject, rejectFinalPromise); CallbackRemovers.add( callbackRemovers, promise, callbacks => callbacks.onReject, callbackNode); | `Merged(_) => /* Impossible, because of the call to underlying above. */ assert false; }); finalPromise; }; type result('a, 'e) = Result.result('a, 'e); let flatMapOk = (promise, callback) => flatMap(promise, fun | Result.Ok(value) => callback(value) | Result.Error(_) as error => resolved(error)); let flatMapError = (promise, callback) => flatMap(promise, fun | Result.Ok(_) as ok => resolved(ok) | Result.Error(error) => callback(error)); let mapOk = (promise, callback) => map(promise, fun | Result.Ok(value) => Result.Ok(callback(value)) | Result.Error(_) as error => error); let mapError = (promise, callback) => map(promise, fun | Result.Ok(_) as ok => ok | Result.Error(error) => Result.Error(callback(error))); let getOk = (promise, callback) => get(promise, fun | Result.Ok(value) => callback(value) | Result.Error(_) => ()); let getError = (promise, callback) => get(promise, fun | Result.Ok(_) => () | Result.Error(error) => callback(error)); let tapOk = (promise, callback) => { getOk(promise, callback); promise; }; let tapError = (promise, callback) => { getError(promise, callback); promise; }; module Operators = { let (>|=) = mapOk; let (>>=) = flatMapOk; }; let flatMapSome = (promise, callback) => flatMap(promise, fun | Some(value) => callback(value) | None => resolved(None)); let mapSome = (promise, callback) => map(promise, fun | Some(value) => Some(callback(value)) | None => None); let getSome = (promise, callback) => get(promise, fun | Some(value) => callback(value) | None => ()); let tapSome = (promise, callback) => { getSome(promise, callback); promise; }; module Js = { type t('a, 'e) = rejectable('a, 'e); external relax: promise('a) => rejectable('a, _) = "%identity"; let pending = () => { let p = newInternal(); let resolve = resolveInternal(p); let reject = rejectInternal(p); (p, resolve, reject); }; let resolved = resolved; let rejected = rejected; let flatMap = flatMap; let map = map; let get = get; let tap = tap; let catch = catch; let all = all; let race = race; let toResult = promise => catch(map(promise, v => Result.Ok(v)), e => resolved(Result.Error(e))); let fromResult = promise => flatMap(relax(promise), fun | Result.Ok(v) => resolved(v) | Result.Error(e) => rejected(e)); }; let pending = () => { let (p, resolve, _) = Js.pending(); (p, resolve); } let exec = executor => { let (p, resolve) = pending(); executor(resolve); p; }; let allOkArray = promises => { let promiseCount = Array.length(promises); if (promiseCount == 0) { resolved(Result.Ok([||])); } else { let resultValues = Array.make(promiseCount, None); let resultCount = ref(0); let (resultPromise, resolve) = pending(); let (callbackRemover, removeCallbacks) = pending(); promises |> Array.iteri((index, promise) => /* Because callbacks are added to the user's promises through calls to the JS runtime's Promise.race, this function leaks memory if and only if the JS runtime's Promise functions leak memory. In particular, if one of the promises resolves with Error(_), the callbacks on the other promises should be removed. If not done, and long-pending promises are repeatedly passed to allOk in a loop, they will gradually accumulate huge lists of stale callbacks. This is also true of Promise.race, so we rely on the quality of the runtime's Promise.race implementation to proactively remove these callbacks. */ race([promise, callbackRemover]) |> wrapped => get(wrapped, result => switch (result) { | Result.Ok(v) => resultValues[index] = Some(v); incr(resultCount); if (resultCount^ >= promiseCount) { resultValues |> Array.map(v => switch (v) { | Some(v) => v | None => assert(false) }) |> values => resolve(Result.Ok(values)) }; | Result.Error(e) => resolve(Result.Error(e)); removeCallbacks(Result.Error(e)); })); resultPromise }; }; let allOk = promises => mapOk(allOkArray(Array.of_list(promises)), Array.to_list); let allOk2 = (p1, p2) => { let promises = [|Obj.magic(p1), Obj.magic(p2)|]; mapOk(allOkArray(promises), fun | [|v1, v2|] => (Obj.magic(v1), Obj.magic(v2)) | _ => assert(false)) }; let allOk3 = (p1, p2, p3) => { let promises = [|Obj.magic(p1), Obj.magic(p2), Obj.magic(p3)|]; mapOk(allOkArray(promises), fun | [|v1, v2, v3|] => (Obj.magic(v1), Obj.magic(v2), Obj.magic(v3)) | _ => assert(false)) }; let allOk4 = (p1, p2, p3, p4) => { let promises = [|Obj.magic(p1), Obj.magic(p2), Obj.magic(p3), Obj.magic(p4)|]; mapOk(allOkArray(promises), fun | [|v1, v2, v3, v4|] => (Obj.magic(v1), Obj.magic(v2), Obj.magic(v3), Obj.magic(v4)) | _ => assert(false)) }; let allOk5 = (p1, p2, p3, p4, p5) => { let promises = [| Obj.magic(p1), Obj.magic(p2), Obj.magic(p3), Obj.magic(p4), Obj.magic(p5) |]; mapOk(allOkArray(promises), fun | [|v1, v2, v3, v4, v5|] => (Obj.magic(v1), Obj.magic(v2), Obj.magic(v3), Obj.magic(v4), Obj.magic(v5)) | _ => assert(false)) }; let allOk6 = (p1, p2, p3, p4, p5, p6) => { let promises = [| Obj.magic(p1), Obj.magic(p2), Obj.magic(p3), Obj.magic(p4), Obj.magic(p5), Obj.magic(p6) |]; mapOk(allOkArray(promises), fun | [|v1, v2, v3, v4, v5, v6|] => ( Obj.magic(v1), Obj.magic(v2), Obj.magic(v3), Obj.magic(v4), Obj.magic(v5), Obj.magic(v6) ) | _ => assert(false)) }; module PipeFirst = { let (|.) = (v, f) => f(v); }; ================================================ FILE: src/native/promise.rei ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ /* Internal type names; don't use these. Instead, use Promise.t and Promise.Js.t from outside this library. */ type rejectable('a, 'e); /* Internal; use Promise.Js.t. */ type never; type promise('a) = rejectable('a, never); /* Internal; use Promise.t. */ /* The main, public promise type (Promise.t). */ type t('a) = promise('a); /* Making promises. */ let pending: unit => (promise('a), 'a => unit); let resolved: 'a => promise('a); let exec: (('a => unit) => unit) => promise('a); /* Using promises. */ let get: (promise('a), 'a => unit) => unit; let tap: (promise('a), 'a => unit) => promise('a); let map: (promise('a), 'a => 'b) => promise('b); let flatMap: (promise('a), 'a => promise('b)) => promise('b); /* Compatibility with OCaml 4.02. */ type result('a, 'e) = Result.result('a, 'e); /* Results. */ let getOk: (promise(result('a, 'e)), 'a => unit) => unit; let tapOk: (promise(result('a, 'e)), 'a => unit) => promise(result('a, 'e)); let mapOk: (promise(result('a, 'e)), 'a => 'b) => promise(result('b, 'e)); let flatMapOk: (promise(result('a, 'e)), 'a => promise(result('b, 'e))) => promise(result('b, 'e)); let getError: (promise(result('a, 'e)), 'e => unit) => unit; let tapError: (promise(result('a, 'e)), 'e => unit) => promise(result('a, 'e)); let mapError: (promise(result('a, 'e)), 'e => 'e2) => promise(result('a, 'e2)); let flatMapError: (promise(result('a, 'e)), 'e => promise(result('a, 'e2))) => promise(result('a, 'e2)); module Operators: { [@ocaml.deprecated "Use the let* syntax"] let (>|=): (promise(result('a, 'e)), 'a => 'b) => promise(result('b, 'e)); [@ocaml.deprecated "Use the let* syntax"] let (>>=): (promise(result('a, 'e)), 'a => promise(result('b, 'e))) => promise(result('b, 'e)); }; /* Options. */ let getSome: (promise(option('a)), 'a => unit) => unit; let tapSome: (promise(option('a)), 'a => unit) => promise(option('a)); let mapSome: (promise(option('a)), 'a => 'b) => promise(option('b)); let flatMapSome: (promise(option('a)), 'a => promise(option('b))) => promise(option('b)); /* Combining promises. */ let race: list(promise('a)) => promise('a); let all: list(promise('a)) => promise(list('a)); let allArray: array(promise('a)) => promise(array('a)); let all2: (promise('a), promise('b)) => promise(('a, 'b)); let all3: (promise('a), promise('b), promise('c)) => promise(('a, 'b, 'c)); let all4: (promise('a), promise('b), promise('c), promise('d)) => promise(('a, 'b, 'c, 'd)); let all5: (promise('a), promise('b), promise('c), promise('d), promise('e)) => promise(('a, 'b, 'c, 'd, 'e)); let all6: (promise('a), promise('b), promise('c), promise('d), promise('e), promise('f)) => promise(('a, 'b, 'c, 'd, 'e, 'f)); let allOk: list(promise(result('a, 'e))) => promise(result(list('a), 'e)); let allOkArray: array(promise(result('a, 'e))) => promise(result(array('a), 'e)); let allOk2: (promise(result('a, 'err)), promise(result('b, 'err))) => promise(result(('a, 'b), 'err)); let allOk3: (promise(result('a, 'err)), promise(result('b, 'err)), promise(result('c, 'err))) => promise(result(('a, 'b, 'c), 'err)); let allOk4: (promise(result('a, 'err)), promise(result('b, 'err)), promise(result('c, 'err)), promise(result('d, 'err))) => promise(result(('a, 'b, 'c, 'd), 'err)); let allOk5: (promise(result('a, 'err)), promise(result('b, 'err)), promise(result('c, 'err)), promise(result('d, 'err)), promise(result('e, 'err))) => promise(result(('a, 'b, 'c, 'd, 'e), 'err)); let allOk6: (promise(result('a, 'err)), promise(result('b, 'err)), promise(result('c, 'err)), promise(result('d, 'err)), promise(result('e, 'err)), promise(result('f, 'err))) => promise(result(('a, 'b, 'c, 'd, 'e, 'f), 'err)); /* Shouldn't be used; provided for compatibility with Js. */ module Js: { type t('a, 'e) = rejectable('a, 'e); /* Making. */ let pending: unit => (rejectable('a, 'e), 'a => unit, 'e => unit); let resolved: 'a => rejectable('a, 'e); let rejected: 'e => rejectable('a, 'e); /* Handling fulfillment. */ let get: (rejectable('a, 'e), 'a => unit) => unit; let tap: (rejectable('a, 'e), 'a => unit) => rejectable('a, 'e); let map: (rejectable('a, 'e), 'a => 'b) => rejectable('b, 'e); let flatMap: (rejectable('a, 'e), 'a => rejectable('b, 'e)) => rejectable('b, 'e); /* Handling rejection. */ let catch: (rejectable('a, 'e), 'e => rejectable('a, 'e2)) => rejectable('a, 'e2); /* Combining. */ let all: list(rejectable('a, 'e)) => rejectable(list('a), 'e); let race: list(rejectable('a, 'e)) => rejectable('a, 'e); /* Conversions. */ let relax: promise('a) => rejectable('a, 'e); let toResult: rejectable('a, 'e) => promise(result('a, 'e)); let fromResult: promise(result('a, 'e)) => rejectable('a, 'e); }; module PipeFirst: { let (|.): ('a, 'a => 'b) => 'b; }; let onUnhandledException: ref(exn => unit); /* This is not part of the public API. It is used by I/O libraries to drive native promise callbacks on each tick. */ module ReadyCallbacks: { let callbacksPending: unit => bool; /* When about to iterate over the ready callbacks, reason-promise first takes a snapshot of them, and iterates over the snapshot. This is to prevent new ready callbacks, that may be created by the processing of the current ones, from being processed immediately. That could lead to I/O loop starvation and other problems. */ type snapshot; let snapshot: unit => snapshot; let isEmpty: snapshot => bool; let call: snapshot => unit; }; ================================================ FILE: src/native/release.sh ================================================ set -e set -x VERSION=$(git describe --abbrev=0) RELEASE=promise-$VERSION rm -rf $RELEASE $RELEASE.tar $RELEASE.tar.gz mkdir -p $RELEASE cp -r dune-project LICENSE.md promise.opam README.md src test $RELEASE rm -rf $RELEASE/src/js rm -rf $RELEASE/src/native/release.sh rm -rf $RELEASE/test/bundle rm -rf $RELEASE/test/framework/js rm -rf $RELEASE/test/isoresult/js rm -rf $RELEASE/test/js sed -i "s/version: \"dev\"/version: \"$VERSION\"/" $RELEASE/promise.opam tar cf $RELEASE.tar $RELEASE ls -l $RELEASE.tar gzip -9 $RELEASE.tar mkdir -p _release cp $RELEASE.tar.gz _release (cd _release && tar xf $RELEASE.tar.gz) opam install --verbose --with-test -y _release/$RELEASE/promise.opam opam remove -y promise opam pin remove -y promise colordiff -u promise.opam $RELEASE/promise.opam || true opam lint $RELEASE ls -l $RELEASE.tar.gz md5sum $RELEASE.tar.gz ================================================ FILE: test/bundle/control.re ================================================ /* A program that links Block, Curry, Caml_option, and Caml_builtin_exceptions, as typical BuckleScript programs are likely to be using these anyway. */ let f = (g, x) => raise(Invalid_argument( g( Some(Belt.Array.map(x, ignore)), Belt.Result.Ok(Belt.List.fromArray(x))))); ================================================ FILE: test/bundle/size.sh ================================================ #!/bin/bash set -e npm run build npx webpack \ --display none --mode production --optimize-minimize \ --entry ./lib/js/test/bundle/control.js \ --output ./test/bundle/control.js npx webpack \ --display none --mode production --optimize-minimize \ --entry ./lib/js/test/bundle/uses_promise.js \ --output ./test/bundle/uses_promise.js gzip -9f test/bundle/control.js gzip -9f test/bundle/uses_promise.js CONTROL=`stat -c '%s' test/bundle/control.js.gz` PROMISE=`stat -c '%s' test/bundle/uses_promise.js.gz` DIFFERENCE=`expr $PROMISE - $CONTROL` LIMIT=1152 if [ $DIFFERENCE -gt $LIMIT ] then echo "Bundle size (incremental) $DIFFERENCE exceeds $LIMIT" exit 1 else echo "Bundle size (incremental): $DIFFERENCE" fi ================================================ FILE: test/bundle/uses_promise.re ================================================ let _ = Promise.resolved(1); ================================================ FILE: test/dune ================================================ (executable (name test_main) (libraries isoresult promise test_ffi)) ================================================ FILE: test/framework/dune ================================================ (library (name framework) (libraries promise run)) ================================================ FILE: test/framework/framework.re ================================================ /* OCaml promise library * http://www.ocsigen.org/lwt * Copyright (C) 2009 Jérémie Dimino * Copyright (C) 2017-2018 Anton Bachin * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as * published by the Free Software Foundation, with linking exceptions; * either version 2.1 of the License, or (at your option) any later * version. See COPYING file for details. * * This program is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA * 02111-1307, USA. */ /* This is a vendored copy/port of Lwt's tester – it is the only OCaml fully-asynchronous tester already available. For the file's history and blame before import, see https://github.com/ocsigen/lwt/blob/c7ad8b3/test/test.ml */ /* There are a few features in here that we are currently not using. We should probably delete them eventually. It's a bit of a blind conversion. A few syntactic constructs were well-adapted to OCaml, but don't look so legible in Reason, meanwhile Reason offers other syntax advantages. */ type test = { test_name: string, skip_if_this_is_false: unit => bool, run: unit => Promise.t(bool), }; type outcome = | Passed | Failed | Skipped; let test = (test_name, ~only_if = () => true, run) => {test_name, skip_if_this_is_false: only_if, run}; let currentSuiteName = ref("none"); let currentTestName = ref("none"); let () = { let onUnhandledException = Promise.onUnhandledException^; Promise.onUnhandledException := exn => { Printf.eprintf("\nIn test '%s/%s':\n", currentSuiteName^, currentTestName^); onUnhandledException(exn); }; }; let run_test = test => { currentTestName := test.test_name; if (test.skip_if_this_is_false() == false) { Promise.resolved(Skipped) } else { Promise.flatMap(test.run(), test_did_pass => if (test_did_pass) { Promise.resolved(Passed) } else { Promise.resolved(Failed) }) }; }; /* We don't support exception handling in the tester for now, largely because the [Promise] module doesn't know what to do about exceptions at this point. Future work. */ let outcome_to_character = fun | Passed => '.' | Failed => 'F' | Skipped => 'S'; type suite = { suite_name: string, suite_tests: list(test), skip_entire_suite_if_this_is_false: unit => bool, }; /* Test names paired with the corresponding outcomes. */ type suite_outcomes = list((string, outcome)); let suite = (name, ~only_if = () => true, tests) => {suite_name: name, suite_tests: tests, skip_entire_suite_if_this_is_false: only_if}; let run_test_suite: suite => Promise.t(suite_outcomes) = suite => if (suite.skip_entire_suite_if_this_is_false() == false) { /* For the outcome list, list all tests in the suite as skipped. */ let outcomes = suite.suite_tests |> List.map(({test_name, _}) => (test_name, Skipped)); /* Print a number of Skipped (S) symbols equal to the number of tests in the suite. */ outcome_to_character(Skipped) |> String.make(List.length(outcomes)) |> print_string; flush(stdout); Promise.resolved(outcomes); } else { let rec run_each_test(tests, reversed_outcomes) = switch tests { | [] => Promise.resolved(List.rev(reversed_outcomes)) | [test, ...more_tests] => Promise.flatMap(run_test(test), new_outcome => { new_outcome |> outcome_to_character |> print_char; flush(stdout); let outcome_with_name = (test.test_name, new_outcome); run_each_test(more_tests, [outcome_with_name, ...reversed_outcomes]); }) }; currentSuiteName := suite.suite_name; run_each_test(suite.suite_tests, []); }; let outcomes_all_ok = List.for_all(((_test_name, outcome)) => switch outcome { | Passed | Skipped => true | Failed => false }); let show_failures = List.iter(((test_name, outcome)) => switch outcome { | Passed | Skipped => () | Failed => Printf.eprintf("Test '%s' produced 'false'\n", test_name) }); /* Suite names paired with all the outcomes from all the tests in each suite. */ type aggregated_outcomes = list((string, suite_outcomes)); let fold_over_outcomes = (init, f, aggregated_outcomes) => { let apply_to_single_test_outcome = suite_name => (accumulator, (test_name, outcome)) => f(accumulator, ~suite_name, ~test_name, outcome); let apply_to_suite_outcomes = (accumulator, (suite_name, suite_outcomes)) => List.fold_left( apply_to_single_test_outcome(suite_name), accumulator, suite_outcomes); List.fold_left(apply_to_suite_outcomes, init, aggregated_outcomes); }; let count_ran: aggregated_outcomes => int = fold_over_outcomes(0, (count, ~suite_name as _, ~test_name as _) => fun | Skipped => count | _ => count + 1); let count_skipped: aggregated_outcomes => int = fold_over_outcomes(0, (count, ~suite_name as _, ~test_name as _) => fun | Skipped => count + 1 | _ => count); /* Runs a series of test suites. If one of the test suites fails, does not run subsequent suites. */ let run = (library_name, suites) => { Printexc.register_printer(fun | Failure(message) => Some(Printf.sprintf("Failure(%S)", message)) | _ => None); Printf.printf("Testing library '%s'...\n", library_name); let rec loop_over_suites = (aggregated_outcomes, suites) => switch suites { | [] => Printf.printf( "\nOk. %i tests ran, %i tests skipped\n", count_ran(aggregated_outcomes), count_skipped(aggregated_outcomes)); Promise.resolved(); | [suite, ...rest] => Promise.flatMap(run_test_suite(suite), outcomes => if (!outcomes_all_ok(outcomes)) { print_newline(); flush(stdout); Printf.eprintf("Failures in test suite '%s':\n", suite.suite_name); show_failures(outcomes); exit(1); } else { loop_over_suites( [(suite.suite_name, outcomes), ...aggregated_outcomes], rest); }) }; loop_over_suites([], suites) |> ignore; Run.main_loop(); }; ================================================ FILE: test/framework/framework.rei ================================================ /* OCaml promise library * http://www.ocsigen.org/lwt * Copyright (C) 2009 Jérémie Dimino * Copyright (C) 2017-2018 Anton Bachin * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as * published by the Free Software Foundation, with linking exceptions; * either version 2.1 of the License, or (at your option) any later * version. See COPYING file for details. * * This program is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA * 02111-1307, USA. */ /* This is a vendored copy/port of Lwt's tester – it is the only OCaml fully-asynchronous tester already available. For the file's history and blame before import, see https://github.com/ocsigen/lwt/blob/c7ad8b3/test/test.mli */ /** Helpers for tests. */ type test; type suite; let test: (string, ~only_if: unit => bool = ?, unit => Promise.t(bool)) => test; /** Like [test_direct], but defines a test which runs a thread. */ let suite: (string, ~only_if: unit => bool = ?, list(test)) => suite; /** Defines a suite of tests */ let run: (string, list(suite)) => unit; /** Run all the given tests and exit the program with an exit code of [0] if all tests succeeded and with [1] otherwise. */ ================================================ FILE: test/framework/js/run.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ /* On JavaScript platforms, the main loop is built into the surrounding application, such as the browser or Node. */ let main_loop = ignore; ================================================ FILE: test/framework/native/dune ================================================ (library (name run) (libraries promise)) ================================================ FILE: test/framework/native/run.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ let rec main_loop = () => { if (!Promise.ReadyCallbacks.callbacksPending()) { () } else { let callbackSnapshot = Promise.ReadyCallbacks.snapshot(); Promise.ReadyCallbacks.call(callbackSnapshot); main_loop(); } }; ================================================ FILE: test/isoresult/js/isoresult.re ================================================ include Belt.Result ================================================ FILE: test/isoresult/native/dune ================================================ (library (name isoresult) (libraries result)) ================================================ FILE: test/isoresult/native/isoresult.re ================================================ include Result ================================================ FILE: test/js/benchmark.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ let test = Framework.test; [@bs.val] external hrtime: unit => (int, int) = "process.hrtime"; let hrtime = () => { let (seconds, nanoseconds) = hrtime (); float_of_int(seconds) +. float_of_int(nanoseconds) *. 1e-9 }; let resolved_repetitions = 100_000_000; let measure_resolved = (label, f) => { let start_time = hrtime(); f(); let elapsed = hrtime() -. start_time; let nanoseconds = elapsed /. float_of_int(resolved_repetitions) *. 1e9; Printf.printf("%s %f\n", label, nanoseconds); Promise.resolved(true); }; let resolved = Framework.suite("resolved", [ test("Js.Promise.resolve", () => { measure_resolved("Js.Promise.resolve", () => for (_ in 1 to resolved_repetitions) { ignore(Js.Promise.resolve(1)); }); }), test("Promise.resolved", () => { measure_resolved("Promise.resolved", () => for (_ in 1 to resolved_repetitions) { ignore(Promise.resolved(1)); }); }), test("Js.Promise.resolve, nested promise", () => { let p = Js.Promise.resolve(1); measure_resolved("Js.Promise.resolve, nested", () => for (_ in 1 to resolved_repetitions) { ignore(Js.Promise.resolve(p)); }); }), test("Promise.resolved, nested promise", () => { let p = Promise.resolved(1); measure_resolved("Promise.resolved, nested", () => for (_ in 1 to resolved_repetitions) { ignore(Promise.resolved(p)) }); }), ]); /* The number of "thens" we can schedule is limited by the size of the heap, because each one's callback is queued for calling on the next tick. With a number of repetitions that *almost* exhausts the heap (1M, with my setup), we *have* to run multiple ticks. Otherwise, we don't trigger a garbage collection during the Js.Promise measurement, and *do* trigger GC during the Promise measurement, invalidating its result. By running many ticks, we suffer multiple garbage collections during each measurement, and the cost is fairly included in each one. */ let then_repetitions = 1_000_000; let then_ticks = 20; let measure_then = (label, f) => { let start_time = hrtime(); let rec iteration = iterations_remaining => { if (iterations_remaining > 0) { f(); /* The callback will be called on the next event loop iteration, after any callbacks scheduled by f(). */ Promise.resolved() ->Promise.flatMap(() => iteration(iterations_remaining - 1)); } else { let elapsed = hrtime() -. start_time; let nanoseconds = elapsed /. float_of_int(then_repetitions) /. float_of_int(then_ticks) *. 1e9; Printf.printf("%s %f\n", label, nanoseconds); Promise.resolved(true); } }; iteration(then_ticks); }; let flatMap = Framework.suite("flatMap", [ test("Js.Promise.then_", () => { let p = Js.Promise.resolve(1); measure_then("Js.Promise.then_", () => for (_ in 1 to then_repetitions) { p |> Js.Promise.then_(_ => p) |> ignore }); }), test("Promise.flatMap", () => { let p = Promise.resolved(1); measure_then("Promise.flatMap", () => for (_ in 1 to then_repetitions) { ignore(p->Promise.flatMap(_ => p)); }); }), ]); let suites = [resolved, flatMap]; let () = Framework.run("benchmark", suites); ================================================ FILE: test/js/test_ffi.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ [%%bs.raw {| function isPromise (p) { return (p instanceof Promise); } function isPromiseLike(v) { return v && v.then && typeof(v.then) === 'function'; }; |}]; [@bs.val] external isPromise: Promise.Js.t(_, _) => bool = "isPromise"; [@bs.val] external jsPromiseIsPromise: Js.Promise.t(_) => bool = "isPromise"; [@bs.val] external jsPromiseIsPromiseLike: Js.Promise.t(_) => bool = "isPromiseLike"; let test = Framework.test; let interopTests = Framework.suite("interop", [ test("pending is js promise", () => { let (p, _) = Promise.pending(); Promise.resolved(isPromise(p)); }), test("resolved is js promise", () => { let p = Promise.resolved(); Promise.resolved(isPromise(p)); }), test("rejected is js promise", () => { let p = Promise.Js.rejected(); let _ = p->Promise.Js.catch(() => Promise.resolved()); Promise.resolved(isPromise(p)); }), test("flatMap is js promise", () => { let p = Promise.pending() ->fst ->Promise.flatMap((_) => Promise.resolved()); Promise.resolved(isPromise(p)); }), test("map is js promise", () => { let p = fst(Promise.pending()) ->Promise.map(v => v); Promise.resolved(isPromise(p)); }), test("catch is js promise", () => { let p = Promise.pending() ->fst ->Promise.Js.catch((_) => Promise.resolved()); Promise.resolved(isPromise(p)); }), test("js promise is reason-promise", () => { let js_promise: Promise.t(int) = [%bs.raw {|Promise.resolve(1)|}]; js_promise ->Promise.flatMap(n => Promise.resolved(n + 1)) ->Promise.flatMap(n => Promise.resolved(n == 2)); }), test("reason-promise as js argument", () => { module Then = { [@bs.send.pipe: Promise.t('a)] external js_then: ('a => Promise.t('b)) => Promise.t('b) = "then"; }; (Promise.resolved(1) |> Then.js_then(n => Promise.resolved(n + 1))) ->Promise.flatMap(n => Promise.resolved(n == 2)); }), test("coerce from Js.Promise", () => { Js.Promise.resolve(42) ->Promise.Js.fromBsPromise ->Promise.Js.catch(_ => assert(false)) ->Promise.map(n => n == 42); }), test("coerce to Js.Promise", () => { (Promise.resolved(42) ->Promise.Js.toBsPromise |> Js.Promise.then_(n => Js.Promise.resolve(n + 1))) ->Promise.Js.fromBsPromise ->Promise.Js.catch(_ => assert(false)) ->Promise.map(n => n == 43); }), ]); /* The method name "_then," below, is actually resolved to "then" in JavaScript. The leading underscore is removed by BuckleScript. This mangling is for avoiding collision with the OCaml keyword "then." */ external castToPromise: {."_then": ('a => unit, 'e => unit) => unit} => Js.Promise.t('a) = "%identity"; let makePromiseLike: 'a => Js.Promise.t('a) = v => {"_then": (resolve, _) => resolve(v)} |> castToPromise; let makeAlmostPromiseLike = v => {"_then": v}; let isPromiseResolvedWith42 = p => if (!isPromise(p)) { Promise.resolved(false); } else { p->Promise.flatMap(n => Promise.resolved(n == 42)); }; let isPromiseRejectedWith42 = p => if (!isPromise(p)) { Promise.resolved(false); } else { p->Promise.Js.catch(n => Promise.resolved(n == 42)); }; let soundnessTests = Framework.suite("soundness", [ test("pending: resolved, resolve", () => { let (p, resolve) = Promise.pending(); resolve(Promise.resolved(42)); p->Promise.flatMap(isPromiseResolvedWith42); }), test("pending: resolve, reject", () => { let (p, _, reject) = Promise.Js.pending(); reject(Promise.resolved(42)); p->Promise.Js.catch(isPromiseResolvedWith42); }), test("pending: rejected, resolve", () => { let (p, resolve) = Promise.pending(); resolve(Promise.Js.rejected(42)); p->Promise.flatMap(isPromiseRejectedWith42); }), test("pending: rejected, reject", () => { let (p, _, reject) = Promise.Js.pending(); reject(Promise.Js.rejected(42)); p->Promise.Js.catch(isPromiseRejectedWith42); }), test("resolve: resolved", () => { Promise.resolved(Promise.resolved(42)) ->Promise.flatMap(isPromiseResolvedWith42); }), test("resolve: rejected", () => { Promise.resolved(Promise.Js.rejected(42)) ->Promise.flatMap(isPromiseRejectedWith42); }), test("rejected: resolved", () => { Promise.Js.rejected(Promise.resolved(42)) ->Promise.Js.catch(isPromiseResolvedWith42); }), test("rejected: rejected", () => { Promise.Js.rejected(Promise.Js.rejected(42)) ->Promise.Js.catch(isPromiseRejectedWith42); }), test("flatMap: resolved", () => { Promise.resolved() ->Promise.flatMap(() => Promise.resolved(Promise.resolved(42))) ->Promise.flatMap(isPromiseResolvedWith42); }), test("flatMap: rejected", () => { Promise.Js.resolved() ->Promise.Js.flatMap(() => Promise.Js.rejected(Promise.Js.rejected(42))) ->Promise.Js.catch(isPromiseRejectedWith42); }), test("map: resolved", () => { Promise.resolved() ->Promise.map(() => Promise.resolved(42)) ->Promise.flatMap(isPromiseResolvedWith42); }), test("map: rejected", () => { Promise.resolved() ->Promise.map(() => Promise.Js.rejected(42)) ->Promise.flatMap(isPromiseRejectedWith42); }), test("catch: resolved", () => { Promise.Js.rejected() ->Promise.Js.catch(() => Promise.resolved(Promise.resolved(42))) ->Promise.flatMap(isPromiseResolvedWith42); }), test("catch: rejected", () => { Promise.Js.rejected() ->Promise.Js.catch(() => Promise.Js.rejected(Promise.Js.rejected(42))) ->Promise.Js.catch(isPromiseRejectedWith42); }), test("pending: JS promise", () => { let (p, resolve) = Promise.pending(); resolve(Js.Promise.resolve()); p->Promise.flatMap(p => Promise.resolved(jsPromiseIsPromise(p))); }), test("resolved: JS promise", () => { Promise.resolved(Js.Promise.resolve()) ->Promise.flatMap(p => Promise.resolved(jsPromiseIsPromise(p))); }), test("rejected: JS promise", () => { Promise.Js.rejected(Js.Promise.resolve(42)) ->Promise.Js.catch(p => Promise.resolved(jsPromiseIsPromise(p))); }), test("resolved: Promise-like", () => { Promise.resolved(makePromiseLike()) ->Promise.flatMap(p => Promise.resolved(jsPromiseIsPromiseLike(p))); }), [@ocaml.warning "-33"] test("resolved: Almost-Promise-like", () => { let open Js_OO; Promise.resolved(makeAlmostPromiseLike(42)) ->Promise.flatMap(x => Promise.resolved(x##_then == 42)); }), test("all", () => { let (p1, resolve) = Promise.pending(); let p2 = Promise.all([p1]); resolve(Promise.resolved(42)); p2->Promise.flatMap(results => switch (results) { | [maybePromise] => isPromiseResolvedWith42(maybePromise) | _ => Promise.resolved(false) }); }), test("all, rejection", () => { let (p1, _, reject) = Promise.Js.pending(); let p2 = Promise.Js.all([p1]); reject(Promise.resolved(42)); p2 ->Promise.Js.map((_) => false) ->Promise.Js.catch(isPromiseResolvedWith42); }), test("race", () => { let (p1, resolve) = Promise.pending(); let p2 = Promise.race([p1]); resolve(Promise.resolved(42)); p2->Promise.flatMap(isPromiseResolvedWith42); }), test("race, rejection", () => { let (p1, _, reject) = Promise.Js.pending(); let p2 = Promise.Js.race([p1]); reject(Promise.resolved(42)); p2 ->Promise.Js.map((_) => false) ->Promise.Js.catch(isPromiseResolvedWith42); }), ]); let curryTests = Framework.suite("curry", [ test("partially applied", () => { let add = (a, b) => a + b; Promise.resolved(1) ->Promise.map(add(1)) ->Promise.map(n => n == 2); }), test("partially applied, cascade", () => { let add3 = (a, b, c) => a + b + c; Promise.resolved(1) ->Promise.map(add3(2)) ->Promise.map(f => f(3)) ->Promise.map(n => n == 6); }), ]); type type_ = [ | `A | `B ] type subtype = [ | `A ] let covarianceTests = Framework.suite("covariance", [ test("promise", () => { let p: Promise.t(subtype) = Promise.resolved(`A); let p: Promise.t(type_) = (p :> Promise.t(type_)); ignore(p); Promise.resolved(true); }), test("ok", () => { let p: Promise.t(result(subtype, unit)) = Promise.resolved(Ok(`A)); let p: Promise.t(result(type_, unit)) = (p :> Promise.t(result(type_, unit))); ignore(p); Promise.resolved(true); }), test("error", () => { let p: Promise.t(result(unit, subtype)) = Promise.resolved(Error(`A)); let p: Promise.t(result(unit, type_)) = (p :> Promise.t(result(unit, type_))); ignore(p); Promise.resolved(true); }), test("option", () => { let p: Promise.t(option(subtype)) = Promise.resolved(Some(`A)); let p: Promise.t(option(type_)) = (p :> Promise.t(option(type_))); ignore(p); Promise.resolved(true); }), test("fulfillment", () => { let p: Promise.Js.t(subtype, unit) = Promise.Js.resolved(`A); let p: Promise.Js.t(type_, unit) = (p :> Promise.Js.t(type_, unit)); ignore(p); Promise.resolved(true); }), test("rejection", () => { let p: Promise.Js.t(unit, subtype) = Promise.Js.rejected(`A); let p: Promise.Js.t(unit, type_) = (p :> Promise.Js.t(unit, type_)); p->Promise.Js.catch(_ => Promise.resolved())->ignore; Promise.resolved(true); }), ]); let suites = [interopTests, soundnessTests, curryTests, covarianceTests]; ================================================ FILE: test/native/dune ================================================ (library (name test_ffi) (libraries framework)) ================================================ FILE: test/native/test_ffi.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ let test = Framework.test; open Promise.PipeFirst; /* Counts the number of live words in the heap at the time it is called. To get the number allocated and retained between two points, call this function at both points, then subtract the two results from each other. */ let countAllocatedWords = () => { Gc.full_major(); let stat = Gc.stat(); stat.Gc.live_words; }; /* Checks that loop() does not leak memory. loop() is a function that starts an asynchronous computation, and the promise it returns resolves with the number of words allocated in the heap during the computation. loop() is run twice, the second time for 10 times as many iterations as the first. If the number of words allocated is not roughly constant, the computation leaks memory. baseIterations is used to adjust how many iterations to run. Different loops take different amounts of time, and we don't want to slow down the tests too much by running a slow loop for too many iterations. loop must call countAllocatedWords itself. Factoring the call out to this function doesNotLeakMemory will call countAllocatedWords too late, because loop will have returned and released all references that it is holding. */ let doesNotLeakMemory = (loop, baseIterations) => Promise.Js.flatMap(loop(baseIterations), wordsAllocated => Promise.Js.flatMap(loop(baseIterations * 10), wordsAllocated' => { let ratio = float_of_int(wordsAllocated') /. float_of_int(wordsAllocated); Promise.Js.resolved(ratio < 2.); })); let promiseLoopTests = Framework.suite("promise loop", [ /* A pretty simple promise loop. This is just a function that takes a promise, and calls .flatMap on it. The callback passed to .flatMap calls the loop recursively, passing another promise to the next iteration. The interesting part is not the argument promise, but the result promise returned by each iteration. If Promise is implemented naively, the iteration will result in a big chain of promises hanging in memory: a memory leak. Here is how: - At the first iteration, .flatMap creates an outer pending promise p0, and returns it immediately to the rest of the code. - Later, the callback passed to .flatMap runs. It again calls .flatMap, creating another pending promise p1. The callback then returns p1. This means that resolving p1 should resolve p0, so a naive implementation will store a reference in p1 to p0. - Later, the callback passed to p1's .flatMap runs, doing the same thing: creating another pending promise p2, pointing to p1. - By iteration N, there is a chain of N pending promises set up, such that resolving the inner-most promise in the chain, created by the last .flatMap, will resolve the outer-most promise p0, created by the first .flatMap. This is the memory leak. */ test("promise loop memory leak", () => { let instrumentedPromiseLoop = n => { let initialWords = countAllocatedWords(); let rec promiseLoop: Promise.t(int) => Promise.t(int) = previousPromise => Promise.flatMap(previousPromise, n => { if (n == 0) { let wordsAllocated = countAllocatedWords() - initialWords; Promise.resolved(wordsAllocated); } else { promiseLoop(Promise.resolved(n - 1)) }}); promiseLoop(Promise.resolved(n)); }; doesNotLeakMemory(instrumentedPromiseLoop, 1000); }), /* The fix for the above memory leak carries a potential pitfall: the fix is to merge the inner promise returned to flatMap into flatMap's outer promise. After that, all operations on the inner promise reference are actually performed on the outer promise. This carries the danger that a tower of these merged promises can build up. If a pending promise is repeatedly returned to flatMap, it will gradually become the head of a growing chain of forwarding promises, that point to the outer promise created in the last call to flatMap. To avoid this, the implementation has to perform union-find: each time it traverses a chain of merged promises, it has to set the head promise to point directly to the final outer promise, cutting out all intermediate merged promises. Then, any of these merged promises that aren't being referenced by the user program can be garbage-collected. */ test("promise tower memory leak", () => { let instrumentedPromiseTower = n => { let (foreverPendingPromise, _) = Promise.pending(); let initialWords = countAllocatedWords(); let rec tryToBuildTower = n => if (n == 0) { let wordsAllocated = countAllocatedWords() - initialWords; Promise.resolved(wordsAllocated); } else { /* The purpose of the delay promise is to make sure the second call to flatMap runs after the first. */ let delay = Promise.resolved(); /* If union-find is not implemented, we will leak memory here. */ ignore(Promise.flatMap(delay, () => foreverPendingPromise)); Promise.flatMap(delay, () => tryToBuildTower(n - 1)); }; tryToBuildTower(n); }; doesNotLeakMemory(instrumentedPromiseTower, 1000); }), ]); /* The skeleton of a test for memory safety of Promise.race. Creates a long-lived promise, and repeatedly calls the body function on it, which is customized by each test. */ let raceTest = (name, body) => test(name, () => { let instrumentedLoop = n => { let (foreverPendingPromise, _, _) = Promise.Js.pending(); let initialWords = countAllocatedWords(); let rec theLoop: int => Promise.Js.t(int, unit) = n => if (n == 0) { let wordsAllocated = countAllocatedWords() - initialWords; Promise.Js.resolved(wordsAllocated); } else { let nextIteration = () => theLoop(n - 1); body(foreverPendingPromise, nextIteration); }; theLoop(n); }; Promise.Js.catch( doesNotLeakMemory(instrumentedLoop, 100), () => assert(false)); }); let raceLoopTests = Framework.suite("race loop", [ /* To implement p3 = Promise.race([p1, p2]), Promise has to attach callbacks to p1 and p2, so that whichever of them is the first to resolve will cause the resolution of p3. This means that p1 and p2 hold references to p3. If, say, p1 is a promise that remains pending for a really long time, and it is raced with many other promises in a loop, i.e. p3 = Promise.race([p1, p2]) p3' = Promise.race([p1, p2']) etc. Then p1 will accumulate callbacks with references to p3, p3', etc. This will be a memory leak, that grows in proportion to the number of times the race loop has run. Since this is a common usage pattern, a reasonable implementation has to remove callbacks from p1 when p3, p3', etc. are resolved by race. This test checks for such an implementation. */ raceTest("race loop memory leak", (foreverPendingPromise, nextIteration) => { let (shortLivedPromise, resolveShortLivedPromise, _) = Promise.Js.pending(); let racePromise = Promise.Js.race([foreverPendingPromise, shortLivedPromise]); resolveShortLivedPromise(); Promise.Js.flatMap(racePromise, nextIteration); }), raceTest("race loop memory leak, with already-resolved promises", (foreverPendingPromise, nextIteration) => { let resolvedPromise = Promise.Js.resolved(); let racePromise = Promise.Js.race([foreverPendingPromise, resolvedPromise]); Promise.Js.flatMap(racePromise, nextIteration); }), raceTest("race loop memory leak, with rejection", (foreverPendingPromise, nextIteration) => { let (shortLivedPromise, _, rejectShortLivedPromise) = Promise.Js.pending(); let racePromise = Promise.Js.race([foreverPendingPromise, shortLivedPromise]); rejectShortLivedPromise(); Promise.Js.flatMap(racePromise, () => assert(false)) ->Promise.Js.catch(nextIteration); }), raceTest("race loop memory leak, with already-rejected promises", (foreverPendingPromise, nextIteration) => { let rejectedPromise = Promise.Js.rejected(); let racePromise = Promise.Js.race([foreverPendingPromise, rejectedPromise]); Promise.Js.flatMap(racePromise, () => assert(false)) ->Promise.Js.catch(nextIteration); }), /* This test is like the first, but it tests for the interaction of the fixes for the flatMap and race loop memory leaks. The danger is: - The flatMap fix "wants" to merge callback lists when an inner pending promise is returned from the callback of flatMap. - The race fix "wants" to delete callbacks from a callback list, when a promise "loses" to another one that resolved sooner. It is important that the callback list merging performed by flatMap doesn't prevent race from finding and deleting the correct callbacks in the merged lists. */ raceTest("race loop memory leak with flatMap merging", (foreverPendingPromise, nextIteration) => { let (shortLivedPromise, resolveShortLivedPromise, _) = Promise.Js.pending(); let racePromise = Promise.Js.race([foreverPendingPromise, shortLivedPromise]); /* Return foreverPendingPromise from the callback of flatMap. This causes all of its callbacks to be moved to the outer promise of the flatMap (which we don't give a name to). The delay promise is just used to make the second call to flatMap definitely run after the first. */ let delay = Promise.Js.resolved(); ignore(Promise.Js.flatMap(delay, () => foreverPendingPromise)); Promise.Js.flatMap(delay, () => { /* Now, we resolve the short-lived promise. If that doesn't delete the callback that was merged away from foreverPendingPromise, then this is where we will accumulate the memory leak. */ resolveShortLivedPromise(); Promise.Js.flatMap(racePromise, nextIteration); }); }), ]); let allLoopTests = Framework.suite("all loop", [ /* Like Promise.race, there is a danger of memory leak in Promise.all. When one of the promises in Promise.all is rejected, the final promise is rejected immediately. If callbacks attached to still-pending promises are not removed, a memory leak will accumulate. We reuse the raceTest helper, because the tests are structurally the same. race remains the function with the most opportunities to leak memory. */ raceTest("all loop memory leak", (foreverPendingPromise, nextIteration) => { let (shortLivedPromise, _, rejectShortLivedPromise) = Promise.Js.pending(); let allPromise = Promise.Js.all([foreverPendingPromise, shortLivedPromise]); rejectShortLivedPromise(); Promise.Js.flatMap(allPromise, (_) => assert false) ->Promise.Js.catch(nextIteration); }), raceTest("all loop memory leak, with already-rejected promises", (foreverPendingPromise, nextIteration) => { let rejectedPromise = Promise.Js.rejected(); let allPromise = Promise.Js.all([foreverPendingPromise, rejectedPromise]); Promise.Js.flatMap(allPromise, (_) => assert false) ->Promise.Js.catch(nextIteration); }), /* Tests the interaction of the memory-leak fixes in all and flatMap, as tested for race and flatMap above. */ raceTest("race loop memory leak with flatMap merging", (foreverPendingPromise, nextIteration) => { let (shortLivedPromise, _, rejectShortLivedPromise) = Promise.Js.pending(); let allPromise = Promise.Js.all([foreverPendingPromise, shortLivedPromise]); let delay = Promise.Js.resolved(); let p = delay->Promise.Js.catch((_) => assert(false)); ignore(Promise.Js.flatMap(p, () => foreverPendingPromise)); let p = delay->Promise.Js.catch((_) => assert(false)); Promise.Js.flatMap(p, () => { rejectShortLivedPromise(); Promise.Js.flatMap(allPromise, (_) => assert false) ->Promise.Js.catch(nextIteration); }); }), ]); let suites = [promiseLoopTests, raceLoopTests, allLoopTests]; ================================================ FILE: test/test_main.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ let tests = Test_promise.suites @ Test_ffi.suites; let () = Framework.run("reason-promise", tests); ================================================ FILE: test/test_promise.re ================================================ /* This file is part of reason-promise, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/promise/blob/master/LICENSE.md. */ let test = Framework.test; open! Promise.PipeFirst; let basicTests = Framework.suite("basic", [ /* The basic [resolved]-[flatMap] tests are a bit useless, because the testing framework itself already uses both [resolved] and [then], i.e. every test implicitly tests those. However, we include these for completeness, in case we become enlightened and rewrite the framework in CPS or something. */ test("resolved", () => { Promise.resolved(true); }), test("get", () => { let correct = ref(false); Promise.resolved(1)->Promise.get(n => correct := (n == 1)); Promise.resolved()->Promise.map(() => correct^); }), test("tap", () => { let correct = ref(false); Promise.resolved(1) ->Promise.tap(n => correct := (n == 1)) ->Promise.map(n => n == 1 && correct^); }), test("flatMap", () => { Promise.resolved(1) ->Promise.flatMap(n => Promise.resolved(n == 1)); }), test("map", () => { let p = Promise.resolved(6)->Promise.map(v => v * 7); p->Promise.flatMap(r => Promise.resolved(r == 42)); }), test("map chain", () => { let p = Promise.resolved(6) ->Promise.map(v => v * 7) ->Promise.map(r => r * 10); p->Promise.flatMap(r => Promise.resolved(r == 420)); }), test("map soundness", () => { Promise.resolved(6) ->Promise.map(v => v * 7) ->Promise.map(x => Promise.resolved(x == 42)) ->Promise.flatMap(r => r); }), test("flatMap chain", () => { Promise.resolved(1) ->Promise.flatMap(n => Promise.resolved(n + 1)) ->Promise.flatMap(n => Promise.resolved(n == 2)); }), test("flatMap nested", () => { Promise.resolved(1) ->Promise.flatMap (n => Promise.resolved(n + 1) ->Promise.flatMap(n => Promise.resolved(n + 1))) ->Promise.flatMap(n => Promise.resolved(n == 3)); }), /* If promises are implemented on JS directly as ordinary JS promises, [resolved(resolved(42))] will collapse to just a [promise(int)], even though the Reason type is [promise(promise(int))]. This causes a soundness bug, because, due to the type, the callback of [flatMap] will expect the nested value to be a [promise(int)]. A correct implementation of Reason promises on JS will avoid this bug. */ test("no collapsing", () => { Promise.resolved(Promise.resolved(1)) ->Promise.flatMap(p => p->Promise.flatMap(n => Promise.resolved(n == 1))); }), test("pending", () => { let (p, resolve) = Promise.pending(); resolve(true); p; }), test("defer", () => { let (p, resolve) = Promise.pending(); let p' = p->Promise.flatMap(n => Promise.resolved(n == 1)); resolve(1); p'; }), test("double resolve", () => { let (p, resolve) = Promise.pending(); resolve(42); p->Promise.flatMap(n => { resolve(43); p->Promise.map(n' => n == 42 && n' == 42)}); }), test("exec", () => { Promise.exec(resolve => resolve(true)); }), test("callback order (already resolved)", () => { let firstCallbackCalled = ref(false); let p = Promise.resolved(); p->Promise.map(() => firstCallbackCalled := true) |> ignore; p->Promise.map(() => firstCallbackCalled^); }), test("callback order (resolved later)", () => { let firstCallbackCalled = ref(false); let secondCallbackCalledSecond = ref(false); let (p, resolve) = Promise.pending(); p->Promise.map(() => firstCallbackCalled := true) |> ignore; p->Promise.map(() => secondCallbackCalledSecond := firstCallbackCalled^) |> ignore; resolve(); p->Promise.map(() => secondCallbackCalledSecond^); }), test("relax", () => { let p = Promise.resolved(); Promise.resolved(Promise.Js.relax(p) === p); }), ]); let rejectTests = Framework.suite("reject", [ test("pending", () => { let (p, _, reject) = Promise.Js.pending(); reject(1); p->Promise.Js.catch(n => Promise.resolved(n == 1)); }), test("reject, catch", () => { Promise.Js.rejected("foo") ->Promise.Js.catch(s => Promise.resolved(s == "foo")); }), test("catch chosen", () => { Promise.Js.rejected("foo") ->Promise.Js.catch(s => Promise.resolved(s == "foo")); }), test("flatMap, reject, catch", () => { Promise.Js.resolved(1) ->Promise.Js.flatMap(n => Promise.Js.rejected(n + 1)) ->Promise.Js.catch(n => Promise.resolved(n == 2)); }), test("reject, catch, flatMap", () => { Promise.Js.rejected(1) ->Promise.Js.catch(n => Promise.resolved(n + 1)) ->Promise.flatMap(n => Promise.resolved(n == 2)); }), test("no double catch", () => { Promise.Js.rejected("foo") ->Promise.Js.catch(s => Promise.resolved(s == "foo")) ->Promise.Js.catch((_) => Promise.resolved(false)); }), test("catch chain", () => { Promise.Js.rejected(1) ->Promise.Js.catch(n => Promise.Js.rejected(n + 1)) ->Promise.Js.catch(n => Promise.resolved(n == 2)); }), test("no catching resolved", () => { Promise.resolved(true) ->Promise.Js.catch((_) => Promise.resolved(false)); }), test("no catching resolved, after flatMap", () => { Promise.resolved() ->Promise.flatMap(() => Promise.resolved(true)) ->Promise.Js.catch((_) => Promise.resolved(false)); }), /* See https://github.com/aantron/promise/issues/74. If tap internally calls map, but then returns the original promise, and the original promise gets rejected, then both the mapped promise and the original promise are rejected. The rejected mapped promise results in an unhandled promise rejection, because there is no way to handle that rejection - the mapped promise is ignored internally by tap. */ test("tap unhandled rejetion", () => { Promise.Js.rejected("foo") ->Promise.Js.tap(ignore) ->Promise.Js.catch(_ => Promise.resolved(true)); }), ]); let remainsPending = (p, dummyValue) => { let rec repeat = (n, f) => if (n == 0) { Promise.resolved(true); } else { f () ->Promise.flatMap(result => if (!result) { Promise.resolved(false); } else { repeat(n - 1, f); }) }; repeat(10, () => Promise.race([p, Promise.resolved(dummyValue)]) ->Promise.flatMap(v1 => Promise.race([Promise.resolved(dummyValue), p]) ->Promise.map(v2 => v1 == dummyValue && v2 == dummyValue))); }; let allTests = Framework.suite("all", [ test("already resolved", () => { Promise.all([Promise.resolved(42), Promise.resolved(43)]) ->Promise.map(results => results == [42, 43]); }), test("resolved later", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let p3 = Promise.all([p1, p2]); resolveP1(42); resolveP2(43); p3->Promise.map(results => results == [42, 43]); }), test("not all resolved", () => { let (p1, resolveP1) = Promise.pending(); let (p2, _) = Promise.pending(); let p3 = Promise.all([p1, p2]); resolveP1(42); remainsPending(p3, []); }), test("simultaneous resolve", () => { let (p1, resolveP1) = Promise.pending(); let p2 = Promise.all([p1, p1]); resolveP1(42); p2->Promise.map(results => results == [42, 42]); }), test("already rejected", () => { let (p1, _, _) = Promise.Js.pending(); let p2 = Promise.Js.all([p1, Promise.Js.rejected(43)]); p2 ->Promise.Js.flatMap((_) => Promise.Js.resolved(false)) ->Promise.Js.catch(n => Promise.resolved(n == 43)); }), test("rejected later", () => { let (p1, _, rejectP1) = Promise.Js.pending(); let (p2, _, _) = Promise.Js.pending(); let p3 = Promise.Js.all([p1, p2]); rejectP1(42); p3 ->Promise.Js.flatMap((_) => Promise.Js.resolved(false)) ->Promise.Js.catch(n => Promise.resolved(n == 42)); }), test("remains rejected", () => { let (p1, _, rejectP1) = Promise.Js.pending(); let (p2, resolveP2, _) = Promise.Js.pending(); let p3 = Promise.Js.all([p1, p2]); rejectP1(42); resolveP2(43); p2 ->Promise.Js.catch((_) => assert false) ->Promise.Js.flatMap((_) => p3 ->Promise.Js.flatMap((_) => Promise.Js.resolved(false)) ->Promise.Js.catch(n => Promise.resolved(n == 42))); }), test("empty", () => { Promise.all([]) ->Promise.map(results => results == []); }), test("all2", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let result = Promise.all2(p1, p2) ->Promise.map(((x, y)) => x == 42 && y == 43); resolveP1(42); resolveP2(43); result; }), test("all3", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let (p3, resolveP3) = Promise.pending(); let result = Promise.all3(p1, p2, p3) ->Promise.map(((x, y, z)) => x == 42 && y == 43 && z == 44); resolveP1(42); resolveP2(43); resolveP3(44); result; }), test("all4", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let (p3, resolveP3) = Promise.pending(); let (p4, resolveP4) = Promise.pending(); let result = Promise.all4(p1, p2, p3, p4) ->Promise.map(((x, y, z, u)) => x == 42 && y == 43 && z == 44 && u == 45); resolveP1(42); resolveP2(43); resolveP3(44); resolveP4(45); result; }), test("all5", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let (p3, resolveP3) = Promise.pending(); let (p4, resolveP4) = Promise.pending(); let (p5, resolveP5) = Promise.pending(); let result = Promise.all5(p1, p2, p3, p4, p5) ->Promise.map(((x, y, z, u, v)) => x == 42 && y == 43 && z == 44 && u == 45 && v == 46); resolveP1(42); resolveP2(43); resolveP3(44); resolveP4(45); resolveP5(46); result; }), test("all6", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let (p3, resolveP3) = Promise.pending(); let (p4, resolveP4) = Promise.pending(); let (p5, resolveP5) = Promise.pending(); let (p6, resolveP6) = Promise.pending(); let result = Promise.all6(p1, p2, p3, p4, p5, p6) ->Promise.map(((x, y, z, u, v, w)) => x == 42 && y == 43 && z == 44 && u == 45 && v == 46 && w == 47); resolveP1(42); resolveP2(43); resolveP3(44); resolveP4(45); resolveP5(46); resolveP6(47); result; }), test("allArray", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let result = Promise.allArray([|p1, p2|]) ->Promise.map(fun | [|x, y|] => x == 42 && y == 43 | _ => false); resolveP1(42); resolveP2(43); result; }), ]); let raceTests = Framework.suite("race", [ test("first resolves", () => { let (p1, resolveP1) = Promise.pending(); let (p2, _) = Promise.pending(); let p3 = Promise.race([p1, p2]); resolveP1(42); p3->Promise.map(n => n == 42); }), test("second resolves", () => { let (p1, _) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let p3 = Promise.race([p1, p2]); resolveP2(43); p3->Promise.map(n => n == 43); }), test("first resolves first", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let p3 = Promise.race([p1, p2]); resolveP1(42); resolveP2(43); p3->Promise.map(n => n == 42); }), test("second resolves first", () => { let (p1, resolveP1) = Promise.pending(); let (p2, resolveP2) = Promise.pending(); let p3 = Promise.race([p1, p2]); resolveP2(43); resolveP1(42); p3->Promise.map(n => n == 43); }), test("rejection", () => { let (p1, _, rejectP1) = Promise.Js.pending(); let (p2, _, _) = Promise.Js.pending(); let p3 = Promise.Js.race([p1, p2]); rejectP1(42); p3->Promise.Js.catch(n => Promise.resolved(n == 42)); }), test("already resolved", () => { let (p1, _) = Promise.pending(); let p2 = Promise.resolved(43); let p3 = Promise.race([p1, p2]); p3->Promise.map(n => n == 43); }), test("already rejected", () => { let (p1, _, _) = Promise.Js.pending(); let p2 = Promise.Js.rejected(43); let p3 = Promise.Js.race([p1, p2]); p3->Promise.Js.catch(n => Promise.resolved(n == 43)); }), test("two resolved", () => { let p1 = Promise.resolved(42); let p2 = Promise.resolved(43); let p3 = Promise.race([p1, p2]); p3->Promise.map(n => n == 42 || n == 43); }), test("forever pending", () => { let (p1, _) = Promise.pending(); let (p2, _) = Promise.pending(); let p3 = Promise.race([p1, p2]); remainsPending(p3, 43); }), test("simultaneous resolve", () => { let (p1, resolveP1) = Promise.pending(); let p2 = Promise.race([p1, p1]); resolveP1(42); p2->Promise.map(n => n == 42); }), test("empty", () => { try ({ ignore(Promise.race([])); Promise.resolved(false); }) { | Invalid_argument(_) => Promise.resolved(true); }; }), /* This test is for an implementation detail. When a pending promise p is returned by the callback of flatMap, the native implementation (and non-memory-leaking JavaScript implementations) will move the callbacks attached to p into the list attached to the outer promise of flatMap. We want to make sure that callbacks attached by race survive this moving. For that, p has to be involved in a call to race. */ test("race, then callbacks moved", () => { let (p, resolve) = Promise.pending(); let final = Promise.race([p]); /* We are using this resolve() just so we can call flatMap on it, guaranteeing that the second time will run after the first time.. */ let delay = Promise.resolved(); ignore(delay->Promise.flatMap(() => p)); delay->Promise.flatMap(() => { resolve(42); /* This tests now succeeds only if resolving p resolved final^, despite the fact that p was returned to flatMap while still a pending promise. */ final->Promise.map(n => n == 42); }); }), /* Similar to the preceding test, but the race callback is attached to p after its callback list has been merged with the outer promise of flatMap. */ test("callbacks moved, then race", () => { let (p, resolve) = Promise.pending(); let delay = Promise.resolved(); ignore(delay->Promise.flatMap(() => p)); delay ->Promise.flatMap(() => { let final = Promise.race([p]); resolve(42); final->Promise.map(n => n == 42); }); }), ]); /* Compatibility with BukleScript < 6. */ open! Isoresult; let resultTests = Framework.suite("result", [ test("mapOk, ok", () => { Promise.resolved(Ok(42)) ->Promise.mapOk(n => n + 1) ->Promise.map(v => v == Ok(43)); }), test("mapOk, error", () => { Promise.resolved(Error(42)) ->Promise.mapOk(n => n + 1) ->Promise.map(v => v == Error(42)); }), test("mapError, ok", () => { Promise.resolved(Ok(42)) ->Promise.mapError(n => n + 1) ->Promise.map(v => v == Ok(42)); }), test("mapError, error", () => { Promise.resolved(Error(42)) ->Promise.mapError(n => n + 1) ->Promise.map(v => v == Error(43)); }), test("getOk, ok", () => { let (p, resolve) = Promise.pending(); Promise.resolved(Ok(42))->Promise.getOk(n => resolve(n + 1)); p->Promise.map(n => n == 43); }), test("getOk, error", () => { let called = ref(false); Promise.resolved(Error(42))->Promise.getOk(_ => called := true); Promise.resolved()->Promise.map(() => !called^); }), test("getError, ok", () => { let called = ref(false); Promise.resolved(Ok(42))->Promise.getError(_ => called := true); Promise.resolved()->Promise.map(() => !called^); }), test("getError, error", () => { let (p, resolve) = Promise.pending(); Promise.resolved(Error(42))->Promise.getError(n => resolve(n + 1)); p->Promise.map(n => n == 43); }), test("tapOk, ok", () => { let correct = ref(false); Promise.resolved(Ok(42)) ->Promise.tapOk(n => correct := n == 42) ->Promise.map(result => result == Ok(42) && correct^); }), test("tapOk, error", () => { let called = ref(false); Promise.resolved(Error(42)) ->Promise.tapOk(_ => called := true) ->Promise.map(result => result == Error(42) && !called^); }), test("tapError, ok", () => { let called = ref(false); Promise.resolved(Ok(42)) ->Promise.tapError(_ => called := true) ->Promise.map(result => result == Ok(42) && !called^); }), test("getError, error", () => { let correct = ref(false); Promise.resolved(Error(42)) ->Promise.tapError(n => correct := n == 42) ->Promise.map(result => result == Error(42) && correct^); }), test("flatMapOk, ok", () => { Promise.resolved(Ok(42)) ->Promise.flatMapOk(n => Promise.resolved(Ok(n + 1))) ->Promise.map(v => v == Ok(43)); }), test("flatMapOk, error", () => { Promise.resolved(Error(42)) ->Promise.flatMapOk(n => Promise.resolved(Ok(n + 1))) ->Promise.map(v => v == Error(42)); }), test("flatMapError, ok", () => { Promise.resolved(Ok(42)) ->Promise.flatMapError(n => Promise.resolved(Error(n + 1))) ->Promise.map(v => v == Ok(42)); }), test("flatMapError, error", () => { Promise.resolved(Error(42)) ->Promise.flatMapError(n => Promise.resolved(Error(n + 1))) ->Promise.map(v => v == Error(43)); }), [@ocaml.warning "-3"] test(">|=, ok", () => { let open Promise.Operators; (Promise.resolved(Ok(42)) >|= (n => n + 1)) ->Promise.map(v => v == Ok(43)); }), [@ocaml.warning "-3"] test(">|=, error", () => { let open Promise.Operators; (Promise.resolved(Error(42)) >|= (n => n + 1)) ->Promise.map(v => v == Error(42)); }), [@ocaml.warning "-3"] test(">>=, ok", () => { let open Promise.Operators; (Promise.resolved(Ok(42)) >>= (n => Promise.resolved(Ok(n + 1)))) ->Promise.map(v => v == Ok(43)); }), [@ocaml.warning "-3"] test(">>=, error", () => { let open Promise.Operators; (Promise.resolved(Error(42)) >>= (n => Promise.resolved(Ok(n + 1)))) ->Promise.map(v => v == Error(42)); }), test("toResult, resolved", () => { Promise.Js.resolved(1) ->Promise.Js.toResult ->Promise.Js.map(result => result == Ok(1)); }), test("toResult, rejected", () => { Promise.Js.rejected(2) ->Promise.Js.toResult ->Promise.Js.map(result => result == Error(2)); }), test("fromResult, ok", () => { Promise.resolved(Ok(3)) ->Promise.Js.fromResult ->Promise.Js.map(v => v == 3); }), test("fromResult, error", () => { Promise.resolved(Error(4)) ->Promise.Js.fromResult ->Promise.Js.catch(v => Promise.resolved(v == 4)); }), test("allOk, ok", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let p3 = Promise.allOk([p1, p2]); r1(Ok(42)); r2(Ok(43)); p3->Promise.map((==)(Ok([42, 43]))); }), test("allOk, error", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let p3 = Promise.allOk([p1, p2]); r1(Ok(42)); r2(Error(43)); p3->Promise.map((==)(Error(43))); }), test("allOk, fast fail", () => { let (p1, _) = Promise.pending(); let (p2, r2) = Promise.pending(); let p3 = Promise.allOk([p1, p2]); r2(Error(43)); p3->Promise.map((==)(Error(43))); }), test("allOk, multiple error", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let p3 = Promise.allOk([p1, p2]); r1(Error(42)); r2(Error(43)); p3->Promise.map((==)(Error(42))); }), test("allOk, empty", () => { Promise.allOk([]) ->Promise.map(result => result == Ok([])); }), test("allOk2, ok", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let p3 = Promise.allOk2(p1, p2); r1(Ok(42)); r2(Ok("43")); p3->Promise.map((==)(Ok((42, "43")))); }), test("allOk2, error", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let p3 = Promise.allOk2(p1, p2); r1(Ok(42)); r2(Error("43")); p3->Promise.map((==)(Error("43"))); }), test("allOk3, ok", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let (p3, r3) = Promise.pending(); let p4 = Promise.allOk3(p1, p2, p3); r1(Ok(42)); r2(Ok("43")); r3(Ok(44)); p4->Promise.map((==)(Ok((42, "43", 44)))); }), test("allOk3, error", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let (p3, _) = Promise.pending(); let p4 = Promise.allOk3(p1, p2, p3); r1(Ok(42)); r2(Error("43")); p4->Promise.map((==)(Error("43"))); }), test("allOk4, ok", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let (p3, r3) = Promise.pending(); let (p4, r4) = Promise.pending(); let p5 = Promise.allOk4(p1, p2, p3, p4); r1(Ok(42)); r2(Ok("43")); r3(Ok(44)); r4(Ok(45)); p5->Promise.map((==)(Ok((42, "43", 44, 45)))); }), test("allOk4, error", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let (p3, _) = Promise.pending(); let (p4, _) = Promise.pending(); let p5 = Promise.allOk4(p1, p2, p3, p4); r1(Ok(42)); r2(Error("43")); p5->Promise.map((==)(Error("43"))); }), test("allOk5, ok", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let (p3, r3) = Promise.pending(); let (p4, r4) = Promise.pending(); let (p5, r5) = Promise.pending(); let p6 = Promise.allOk5(p1, p2, p3, p4, p5); r1(Ok(42)); r2(Ok("43")); r3(Ok(44)); r4(Ok(45)); r5(Ok(46)); p6->Promise.map((==)(Ok((42, "43", 44, 45, 46)))); }), test("allOk5, error", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let (p3, _) = Promise.pending(); let (p4, _) = Promise.pending(); let (p5, _) = Promise.pending(); let p6 = Promise.allOk5(p1, p2, p3, p4, p5); r1(Ok(42)); r2(Error("43")); p6->Promise.map((==)(Error("43"))); }), test("allOk6, ok", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let (p3, r3) = Promise.pending(); let (p4, r4) = Promise.pending(); let (p5, r5) = Promise.pending(); let (p6, r6) = Promise.pending(); let p7 = Promise.allOk6(p1, p2, p3, p4, p5, p6); r1(Ok(42)); r2(Ok("43")); r3(Ok(44)); r4(Ok(45)); r5(Ok(46)); r6(Ok(47)); p7->Promise.map((==)(Ok((42, "43", 44, 45, 46, 47)))); }), test("allOk6, error", () => { let (p1, r1) = Promise.pending(); let (p2, r2) = Promise.pending(); let (p3, _) = Promise.pending(); let (p4, _) = Promise.pending(); let (p5, _) = Promise.pending(); let (p6, _) = Promise.pending(); let p7 = Promise.allOk6(p1, p2, p3, p4, p5, p6); r1(Ok(42)); r2(Error("43")); p7->Promise.map((==)(Error("43"))); }), ]); let optionTests = Framework.suite("option", [ test("mapSome, some", () => { Promise.resolved(Some(42)) ->Promise.mapSome(n => n + 1) ->Promise.map(v => v == Some(43)); }), test("mapSome, none", () => { Promise.resolved(None) ->Promise.mapSome(n => n + 1) ->Promise.map(v => v == None); }), test("getSome, some", () => { let (p, resolve) = Promise.pending(); Promise.resolved(Some(42))->Promise.getSome(n => resolve(n + 1)); p->Promise.map(n => n == 43); }), test("getSome, none", () => { let called = ref(false); Promise.resolved(None)->Promise.getSome(_ => called := true); Promise.resolved()->Promise.map(() => !called^); }), test("tapSome, some", () => { let correct = ref(false); Promise.resolved(Some(42)) ->Promise.tapSome(n => correct := n == 42) ->Promise.map(result => result == Some(42) && correct^); }), test("tapSome, none", () => { let called = ref(false); Promise.resolved(None) ->Promise.tapSome(_ => called := true) ->Promise.map(result => result == None && !called^); }), test("flatMapSome, some", () => { Promise.resolved(Some(42)) ->Promise.flatMapSome(n => Promise.resolved(Some(n + 1))) ->Promise.map(v => v == Some(43)); }), test("flatMapSome, none", () => { Promise.resolved(None) ->Promise.flatMapSome(n => Promise.resolved(Some(n + 1))) ->Promise.map(v => v == None); }), ]); let raiseTests = Framework.suite("raise", [ test("stops, then", () => { let continued = ref(false); let p = Promise.resolved() ->Promise.flatMap(() => raise(Exit)) ->Promise.flatMap(() => { continued := true; Promise.resolved(42); }); remainsPending(p, 43); }), test("stops, catch", () => { let continued = ref(false); let p = Promise.Js.rejected() ->Promise.Js.catch(() => raise(Exit)) ->Promise.Js.flatMap(() => { continued := true; Promise.resolved(42); }); remainsPending(p, 43); }), ]); let suites = [ basicTests, rejectTests, allTests, raceTests, resultTests, optionTests, raiseTests, ];