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>

Readme.org

@@ -1,7 +1,7 @@
 #+TITLE: bjogui
 
-Desktop programs in Bjolang, written as a model, an ~update~ and a ~view~, and
+Desktop programs in Bjolang, written as a model, a ~gui-update~ and a ~view~,
-shown with [[https://avaloniaui.net][Avalonia]].
+and shown with [[https://avaloniaui.net][Avalonia]].
 
 #+BEGIN_SRC scheme
 (import (bjogui view))
@@ -9,9 +9,9 @@ shown with [[https://avaloniaui.net][Avalonia]].
 
 (type (: Msg (Union Inc Dec)))
 
-(: update (-> Msg int int))
+(: gui-update (-> Msg int (Tuple int (List (Event Msg)))))
-(defun (update msg n)
+(defun (gui-update msg n)
-  (match msg (Inc (+ n 1)) (Dec (- n 1))))
+  (next (match msg (Inc (+ n 1)) (Dec (- n 1)))))
 
 (: view (-> int (View Msg)))
 (defun (view n)
@@ -21,7 +21,7 @@ shown with [[https://avaloniaui.net][Avalonia]].
     (button "+" Inc)))
 
 (defun (main)
-  (run-app 0 update view #:title "Counter"))
+  (run-app 0 gui-update view #:title "Counter"))
 #+END_SRC
 
 A program never names an Avalonia type. A view is a Bjolang value, an event
@@ -30,7 +30,7 @@ is a message, and the controls are made and changed by the package.
 * How it works
 
 An event finds its message in the view its control was last given.
-~update~ makes the next model from the message, and ~view~ makes the next
+~gui-update~ makes the next model from the message, and ~view~ makes the next
 view. The next view is compared with the last one, control by control, and
 only what differs is changed. So a control keeps its focus, its caret and its
 scroll position when the model changes.
@@ -57,14 +57,59 @@ They take keywords where they apply: ~#:size~ (the font size of a text),
 children of a column or a row), ~#:enabled~ and ~#:placeholder~. A size of
 zero, the default, leaves the size to the control.
 
+* Work: commands and subscriptions
+
+~gui-update~ is a plain function, so it cannot wait, and the compiler says so
+if it tries. Work is a value it returns, and the app runs it.
+
+A *command* is an ~(Event %m)~: an event whose answer is a message. ~(next m
+command ...)~ is the next model and the commands to start; ~(next m)~ is the
+model alone. The app syncs each command in a fiber of its own and gives its
+message to ~gui-update~. Any event will do: a ~timeout~, a ~blocking~ call, a
+channel, a ~choose~ of several.
+
+#+BEGIN_SRC scheme
+(Load (next (record-set m (loading #t))
+            (wrap (blocking (fun () (file-read-text path))) Loaded)))
+#+END_SRC
+
+A *subscription* is a source of messages that runs while the model asks for
+it. ~subscriptions~ gives the list for a model. After each update the app
+starts those that are new and cancels those that are gone; the others keep
+running. A subscription is known by its key.
+
+- ~(every duration msg)~ sends ~msg~ each time ~duration~ has passed.
+- ~(subscription key next-event)~ is a source of your own: ~next-event~ gives
+  the event of the next message, and is called again after each one.
+  ~(subscription "jobs" (fun () (wrap (chan-recv jobs) Got)))~ sends what
+  comes on a channel.
+
+#+BEGIN_SRC scheme
+(: subscriptions (-> Model (List (Sub Msg))))
+(defun (subscriptions m)
+  (if (.running m) (list (every (milliseconds 100) Tick)) '()))
+#+END_SRC
+
+The fibers belong to the app. They post their messages to the UI thread, so
+~gui-update~ and ~view~ always run there. When the window is closed they are
+cancelled, and the program ends.
+
 * Running: (bjogui app)
 
-- ~(run-app init update view #:title #:width #:height)~ opens a window and
+- ~(run-app init gui-update view #:subscriptions #:title #:width #:height)~
-  runs until it is closed.
+  opens a window and runs until it is closed.
-- ~(start-app init update view on-root)~ makes the controls with no window,
+- ~(start-app init gui-update view on-root #:subscriptions)~ makes the controls
-  and gives ~on-root~ the control to show. ~app-dispatch!~ sends a message,
+  with no window, and gives ~on-root~ the control to show. Its fibers belong
-  ~app-model~ reads the model, and ~app-control-at~ finds a control by its
+  to the scope it is started in.
-  path of child indices. ~tests/app.bjo~ uses these to drive an app through
+  - ~app-dispatch!~ gives a message on the UI thread, and ~app-send!~ from any
+    thread.
+  - ~app-run-pending!~ runs what fibers have posted, where no loop of
+    Avalonia's does.
+  - ~app-stop!~ cancels the subscriptions and drops later messages.
+  - ~app-model~ reads the model, and ~app-control-at~ finds a control by its
+    path of child indices.
+
+  ~tests/app.bjo~ and ~tests/effects.bjo~ use these to drive an app through
   its real controls.
 
 * Requirements
@@ -78,11 +123,12 @@ zero, the default, leaves the size to the control.
 
 #+BEGIN_SRC sh
 bjo run tests/app.bjo       # prints "bjogui ok"
+bjo run tests/effects.bjo   # prints "bjogui effects ok"
 bjo run examples/counter.bjo
+bjo run examples/stopwatch.bjo
 #+END_SRC
 
 * Not yet
 
 - Keyed children, for lists whose items move.
-- Messages from fibers and timers, for work that is not a click.
 - More controls: lists, grids, images, scroll views, menus.

examples/counter.bjo

@@ -13,12 +13,13 @@
 (type (: Msg (Union Inc Dec (: Typed string))))
 (type (: Model (Record (: count int) (: name string))))
 
-(: update (-> Msg Model Model))
+(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
-(defun (update msg m)
+(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)))))
+      ((Typed s) (record-set m (name s))))))
 
 (: view (-> Model (View Msg)))
 (defun (view m)
@@ -31,4 +32,4 @@
       (button "+" Inc #:width 40.0))))
 
 (defun (main)
-  (run-app (Model (count 0) (name "")) update view #:title "Counter" #:width 320.0 #:height 200.0))
+  (run-app (Model (count 0) (name "")) gui-update view #:title "Counter" #:width 320.0 #:height 200.0))

examples/stopwatch.bjo

@@ -0,0 +1,55 @@
+;; 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/examples/stopwatch.bjo — a subscription and a command.
+;;
+;;     bjo run examples/stopwatch.bjo
+;;
+;; The stopwatch ticks while it runs: `subscriptions` asks for a tick only
+;; then, so stopping it stops the fiber. "Lap" saves the time after a pause,
+;; to show a command: the pause runs in a fiber, and the window does not wait
+;; for it.
+
+(import (std prelude))
+(import (bjogui view))
+(import (bjogui app))
+
+(type (: Msg (Union Toggle Tick Reset Lap (: Saved int))))
+(type (: Model (Record (: tenths int) (: running bool) (: saving bool) (: laps (List int)))))
+
+(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
+(defun (gui-update msg m)
+  (match msg
+    (Toggle (next (record-set m (running (not (.running m))))))
+    (Tick (next (record-set m (tenths (+ (.tenths m) 1)))))
+    (Reset (next (record-set m (tenths 0) (laps '()))))
+    ;; The time is taken now, and saved half a second later.
+    (Lap (next (record-set m (saving #t))
+               (wrap (timeout (milliseconds 500)) (fun (_) (Saved (.tenths m))))))
+    ((Saved t) (next (record-set m (saving #f) (laps (cons t (.laps m))))))))
+
+(: subscriptions (-> Model (List (Sub Msg))))
+(defun (subscriptions m)
+  (if (.running m) (list (every (milliseconds 100) Tick)) '()))
+
+(: (-> int string))
+(defun (show tenths)
+  #"${(/ tenths 10)}.${(% tenths 10)} s")
+
+(: view (-> Model (View Msg)))
+(defun (view m)
+  (column #:spacing 8.0 #:margin 16.0
+    (text (show (.tenths m)) #:size 32.0)
+    (row #:spacing 8.0
+      (button (if (.running m) "Stop" "Start") Toggle #:width 80.0)
+      (button "Lap" Lap #:enabled (not (.saving m)) #:width 80.0)
+      (button "Reset" Reset #:width 80.0))
+    (apply column (vec->array (vec-map (fun (t) (text #"lap: ${(show t)}"))
+                                       (list->vec (.laps m)))))))
+
+(defun (main)
+  (run-app (Model (tenths 0) (running #f) (saving #f) (laps '()))
+           gui-update view
+           #:subscriptions subscriptions
+           #:title "Stopwatch" #:width 320.0 #:height 300.0))

src/app.bjo

@@ -4,24 +4,34 @@
 
 ;; bjogui/src/app.bjo — the module (bjogui app).
 ;;
-;; Runs a program written as a model, an `update` and a `view`, in an Avalonia
+;; Runs a program written as a model, a `gui-update` and a `view`, in an
-;; window. Every Avalonia name stays in this module: what it exports takes
+;; Avalonia window. Every Avalonia name stays in this module: what it exports
-;; and gives Bjolang values, and a control only as an opaque `Control`.
+;; takes and gives Bjolang values, and a control only as an opaque `Control`.
 ;;
 ;; The loop: an event finds its message in the view the control was last
-;; given. `update` makes the next model from it, and `view` the next view.
+;; given. `gui-update` makes the next model from it, and `view` the next view.
 ;; The next view is compared with the last one, control by control, and only
 ;; what differs is changed. So a control keeps its focus, its caret and its
 ;; scroll position when the model changes.
 ;;
+;; `gui-update` does no work of its own: it is a plain function, so it cannot
+;; wait. Work is a value it returns. A command is an `(Event %m)`: the app
+;; syncs it in a fiber, and gives the message it answers to `gui-update`. A
+;; subscription is a source of messages that runs as long as the model asks
+;; for it: after each update the app starts the subscriptions that are new
+;; and stops those that are gone.
+;;
 ;; Every control is made with plain constructors and changed with
 ;; `AvaloniaObject.SetValue`, so no Avalonia class is subclassed.
 
 (export
-  App Live Control
+  App Live Control Sub
-  run-app
+  run-app next
+  ;; Subscriptions.
+  every subscription
   ;; For tests and for hosts of their own: an app with no window.
-  start-app app-dispatch! app-model app-control app-control-at)
+  start-app app-dispatch! app-send! app-stop! app-run-pending!
+  app-model app-control app-control-at)
 
 (import (std prelude))
 (import (std interop))
@@ -67,7 +77,10 @@
   (AppBuilder        (: Avalonia.AppBuilder))
   (ILifetime         (: Avalonia.Controls.ApplicationLifetimes.IApplicationLifetime))
   (Lifetime          (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime
-                        (-> Lifetime))))
+                        (-> Lifetime)))
+  (Dispatcher        (: Avalonia.Threading.Dispatcher))
+  (UiPriority        (: Avalonia.Threading.DispatcherPriority))
+  ((DispatcherOp %a) (: Avalonia.Threading.DispatcherOperation)))
 
 (import/extern
   ;; Properties, as the objects `SetValue` takes.
@@ -108,6 +121,13 @@
   (panel-children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
   (clr-string     (: System.Convert.ToString (-> string ClrString)))
 
+  ;; The UI thread. Controls may be touched only there, so a message from a
+  ;; fiber is posted to it.
+  (ui-dispatcher  (: Avalonia.Threading.Dispatcher.UIThread #:get))
+  (ui-thread?     (: Avalonia.Threading.Dispatcher.CheckAccess (-> Dispatcher bool)))
+  (ui-post        (: Avalonia.Threading.Dispatcher.InvokeAsync (-> Dispatcher (-> Unit) (DispatcherOp Unit))))
+  (ui-run-jobs    (: Avalonia.Threading.Dispatcher.RunJobs (-> Dispatcher (Nullable UiPriority) void)))
+
   ;; The window and the application.
   (configure           (: Avalonia.AppBuilder.Configure (-> (-> Application) AppBuilder)))
   (use-platform-detect (: Avalonia.AppBuilderDesktopExtensions.UsePlatformDetect
@@ -226,16 +246,65 @@
                            (: view (View %m) #:mutable)
                            (: children (MutableVec (Live %m))))))
 
+;; ---------------------------------------------------------------------------
+;; Commands and subscriptions
+;; ---------------------------------------------------------------------------
+
+;; A source of messages that runs while the model asks for it. `key` says
+;; which one it is: after an update, a subscription whose key was there before
+;; keeps running, and is not started again.
+;;
+;; `next-event` gives the event of the next message. A fiber of the
+;; subscription's own calls it, syncs the event, sends the message, and calls
+;; it again. The fiber is cancelled at that `sync` when the key is gone, and
+;; when the app stops.
+(type (: (Sub %m) #:opaque (Record (: key string)
+                                   (: next-event (-> (Event %m))))))
+
+;; A subscription to a source of your own: `(subscription "jobs" (fun ()
+;; (chan-recv jobs)))` sends each value that comes on a channel. Two
+;; subscriptions with the same key are one: the first is the one that runs.
+(: subscription (-> string (-> (Event %m)) (Sub %m)))
+(defun (subscription key next-event)
+  (Sub (key key) (next-event next-event)))
+
+;; Sends `msg` each time `d` has passed. The time is counted from the last
+;; message, so a slow update makes the next one later and they do not queue
+;; up.
+(: every (-> Duration %m (Sub %m)) (where (Written %m)))
+(defun (every d msg)
+  (Sub (key #"every ${(duration-ticks d)} ${(written msg)}")
+       (next-event (fun () (wrap (timeout d) (fun (_) msg))))))
+
+;; The next model, and the commands to run. `(next m)` is the model alone.
+(: next (-> %model #:rest (Event %m) (Tuple %model (List (Event %m)))))
+(defun (next m #:rest commands)
+  (Tuple m (->list commands)))
+
+;; ---------------------------------------------------------------------------
+;; The app
+;; ---------------------------------------------------------------------------
+
 ;; A running program.
 ;;
 ;; `patching` is true while the controls are being changed. A control that
 ;; is changed raises its own events, such as a text input whose text is set,
 ;; and those are not the user's: they are dropped.
-(type (: (App %model %m) #:opaque (Record (: model %model #:mutable)
+;;
-                                 (: update (-> %m %model %model))
+;; `home` is the scope the app's fibers belong to. A message can arrive from
+;; Avalonia on a thread with no scope, so each update is run in it.
+;; `subs` holds each running subscription's key, and the scope it runs in, so
+;; that one can be cancelled and the others not.
+(type (: (App %model %m) #:opaque
+         (Record (: model %model #:mutable)
+                 (: gui-update (-> %m %model (Tuple %model (List (Event %m)))))
                  (: view (-> %model (View %m)))
+                 (: subscriptions (-> %model (List (Sub %m))))
                  (: root (Option (Live %m)) #:mutable)
                  (: patching bool #:mutable)
+                 (: stopped bool #:mutable)
+                 (: home Scope)
+                 (: subs (List (Tuple string Scope)) #:mutable)
                  (: on-root (-> Control void)))))
 
 (: (-> (App %model %m) %model))
@@ -261,29 +330,110 @@
     ((Some live) (walk live path))
     (None (raise (cast Exception (InvalidOperation. "the app has no view"))))))
 
-;; Makes the next model from `msg`, and shows its view.
+;; Makes the next model from `msg`, shows its view, starts its commands, and
+;; starts and stops subscriptions. Only on the UI thread; from anywhere else,
+;; use `app-send!`. A stopped app drops the message.
 (: (-> (App %model %m) %m void))
 (defun (app-dispatch! app msg)
-  (record-set! app (model ((.update app) msg (.model app))))
+  (unless (.stopped app)
-  (render! app))
+    (def (Tuple model commands) ((.gui-update app) msg (.model app)))
+    (record-set! app (model model))
+    (step! app commands)))
+
+;; Gives `msg` to the app from any thread. Off the UI thread it is posted to
+;; the UI thread, and runs there after the messages posted before it.
+(: (-> (App %model %m) %m void))
+(defun (app-send! app msg)
+  (if (ui-thread? ui-dispatcher)
+      (app-dispatch! app msg)
+      (post! app msg)))
+
+;; Posts `msg` to the UI thread. What a fiber does: it is never on the UI
+;; thread, and it must not run an update itself.
+(: (-> (App %model %m) %m void))
+(defun (post! app msg)
+  (ignore (ui-post ui-dispatcher (fun () (app-dispatch! app msg) unit))))
+
+;; Runs the messages that fibers have posted to the UI thread, now. For a test
+;; or a host with no window, where no loop of Avalonia's runs them.
+(: (-> (App %model %m) void))
+(defun (app-run-pending! app)
+  (ui-run-jobs ui-dispatcher (clr-default)))
+
+;; Stops the app: its subscriptions are cancelled, and later messages are
+;; dropped. A command that is still running is cancelled when the scope the
+;; app was started in ends.
+(: (-> (App %model %m) void))
+(defun (app-stop! app)
+  (record-set! app (stopped #t))
+  (loop (:for (Tuple _ scope) (.subs app)) (:do (stop-scope! scope)))
+  (record-set! app (subs '())))
+
+(: (-> (App %model %m) (List (Event %m)) void))
+(defun (step! app commands)
+  (render! app)
+  (in-scope (.home app)
+    (loop (:for command commands)
+          (:do (spawn/daemon (run-command app command)))))
+  (sync-subs! app))
+
+(: (-bjo-> (App %model %m) (Event %m) void))
+(defbjo (run-command app command)
+  (post! app (sync command)))
+
+(: (-bjo-> (App %model %m) (-> (Event %m)) void))
+(defbjo (run-sub app next-event)
+  (let go ()
+    (post! app (sync (next-event)))
+    (go)))
+
+;; Cancels a subscription's scope, and so its fiber. The scope is not closed:
+;; closing waits, and nothing is owned in it to release.
+(: (-> Scope void))
+(defun (stop-scope! scope)
+  (scope-cancel! scope (Requested "the subscription is gone")))
+
+;; Starts a subscription in a scope of its own, inside the app's, so that it
+;; can be cancelled alone.
+(: (-> (App %model %m) (Sub %m) Scope))
+(defun (start-sub! app sub)
+  (in-scope (.home app)
+    (def scope (scope-open! 0))
+    (in-scope scope
+      (spawn/daemon (run-sub app (.next-event sub))))
+    scope))
+
+(: (-> (App %model %m) void))
+(defun (sync-subs! app)
+  (def wanted ((.subscriptions app) (.model app)))
+  (defun (wanted? key) (any? (fun (sub) (= (.key sub) key)) wanted))
+  (def/mutable kept '())
+  (loop (:for (Tuple key scope) (.subs app))
+        (:do (if (wanted? key)
+                 (set! kept (cons (Tuple key scope) kept))
+                 (stop-scope! scope))))
+  (loop (:for sub wanted)
+        (:when (not (any? (fun (t) (= (fst t) (.key sub))) kept)))
+        (:do (set! kept (cons (Tuple (.key sub) (start-sub! app sub)) kept))))
+  (record-set! app (subs kept)))
 
 (: (-> (App %model %m) void))
 (defun (render! app)
-  (def next ((.view app) (.model app)))
+  (def next-view ((.view app) (.model app)))
   (record-set! app (patching #t))
   (match (.root app)
     (None
-     (def live (mount app next))
+     (def live (mount app next-view))
      (record-set! app (root (Some live)))
      ((.on-root app) (.control live)))
     ((Some live)
-     (def now (patch! app live next))
+     (def now (patch! app live next-view))
      (unless (eq? now live)
        (record-set! app (root (Some now)))
        ((.on-root app) (.control now)))))
   (record-set! app (patching #f)))
 
-;; Gives the message that `pick` finds in the control's events to `update`.
+;; Gives the message that `pick` finds in the control's events to `gui-update`.
 (: (-> (App %model %m) (Live %m) (-> (On %m) (Option %m)) void))
 (defun (fire! app live pick)
   (unless (.patching app)
@@ -391,21 +541,27 @@
              (mutablevec-add! kids c)
              (.Add controls (.control c)))))
 
-;; An app with no window: its view is made now, and `on-root` is given the
+;; An app with no window: its view is made now, its subscriptions started,
-;; control to show each time that control changes.
+;; and `on-root` is given the control to show each time that control changes.
-(: (-> %model (-> %m %model %model) (-> %model (View %m)) (-> Control void)
+;; Its fibers belong to the scope it is started in.
+(: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
+       (-> Control void) (#:subscriptions (-> %model (List (Sub %m))))
        (App %model %m)))
-(defun (start-app init update view on-root)
+(defun (start-app init gui-update view on-root #:subscriptions (fun (m) '()))
-  (def app (App (model init) (update update) (view view) (root None) (patching #f)
+  (def app (App (model init) (gui-update gui-update) (view view)
-                (on-root on-root)))
+                (subscriptions subscriptions) (root None) (patching #f) (stopped #f)
-  (render! app)
+                (home (current-scope)) (subs '()) (on-root on-root)))
+  (step! app '())
   app)
 
-;; Runs the program in a window, until the window is closed.
+;; Runs the program in a window, until the window is closed. Then the
-(: (-> %model (-> %m %model %model) (-> %model (View %m))
+;; subscriptions and the commands still running are cancelled.
+(: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
+       (#:subscriptions (-> %model (List (Sub %m))))
        (#:title string) (#:width double) (#:height double)
        void))
-(defun (run-app init update view #:title "bjogui" #:width 400.0 #:height 300.0)
+(defun (run-app init gui-update view #:subscriptions (fun (m) '())
+                #:title "bjogui" #:width 400.0 #:height 300.0)
   ;; The Application is made inside the setup, because making one uses the
   ;; dispatcher, and the dispatcher is the platform's only after the setup.
   (def lifetime (Lifetime.))
@@ -418,7 +574,11 @@
                      (cast Object width) Priority.LocalValue))
   (ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty height-property)
                      (cast Object height) Priority.LocalValue))
-  (ignore (start-app init update view
+  (with-cancel (cancel)
-                     (fun (c) (window-content! (cast ContentControl w) (cast Object c)))))
+    (def app (start-app init gui-update view
+                        (fun (c) (window-content! (cast ContentControl w) (cast Object c)))
+                        #:subscriptions subscriptions))
     (main-window! lifetime w)
-  (ignore (start-lifetime lifetime (: (make-array 0) (Array ClrString)))))
+    (ignore (start-lifetime lifetime (: (make-array 0) (Array ClrString))))
+    (app-stop! app)
+    (cancel (Requested "the window is closed"))))

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))
+(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
-(defun (update msg m)
+(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)))))
+      (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"))