From be39f9f57fa1ddb5b1d161f1ef9a69bd9cf8630f Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 5 Jul 2024 15:04:36 -0400 Subject: Propagator improvements and cleanup. --- chapter-7/propagators.js | 78 ++----------------------------- chapter-7/propagators.scm | 115 ++++++++++++++++++++++------------------------ 2 files changed, 59 insertions(+), 134 deletions(-) diff --git a/chapter-7/propagators.js b/chapter-7/propagators.js index 1477a86..c392ad1 100644 --- a/chapter-7/propagators.js +++ b/chapter-7/propagators.js @@ -3,89 +3,21 @@ window.addEventListener("load", async () => { reflect_wasm_dir: "hoot", user_imports: { window: { - scrollTo: window.scrollTo, - setTimeout: setTimeout, - getWindow: function() { - return window; - }, + setTimeout: setTimeout }, document: { makeTextNode: Document.prototype.createTextNode.bind(document), makeElement: Document.prototype.createElement.bind(document), - getElementById: Document.prototype.getElementById.bind(document), - getBody: function() { - return document.body; - }, + body: () => document.body, }, element: { - firstChild: (elem) => elem.firstChild, - nextSibling: (elem) => elem.nextSibling, - appendChild: function(parent, child) { - return parent.appendChild(child); - }, - setAttribute: function(elem, attr, value) { - return elem.setAttribute(attr, value); - }, - getAttribute: function(elem, attr) { - return elem.getAttribute(attr); - }, - getProperty: function(elem, property, dflt) { - // The little + '' ensures the value is a string - return value = elem[property] + ''; - }, - setProperty: function(elem, property, new_value) { - elem[property] = new_value; - }, + appendChild: (parent, child) => parent.appendChild(child), + setAttribute: (elem, attr, value) => elem.setAttribute(attr, value), getValue: (elem) => elem.value, setValue: (elem, val) => elem.value = val, - remove: function(elem) { - elem.remove(); - }, replaceWith: (oldElem, newElem) => oldElem.replaceWith(newElem), - addEventListener: function(elem, name, f) { - elem.addEventListener(name, f); - }, + addEventListener: (elem, name, f) => elem.addEventListener(name, f) }, - websocket: { - create: function(uri) { - ws = new WebSocket(uri); - return ws; - }, - registerHandler: function(sock, handler, f) { - sock[handler] = function (event) { - if (handler == "onmessage") { - f(event.data); - } else { - f(event); - } - }; - }, - send: function(sock, message) { - sock.send(message); - }, - }, - notification: { - create: function(text) { - return new Notification(text); - }, - permission: function() { - return Notification.permission; - }, - requestPermission: Notification.requestPermission, - }, - promise: { - on: function(promise, f) { - promise.then(f); - }, - }, - localStorage: { - getItem: (key) => localStorage.getItem(key) || "#f", - setItem: (key, value) => localStorage.setItem(key, value) - }, - location: { - protocol: () => location.protocol, - hostname: () => location.hostname - } } }); }); diff --git a/chapter-7/propagators.scm b/chapter-7/propagators.scm index db27a2e..e0096b6 100644 --- a/chapter-7/propagators.scm +++ b/chapter-7/propagators.scm @@ -4,49 +4,34 @@ ((hoot hashtables) #:select (make-weak-key-hashtable weak-key-hashtable-ref weak-key-hashtable-set!)) + ((hoot lists) #:select (fold)) ((hoot numbers) #:select (truncate)) (hoot ffi)) -(define-foreign make-element - "document" "makeElement" - (ref string) -> (ref extern)) +(define-foreign timeout + "window" "setTimeout" + (ref extern) f64 -> i32) + +(define-foreign document-body + "document" "body" + -> (ref null extern)) (define-foreign make-text-node "document" "makeTextNode" (ref string) -> (ref extern)) -(define-foreign get-element-by-id - "document" "getElementById" - (ref string) -> (ref null extern)) - -(define-foreign first-child - "element" "firstChild" - (ref extern) -> (ref null extern)) - -(define-foreign next-sibling - "element" "nextSibling" - (ref extern) -> (ref null extern)) +(define-foreign make-element + "document" "makeElement" + (ref string) -> (ref extern)) (define-foreign append-child! "element" "appendChild" (ref extern) (ref extern) -> (ref extern)) -(define-foreign attribute-ref - "element" "getAttribute" - (ref extern) (ref string) -> (ref string)) - -(define-foreign set-attribute! +(define-foreign attribute-set! "element" "setAttribute" (ref extern) (ref string) (ref string) -> none) -(define-foreign property-ref - "element" "getProperty" - (ref extern) (ref string) -> (ref string)) - -(define-foreign set-property! - "element" "setProperty" - (ref extern) (ref string) (ref string) -> none) - (define-foreign value "element" "getValue" (ref extern) -> (ref string)) @@ -59,22 +44,10 @@ "element" "addEventListener" (ref extern) (ref string) (ref extern) -> none) -(define-foreign remove! - "element" "remove" - (ref extern) -> none) - (define-foreign replace-with! "element" "replaceWith" (ref extern) (ref extern) -> none) -(define-foreign document-body - "document" "getBody" - -> (ref null extern)) - -(define-foreign timeout - "window" "setTimeout" - (ref extern) f64 -> i32) - (define (lset-adjoin = list . rest) (define pred (if (or (eq? = eq?) (eq? = eqv?)) @@ -325,21 +298,41 @@ (lp rest))))))))) (define (merge-ephemeral-timestamps ephemerals) - (let lp ((ephemerals ephemerals) (timestamps '())) - (match ephemerals - (() timestamps) - ((($ _ timestamps*) . rest) - (let lp2 ((timestamps* timestamps*) (timestamps timestamps)) - (match timestamps* - (() (lp rest timestamps)) - (((and timestamp (key . time)) . rest) - (match (assq-ref timestamps key) - (#f (lp2 rest (cons timestamp timestamps))) - (time* - (if (= time time*) - (lp2 rest timestamps) - #f))))))) - ((_ . rest) (lp rest timestamps))))) + (define (adjoin-keys alist keys) + (fold (lambda (key+value keys) + (match key+value + ((key . _) + (lset-adjoin eq? keys key)))) + keys alist)) + (define (check-timestamps id) + (let lp ((ephemerals ephemerals) (t #f)) + (match ephemerals + (() t) + ((($ _ timestamps) . rest) + (match (assq-ref timestamps id) + ;; No timestamp for this id in this ephemeral. Continue. + (#f (lp rest t)) + (t* + (if t + ;; If timestamps don't match then we have a mix of + ;; fresh and stale values, so return #f. Otherwise, + ;; continue. + (and (= t t*) (lp rest t)) + ;; Initialize timestamp and continue. + (lp rest t*)))))))) + ;; Build a set of all reactive identifiers across all ephemerals. + (let ((ids (fold (lambda (ephemeral ids) + (adjoin-keys (ephemeral-timestamps ephemeral) ids)) + '() ephemerals))) + (let lp ((ids ids) (timestamps '())) + (match ids + (() timestamps) + ((id . rest) + ;; Check for consistent timestamps. If they are consistent + ;; then add it to the alist and continue. Otherwise, return + ;; #f. + (let ((t (check-timestamps id))) + (and t (lp rest (cons (cons id t) timestamps))))))))) (define (merge-ephemerals old new) (cond @@ -360,15 +353,15 @@ (define-syntax-rule (define-primitive-reactive-propagator name proc) (define name (primitive-reactive-propagator 'name proc))) -(define (r:property input elem property) - (let ((property (symbol->string property))) +(define (r:attribute input elem attr) + (let ((attr (symbol->string attr))) (define (activate) (match (cell-strongest input) (($ val) - (set-property! elem property (obj->string val))) + (attribute-set! elem attr (obj->string val))) ;; Ignore unusable values. (_ (values)))) - (make-propagator 'property (list input) '() activate))) + (make-propagator 'r:attribute (list input) '() activate))) (define-record-type (make-binding id cell default group) @@ -454,15 +447,15 @@ (for-each (lambda (attr) (match attr (((? symbol? name) (? string? val)) - (set-attribute! elem + (attribute-set! elem (symbol->string name) val)) (((? symbol? name) (? number? val)) - (set-attribute! elem + (attribute-set! elem (symbol->string name) (number->string val))) (((? symbol? name) (? cell? cell)) - (r:property cell elem name)) + (r:attribute cell elem name)) ;; The value attribute is special and can be ;; used to setup a 2-way data binding. (('value (? binding? binding)) -- cgit v1.2.3