From b4ea34e31a925854109bc82f5e49b2dc18f9c71f Mon Sep 17 00:00:00 2001 From: Giuseppe Zerbo Date: Tue, 17 Oct 2017 17:22:46 +0200 Subject: [PATCH] Version 0.1.0. --- .gitignore | 16 + CHANGELOG.md | 24 ++ LICENSE.txt | 373 +++++++++++++++++++ README.md | 266 +++++++++++++ dev/shrimp/dev.cljs | 8 + doc/intro.md | 3 + lumo-repl.cljsh | 8 + lumo-test.sh | 3 + project.clj | 48 +++ src/clj/shrimp/macros.clj | 73 ++++ src/clj/shrimp/test/macros.clj | 40 ++ src/cljs/shrimp/core.cljs | 637 ++++++++++++++++++++++++++++++++ src/cljs/shrimp/test.cljs | 78 ++++ test/cljs/shrimp/core_test.cljs | 109 ++++++ test/cljs/shrimp/tests.cljs | 18 + 15 files changed, 1704 insertions(+) create mode 100644 .gitignore create mode 100644 CHANGELOG.md create mode 100644 LICENSE.txt create mode 100644 README.md create mode 100644 dev/shrimp/dev.cljs create mode 100644 doc/intro.md create mode 100755 lumo-repl.cljsh create mode 100755 lumo-test.sh create mode 100644 project.clj create mode 100644 src/clj/shrimp/macros.clj create mode 100644 src/clj/shrimp/test/macros.clj create mode 100644 src/cljs/shrimp/core.cljs create mode 100644 src/cljs/shrimp/test.cljs create mode 100644 test/cljs/shrimp/core_test.cljs create mode 100644 test/cljs/shrimp/tests.cljs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d0f885f --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +/target +/classes +/checkouts +pom.xml +pom.xml.asc +*.jar +*.class +/.lein-* +/.nrepl-port +.hgignore +.hg/ +.lumo_cache +package* +node_modules +figwheel_* +README.html diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..934e72c --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,24 @@ +# Change Log +All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). + +## [Unreleased] +### Changed +- Add a new arity to `make-widget-async` to provide a different widget shape. + +## [0.1.1] - 2017-10-07 +### Changed +- Documentation on how to make the widgets. + +### Removed +- `make-widget-sync` - we're all async, all the time. + +### Fixed +- Fixed widget maker to keep working when daylight savings switches over. + +## 0.1.0 - 2017-10-07 +### Added +- Files from the new template. +- Widget maker public API - `make-widget-sync`. + +[Unreleased]: https://github.com/your-name/shrimp/compare/0.1.1...HEAD +[0.1.1]: https://github.com/your-name/shrimp/compare/0.1.0...0.1.1 diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..14e2f77 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,373 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. diff --git a/README.md b/README.md new file mode 100644 index 0000000..293a213 --- /dev/null +++ b/README.md @@ -0,0 +1,266 @@ +## What is Shrimp? + +Shrimp is a [ClojureScript](https://clojurescript.org/) library that implements asynchronous communication channels, built on top of [Red Lobster](https://github.com/whamtet/redlobster) promise library. +It targets [Node.js](https://nodejs.org/en/) and [Lumo](https://github.com/anmonteiro/lumo) with the aim to be lightweight and to offer in addition useful functionalities for testing async functions. +Shrimp is *not* intended as a replacement for [core.async](https://github.com/clojure/core.async), in particular few operations on the channels are provided (put!, take!, alts!), and all operations return Red Lobster promises. + +## Rationale + +While there is evidence to support the diagnosis of NIH syndrome, this project is motivated by the relative complexity/overhead of using core.async with Lumo. +Shrimp should be fast at compile and run-time and it only requires one additional dependency. +Also it's fun to experiment! + +## Installation + +[![Clojars Project](https://img.shields.io/clojars/v/shrimp.svg)](https://clojars.org/shrimp) + +If you use Leiningen add redlobster and shrimp to the dependencies in your project.clj file. + + :dependencies [... + [org.clojars.pepzer/redlobster "0.2.2"] + [shrimp "0.1.0"]] + +For Lumo you could either download the dependencies with Leiningen/Maven and then add them to Lumo like so: + + $ lumo -D org.clojars.pepzer/redlobster:0.2.2,shrimp:0.1.0 + +Or you could download the jar files from [Clojars](https://clojars.org/) and add them to the Lumo classpath: + + $ lumo -c redlobster-0.2.2.jar:shrimp-0.1.0.jar + +## Note on Red Lobster + +The release of Red Lobster listed above is my version, the reason is a small fix that avoids annoying (especially with Lumo) warnings on compilation. +I will send a pull request with this fix and if the official release gets updated i will switch to that as a dependency. + +## Usage + +To use shrimp, require the shrimp.core namespace, and create a channnel: + + (require '[shrimp.core :as sc]) + + (def chan1 (sc/chan)) + +To close a channel: + + (sc/close! chan1) + +A closed channel allows to take! until the values-queue is empty, then it switches to dead, to test the channel state: + + (sc/closed? chan1) + + (sc/dead? chan1) + +A channel has a buffer-size that defines the maximum dimension of the queue for both put! and take! operations. +After the number of puts or takes reaches the buffer-size, a new call will fail (i.e. return a promise already realised to respectively false and nil for put! and take!/alts!). +The default limit for the buffer is 1024, a different value could be specified on creation: + + (def chan2 (sc/chan 20)) + +### put! and take! + +Require Red Lobster macros with use-macros to manage the channel promises: + + (require '[shrimp.core :as sc]) + (use-macros '[redlobster.macros :only [let-realised]]) + + ; Define the channel + (def chan1 (sc/chan)) + + ; Try to take from the channel + ; Print the value when the promise is realised + (let-realised [prom (sc/take! chan1)] + (do (println "Val: " @prom) + (sc/close! chan1))) + + ; Put a value inside the channnel + (sc/put! chan1 "foo") + + => Val: foo + +### alts! + +There is an alts! function to take from the first available channel with an optional timeout and corresponding default value: + + (require '[shrimp.core :as sc]) + (use-macros '[redlobster.macros :only [let-realised]]) + + ; Define the channels + (def chan1 (sc/chan)) + (def chan2 (sc/chan)) + + ; Try to take from both channels + ; Print the value when the promise is realised + (let-realised [prom (sc/alts! [chan1 chan2])] + (let [[v ch] @prom] + (if (= ch chan1) + (println "Val: " v ", from chan1") + (println "Val: " v ", from chan2")) + (sc/close! chan1))) + + ; Put a value inside the channnel + (sc/put! chan1 "foo") + + => Val: foo , from chan1 + +To define a timeout of 1 second and a default value on expiration: + + (ps/alts! [chan1 chan2] 1000 "default value") + +### defer-loop + +This macro mimics Clojure's loop, but it allows to use asynchronous functions inside the loop: + + (require '[shrimp.core :as sc]) + (use-macros '[redlobster.macros :only [when-realised]]) + (use-macros '[shrimp.macros :only [defer-loop]]) + + ; Define the channel + (def chan1 (sc/chan)) + + ; The loop stops when the take! promise realises to nil + (defer-loop [prom (sc/take! chan1)] + (when-realised [prom] + (if @prom + (do + (println "Val: " @prom ", from defer-loop") + + ; defer-recur works like recur + ; It is only defined under the scope of the defer-loop macro + (defer-recur (sc/take! chan1))) + + (println "Exit from the loop")))) + + ; Put a value inside the channnel + (sc/put! chan1 "foo") + + (sc/close! chan1) + + => Val: foo , from defer-loop + Exit from the loop + +## Extras and Testing + +There are other macros in shrimp that might be useful in particular for testing. + +### defer + +This is a slight variation on the Red Lobster's defer macro, it allows to defer the execution of an expression with a delay. +Compared to Red Lobster, this version always requires the integer value for the delay, but now it could be a var in addition to a literal number, also if the delay is any negative value defer will use js/setImmediate. + + (use-macros '[shrimp.macros :only [defer]]) + + (defer 2000 (println "foo")) + + => foo + +### defer-time + +This small macro allows to easily print the elapsed time for an asynchronous function. The function do-time is defined inside the scope of the macro, it should be called as the last expression in the asynchronous block (or as a wrapper for it): + + (use-macros '[shrimp.macros :only [defer-time defer]]) + + (defer-time + (defer 2000 (do (println "foo") + (do-time (println "bar"))))) + + => foo + bar + "Elapsed time: 2003.601113 msecs" + +### Testing asynchronous functions + +Shrimp provides a macro and the necessary helper functions to run asynchronous tests and receive correct error reports. The differences compared to standard tests are minimal. +First create a test namespace to run all the other tests with the run-async-tests macro: + + (ns foo.all-tests + (:require [foo.core-test] + [foo.bar-test]) + (:use-macros [shrimp.test.macros :only [run-async-tests]])) + + (defn -main [] + (run-async-tests + foo.core-test + foo.bar-test)) + +The only addition to the tests is a call to the done! function at the end of each deftest, a call to done! is required for *ALL* tests even for synchronous ones: + + (ns foo.core-test + (:require [cljs.test :refer [deftest is]] + [shrimp.test :as st]) + (:use-macros [shrimp.macros :only [defer]])) + + (deftest sync-test + (is (= 3 (+ 1 2))) + (st/done!)) + + ; Call st/done! as the last expression in the async block + (deftest async-test + (defer 2000 (do + (is (= 1 1)) + (st/done!)))) + +To run the tests invoke the main of foo.all-tests, for example with Lumo: + + $ lumo -c ... -m foo.all-tests + +The output should be similar to this: + + Testing foo.core-test + + Ran 2 tests containing 2 assertions. + 0 failures, 0 errors. + + Testing foo.bar-test + + Ran 2 tests containing 2 assertions. + 0 failures, 0 errors. + + All namespaces: + + Ran 4 tests containing 4 assertions. + 0 failures, 0 errors. + +## REPL + +To run a REPL inside shrimp you could either use lein figwheel (optionally with rlwrap): + + $ rlwrap lein figwheel dev + +With Node.js and npm installed open a shell, navigate to the root of the project and run: + + $ npm install ws + $ node target/out/shrimp.js + +Then the REPL should connect in the lein figwheel window. + +With Lumo installed just run the lumo-repl.cljsh script: + + $ bash lumo-repl.cljsh + +This will run the REPL and will also listen on the port 12345 of the localhost for connections. +You could connect with Emacs and inf-clojure-connect. + +## Tests + +To run the tests with Leiningen use: + + $ lein cljsbuild once + $ node target/out-test/shrimp.js + +With Lumo: + + $ bash lumo-test.sh + +## Code Maturity + +This is an early release, hence bugs should be expected and future releases could break the current API. + +## Contacts + +[Giuseppe Zerbo](https://github.com/pepzer), [giuseppe (dot) zerbo (at) gmail (dot) com](mailto:giuseppe.zerbo@gmail.com). + +## License + +Copyright © 2017 Giuseppe Zerbo. +Distributed under the [Mozilla Public License, v. 2.0](http://mozilla.org/MPL/2.0/). diff --git a/dev/shrimp/dev.cljs b/dev/shrimp/dev.cljs new file mode 100644 index 0000000..617f2ac --- /dev/null +++ b/dev/shrimp/dev.cljs @@ -0,0 +1,8 @@ +(ns shrimp.dev + (:require [shrimp.core :as core] + [figwheel.client :as fw])) + +(defn -main [] + (fw/start { })) + +(set! *main-cli-fn* -main) diff --git a/doc/intro.md b/doc/intro.md new file mode 100644 index 0000000..6f533ce --- /dev/null +++ b/doc/intro.md @@ -0,0 +1,3 @@ +# Introduction to shrimp + +TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) diff --git a/lumo-repl.cljsh b/lumo-repl.cljsh new file mode 100755 index 0000000..35dac5f --- /dev/null +++ b/lumo-repl.cljsh @@ -0,0 +1,8 @@ +#!/bin/bash + +":"; exec lumo --socket-repl 12345 -c ../libs/redlobster-0.2.2-SNAPSHOT.jar:src/cljs:src/clj:test/cljs -K -i "$0" -r + +(ns repl.run + (:require [shrimp.core])) + +(println "\nNamespace shrimp.core loaded,\nswitch to it with (in-ns 'shrimp.core).\n") diff --git a/lumo-test.sh b/lumo-test.sh new file mode 100755 index 0000000..870a504 --- /dev/null +++ b/lumo-test.sh @@ -0,0 +1,3 @@ +#!/bin/bash +lumo -c ../libs/redlobster-0.2.2-SNAPSHOT.jar:src/cljs:src/clj:test/cljs -K -m shrimp.tests + diff --git a/project.clj b/project.clj new file mode 100644 index 0000000..bebf7c1 --- /dev/null +++ b/project.clj @@ -0,0 +1,48 @@ +(defproject shrimp "0.1.0" + :description "A ClojureScript library targeting Node.js and providing async channels on top of Red Lobster promise library." + :url "https://github.com/pepzer/shrimp" + :license {:name "Mozilla Public License Version 2.0" + :url "http://mozilla.org/MPL/2.0/"} + + :min-lein-version "2.7.1" + + :dependencies [[org.clojure/clojure "1.9.0-beta1"] + [org.clojure/clojurescript "1.9.946"] + [org.clojars.pepzer/redlobster "0.2.2"]] + + :plugins [[lein-figwheel "0.5.13"] + [lein-cljsbuild "1.1.7" :exclusions [[org.clojure/clojure]]]] + + :clean-targets ^{:protect false} ["target"] + + :source-paths ["src/clj" "src/cljs" "test/cljs"] + + :cljsbuild { + :builds [{:id "dev" + :source-paths ["src/clj" "src/cljs"] + :figwheel true + :compiler {:main shrimp.dev + :output-to "target/out/shrimp.js" + :output-dir "target/out" + :target :nodejs + :optimizations :none + :source-map true }} + {:id "test-all" + :source-paths ["src/clj" "src/cljs" "test/cljs"] + :compiler {:main shrimp.tests + :output-to "target/out-test/shrimp.js" + :output-dir "target/out-test" + :target :nodejs + :optimizations :none + :source-map true }} + {:id "prod" + :source-paths ["src/clj" "src/cljs"] + :compiler {:output-to "target/out-rel/shrimp.js" + :output-dir "target/out-rel" + :target :nodejs + :optimizations :advanced + :source-map false }}]} + + :profiles {:dev {:source-paths ["dev"]}} + :figwheel {}) + diff --git a/src/clj/shrimp/macros.clj b/src/clj/shrimp/macros.clj new file mode 100644 index 0000000..ad7cc06 --- /dev/null +++ b/src/clj/shrimp/macros.clj @@ -0,0 +1,73 @@ +;; Copyright © 2017 Giuseppe Zerbo. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns shrimp.macros) + +(defmacro defer + "Run the given forms in the next tick of the event loop or after a delay. + + If the delay is negative run the form with setImmediate, otherwise run the forms + with setTimeout and the delay. + + :param delay + Delay in milliseconds to defer the forms, or negative to run with setImmediate. + :param forms + Forms to execute through setTimeout or setImmediate. + " + [delay & forms] + `(let [fn# (fn [] ~@forms) + t# (.-setImmediate js/global)] + (if (and (< ~delay 0) t#) + (js/setImmediate fn#) + (js/setTimeout fn# (max ~delay 0))))) + +(defmacro defer-loop + "Equivalent to loop but use setImmediate and defer-recur for recursion. + + Accept bindings and recur without consuming stack using setImmediate, + needs a call to 'defer-recur' for recursion. + Useful when using 'let-realised', 'when-realised' and similar inside the loop. + " + [bindings & forms] + (if (odd? (count bindings)) + `(throw (js/Error. "Defer-loop needs an even number of binding clauses!")) + (let [pairs (partition 2 bindings) + symbols (mapv first pairs) + args (map second pairs) + fn-sym (gensym "defer-loop-") + defer-recur (symbol "defer-recur")] + `(do + (defn- ~fn-sym + ~symbols + (let [t# (.-setImmediate js/global) + ~defer-recur (if t# + (fn [& args#] + (js/setImmediate + (fn [] (apply ~fn-sym args#)))) + (fn [& args#] + (js/setTimeout + (fn [] (apply ~fn-sym args#)) + 0)))] + ~@forms)) + (~fn-sym ~@args))))) + +(defmacro defer-time + "Async version of cljs.core/time, run expr and return its value. + + To actually compute the elapsed time invoke '(do-time last-expr)' as your last + expression inside a possibly async block, the result of last-expr is returned. + Invoke '(do-time)' with no arguments as your last expression to return nil. + Calling 'do-time' at any point (even multiple times) is legit although probably + not too useful. + " + [expr] + `(let [start# (system-time) + do-time# (fn [& res#] + (prn (cljs.core/str "Elapsed time: " + (.toFixed (- (system-time) start#) 6) + " msecs")) + (first res#)) + ~(symbol "do-time") do-time#] + ~expr)) diff --git a/src/clj/shrimp/test/macros.clj b/src/clj/shrimp/test/macros.clj new file mode 100644 index 0000000..a19ed52 --- /dev/null +++ b/src/clj/shrimp/test/macros.clj @@ -0,0 +1,40 @@ +;; Copyright © 2017 Giuseppe Zerbo. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns shrimp.test.macros) + +(def r-when-realised 'redlobster.macros/when-realised) +(def t-init! 'shrimp.test/init!) +(def t-close! 'shrimp.test/close!) +(def t-reset! 'shrimp.test/reset-collection!) +(def t-tests-done 'shrimp.test/tests-done) +(def t-collect 'shrimp.test/collect-results!) +(def t-report-counter! 'shrimp.test/inc-report-counter!) +(def t-orig-inc-report 'cljs.test/inc-report-counter!) + +(defn- realise-form [in-form ns] + `(do + (~t-reset!) + (cljs.test/run-tests (quote ~ns)) + (~t-collect) + (~r-when-realised [(deref ~t-tests-done)] + ~in-form))) + +(defn- realise-forms [forms end-form] + (reduce realise-form + end-form + (reverse forms))) + +(defmacro run-async-tests + [& forms] + (let [orig-rep-fn (gensym "orig-fn") + end-form `(do (~t-close!) + (set! ~t-orig-inc-report ~orig-rep-fn)) + chained (realise-forms forms end-form)] + `(let [~orig-rep-fn ~t-orig-inc-report] + (set! ~t-orig-inc-report + (~t-report-counter! ~orig-rep-fn)) + (~t-init!) + ~chained))) diff --git a/src/cljs/shrimp/core.cljs b/src/cljs/shrimp/core.cljs new file mode 100644 index 0000000..a2e4483 --- /dev/null +++ b/src/cljs/shrimp/core.cljs @@ -0,0 +1,637 @@ +;; Copyright © 2017 Giuseppe Zerbo. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns shrimp.core + (:require [redlobster.promise :as p] + [clojure.spec.alpha :as s]) + (:use-macros [redlobster.macros :only [when-realised let-realised]] + [shrimp.macros :only [defer]])) + +(declare chan-loop) + +(defn- try-realise + "Realise a promise only if not already realised. + + Avoid throwing an error if the promise is realised more than once. + + :param prom + The promise to realise. + :param v + The value to send to the promise. + " + [prom v] + (when-not (p/realised? prom) + (p/realise prom v))) + +(defn- try-realise-error + "Realise a failed promise only if not already realised. + + Avoid throwing an error if the promise is realised more than once. + + :param prom + The promise to realise. + :param v + The value to send to the promise. + " + [prom v] + (when-not (p/realised? prom) + (p/realise-error prom v))) + +(defprotocol IChan + (-put! + [this value] + [this value tag prom]) + (-take! + [this] + [this tag prom]) + (-alts! + [this cb-prom] + [this cb-prom tag prom]) + (-close! + [this] + [this tag prom]) + (-closed? [this]) + (-dead? [this])) + +(let [atom? #(instance? Atom %) + prom-inside? #(p/promise? (deref %)) + nil-inside? #(nil? (deref %)) + symbol-inside? #(symbol? (deref %)) + queue-inside? #(instance? cljs.core/PersistentQueue (deref %)) + bool-inside? #(boolean? (deref %))] + + (s/def ::chan-id symbol?) + (s/def ::chan-transformer fn?) + (s/def ::poll-interval int?) + (s/def ::take-ready (s/and atom? prom-inside?)) + (s/def ::put-ready (s/and atom? prom-inside?)) + (s/def ::buffer-size (s/and int? pos?)) + (s/def ::chan-lock (s/and atom? (s/or :nil-in nil-inside? + :sym-in symbol-inside?))) + (s/def ::put-promises (s/and atom? queue-inside?)) + (s/def ::take-promises (s/and atom? queue-inside?)) + (s/def ::values-queue (s/and atom? queue-inside?)) + (s/def ::next-take-promise (s/and atom? (s/or :nil-in nil-inside? + :prom-in prom-inside?))) + (s/def ::alts-cb-promise (s/and atom? (s/or :nil-in nil-inside? + :prom-in prom-inside?))) + (s/def ::is-closed? (s/and atom? bool-inside?)) + (s/def ::is-dead? (s/and atom? bool-inside?))) + +(s/def ::chan (s/keys :req-un [::chan-id + ::chan-transformer + ::poll-interval + ::take-ready + ::put-ready + ::buffer-size + ::chan-lock + ::put-promises + ::take-promises + ::values-queue + ::next-take-promise + ::alts-cb-promise + ::is-closed? + ::is-dead?])) + +(defrecord + ^{:doc "Channel implementation as a record of atoms. + +The channel is mostly a mutable object, all mutable fields are atoms. +The fields 'take-ready' and 'put-ready' are used by the main loop to sleep +until these promises gets realised by puts and takes. +"} + Chan + [chan-id + chan-transformer + poll-interval + take-ready + put-ready + buffer-size + chan-lock + put-promises + take-promises + values-queue + next-take-promise + alts-cb-promise + is-closed? + is-dead?] + cljs.core/IEquiv + (-equiv [this o] + (= chan-id (.chan-id o)))) + +(extend-type Chan + IChan + (-closed? [this] + (deref (:is-closed? this))) + (-dead? [this] + (deref (:is-dead? this)))) + +(def ^:private empty-queue (.-EMPTY cljs.core/PersistentQueue)) + +(defn chan + "Create a new channel and start the channel loop to manage it. + + Create the channel with default options or if given any of the optional + arguments try to validate and use those. + + :param buffer-size + If the number of buffered puts exceeds 'buffer-size' realise the put promise + to false and drop it and the value. + If the number of buffered takes exceeds 'buffer-size' realise the take + promise to 'nil' and drop it. + Default: 1024. + + :param transformer + When a value gets taken from the channel apply this function to it and return + the result instead. + + :param delay + To avoid consuming stack space recur on the loop with defer and this delay. + Could be negative in which case the macro defer will use setImmediate instead + of setTimeout. + Default: -1. + + :return + A channel object to use with put!, take!, etc. + " + ([] (chan nil nil nil)) + ([buffer-size] (chan buffer-size nil nil)) + ([buffer-size transformer] (chan buffer-size transformer nil)) + ([buffer-size transformer delay] + (let [c (map->Chan {:chan-id (gensym "chan-") + :poll-interval (or (and (number? delay) + (>= delay 0) + delay) + -1) + :chan-transformer (or (and (fn? transformer) + transformer) + identity) + :take-ready (atom (p/promise)) + :put-ready (atom (p/promise)) + :buffer-size (or (and (number? buffer-size) + (> buffer-size 0) + buffer-size) + 1024) + :chan-lock (atom nil) + :put-promises (atom empty-queue) + :take-promises (atom empty-queue) + :values-queue (atom empty-queue) + :next-take-promise (atom nil) + :alts-cb-promise (atom nil) + :is-closed? (atom false) + :is-dead? (atom false)})] + (chan-loop c) + c))) + +(defn- chan-or-throw + "Throw an exception if the argument isn't a valid shrimp channel. + + :param chan + The shrimp channel. + " + [chan] + (when-not (instance? Chan chan) + (throw (js/Error. "Error: invalid shrimp channel!")))) + +(defn closed? + "Return true if the channel is closed, false otherwise. + + Closed channels accept take operations as long as there are values to take, + after the last value is taken it switches to dead. + Put operations are refused on a closed channel and realise immediately to false. + + :param chan + The shrimp channel. + " + [chan] + (-closed? chan)) + +(defn dead? + "Return true if the channel is dead, false otherwise. + + A channel is dead when after being closed all values are taken, a dead channel + is useless, the loop is stopped, put operations immediately realise to false, + take operations immediately realise to nil. + + :param chan + The shrimp channel. + " + [chan] + (-dead? chan)) + +(defn- close-takes! + "Switch a channel to dead after the values queue has been emptied. + + All remaining take or alts promises are realised to nil. + " + [{:keys [take-promises + next-take-promise + alts-cb-promise + is-dead?]}] + (if (p/promise? @next-take-promise) + (try-realise @next-take-promise nil)) + (reset! next-take-promise nil) + (doseq [prom @take-promises] + (if (p/promise? prom) + (try-realise prom nil) + (do (try-realise (first prom) nil) + (try-realise (second prom) nil)))) + (reset! take-promises empty-queue) + (when (p/promise? @alts-cb-promise) + (try-realise @alts-cb-promise nil)) + (reset! alts-cb-promise nil) + (reset! is-dead? true)) + +(defn- close-do! + "Close the channel and realise all the put promises to nil. + + Helper function called by close!. + " + [{:keys [chan-lock + put-promises + put-ready + take-promises + alts-cb-promise + values-queue + is-closed?] :as chan} tag prom] + (reset! is-closed? true) + (doseq [prom @put-promises] + (try-realise prom nil)) + (reset! put-promises empty-queue) + (try-realise @put-ready true) + (p/realise prom true) + (reset! chan-lock nil)) + +(extend-type Chan + IChan + (-close! + ([this] (-close! this (gensym "close!") (p/promise))) + ([{:keys [is-closed? chan-lock poll-interval] :as this} tag prom] + (if @is-closed? + (p/realise prom false) + (if (= tag (swap! chan-lock #(or %1 %2) tag)) + (close-do! this tag prom) + (defer poll-interval (-close! this tag prom)))) + prom))) + +(defn close! + "Close a channel if not already closed. + + Retry if the channel is busy. + " + [chan] + (-close! chan)) + +(defn- swap-take-promises! + "Advance the take promises queue, handle the case of an alts! promise. + " + [{:keys [take-promises + next-take-promise + alts-cb-promise + take-ready]}] + (let [next-take-prom (peek @take-promises)] + (swap! take-promises pop) + (cond + (vector? next-take-prom) + (let [[cb-prom res-prom] next-take-prom] + (reset! next-take-promise res-prom) + (reset! alts-cb-promise cb-prom)) + + (nil? next-take-prom) + (do + (reset! next-take-promise nil) + (reset! take-ready (p/promise))) + + :else + (reset! next-take-promise next-take-prom)))) + +(defn- chan-loop-do! + "Perform a delivery and handle the case of an alts! promise. + + Realise the next take promise with the next value, realise the corresponding + put promise to true, then advance all queues. + For alts! that already received a value drop the promise and deliver to the next + take. + This is an helper function invoked by chan-loop, it could recur to itself once. + + :param chan + The shrimp channel. + :param tag + A symbol that has been used to acquire the lock. + " + [{:keys [chan-lock + is-closed? + poll-interval + take-promises + take-ready + put-promises + put-ready + values-queue + next-take-promise + alts-cb-promise + chan-transformer] :as chan} tag] + + (let [value (first @values-queue) + take-prom @next-take-promise + put-prom (first @put-promises) + alts-prom @alts-cb-promise] + + (if (p/promise? alts-prom) + (if (p/realised? alts-prom) + (do + (reset! alts-cb-promise nil) + (swap-take-promises! chan) + (reset! chan-lock nil) + (defer poll-interval (chan-loop chan tag))) + (do + (reset! alts-cb-promise nil) + (p/realise take-prom [(chan-transformer value) chan]) + (chan-loop-do! chan tag))) + + (do + (swap-take-promises! chan) + (swap! values-queue pop) + (swap! put-promises pop) + + (when (and (empty? @put-promises) + (not @is-closed?)) + (reset! put-ready (p/promise))) + + (reset! chan-lock nil) + (defer poll-interval (chan-loop chan tag)) + + (and put-prom (p/realise put-prom true)) + (when-not (p/realised? take-prom) + (p/realise take-prom (chan-transformer value))))))) + +(defn- chan-loop + "Call chan-loop-do! to realise the next promise if put and a take are received. + + If the channel is closed and the values queue is empty call close-takes! and + terminate the loop. + + :param chan + The shrimp channel. + + :param tag + A symbol used to acquire the lock, if absent is generated randomly. + " + ([chan] (chan-loop chan (gensym "chan-loop"))) + ([{:keys [is-closed? + take-ready + put-ready + values-queue + poll-interval] :as chan} tag] + (let [empty-values? (< (count @values-queue) 1)] + (if (and @is-closed? empty-values?) + (close-takes! chan) + (when-realised [@put-ready] + (if (and @is-closed? empty-values?) + (close-takes! chan) + (when-realised [@take-ready] + (let [lock (:chan-lock chan)] + (if (= tag (swap! lock #(or %1 %2) tag)) + (chan-loop-do! chan tag) + (defer poll-interval (chan-loop chan tag))))))))))) + +(defn- put-do! + "Perform the put! operation on the channel. + + Helper function called by put!. + " + [{:keys [chan-lock + is-closed? + buffer-size + put-ready + put-promises + values-queue] :as chan} value tag prom] + (if (>= (count @values-queue) buffer-size) + (p/realise prom false) + (do + (try-realise @put-ready true) + (swap! put-promises conj prom) + (swap! values-queue conj value))) + (reset! chan-lock nil)) + +(extend-type Chan + IChan + (-put! + ([this value] (-put! this value (gensym "put!") (p/promise))) + ([{:keys [chan-lock poll-interval is-closed?] :as this} + value tag prom] + (if @is-closed? + (p/realise prom false) + (if (= tag (swap! chan-lock #(or %1 %2) tag)) + (put-do! this value tag prom) + (defer poll-interval (-put! this value tag prom)))) + prom))) + +(defn put! + "Put a value in the channel, return a promise realised when the value is taken. + + Refuse the put! and immediately realise the return promise to 'false' if the + channel is closed or the buffer is full. + + The return promise is realised to 'true' if the value is taken. + If the channel is closed after the put! but before a take!, the return promise + will be realised to 'nil'. + + :param chan + The shrimp channel. + + :param value + The value to put in the channel. + + :return + A callback promise realised after a take or on failure. + " + ([chan value] (-put! chan value))) + +(defn- take-do! + "Perform the take! operation on the channel. + + Helper function called by take!. + " + [{:keys [chan-lock + is-closed? + take-promises + next-take-promise + take-ready + values-queue + buffer-size]} tag prom] + + (if (>= (count @take-promises) buffer-size) + (p/realise prom nil) + (if @next-take-promise + (swap! take-promises conj prom) + (do + (try-realise @take-ready true) + (reset! next-take-promise prom)))) + (reset! chan-lock nil)) + +(extend-type Chan + IChan + (-take! + ([this] (-take! this (gensym "take!") (p/promise))) + ([{:keys [chan-lock poll-interval is-dead?] :as this} tag prom] + (if @is-dead? + (p/realise prom nil) + (if (= tag (swap! chan-lock #(or %1 %2) tag)) + (take-do! this tag prom) + (defer poll-interval (-take! this tag prom)))) + prom))) + +(defn take! + "Perform a take on the channel, return a promise realised with the value. + + Refuse the take and immediately realise the return promise to 'nil' if the + channel is dead, or the buffer is full. + The return promise is placed on the channel and realised as soon as a value is + available and this promise is the first in the queue. + + :param chan + The shrimp channel. + + :param tag + A symbol used to acquire the lock, randomly generated if absent. + + :return + A promise realised to a value from the channel or 'nil' on failure. + " + ([chan] (-take! chan))) + +(defn timeout + "Create a timeout and return a promise that is realised on expiration. + + This method is used by alts! to provide a timeout with an optional default + value. + + :param ms + Delay in milliseconds before the expiration. + + :param value + Realise the returned promise to this value on expiration. + + :param success-fn + Optional callback attached to the return promise and called on realisation. + + :param failure-fn + Optional callback called when the return promise is realised with + 'realise-error'. + + :return + A promise realised on expiration. + " + ([ms] (timeout ms nil nil nil)) + ([ms value success-fn error-fn] + (let [prom (p/promise)] + (when (and success-fn error-fn) + (p/on-realised prom + success-fn + error-fn)) + (js/setTimeout #(p/realise prom value) ms) + prom))) + +(defn- alts-do! + "Perform an alts! on the channel. + + helper function invoked by alts!. + " + [{:keys [chan-lock + is-closed? + take-promises + take-ready + values-queue + next-take-promise + alts-cb-promise + buffer-size]} tag cb-prom res-prom] + + (if (>= (count @take-promises) buffer-size) + (do + (p/realise cb-prom nil) + (p/realise res-prom nil)) + (if @next-take-promise + (swap! take-promises conj [cb-prom res-prom]) + (do + (try-realise @take-ready true) + (reset! next-take-promise res-prom) + (reset! alts-cb-promise cb-prom)))) + (reset! chan-lock nil)) + +(extend-type Chan + IChan + (-alts! + ([this cb-prom] (-alts! this (gensym "alts!") cb-prom (p/promise))) + ([{:keys [chan-lock poll-interval] :as this} + tag cb-prom res-prom] + (if (= tag (swap! chan-lock #(or %1 %2) tag)) + (alts-do! this tag cb-prom res-prom) + (defer poll-interval (-alts! this tag cb-prom res-prom))) + res-prom))) + +(defn alts! + "Try to take from one or more channels, return a promise realised to the first + available value. + + Realise the promise to a vector [value channel]. + Immediately realise the promise to '[nil :dead]' if one or more channels are + dead. + If 'ttime' is provided start a timer with delay 'ttime' that will realise the + alts! promise to '[tvalue :expired]', 'tvalue' defaults to 'nil' if absent. + + :param chans + A seq of shrimp channels. + + :param ttime + Timeout delay in milliseconds. + + :param tvalue + Timeout value to use to realise the alts! promise with. + + :return + A promise realised to a value from a channel, or '[nil :dead]' on failure, + or '[tvalue :expired]' if ttime was defined and no channel had a value to + take before the expiration. + " + ([chans] (alts! chans nil nil)) + ([chans ttime] (alts! chans ttime nil)) + ([chans ttime tvalue] + (let [dtoll (for [chan chans] + (do (chan-or-throw chan) + (deref (:is-dead? chan))))] + + (if (some true? dtoll) + (p/promise [nil :dead]) + (let [res-prom (p/promise) + realise-cb (fn [cb] + (fn [value] + (try-realise cb true) + (try-realise res-prom value))) + + realise-err-cb (fn [cb] + (fn [value] + (try-realise cb true) + (try-realise-error res-prom value))) + cb-prom (p/promise) + realised (fn [value] + (try-realise cb-prom true) + (try-realise res-prom value)) + realised-err (fn [value] + (try-realise cb-prom true) + (try-realise-error res-prom value)) + proms (doall (map #(-alts! % cb-prom) chans))] + + (doseq [alts-prom proms] + (p/on-realised alts-prom + (realise-cb cb-prom) + (realise-err-cb cb-prom))) + + (when ttime + (timeout ttime + [tvalue :expired] + realised + realised-err)) + + res-prom))))) diff --git a/src/cljs/shrimp/test.cljs b/src/cljs/shrimp/test.cljs new file mode 100644 index 0000000..69a6eb5 --- /dev/null +++ b/src/cljs/shrimp/test.cljs @@ -0,0 +1,78 @@ +;; Copyright © 2017 Giuseppe Zerbo. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns shrimp.test + (:require [shrimp.core :as sp] + [cljs.test :as t] + [redlobster.promise :as p]) + (:use-macros [redlobster.macros :only [let-realised]] + [shrimp.macros :only [defer]])) + +(defonce ^:private one-test-data (atom nil)) +(defonce ^:private all-tests-data (atom nil)) +(defonce ^:private test-ch (atom nil)) +(defonce tests-done (atom nil)) + +(defn init! [] + (reset! all-tests-data + {:tests 0 :pass 0 + :fail 0 :error 0}) + (reset! test-ch (sp/chan))) + +(defn inc-report-counter! [orig-inc-report!] + (fn [name] + (sp/put! @test-ch name) + (orig-inc-report! name))) + +(defmethod cljs.test/report [:cljs.test/default :summary] [m] + (let [tot (:test m)] + (swap! one-test-data assoc :tot tot))) + +(defn- print-results! [data] + (let [{:keys [tests fail error pass]} data] + (println "\nRan" tests "tests containing" + (+ pass fail error) "assertions.") + (println fail "failures," error "errors."))) + +(defn reset-collection! [] + (reset! tests-done (p/promise)) + (swap! all-tests-data #(merge-with + % @one-test-data)) + (reset! one-test-data + {:tests 0 :pass 0 + :fail 0 :error 0})) + +(defn close! [] + (println "\nAll namespaces:") + (print-results! (swap! all-tests-data + #(merge-with + % @one-test-data))) + (sp/close! @test-ch)) + +(defn- test-complete! [] + (let [curr (-> one-test-data + (swap! update :tests inc) + :tests) + tot (:tot @one-test-data)] + (when (and tot (= curr tot)) + (print-results! @one-test-data) + (p/realise @tests-done true)))) + +(defn collect-results! [] + (let-realised [prom (sp/take! @test-ch)] + (if @prom + (do + (case @prom + :done (test-complete!) + :pass (swap! one-test-data update :pass inc) + :error (swap! one-test-data update :error inc) + :fail (swap! one-test-data update :fail inc)) + (defer 50 (collect-results!))) + nil))) + +(defn done! + ([] (done! nil)) + ([test-id] + (when test-id + (println "Completing" test-id)) + (sp/put! @test-ch :done))) diff --git a/test/cljs/shrimp/core_test.cljs b/test/cljs/shrimp/core_test.cljs new file mode 100644 index 0000000..32882b0 --- /dev/null +++ b/test/cljs/shrimp/core_test.cljs @@ -0,0 +1,109 @@ +;; Copyright © 2017 Giuseppe Zerbo. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns shrimp.core-test + (:require [cljs.test :refer [deftest is]] + [cljs.spec.alpha :as s] + [shrimp.core :as sc :refer [put! take! alts!]] + [shrimp.test :as st] + [redlobster.promise :as p]) + (:use-macros [redlobster.macros :only [when-realised let-realised]] + [shrimp.macros :only [defer defer-loop]])) + +(deftest put-take + (let [chan (sc/chan) + value :foo + put-prom (put! chan value) + take-prom (take! chan)] + (is (s/valid? :shrimp.core/chan chan) "put-take spec") + (defer 2000 (do + (sc/try-realise take-prom nil) + (sc/try-realise put-prom nil))) + (when-realised [put-prom take-prom] + (is (= @put-prom true) "put-take put") + (is (= @take-prom value) "put-take take") + (when-realised [(sc/close! chan)] + (is (sc/closed? chan) "put-take close") + (is (s/valid? :shrimp.core/chan chan) "put-take spec #2") + (st/done! 'put-take))))) + +(deftest put-alts + (let [chan1 (sc/chan 100 inc) + chan2 (sc/chan 100 #(* -1 %)) + value (atom 0) + alts-prom (alts! [chan1 chan2]) + put-prom (put! chan1 (swap! value inc))] + + (defer 2000 (do + (sc/try-realise alts-prom [nil nil]) + (sc/try-realise put-prom nil))) + + (when-realised [put-prom alts-prom] + (is (= @put-prom true) "put-alts put #1") + (let [[v ch] @alts-prom] + (is (= ch chan1) "put-alts chan #1") + (is (= v 2) "put-alts value #1")) + + (is (s/valid? :shrimp.core/chan chan1) "put-alts spec #1") + (is (s/valid? :shrimp.core/chan chan2) "put-alts spec #2") + + (let [alts-prom (alts! [chan1 chan2] 500 :foo) + put-prom (put! chan2 (swap! value inc))] + + (defer 2000 (do + (sc/try-realise alts-prom [nil nil]) + (sc/try-realise put-prom nil))) + + (when-realised [put-prom alts-prom] + (is (= @put-prom true) "put-alts put #2") + (let [[v ch] @alts-prom] + (is (= ch chan2) "put-alts chan #2") + (is (= v -2) "put-alts value #2")) + + (let [alts-prom (alts! [chan1 chan2] 500 :foo)] + + (defer 2000 (sc/try-realise alts-prom [nil nil])) + + (when-realised [alts-prom] + (let [[v ch] @alts-prom] + (is (= ch :expired) "put-alts chan #3") + (is (= v :foo) "put-alts value #3")) + + (when-realised [(sc/close! chan1) + (sc/close! chan2)] + (is (sc/closed? chan1) "put-alts close #1") + (is (sc/closed? chan2) "put-alts close #2") + + (let-realised [alts-prom (alts! [chan1 chan2] 500 :foo)] + (let [[v ch] @alts-prom] + (is (= ch :dead) "put-alts chan dead") + (is (= v nil) "put-alts value nil")) + (st/done! 'put-alts)))))))))) + +(deftest take-loop-test + (let [n 1000 + chan (sc/chan (* n 2)) + end (p/promise) + r (range n)] + (doseq [i r] + (put! chan i)) + (sc/close! chan) + + (is (s/valid? :shrimp.core/chan chan) "take-loop spec #1") + + (defer-loop [chan chan acc [] end end] + (if (sc/dead? chan) + (p/realise end acc) + (let-realised [prom (take! chan)] + (defer-recur chan (conj acc @prom) end)))) + + (when-realised [end] + ;; end could contain a nil at the end + (is (= r (take n @end)) "take-loop acc") + (let-realised [prom (take! chan)] + (is (= nil @prom) "take-loop after close!") + (is (sc/dead? chan) "take-loop dead?") + (is (s/valid? :shrimp.core/chan chan) "take-loop spec #2") + (st/done! 'take-loop))))) diff --git a/test/cljs/shrimp/tests.cljs b/test/cljs/shrimp/tests.cljs new file mode 100644 index 0000000..4895385 --- /dev/null +++ b/test/cljs/shrimp/tests.cljs @@ -0,0 +1,18 @@ +;; Copyright © 2017 Giuseppe Zerbo. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns shrimp.tests + (:require [shrimp.core-test] + [cljs.nodejs :as nodejs]) + (:use-macros [shrimp.test.macros :only [run-async-tests]])) + +(nodejs/enable-util-print!) + +(defn -main + [& args] + (run-async-tests + shrimp.core-test)) + +(set! *main-cli-fn* -main)