bjoli/bjogui
SHA256
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Commands and subscriptions, and gui-update

Browse source 
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>
This commit is contained in:
Linus Björnstam 2026-10-25 17:02:02 +01:00
parent 2f4c99ba62
commit 4f48282314
6 changed files with 460 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

130
tests/effects.bjo Normal file
View file

@ -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"))