Linus Björnstam
4f48282314
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>
130 lines
5.1 KiB
Text
130 lines
5.1 KiB
Text
;; 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"))
|