experiments

hyperfiddle · Apr 26, 2024 · 044fa6d · 044fa6d
1 parent 87abb5e
commit 044fa6d
Show file tree

Hide file tree

Showing 3 changed files with 80 additions and 15 deletions.
diff --git a/src/contrib/data.cljc b/src/contrib/data.cljc
@@ -214,7 +214,11 @@
 
 ;; https://github.com/weavejester/medley/blob/master/src/medley/core.cljc
 ;; https://clojure.atlassian.net/browse/CLJ-1451
-(defn take-upto [pred]
+(defn take-upto
+  "Returns a lazy sequence of successive items from coll up to and including
+the first item for which `(pred item)` returns true. Returns a transducer
+when no collection is provided."
+  [pred]
   (fn [rf] 
     (fn 
       ([] (rf))
@@ -224,6 +228,53 @@
 (tests
   (into [] (take-upto odd?) [2 4 6 8 9 10 12 14]) := [2 4 6 8 9])
 
+(defn pause-after
+  "Return a lazy sequence of successive items from coll up to and including the
+  first item for which `(pred item)` returns false, then stop returning item
+  until `::resume` is seen. When `::resume` is seen, resume returning successive
+  items up to and including the first item for which `(pred item)` returns false.
+  This can be compared to a resumable `take-upto`."
+  ([pred]
+   (fn [rf]
+     (let [!sample? (volatile! nil)
+           !last    (volatile! ::nil)]
+       (fn rec
+         ([] (rf))
+         ([result] (rf result))
+         ([result value]
+          (let [sample? @!sample?
+                last    @!last]
+            (if (= ::resume value)
+              (do (vreset! !sample? true)
+                  (if (or sample? (= ::nil last))
+                    result
+                    (rec result last)))
+              (do (vreset! !last value)
+                  (if sample?
+                    (if (pred value)
+                      (rf result value)
+                      (do (vreset! !sample? false)
+                          (rf result value)))
+                    result)))))))))
+  ([pred coll] (sequence (pause-after pred) coll)))
+
+(tests
+  (pause-after #{::pending} [])                             := ()
+  (pause-after #{::pending} [::resume])                     := ()
+  (pause-after #{::pending} [1])                            := ()
+  (pause-after #{::pending} [1 ::resume])                   := '(1)
+  (pause-after #{::pending} [::pending])                    := '()
+  (pause-after #{::pending} [::pending ::resume])           := '(::pending)
+  (pause-after #{::pending} [::pending ::resume ::resume])  := '(::pending)
+  (pause-after #{::pending} [::pending ::resume ::pending]) := '(::pending ::pending)
+  (pause-after #{::pending} [::pending 1 ::resume])         := '(1)
+  (pause-after #{::pending}
+    [::pending ::pending ::resume ::pending 1])             := '(::pending ::pending 1)
+  (pause-after #{::pending} [1 ::resume 2])                 := '(1)
+  (pause-after #{::pending} [1 ::pending 2 ::resume 3])     := '(2)
+  (pause-after #{::pending} [1 ::pending ::resume 2])       := '(::pending 2)
+  )
+
 (defn round-floor [n base] (* base (clojure.math/floor (/ n base))))
 
 (comment

diff --git a/src/hyperfiddle/electric.cljc b/src/hyperfiddle/electric.cljc
@@ -542,12 +542,24 @@ Quoting it directly is idiomatic as well."
 
 (hyperfiddle.electric/def http-request "Bound to the HTTP request of the page in which the current Electric program is running." nil)
 
-(cc/defn -snapshot [flow] (->> flow (m/eduction (contrib.data/take-upto (complement #{r/pending})))))
+(cc/defn -snapshot
+  ([flow] (->> flow (m/eduction (contrib.data/take-upto (complement #{r/pending}))))) ; freezes after first non-pending
+  ([flow sampler] (-snapshot flow sampler r/pending))
+  ([flow sampler init]
+   (m/reductions {} init
+     (m/eduction (contrib.data/pause-after #{r/pending})
+       (mx/mix
+         flow
+         (m/eduction (comp (map boolean) (dedupe) (filter identity)
+                       (map (constantly :contrib.data/resume)))
+           sampler))))))
 
 (defmacro snapshot
   "Snapshots the first non-Pending value of reactive value `x` and freezes it,
 inhibiting all further reactive updates."
-  [x] `(check-electric snapshot (new (-snapshot (hyperfiddle.electric/fn* [] ~x)))))
+  ([x] `(check-electric snapshot (new (-snapshot (hyperfiddle.electric/fn* [] ~x)))))
+  ([x sampler] `(check-electric snapshot (new (-snapshot (hyperfiddle.electric/fn* [] (identity ~x)) (hyperfiddle.electric/fn* [] (identity ~sampler))))))
+  ([x sampler init] `(check-electric snapshot (new (-snapshot (hyperfiddle.electric/fn* [] (identity ~x)) (hyperfiddle.electric/fn* [] (identity ~sampler)) (snapshot ~init))))))
 
 (cc/defn ->Object [] #?(:clj (Object.) :cljs (js/Object.))) ; private
 

diff --git a/src/hyperfiddle/electric_css.cljc b/src/hyperfiddle/electric_css.cljc
@@ -92,13 +92,6 @@
                                (! rule)
                                #(delete-rule styled-element rule)))))))
 
-(e/def scope "")
-
-(defn scoped [scope selector]
-  (if-not (empty? scope)
-    (str "." scope " " selector)
-    selector))
-
 (defn rule* [styled-element selector declarations]
   (when (seq declarations)
     `(doto (new (make-rule< ~styled-element ~selector))
@@ -107,11 +100,20 @@
 (e/def selector "")
 
 (defn concat-selectors [selectorA selectorB]
-  (str selectorA
-    (let [selectorB (str/trim selectorB)]
-      (if (str/starts-with? selectorB "&")
-        (str/replace-first selectorB "&" "")
-        (str " " selectorB)))))
+  (if (empty? selectorA)
+    selectorB
+    (str selectorA
+      (let [selectorB (str/trim selectorB)]
+        (if (str/starts-with? selectorB "&")
+          (str/replace-first selectorB "&" "")
+          (str " " selectorB))))))
+
+(e/def scope "")
+
+(defn scoped [scope selector]
+  (if-not (empty? scope)
+    (concat-selectors (str "." scope)  selector)
+    selector))
 
 (defmacro rule [selector & declarations]
   (let [[selector declarations] (if (map? selector) ["&" (cons selector declarations)] [selector declarations])]