summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2024-07-05 15:04:36 -0400
committerDavid Thompson <dthompson2@worcester.edu>2024-07-05 15:04:36 -0400
commitbe39f9f57fa1ddb5b1d161f1ef9a69bd9cf8630f (patch)
treea377c080e319e2b3c342497bcdf6417f1a1d1bc8
parentb33079617253f844db5d7352280504b8f1851483 (diff)
Propagator improvements and cleanup.
-rw-r--r--chapter-7/propagators.js78
-rw-r--r--chapter-7/propagators.scm115
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)
- ((($ <ephemeral> _ 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)
+ ((($ <ephemeral> _ 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)
(($ <ephemeral> 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 <binding>
(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))