From: Andreas Gerler Date: Sun, 22 Dec 2024 12:48:37 +0000 (+0100) Subject: add promise X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=5d33b0960b681403c91b65dcb2537020956c059f;p=emacsconfig.git add promise Signed-off-by: Andreas Gerler --- diff --git a/elpa/promise-20210307.727/promise-autoloads.el b/elpa/promise-20210307.727/promise-autoloads.el new file mode 100644 index 00000000..c1618bd7 --- /dev/null +++ b/elpa/promise-20210307.727/promise-autoloads.el @@ -0,0 +1,104 @@ +;;; promise-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from promise.el + +(autoload 'promise-chain "promise" "\ +Extract PROMISE, BODY include then, catch, done and finally. + +Extract the following code... + + (promise-chain (promise-new ...) + (then + (lambda (value) + ...)) + + (catch + (lambda (reason) + ...)) + + (done + (lambda (value) + ...)) + + (finally + (lambda () ...)) + + ;; Anaphoric versions of `then' and `catch'. + + (thena (message \"result -> %s\" result) + ...) + + (catcha (message \"error: reason -> %s\" reason) + ...)) + +as below. + + (let ((promise (promise-new ...))) + (setf promise (promise-then promise + (lambda (value) + ...))) + + (setf promise (promise-catch promise + (lambda (value) + ...))) + + (setf promise (promise-done promise + (lambda (reason) + ...))) + + (setf promise (promise-finally promise + (lambda () + ...))) + + (setf promise (promise-then promise + (lambda (result) + (message \"result -> %s\" result) + ...))) + + (setf promise (promise-catch promise + (lambda (reason) + (message \"error: reason -> %s\" reason) + ...))) + promise) + +(fn PROMISE &rest BODY)" nil t) +(function-put 'promise-chain 'lisp-indent-function 1) +(register-definition-prefixes "promise" '("promise")) + + +;;; Generated autoloads from promise-core.el + +(register-definition-prefixes "promise-core" '("promise-")) + + +;;; Generated autoloads from promise-es6-extensions.el + +(register-definition-prefixes "promise-es6-extensions" '("promise-")) + + +;;; Generated autoloads from promise-rejection-tracking.el + +(register-definition-prefixes "promise-rejection-tracking" '("promise-")) + +;;; End of scraped data + +(provide 'promise-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; promise-autoloads.el ends here diff --git a/elpa/promise-20210307.727/promise-core.el b/elpa/promise-20210307.727/promise-core.el new file mode 100644 index 00000000..567ff5e1 --- /dev/null +++ b/elpa/promise-20210307.727/promise-core.el @@ -0,0 +1,262 @@ +;;; promise-core.el --- This is a simple implementation of Promises/A+. -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2017 chuntaro + +;; Author: chuntaro +;; URL: https://github.com/chuntaro/emacs-promise +;; Keywords: async promise convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; The original JavaScript code is: +;; +;; Copyright (c) 2014 Forbes Lindesay +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +;; THE SOFTWARE. + +;;; Commentary: + +;; This implementation ported the following Promises/A+ implementation faithfully. +;; https://github.com/then/promise/blob/master/src/core.js +;; +;; This file contains the core Promises/A+ API. +;; (promise-new fn) or (make-instance 'promise-class :fn fn) +;; (promise-then ((this promise-class) &optional on-fulfilled on-rejected)) + +;;; Code: + +(require 'eieio) +(require 'cl-lib) +(eval-when-compile (require 'subr-x)) + +(defun promise--asap (task) + (run-at-time 0.001 nil task)) + +(defun promise--type-of (obj) + (cond + ((not (vectorp obj)) + (type-of obj)) + ((cl-struct-p obj) + ;; Code copied from `cl--describe-class'. + (cl--class-name (symbol-value (aref obj 0)))) + ((eieio-object-p obj) + (eieio-object-class obj)) + (t + 'vector))) + +(defun promise--is-object (obj) + (or (cl-struct-p obj) + (eieio-object-p obj))) + +(defsubst promise--find-then-method (obj) + (cl-find-method #'promise-then '() (list (promise--type-of obj)))) + +(defun promise--find-then-function (obj) + (when-let (method (promise--find-then-method obj)) + (cl--generic-method-function method))) + +;; States: +;; +;; 0 - pending +;; 1 - fulfilled with _value +;; 2 - rejected with _value +;; 3 - adopted the state of another promise, _value +;; +;; once the state is no longer pending (0) it is immutable + +;; to avoid using condition-case inside critical functions, we +;; extract them to here. +(defvar promise--last-error nil) +(defconst promise--is-error (cl-gensym "promise-error")) +(defun promise--get-then (obj) + (condition-case ex + (promise--find-then-function obj) + (error (setf promise--last-error ex) + promise--is-error))) + +(defun promise--try-call-one (fn a) + (condition-case ex + (funcall fn a) + (error (setf promise--last-error ex) + promise--is-error))) + +(defun promise--try-call-two (fn a b) + (condition-case ex + (funcall fn a b) + (error (setf promise--last-error ex) + promise--is-error))) + +(defclass promise-class () + ((_deferred-state :accessor promise-_deferred-state :initform 0) + (_state :accessor promise-_state :initform 0) + (_value :accessor promise-_value :initform nil) + (_deferreds :accessor promise-_deferreds :initform nil) + ;; for rejection-tracking + (_rejection-id :accessor promise-_rejection-id :initform nil))) +(defvar promise--on-handle nil) +(defvar promise--on-reject nil) + +(cl-defmethod initialize-instance ((this promise-class) &optional args) + (cl-call-next-method this) + (let ((fn (plist-get args :fn))) + (unless (eq fn #'ignore) + (promise--do-resolve fn this)))) + +(defun promise-new (fn) + (make-instance 'promise-class :fn fn)) + +(cl-defmethod promise-then ((this promise-class) &optional on-fulfilled on-rejected) + (if (not (eq (promise--type-of this) 'promise-class)) + (promise--safe-then this on-fulfilled on-rejected) + (let ((res (promise-new #'ignore))) + (promise--handle this + (promise--handler-new on-fulfilled + on-rejected + res)) + res))) + +(defun promise--safe-then (self on-fulfilled on-rejected) + (make-instance (promise--type-of self) + :fn (lambda (resolve reject) + (let ((res (promise-new #'ignore))) + (promise-then res resolve reject) + (promise--handle self + (promise--handler-new on-fulfilled + on-rejected + res)))))) + +(defun promise--handle (self deferred) + (while (= (promise-_state self) 3) + (setf self (promise-_value self))) + (when promise--on-handle + (funcall promise--on-handle self)) + (if (= (promise-_state self) 0) + (cond + ((= (promise-_deferred-state self) 0) + (setf (promise-_deferred-state self) 1 + (promise-_deferreds self) deferred)) + ((= (promise-_deferred-state self) 1) + (setf (promise-_deferred-state self) 2 + (promise-_deferreds self) (list (promise-_deferreds self) + deferred))) + (t + (setf (promise-_deferreds self) (nconc (promise-_deferreds self) + (list deferred))))) + (promise--handle-resolved self deferred))) + +(defun promise--handle-resolved (self deferred) + (promise--asap + (lambda () + (let-alist deferred + (let ((cb (if (= (promise-_state self) 1) .on-fulfilled .on-rejected))) + (if (not cb) + (if (= (promise-_state self) 1) + (promise--resolve .promise (promise-_value self)) + (promise--reject .promise (promise-_value self))) + (let ((ret (promise--try-call-one cb (promise-_value self)))) + (if (eq ret promise--is-error) + (promise--reject .promise promise--last-error) + (promise--resolve .promise ret))))))))) + +(defun promise--resolve (self new-value) + "Promise Resolution Procedure. +See: https://github.com/promises-aplus/promises-spec#the-promise-resolution-procedure" + (cl-block nil + (when (eq new-value self) + (cl-return (promise--reject + self + '(wrong-type-argument + "A promise cannot be resolved with itself.")))) + (when (and new-value + (promise--is-object new-value)) + (let ((then (promise--get-then new-value))) + (when (eq then promise--is-error) + (cl-return (promise--reject self promise--last-error))) + (cond + ((and (eq then (ignore-errors (promise--find-then-function self))) + (promise-class-p new-value)) + (setf (promise-_state self) 3 + (promise-_value self) new-value) + (promise--finale self) + (cl-return)) + ((functionp then) + (promise--do-resolve (lambda (resolve reject) + (promise-then new-value resolve reject)) + self) + (cl-return))))) + (setf (promise-_state self) 1 + (promise-_value self) new-value) + (promise--finale self))) + +(defun promise--reject (self new-value) + (setf (promise-_state self) 2 + (promise-_value self) new-value) + (when promise--on-reject + (funcall promise--on-reject self new-value)) + (promise--finale self)) + +(defun promise--finale (self) + (when (= (promise-_deferred-state self) 1) + (promise--handle self (promise-_deferreds self)) + (setf (promise-_deferreds self) nil)) + (when (= (promise-_deferred-state self) 2) + (dolist (deferred (promise-_deferreds self)) + (promise--handle self deferred)) + (setf (promise-_deferreds self) nil)) + nil) + +(defun promise--handler-new (on-fulfilled on-rejected promise) + `((on-fulfilled . ,(and (functionp on-fulfilled) on-fulfilled)) + (on-rejected . ,(and (functionp on-rejected) on-rejected)) + (promise . ,promise))) + +;; Take a potentially misbehaving resolver function and make sure +;; onFulfilled and onRejected are only called once. +;; +;; Makes no guarantees about asynchrony. +(defun promise--do-resolve (fn promise) + (let* ((done nil) + (res (promise--try-call-two + fn + (lambda (&optional value) + (unless done + (setf done t) + (promise--resolve promise value))) + (lambda (&optional reason) + (unless done + (setf done t) + (promise--reject promise reason)))))) + (when (and (not done) + (eq res promise--is-error)) + (setf done t) + (promise--reject promise promise--last-error)))) + +(provide 'promise-core) +;;; promise-core.el ends here diff --git a/elpa/promise-20210307.727/promise-done.el b/elpa/promise-20210307.727/promise-done.el new file mode 100644 index 00000000..8a9a83f1 --- /dev/null +++ b/elpa/promise-20210307.727/promise-done.el @@ -0,0 +1,64 @@ +;;; promise-done.el --- Porting done.js -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2017 chuntaro + +;; Author: chuntaro +;; URL: https://github.com/chuntaro/emacs-promise +;; Keywords: async promise convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; The original JavaScript code is: +;; +;; Copyright (c) 2014 Forbes Lindesay +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +;; THE SOFTWARE. + +;;; Commentary: + +;; This implementation ported the following implementation faithfully. +;; https://github.com/then/promise/blob/master/src/done.js + +;;; Code: + +(require 'promise-core) + +(cl-defmethod promise-done ((this promise-class) &optional on-fulfilled on-rejected) + (let ((self (if (or on-fulfilled on-rejected) + (promise-then this on-fulfilled on-rejected) + this))) + (promise-then self nil (lambda (err) + (run-at-time 0 nil + (lambda () + (signal 'error (list err))))))) + nil) + +(provide 'promise-done) +;;; promise-done.el ends here diff --git a/elpa/promise-20210307.727/promise-es6-extensions.el b/elpa/promise-20210307.727/promise-es6-extensions.el new file mode 100644 index 00000000..251fa849 --- /dev/null +++ b/elpa/promise-20210307.727/promise-es6-extensions.el @@ -0,0 +1,163 @@ +;;; promise-es6-extensions.el --- Porting es6-extensions.js -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2017 chuntaro + +;; Author: chuntaro +;; URL: https://github.com/chuntaro/emacs-promise +;; Keywords: async promise convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; The original JavaScript code is: +;; +;; Copyright (c) 2014 Forbes Lindesay +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +;; THE SOFTWARE. + +;;; Commentary: + +;; This implementation ported the following implementation faithfully. +;; https://github.com/then/promise/blob/master/src/es6-extensions.js +;; +;; This file contains the ES6 extensions to the core Promises/A+ API. +;; (promise-resolve value) +;; (promise-all [values...]) +;; (promise-reject value) +;; (promise-race [values...]) +;; (promise-catch ((this promise-class) on-rejected)) + +;;; Code: + +(require 'promise-core) + +(defsubst promise--then-function () + (ignore-errors + (cl--generic-method-function (cl-find-method #'promise-then + '() + '(promise-class))))) + +;; Static Functions + +(defun promise--value (value) + (let ((p (promise-new #'ignore))) + (setf (promise-_state p) 1 + (promise-_value p) value) + p)) + +(defconst promise-t (promise--value t)) +(defconst promise-nil (promise--value nil)) +(defconst promise-zero (promise--value 0)) +(defconst promise-emptystring (promise--value "")) + +(defun promise-resolve (value) + (cond + ((promise-class-p value) value) + + ((eq value t) promise-t) + ((eq value nil) promise-nil) + ((eq value 0) promise-zero) + ((eq value "") promise-emptystring) + + ((promise--is-object value) + (condition-case ex + (let ((then (ignore-errors (promise--find-then-function value)))) + (if (functionp then) + (promise-new (lambda (resolve reject) + (promise-then value resolve reject))) + (promise--value value))) + (error (promise-new (lambda (_resolve reject) + (funcall reject ex)))))) + (t + (promise--value value)))) + +(defun promise-all (arr) + (let ((args (cl-coerce arr 'vector))) + + (promise-new + (lambda (resolve reject) + (if (zerop (length args)) + (funcall resolve []) + (let ((remaining (length args))) + (cl-labels + ((res (i val) + (cl-block nil + (when (and val (promise--is-object val)) + (cond + ((and (promise-class-p val) + (eq (promise--find-then-function val) + (promise--then-function))) + (while (= (promise-_state val) 3) + (setf val (promise-_value val))) + (when (= (promise-_state val) 1) + (cl-return (res i (promise-_value val)))) + (when (= (promise-_state val) 2) + (funcall reject (promise-_value val))) + (promise-then val + (lambda (val) + (res i val)) + reject) + (cl-return)) + (t + (let ((then (ignore-errors + (promise--find-then-function val)))) + (when (functionp then) + (let ((p (promise-new + (lambda (resolve reject) + (promise-then val + resolve + reject))))) + (promise-then p + (lambda (val) + (res i val)) + reject) + (cl-return))))))) + (setf (aref args i) val) + (when (zerop (cl-decf remaining)) + (funcall resolve args))))) + (cl-loop for i from 0 + for arg across args + do (res i arg))))))))) + +(defun promise-reject (value) + (promise-new (lambda (_resolve reject) + (funcall reject value)))) + +(defun promise-race (values) + (promise-new (lambda (resolve reject) + (cl-loop for value across (cl-coerce values 'vector) + do (promise-then (promise-resolve value) + resolve + reject))))) + +(cl-defmethod promise-catch ((this promise-class) on-rejected) + (promise-then this nil on-rejected)) + +(provide 'promise-es6-extensions) +;;; promise-es6-extensions.el ends here diff --git a/elpa/promise-20210307.727/promise-finally.el b/elpa/promise-20210307.727/promise-finally.el new file mode 100644 index 00000000..bf8c7319 --- /dev/null +++ b/elpa/promise-20210307.727/promise-finally.el @@ -0,0 +1,64 @@ +;;; promise-finally.el --- Porting finally.js -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2017 chuntaro + +;; Author: chuntaro +;; URL: https://github.com/chuntaro/emacs-promise +;; Keywords: async promise convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; The original JavaScript code is: +;; +;; Copyright (c) 2014 Forbes Lindesay +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +;; THE SOFTWARE. + +;;; Commentary: + +;; This implementation ported the following implementation faithfully. +;; https://github.com/then/promise/blob/master/src/finally.js + +;;; Code: + +(require 'promise-es6-extensions) + +(cl-defmethod promise-finally ((this promise-class) f) + (promise-then this + (lambda (value) + (promise-then (promise-resolve (funcall f)) + (lambda (_) value))) + (lambda (err) + (promise-then (promise-resolve (funcall f)) + (lambda (_) + (promise-reject err)))))) + +(provide 'promise-finally) +;;; promise-finally.el ends here diff --git a/elpa/promise-20210307.727/promise-pkg.el b/elpa/promise-20210307.727/promise-pkg.el new file mode 100644 index 00000000..4bec7125 --- /dev/null +++ b/elpa/promise-20210307.727/promise-pkg.el @@ -0,0 +1,14 @@ +(define-package "promise" "20210307.727" "Promises/A+" + '((emacs "25.1")) + :commit "cec51feb5f957e8febe6325335cf57dc2db6be30" :authors + '(("chuntaro" . "chuntaro@sakura-games.jp")) + :maintainers + '(("chuntaro" . "chuntaro@sakura-games.jp")) + :maintainer + '("chuntaro" . "chuntaro@sakura-games.jp") + :keywords + '("async" "promise" "convenience") + :url "https://github.com/chuntaro/emacs-promise") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/promise-20210307.727/promise-rejection-tracking.el b/elpa/promise-20210307.727/promise-rejection-tracking.el new file mode 100644 index 00000000..c91f8132 --- /dev/null +++ b/elpa/promise-20210307.727/promise-rejection-tracking.el @@ -0,0 +1,151 @@ +;;; promise-rejection-tracking.el --- Porting rejection-tracking.js -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2017 chuntaro + +;; Author: chuntaro +;; URL: https://github.com/chuntaro/emacs-promise +;; Keywords: async promise convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; The original JavaScript code is: +;; +;; Copyright (c) 2014 Forbes Lindesay +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +;; THE SOFTWARE. + +;;; Commentary: + +;; This implementation ported the following implementation faithfully. +;; https://github.com/then/promise/blob/master/src/rejection-tracking.js + +;; TODO: Display easy-to-read backtrace + +;;; Code: + +(require 'promise-core) + +(defun promise--warn (message &rest args) + (display-warning 'promise (apply #'format-message message args))) + +(defvar promise--default-whitelist '(void-function + void-variable + wrong-type-argument + args-out-of-range)) + +(defvar promise--enabled nil) + +(defun promise-rejection-tracking-disable () + (setf promise--enabled nil + promise--on-handle nil + promise--on-reject nil)) + +(defun promise-rejection-tracking-enable (&optional options) + (when promise--enabled (promise-rejection-tracking-disable)) + (setf promise--enabled t) + (let ((id -1) + (display-id -1) + (rejections (make-hash-table))) + (cl-flet* + ((rejections (id symbol) (alist-get symbol (gethash id rejections))) + (rejections-set (id symbol value) + (setf (alist-get symbol (gethash id rejections)) + value)) + (options (sym) (alist-get sym options)) + + (on-unhandled (id) + (when (or (options 'all-rejections) + (promise--match-whitelist + (rejections id 'error) + (or (options 'whitelist) + promise--default-whitelist))) + (rejections-set id 'display-id (cl-incf display-id)) + (cond + ((options 'on-unhandled) + (rejections-set id 'logged t) + (funcall (options 'on-unhandled) + (rejections id 'display-id) + (rejections id 'error))) + (t + (rejections-set id 'logged t) + (promise--log-error (rejections id 'display-id) + (rejections id 'error)))))) + (on-handled (id) + (when (rejections id 'logged) + (cond + ((options 'on-handled) + (funcall (options 'on-handled) + (rejections id 'display-id) + (rejections id 'error))) + ((not (rejections id 'on-unhandled)) + (promise--warn "Promise Rejection Handled (id:%d):" + (rejections id 'display-id)) + (promise--warn " This means you can ignore any previous messages of the form \"Possible Unhandled Promise Rejection\" with id %d." + (rejections id 'display-id))))))) + (setf promise--on-handle + (lambda (promise) + (when (and (= (promise-_state promise) 2) ; IS REJECTED + (gethash (promise-_rejection-id promise) rejections)) + (if (rejections (promise-_rejection-id promise) 'logged) + (on-handled (promise-_rejection-id promise)) + (cancel-timer (rejections (promise-_rejection-id promise) 'timeout))) + (remhash (promise-_rejection-id promise) rejections))) + promise--on-reject + (lambda (promise err) + (when (zerop (promise-_deferred-state promise)) ; not yet handled + (setf (promise-_rejection-id promise) (cl-incf id)) + (puthash (promise-_rejection-id promise) + `((display-id . nil) + (error . ,err) + (timeout . ,(run-at-time + (if (promise--match-whitelist + err promise--default-whitelist) + 0.1 + 2) + nil + (lambda () + (on-unhandled (promise-_rejection-id promise))))) + (logged . nil)) + rejections))))))) + +(defun promise--log-error (id error) + (promise--warn "Possible Unhandled Promise Rejection (id:%d):" id) + (display-warning 'promise (prin1-to-string error))) + +(defun promise--match-whitelist (error list) + (cl-some (lambda (cls) + (eq (or (and (consp error) + (car error)) + error) + cls)) + list)) + +(provide 'promise-rejection-tracking) +;;; promise-rejection-tracking.el ends here diff --git a/elpa/promise-20210307.727/promise.el b/elpa/promise-20210307.727/promise.el new file mode 100644 index 00000000..8e1fd29c --- /dev/null +++ b/elpa/promise-20210307.727/promise.el @@ -0,0 +1,711 @@ +;;; promise.el --- Promises/A+ -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2017 chuntaro + +;; Author: chuntaro +;; URL: https://github.com/chuntaro/emacs-promise +;; Package-Requires: ((emacs "25.1")) +;; Version: 1.1 +;; Keywords: async promise convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; The original JavaScript code is: +;; +;; Copyright (c) 2014 Forbes Lindesay +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +;; THE SOFTWARE. + +;;; Commentary: + +;; This is a simple implementation of Promises/A+. +;; +;; This implementation ported the following Promises/A+ implementation faithfully. +;; https://github.com/then/promise +;; +;; * The same API as JavaScript version Promise can be used. +;; * then, catch, resolve, reject, all, race, etc... +;; * supports "thenable" +;; * supports "Inheritance of Promise" +;; * supports "rejection-tracking" +;; +;; Usage: +;; See `promise-examples.el' for details. +;; https://raw.githubusercontent.com/chuntaro/emacs-promise/master/examples/promise-examples.el +;; You can check the operation while downloading and running it interactively. +;; +;; (require 'promise) +;; +;; ;; Please be sure to enable it when developing. +;; (promise-rejection-tracking-enable '((all-rejections . t))) +;; +;; (defun do-something-async (delay-sec value) +;; "Return `Promise' to resolve the value asynchronously." +;; (promise-new (lambda (resolve _reject) +;; (run-at-time delay-sec +;; nil +;; (lambda () +;; (funcall resolve value)))))) +;; +;; (defun example4 () +;; "All processes are asynchronous Promise chain." +;; (promise-chain (do-something-async 1 33) +;; (then (lambda (result) +;; (message "first result: %s" result) +;; (do-something-async 1 (* result 2)))) +;; +;; (then (lambda (second-result) +;; (message "second result: %s" second-result) +;; (do-something-async 1 (* second-result 2)))) +;; +;; (then (lambda (third-result) +;; (message "third result: %s" third-result))))) + +;;; Code: + +(require 'promise-es6-extensions) +(require 'promise-done) +(require 'promise-finally) +(require 'promise-rejection-tracking) + +;;;###autoload +(defmacro promise-chain (promise &rest body) + "Extract PROMISE, BODY include then, catch, done and finally. + +Extract the following code... + + (promise-chain (promise-new ...) + (then + (lambda (value) + ...)) + + (catch + (lambda (reason) + ...)) + + (done + (lambda (value) + ...)) + + (finally + (lambda () ...)) + + ;; Anaphoric versions of `then' and `catch'. + + (thena (message \"result -> %s\" result) + ...) + + (catcha (message \"error: reason -> %s\" reason) + ...)) + +as below. + + (let ((promise (promise-new ...))) + (setf promise (promise-then promise + (lambda (value) + ...))) + + (setf promise (promise-catch promise + (lambda (value) + ...))) + + (setf promise (promise-done promise + (lambda (reason) + ...))) + + (setf promise (promise-finally promise + (lambda () + ...))) + + (setf promise (promise-then promise + (lambda (result) + (message \"result -> %s\" result) + ...))) + + (setf promise (promise-catch promise + (lambda (reason) + (message \"error: reason -> %s\" reason) + ...))) + promise)" + (declare (indent 1) (debug t)) + `(let ((promise ,promise)) + ,@(mapcar (lambda (sexp) + (let ((fn (car-safe sexp)) + (args (cdr-safe sexp))) + (cl-case fn + (promise-new + `(setf promise ,sexp)) + ((promise-then + promise-catch + promise-done + promise-finally) + `(setf promise (,fn promise ,@args))) + (catch + `(setf promise (promise-catch promise ,@args))) + (then + `(setf promise (promise-then promise ,@args))) + (done + `(setf promise (promise-done promise ,@args))) + (finally + `(setf promise (promise-finally promise ,@args))) + (thena + `(setf promise (promise-then promise (lambda (result) ,@args)))) + (catcha + `(setf promise (promise-catch promise (lambda (reason) ,@args)))) + (otherwise + sexp)))) + body) + promise)) + +;; +;; Promise version of various utility functions +;; + +(require 'url-http) + +(defun promise:run-at-time (time function &rest args) + "Return promise to funcall FUNCTION with ARGS at specified TIME. + +Arguments: + - TIME can accept the various formats. See `run-at-time'. + - FUNCTION is funcalled with ARGS. + +Resolve: + - The return value from funcalled FUNCTION. + +Reject: + - " + (declare (indent 1)) + (promise-new + (lambda (resolve _reject) + (run-at-time time nil + (lambda () + (funcall resolve (apply function args))))))) + +(defun promise:delay (time &optional value) + "Return promise to delay specified TIME. + +Arguments: + - TIME can accept the various formats. See `run-at-time'. + - VALUE is return value when resolved this function. + +Resolve: + - VALUE + +Reject: + - " + (declare (indent 1)) + (promise-new + (lambda (resolve _reject) + (run-at-time time + nil + (lambda () + (funcall resolve value)))))) + +(defun promise:time-out (time &optional reason) + "Return promise to reject after specified TIME with REASON. + +Arguments: + - TIME an accept various format. See `run-at-time'. + - REASON is return value when rejected this function. + +Resolve: + - + +Reject: + - REASON" + (declare (indent 1)) + (promise-new + (lambda (_resolve reject) + (run-at-time time nil + (lambda () + (funcall reject reason)))))) + +(defun promise:make-process (command) + "Return promise to make new asynchronous COMMAND. + +Arguments: + - COMMAND is program and shell arguments list of string. + +See `promise:make-process-with-handler' for Resolve and Reject sections." + (funcall #'promise:make-process-with-handler command)) + +(defun promise:make-process-send-buffer (command buf) + "Return promise to make new asynchronous COMMAND. + +Arguments: + - COMMAND is program and shell arguments list of string. + - BUF is buffer, a format that can be accepted by `with-current-buffer'. + `buffer-string' of BUF is sent with EOF after process has been invoked. + +See `promise:make-process-with-handler' for Resolve and Reject sections." + (funcall #'promise:make-process-with-handler + command + (lambda (proc) + (with-current-buffer buf + (process-send-region proc (point-min) (point-max)) + (process-send-eof proc))))) + +(defun promise:make-process-send-string (command string) + "Return promise to make new asynchronous COMMAND. + +Arguments: + - COMMAND is program and shell arguments list of string. + - STRING is sent with EOF after process has been invoked. + +See `promise:make-process-with-handler' for Resolve and Reject sections." + (funcall #'promise:make-process-with-handler + command + (lambda (proc) + (process-send-string proc string) + (process-send-eof proc)))) + +(defun promise:make-process-with-handler (command &optional handler merge-stderr) + "Return promise to make new asynchronous COMMAND. + +Arguments: + - COMMAND is program and shell arguments list of string. + - HANDLER is function, called with process object after program is invoked. + - MERGE-STDERR is boolean, whether merge stdout and stderr or not. + +Resolve: + - A list like as (stdout stderr) when process finish with exitcode 0. + stdout and stderr are string. + +Reject: + - A list like as (event stdout stderr) when process doesn't finish exitcode 0. + event, stdout and stderr are string. + The event is documented at https://www.gnu.org/software/emacs/manual/html_node/elisp/Sentinels.html" + (promise-new + (lambda (resolve reject) + (let* ((program (car command)) + (stdout (generate-new-buffer (concat "*" program "-stdout*"))) + (stderr (unless merge-stderr + (generate-new-buffer (concat "*" program "-stderr*")))) + (stderr-pipe (unless merge-stderr + (make-pipe-process + :name (concat "*" program "-stderr-pipe*") + :noquery t + ;; use :filter instead of :buffer, to get rid of "Process Finished" lines + :filter (lambda (_ output) + (with-current-buffer stderr + (insert output)))))) + (cleanup (lambda () + (kill-buffer stdout) + (unless merge-stderr + (delete-process stderr-pipe) + (kill-buffer stderr))))) + (condition-case err + (let ((proc (if merge-stderr + (make-process :name program :buffer stdout :command command) + (make-process :name program :buffer stdout :command command :stderr stderr-pipe)))) + (set-process-sentinel + proc + (lambda (_process event) + (unwind-protect + (let ((stdout-str (with-current-buffer stdout + (buffer-string))) + (stderr-str (unless merge-stderr + (with-current-buffer stderr + (buffer-string))))) + (if (string= event "finished\n") + (funcall resolve (list stdout-str stderr-str)) + (funcall reject (list event stdout-str stderr-str)))) + (funcall cleanup)))) + (when handler + (funcall handler proc))) + (error (funcall cleanup) + (signal (car err) (cdr err)))))))) + +(require 'subr-x) +(defun promise:maybe-message (msg) + "Display MSG if non-blank." + (let ((m (string-trim-right msg))) + (when (not (string-empty-p m)) + (message "%s" m)))) + +(require 'seq) +(defun promise:make-process-string (command) + "Return promise to make new asynchronous COMMAND. + +Arguments: + - COMMAND is program and shell arguments list of string. + +Resolve: + - Process stdout as string when process finish with exitcode 0. + +Reject: + - Event as string represented process exit state. + The event is documented at https://www.gnu.org/software/emacs/manual/html_node/elisp/Sentinels.html" + (promise-then + (funcall #'promise:make-process command) + (lambda (res) + (seq-let (stdout stderr) res + (promise:maybe-message (propertize stderr 'face '(:foreground "yellow"))) + stdout)) + (lambda (err) + (seq-let (event stdout stderr) err + (promise:maybe-message (propertize stdout 'face '(:foreground "black" :background "white"))) + (promise:maybe-message (propertize stderr 'face '(:foreground "red"))) + (promise-reject event))))) + +(defun promise:make-shell-command (script &optional dir) + "Return promise to make new asynchronous shell SCRIPT. + +Arguments: + - SCRIPT is string, will be passed sh -c. + - DIR is directory path in which SCRIPT will be executed. + +See `promise:make-process-string' for Resolve and Reject sections." + (let ((default-directory (or dir default-directory))) + (promise:make-process-string (list shell-file-name shell-command-switch script)))) + +(defun promise:make-thread (function &rest args) + "Return promise to make new thread via `make-thread'. + +Arguments: + - FUNCTION is funcalled with ARGS in new thread. + +Resolve: + - Return value from funcalled FUNCTION in the thread. + +Reject: + - Error object while running in the thread." + (promise-new + (lambda (resolve reject) + (if (not (fboundp 'make-thread)) + (error "`promise:make-thread' needs `make-thread' attached to Emacs-26.1 or above") + (make-thread + (lambda () + (condition-case err + (funcall resolve (apply function args)) + (error (funcall reject err))))))))) + +(defun promise:wrap-message (promise) + "Return promise to show debug message after PROMISE resolved. + +Arguments: + - PROMISE is any promise object. + +Resolve: + - Return original return value when PROMISE resolved. + +Reject: + - Return original return value when PROMISE rejected." + (promise-new + (lambda (resolve reject) + (promise-then + promise + (lambda (res) + (message "%s: %s" + (propertize "Result" 'face '(:foreground "green")) + (string-trim-right res)) + (funcall resolve res)) + (lambda (err) + (message "%s: %s" + (propertize "Error" 'face '(:foreground "red")) + (string-trim-right err)) + (funcall reject err)))))) + +(defun promise:url-retrieve (url) + "Return promise to retrieve response body from URL. + +Arguments: + - URL is either a string or a parsed URL. See `url-retrieve'. + +Resolve: + - Response body as a string retrieved from the URL. + +Reject: + - Error object while retrieving URL." + (promise-new + (lambda (resolve reject) + (url-retrieve url + (lambda (status) + ;; All errors are reliably captured and rejected with appropriate values. + (if (plist-get status :error) + (funcall reject (plist-get status :error)) + (condition-case err + (if (not (url-http-parse-headers)) + (funcall reject (buffer-string)) + (search-forward-regexp "\n\\s-*\n" nil t) + (funcall resolve (buffer-substring (point) (point-max)))) + (error (funcall reject err))))))))) + +(require 'xml) ; for `xml-parse-region' + +(defun promise:xml-retrieve (url) + "Return promise to retrieve XML object parsed from contents from URL. + +Arguments: + - URL is either a string or a parsed URL. See `url-retrieve'. + +Resolve: + - XML object parsed by `xml-parse-region'. + +Reject: + - Error object while retrieving URL and parsing contents." + (promise-new + (lambda (resolve reject) + (url-retrieve url + (lambda (status) + ;; All errors are reliably captured and rejected with appropriate values. + (if (plist-get status :error) + (funcall reject (plist-get status :error)) + (condition-case err + (if (not (url-http-parse-headers)) + (funcall reject (buffer-string)) + (search-forward-regexp "\n\\s-*\n" nil t) + (funcall resolve (xml-parse-region))) + (error (funcall reject err))))))))) + +(defun promise:request (url) + "Return promise to request URL via `request'. + +Arguments: + - URL is a target url as string. + +Resolve: + - Response body as string. + +Reject: + - A string list like as (status-code response-header response-body)" + (promise:request-with-args url nil)) + +(defun promise:request-post (url data) + "Return promise to POST DATA to URL via `request'. + +Arguments: + - URL is a target url as string. + - DATA is post data alist. + +Resolve: + - Response body as string. + +Reject: + - A string list like as (status-code response-header response-body)" + (declare (indent 1)) + (promise:request-with-args url `(:type "POST" :data ',data))) + +(declare-function request "request.el" (url &rest settings)) +(declare-function request-response-status-code "request.el" (response)) +(declare-function request-response--raw-header "request.el" (response)) +(declare-function request-response-data "request.el" (response)) + +(defun promise:request-with-args (url arglist) + "Return promise to request URL via `request' with ARGLIST. + +Arguments: + - URL is a target url as string. + +Resolve: + - Response body as string. + +Reject: + - A string list like as (status-code response-header response-body)" + (declare (indent 1)) + + (require 'request) + (promise-new + (lambda (resolve reject) + (when (plist-get arglist :success) + (funcall reject "Success callback function is not customizable")) + (when (plist-get arglist :error) + (funcall reject "Error callback function is not customizable")) + (apply #'request url + :success (cl-function + (lambda (&key data &allow-other-keys) + (funcall resolve data))) + :error (cl-function + (lambda (&key response &allow-other-keys) + (funcall reject + (list (request-response-status-code response) + (request-response--raw-header response) + (request-response-data response))))) + arglist)))) + +(declare-function async-start "async.el" (start-func &optional finish-func)) +(declare-function async-when-done "async.el" (proc &optional _change)) + +(defun promise:async-start (start-func &optional finish-func) + "Return promise to eval function in a new Emacs process via `async-start'. + +Arguments: + - START-FUNC is function that will be evaled in new Emacs. + - FINISH-FUNC is function that will be evaled after START-FUNC evaled. + +Resolve: + - Return value from START-FUNC in the Emacs. + +Reject: + - Error object while evaluating START-FUNC and FINISH-FUNC." + (require 'async) + (promise-new + (lambda (resolve reject) + (set-process-sentinel (async-start start-func + (lambda (result) + (when finish-func + (funcall finish-func result)) + (funcall resolve result))) + (lambda (process event) + (condition-case reason + (async-when-done process event) + (error (funcall reject reason)))))))) + +(defun promise-wait (timeout promise) + "Return promise to wait synchronously until PROMISE is resolved or rejected or TIMEOUT. + +Arguments: + - TIMEOUT can accept the various formats. See `run-at-time'. + - PROMISE is any promise object. + +Resolve: + - Return (:fullfilled value), value is PROMISE resolved value. + +Reject: + - Return (:rejected reason), reason is PROMISE rejected reason. + +Timeout: + - Return (:timeouted)." + (declare (indent 1)) + (catch 'done + (let* (handled + (timer (run-at-time timeout nil + (lambda () + (unless handled + (setq handled t) + (throw 'done (promise-reject '(:timeouted)))))))) + (promise-then promise + (lambda (value) + (unless handled + (setq handled t) + (cancel-timer timer) + (throw 'done (promise-resolve `(:fullfilled ,value))))) + (lambda (reason) + (unless handled + (setq handled t) + (cancel-timer timer) + (throw 'done (promise-reject `(:rejected ,reason)))))) + (while t (accept-process-output))))) + +(defun promise-wait-value (promise) + "Return orignal value form PROMISE return value of `promise-wait'." + (seq-let (state value) (promise-_value promise) + (cond + ((eq :fullfilled state) value) + ((eq :rejected state) (error "Rejected: %s" (prin1-to-string value))) + ((eq :timeouted state) (error "Timeouted: %s" (prin1-to-string value)))))) + +(defun promise-concurrent--internal (concurrent limit promisefn &optional no-reject-immediately-p) + "Internal function of `promise-concurrent'. + +Arguments: + - CONCURRENT is limited number of concurrent promises. + - LIMIT is number of PROMISEFN executions. + - PROMISEFN is function should return any promise object. + - If NO-REJECT-IMMEDIATELY-P is non-nil, returned promise is not reject immidiately." + (declare (indent 2)) + (let ((pipeline (make-vector concurrent nil)) + (results (make-vector limit nil)) + (count -1) + reasons) + (dotimes (i concurrent) + (aset pipeline i + (promise-new + (lambda (resolve reject) + (cl-labels + ((worker (inx) + (if (not (< inx limit)) + (funcall resolve) + (promise-chain (funcall promisefn inx) + (then (lambda (res) + (aset results inx res) + (worker (cl-incf count)))) + (catch (lambda (reason) + (if (not no-reject-immediately-p) + (funcall reject reason) + (push `(,inx ,reason) reasons) + (worker (cl-incf count))))))))) + (worker (cl-incf count))))))) + (promise-chain (promise-all pipeline) + (then (lambda (_) + (if (not reasons) + results + (promise-reject `(,results ,reasons)))))))) + +(defun promise-concurrent (concurrent limit promisefn) + "Return promise to run a limited number of concurrent promises. + +This function returns promise which immediately rejected if one +of promises fails. This behavior corresponds to `promise-all'. +See `promise-concurrent-no-reject-immidiately' with no reject immidiately. + +Arguments: + - CONCURRENT is limited number of concurrent promises. + - LIMIT is number of PROMISEFN executions. + - PROMISEFN is function should return any promise object. + +Resolve: + - Return vector includes values resolved for promise with respect to order. + +Reject: + - Return reason for the first rejection." + (declare (indent 2)) + (funcall #'promise-concurrent--internal concurrent limit promisefn)) + +(defun promise-concurrent-no-reject-immidiately (concurrent limit promisefn) + "Return promise to run a limited number of concurrent promises. + +This function returns promise which execute the whole promises if +a promise fails. If all promises are fulfilled, only vectors +with resolved values are returned. If one of promise is +rejected, the whole promises are executed and the index and +reason rejected as the second return value is returned after the +whole state has been determined. In this case, the index location +of the first return value is nil. +See `promise-concurrent' with reject immidiately. + +Arguments: + - CONCURRENT is limited number of concurrent promises. + - LIMIT is number of PROMISEFN executions. + - PROMISEFN is function should return any promise object. + +Resolve: + - Return vector includes values resolved for promise with respect to order. + +Reject: + - Return ( ) + includes values resolved for promise with respect to order. + is list of (index reason)." + (declare (indent 2)) + (funcall #'promise-concurrent--internal concurrent limit promisefn :no-reject-immediately)) + +(provide 'promise) +;;; promise.el ends here