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

230
src/app.bjo
View file

@ -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
;; window. Every Avalonia name stays in this module: what it exports takes
;; and gives Bjolang values, and a control only as an opaque `Control`.
;; Runs a program written as a model, a `gui-update` and a `view`, in an
;; Avalonia window. Every Avalonia name stays in this module: what it exports
;; 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
run-app
App Live Control Sub
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,17 +246,66 @@
(: 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))
(: view (-> %model (View %m)))
(: root (Option (Live %m)) #:mutable)
(: patching bool #:mutable)
(: on-root (-> Control void)))))
;;
;; `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))
(defun (app-model app) (.model app))
@ -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))))
(render! app))
(unless (.stopped 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
;; control to show each time that control changes.
(: (-> %model (-> %m %model %model) (-> %model (View %m)) (-> Control void)
;; An app with no window: its view is made now, its subscriptions started,
;; and `on-root` is given the control to show each time that control changes.
;; 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)
(def app (App (model init) (update update) (view view) (root None) (patching #f)
(on-root on-root)))
(render! app)
(defun (start-app init gui-update view on-root #:subscriptions (fun (m) '()))
(def app (App (model init) (gui-update gui-update) (view view)
(subscriptions subscriptions) (root None) (patching #f) (stopped #f)
(home (current-scope)) (subs '()) (on-root on-root)))
(step! app '())
app)
;; Runs the program in a window, until the window is closed.
(: (-> %model (-> %m %model %model) (-> %model (View %m))
;; Runs the program in a window, until the window is closed. Then the
;; 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
(fun (c) (window-content! (cast ContentControl w) (cast Object c)))))
(main-window! lifetime w)
(ignore (start-lifetime lifetime (: (make-array 0) (Array ClrString)))))
(with-cancel (cancel)
(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))))
(app-stop! app)
(cancel (Requested "the window is closed"))))