Commands and subscriptions, and gui-update

gui-update is a plain function, so it cannot wait. It returns the work to do
as values. A command is an (Event %m), synced in a fiber of its own, whose
answer is the next message. A subscription is a source of messages that the
model asks for: after each update the app starts the new ones and cancels the
ones that are gone, by key. every sends a message on a timer, and
subscription takes a source of one's own.

The fibers belong to the app's scope and post their messages to the UI
thread, so gui-update and view only run there. Closing the window cancels
them. The prelude's path macros already use the name update, hence
gui-update.

🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8)

Co-Authored-By: eca-agent <git@eca.dev>

tests/app.bjo

@@ -8,7 +8,7 @@
 ;;
 ;; No window is opened. The test raises the events a user would cause on the
 ;; Avalonia controls, and reads back what the controls hold, so it goes
-;; through the handlers, update, view and patch as a program does.
+;; through the handlers, gui-update, view and patch as a program does.
 
 (import (std prelude))
 (import (std simpletest))
@@ -60,14 +60,15 @@
 (type (: Msg (Union Inc Dec (: Typed string) (: Shout bool) Reset)))
 (type (: Model (Record (: count int) (: name string) (: loud bool))))
 
-(: update (-> Msg Model Model))
-(defun (update msg m)
-  (match msg
-    (Inc (record-set m (count (+ (.count m) 1))))
-    (Dec (record-set m (count (- (.count m) 1))))
-    ((Typed s) (record-set m (name s)))
-    ((Shout b) (record-set m (loud b)))
-    (Reset (Model (count 0) (name "") (loud #f)))))
+(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
+(defun (gui-update msg m)
+  (next
+    (match msg
+      (Inc (record-set m (count (+ (.count m) 1))))
+      (Dec (record-set m (count (- (.count m) 1))))
+      ((Typed s) (record-set m (name s)))
+      ((Shout b) (record-set m (loud b)))
+      (Reset (Model (count 0) (name "") (loud #f))))))
 
 (: greeting (-> Model string))
 (defun (greeting m)
@@ -92,7 +93,7 @@
 
 (defun (main)
   (def/mutable roots 0)
-  (def app (start-app (Model (count 0) (name "") (loud #f)) update view
+  (def app (start-app (Model (count 0) (name "") (loud #f)) gui-update view
                       (fun (c) (set! roots (+ roots 1)))))
 
   (defun (at path) (app-control-at app path))

tests/effects.bjo

@@ -0,0 +1,130 @@
+;; 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/.
+
+;; bjogui/tests/effects.bjo — commands and subscriptions.
+;;
+;;     bjo run tests/effects.bjo
+;;
+;; No window is opened. The fibers of commands and subscriptions post their
+;; messages to the UI thread, and the test runs what was posted with
+;; `app-run-pending!`, as Avalonia's loop would.
+
+(import (std prelude))
+(import (std simpletest))
+(import (bjogui view))
+(import (bjogui app))
+
+(import/class
+  (TextBlock (: Avalonia.Controls.TextBlock)))
+
+(import/extern
+  (block-text (: Avalonia.Controls.TextBlock.Text (-> TextBlock string) #:get))
+  (sleep-ms   (: System.Threading.Thread.Sleep (-> int void) #:blocking)))
+
+;; ---------------------------------------------------------------------------
+;; The program under test
+;; ---------------------------------------------------------------------------
+
+(type (: Msg (Union Load (: Loaded string) Compute (: Computed int)
+                    Start Stop Tick (: Got int) Other)))
+
+(type (: Model (Record (: text string) (: answer int) (: running bool)
+                       (: ticks int) (: got (List int)) (: others int))))
+
+(def jobs (: (make-chan) (Chan int)))
+
+(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
+(defun (gui-update msg m)
+  (match msg
+    (Load (next (record-set m (text "loading"))
+                (wrap (timeout (milliseconds 20)) (fun (_) (Loaded "done")))))
+    ((Loaded s) (next (record-set m (text s))))
+    (Compute (next m (wrap (blocking (fun () (* 6 7)))
+                           (fun (r) (match r ((Ok n) (Computed n)) ((Err _) (Computed -1)))))))
+    ((Computed n) (next (record-set m (answer n))))
+    (Start (next (record-set m (running #t))))
+    (Stop (next (record-set m (running #f))))
+    (Tick (next (record-set m (ticks (+ (.ticks m) 1)))))
+    ((Got n) (next (record-set m (got (cons n (.got m))))))
+    (Other (next (record-set m (others (+ (.others m) 1)))))))
+
+;; A channel is a rendezvous, so a send waits for the subscription's fiber.
+;; It is a fiber of its own, because `main` cannot wait on an event.
+(: (-bjo-> void))
+(defbjo (feed-jobs)
+  (chan-put jobs 1)
+  (chan-put jobs 2))
+
+(: subscriptions (-> Model (List (Sub Msg))))
+(defun (subscriptions m)
+  (cons (subscription "jobs" (fun () (wrap (chan-recv jobs) Got)))
+        (if (.running m) (list (every (milliseconds 10) Tick)) '())))
+
+(: view (-> Model (View Msg)))
+(defun (view m)
+  (column (text (.text m)) (text #"ticks: ${(.ticks m)}")))
+
+;; ---------------------------------------------------------------------------
+;; The test
+;; ---------------------------------------------------------------------------
+
+(defun (main)
+  (def app (start-app (Model (text "") (answer 0) (running #f) (ticks 0) (got '()) (others 0))
+                      gui-update view (fun (c) unit)
+                      #:subscriptions subscriptions))
+
+  ;; Runs what the fibers posted until `done?` holds, for two seconds at most.
+  (: (-> (-> Model bool) bool))
+  (defun (wait-for done?)
+    (let go ((tries 0))
+      (app-run-pending! app)
+      (cond ((done? (app-model app)) #t)
+            ((> tries 200) #f)
+            (else (sleep-ms 10) (go (+ tries 1))))))
+
+  ;; Waits a while and runs what was posted, for a check that nothing came.
+  (defun (settle)
+    (sleep-ms 60)
+    (app-run-pending! app))
+
+  ;; --- commands -------------------------------------------------------------
+  (app-dispatch! app Load)
+  (expect "a command does not wait" (.text (app-model app)) "loading")
+  (expect "its message comes" (wait-for (fun (m) (= (.text m) "done"))) #t)
+  (expect "and is shown" (block-text (cast TextBlock (app-control-at app '(0)))) "done")
+
+  (app-dispatch! app Compute)
+  (expect "a blocking command" (wait-for (fun (m) (= (.answer m) 42))) #t)
+
+  ;; --- a subscription that the model turns on and off ------------------------
+  (app-dispatch! app Start)
+  (expect "a running subscription ticks" (wait-for (fun (m) (>= (.ticks m) 3))) #t)
+  (app-dispatch! app Other)
+  (expect "it keeps ticking across other messages" 
+          (let ((now (.ticks (app-model app)))) (wait-for (fun (m) (> (.ticks m) now))))
+          #t)
+  (app-dispatch! app Stop)
+  (settle)
+  (def stopped-at (.ticks (app-model app)))
+  (settle)
+  (expect "a subscription that is gone stops" (.ticks (app-model app)) stopped-at)
+  (app-dispatch! app Start)
+  (expect "and starts again" (wait-for (fun (m) (> (.ticks m) stopped-at))) #t)
+  (app-dispatch! app Stop)
+
+  ;; --- a subscription of one's own --------------------------------------------
+  (spawn (feed-jobs))
+  (expect "values from a channel" (wait-for (fun (m) (= (.got m) '(2 1)))) #t)
+
+  ;; --- stopping --------------------------------------------------------------
+  (app-dispatch! app Start)
+  (expect "ticking again" (wait-for (fun (m) (> (.ticks m) stopped-at))) #t)
+  (app-stop! app)
+  (settle)
+  (def final (.ticks (app-model app)))
+  (settle)
+  (expect "a stopped app hears nothing" (.ticks (app-model app)) final)
+  (app-dispatch! app Other)
+  (expect "and takes no messages" (.others (app-model app)) 1)
+  (println "bjogui effects ok"))