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