;; 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/src/app.bjo — the module (bjogui app).
;;
;; 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. `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 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-send! app-stop! app-run-pending!
  app-model app-control app-control-at)

(import (std prelude))
(import (std interop))
(import (std mutable vec))
(import (bjogui view))

;; ---------------------------------------------------------------------------
;; Avalonia
;; ---------------------------------------------------------------------------

(import/class
  (Object            (: System.Object))
  (InvalidOperation  (: System.InvalidOperationException (-> string InvalidOperation)))
  (ClrString         (: System.String))
  (Disposable        (: System.IDisposable))
  (Services          (: System.IServiceProvider))
  ((Nullable %a)     (: System.Nullable))
  ((EventHandler %a) (: System.EventHandler))
  (AvaloniaObject    (: Avalonia.AvaloniaObject))
  (AvaloniaProperty  (: Avalonia.AvaloniaProperty))
  (Priority          (: Avalonia.Data.BindingPriority))
  (Thickness         (: Avalonia.Thickness (-> double Thickness)))
  (Orientation       (: Avalonia.Layout.Orientation))
  (HAlignment        (: Avalonia.Layout.HorizontalAlignment))
  (Control           (: Avalonia.Controls.Control))
  (Controls          (: Avalonia.Controls.Controls))
  (Panel             (: Avalonia.Controls.Panel))
  (StackPanel        (: Avalonia.Controls.StackPanel (-> StackPanel)))
  (TextBlock         (: Avalonia.Controls.TextBlock (-> TextBlock)))
  (Button            (: Avalonia.Controls.Button (-> Button)))
  (TextBox           (: Avalonia.Controls.TextBox (-> TextBox)))
  (CheckBox          (: Avalonia.Controls.CheckBox (-> CheckBox)))
  (ToggleButton      (: Avalonia.Controls.Primitives.ToggleButton))
  (ContentControl    (: Avalonia.Controls.ContentControl))
  (Window            (: Avalonia.Controls.Window (-> Window)))
  (Interactive       (: Avalonia.Interactivity.Interactive))
  (RoutedEvent       (: Avalonia.Interactivity.RoutedEvent))
  (RoutedEventArgs   (: Avalonia.Interactivity.RoutedEventArgs))
  (Routes            (: Avalonia.Interactivity.RoutingStrategies))
  (Application       (: Avalonia.Application (-> Application)))
  (Styles            (: Avalonia.Styling.Styles))
  (FluentTheme       (: Avalonia.Themes.Fluent.FluentTheme (-> Services FluentTheme)))
  (AppBuilder        (: Avalonia.AppBuilder))
  (ILifetime         (: Avalonia.Controls.ApplicationLifetimes.IApplicationLifetime))
  (Lifetime          (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime
                        (-> Lifetime)))
  (Dispatcher        (: Avalonia.Threading.Dispatcher))
  (UiPriority        (: Avalonia.Threading.DispatcherPriority))
  ((DispatcherOp %a) (: Avalonia.Threading.DispatcherOperation)))

(import/extern
  ;; Properties, as the objects `SetValue` takes.
  (text-block-text      (: Avalonia.Controls.TextBlock.TextProperty #:get))
  (text-block-font-size (: Avalonia.Controls.TextBlock.FontSizeProperty #:get))
  (content-property     (: Avalonia.Controls.ContentControl.ContentProperty #:get))
  (text-box-text        (: Avalonia.Controls.TextBox.TextProperty #:get))
  (watermark-property   (: Avalonia.Controls.TextBox.WatermarkProperty #:get))
  (is-checked-property  (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedProperty #:get))
  (is-enabled-property  (: Avalonia.Input.InputElement.IsEnabledProperty #:get))
  (font-size-property   (: Avalonia.Controls.Primitives.TemplatedControl.FontSizeProperty #:get))
  (padding-property     (: Avalonia.Controls.Primitives.TemplatedControl.PaddingProperty #:get))
  (width-property       (: Avalonia.Layout.Layoutable.WidthProperty #:get))
  (height-property      (: Avalonia.Layout.Layoutable.HeightProperty #:get))
  (margin-property      (: Avalonia.Layout.Layoutable.MarginProperty #:get))
  (spacing-property     (: Avalonia.Controls.StackPanel.SpacingProperty #:get))
  (orientation-property (: Avalonia.Controls.StackPanel.OrientationProperty #:get))
  (content-alignment-property
   (: Avalonia.Controls.ContentControl.HorizontalContentAlignmentProperty #:get))

  (set-value  (: Avalonia.AvaloniaObject.SetValue
                 (-> AvaloniaObject AvaloniaProperty Object Priority Disposable)))
  (clear-value (: Avalonia.AvaloniaObject.ClearValue (-> AvaloniaObject AvaloniaProperty void)))

  ;; Events.
  (click-event         (: Avalonia.Controls.Button.ClickEvent #:get))
  ;; TextChanging and not TextChanged: TextChanged is posted to the
  ;; dispatcher and comes later, after the patch that set the text is over.
  (text-changing-event (: Avalonia.Controls.TextBox.TextChangingEvent #:get))
  (checked-event       (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedChangedEvent #:get))
  (add-handler (: Avalonia.Interactivity.Interactive.AddHandler
                  (-> Interactive RoutedEvent Delegate Routes bool void)))

  ;; What a control holds.
  (text-box-value (: Avalonia.Controls.TextBox.Text (-> TextBox string) #:get))
  (is-checked     (: Avalonia.Controls.Primitives.ToggleButton.IsChecked
                     (-> ToggleButton (Nullable bool)) #:get))
  (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
                          (-> AppBuilder AppBuilder)))
  (setup-with-lifetime (: Avalonia.AppBuilder.SetupWithLifetime (-> AppBuilder ILifetime AppBuilder)))
  (current-app         (: Avalonia.Application.Current #:get))
  (app-styles          (: Avalonia.Application.Styles (-> Application Styles) #:get))
  (main-window!        (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.MainWindow
                          (-> Lifetime Window void) #:set))
  (start-lifetime      (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.Start
                          (-> Lifetime (Array ClrString) int)))
  (window-title!       (: Avalonia.Controls.Window.Title (-> Window string void) #:set))
  (window-content!     (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object void) #:set)))

;; ---------------------------------------------------------------------------
;; Properties
;; ---------------------------------------------------------------------------

(: (-> Kind bool))
(defun (stack? kind)
  (match kind
    (ColumnKind #t)
    (RowKind #t)
    (_ #f)))

;; A kind that Avalonia draws with a template, and so has a padding and a
;; font size of its own.
(: (-> Kind bool))
(defun (templated? kind)
  (match kind
    (ButtonKind #t)
    (TextInputKind #t)
    (CheckBoxKind #t)
    (_ #f)))

;; The Avalonia property that a prop sets on a control of this kind. None
;; for a prop that the kind does not take.
(: (-> Kind Prop (Option AvaloniaProperty)))
(defun (slot kind p)
  (match p
    ((Label _)
     (match kind
       (TextKind (Some (cast AvaloniaProperty text-block-text)))
       (ButtonKind (Some (cast AvaloniaProperty content-property)))
       (CheckBoxKind (Some (cast AvaloniaProperty content-property)))
       (_ None)))
    ((Value _) (if (= kind TextInputKind) (Some (cast AvaloniaProperty text-box-text)) None))
    ((Placeholder _) (if (= kind TextInputKind) (Some (cast AvaloniaProperty watermark-property)) None))
    ((Checked _) (if (= kind CheckBoxKind) (Some (cast AvaloniaProperty is-checked-property)) None))
    ((Enabled _) (Some (cast AvaloniaProperty is-enabled-property)))
    ((FontSize _)
     (cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-font-size)))
           ((templated? kind) (Some (cast AvaloniaProperty font-size-property)))
           (else None)))
    ((Width _) (Some (cast AvaloniaProperty width-property)))
    ((Height _) (Some (cast AvaloniaProperty height-property)))
    ((Margin _) (Some (cast AvaloniaProperty margin-property)))
    ((Padding _) (if (templated? kind) (Some (cast AvaloniaProperty padding-property)) None))
    ((Spacing _) (if (stack? kind) (Some (cast AvaloniaProperty spacing-property)) None))))

;; The value of a prop, as the object `SetValue` takes.
(: (-> Prop Object))
(defun (boxed p)
  (match p
    ((Label s) (cast Object (clr-string s)))
    ((Value s) (cast Object (clr-string s)))
    ((Placeholder s) (cast Object (clr-string s)))
    ((Checked b) (cast Object b))
    ((Enabled b) (cast Object b))
    ((FontSize d) (cast Object d))
    ((Width d) (cast Object d))
    ((Height d) (cast Object d))
    ((Margin d) (cast Object (Thickness. d)))
    ((Padding d) (cast Object (Thickness. d)))
    ((Spacing d) (cast Object d))))

;; Which prop it is, without its value. Two props with one tag set the same
;; property.
(: (-> Prop int))
(defun (tag p)
  (match p
    ((Label _) 0) ((Value _) 1) ((Placeholder _) 2) ((Checked _) 3)
    ((Enabled _) 4) ((FontSize _) 5) ((Width _) 6) ((Height _) 7)
    ((Margin _) 8) ((Padding _) 9) ((Spacing _) 10)))

(: (-> Control Kind Prop void))
(defun (set-prop! control kind p)
  (match (slot kind p)
    ((Some property)
     (ignore (set-value (cast AvaloniaObject control) property (boxed p) Priority.LocalValue)))
    (None unit)))

(: (-> Control Kind Prop void))
(defun (clear-prop! control kind p)
  (match (slot kind p)
    ((Some property) (clear-value (cast AvaloniaObject control) property))
    (None unit)))

;; Clears the props that are gone, and sets the ones that are new or have
;; another value. A prop with the same value is not set again.
(: (-> Control Kind (Vec Prop) (Vec Prop) void))
(defun (patch-props! control kind old new)
  (loop (:for p old)
        (:when (not (any? (fun (q) (= (tag q) (tag p))) new)))
        (:do (clear-prop! control kind p)))
  (loop (:for p new)
        (:when (not (vec-contains old p)))
        (:do (set-prop! control kind p))))

;; ---------------------------------------------------------------------------
;; The app
;; ---------------------------------------------------------------------------

;; A control, the view it was last given, and the live children it holds.
(type (: (Live %m) #:opaque (Record (: control Control)
                           (: 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.
;;
;; `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))

;; The control the view is shown in. It changes when the root view changes
;; kind.
(: (-> (App %model %m) Control))
(defun (app-control app)
  (match (.root app)
    ((Some live) (.control live))
    (None (raise (cast Exception (InvalidOperation. "the app has no view"))))))

;; The control at `path`, a child index for each level below the root.
(: (-> (App %model %m) (List int) Control))
(defun (app-control-at app path)
  (: (-> (Live %m) (List int) Control))
  (defun (walk live path)
    (match path
      (() (.control live))
      ((List i rest ...) (walk (mutablevec-ref (.children live) i) rest))))
  (match (.root app)
    ((Some live) (walk live path))
    (None (raise (cast Exception (InvalidOperation. "the app has no 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)
  (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 ((.view app) (.model app)))
  (record-set! app (patching #t))
  (match (.root app)
    (None
     (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-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 `gui-update`.
(: (-> (App %model %m) (Live %m) (-> (On %m) (Option %m)) void))
(defun (fire! app live pick)
  (unless (.patching app)
    (match (loop (:for on (.events (.view live)))
                 (:when-let (Some msg) (pick on))
                 (:finish #t (Some msg))
                 => None)
      ((Some msg) (app-dispatch! app msg))
      (None unit))))

(: (-> Control RoutedEvent (-> Object RoutedEventArgs void) void))
(defun (on! control event handler)
  (add-handler (cast Interactive control) event
               (cast Delegate (cast Object (: (as-delegate handler) (EventHandler RoutedEventArgs))))
               Routes.Bubble #f))

;; Adds the handlers of the kind. A handler reads the view the control has
;; when the event comes, so a new view needs no new handler.
(: (-> (App %model %m) (Live %m) Kind void))
(defun (listen! app live kind)
  (def control (.control live))
  (match kind
    (ButtonKind
     (on! control (cast RoutedEvent click-event)
          (fun (sender e)
            (fire! app live (fun (on) (match on ((Click msg) (Some msg)) (_ None)))))))
    (TextInputKind
     (on! control (cast RoutedEvent text-changing-event)
          (fun (sender e)
            (def s (text-box-value (cast TextBox control)))
            (fire! app live (fun (on) (match on ((Input f) (Some (f s))) (_ None)))))))
    (CheckBoxKind
     (on! control (cast RoutedEvent checked-event)
          (fun (sender e)
            (def b (.GetValueOrDefault (is-checked (cast ToggleButton control))))
            (fire! app live (fun (on) (match on ((Toggle f) (Some (f b))) (_ None)))))))
    (_ unit)))

(: (-> Kind Control))
(defun (make-control kind)
  (match kind
    (TextKind (cast Control (TextBlock.)))
    (ButtonKind
     ;; Centred, because a button given a width shows its label at the left.
     (def b (Button.))
     (ignore (set-value (cast AvaloniaObject b) (cast AvaloniaProperty content-alignment-property)
                        (cast Object HAlignment.Center) Priority.LocalValue))
     (cast Control b))
    (TextInputKind (cast Control (TextBox.)))
    (CheckBoxKind (cast Control (CheckBox.)))
    (ColumnKind (cast Control (StackPanel.)))
    (RowKind
     (def panel (StackPanel.))
     (ignore (set-value (cast AvaloniaObject panel) (cast AvaloniaProperty orientation-property)
                        (cast Object Orientation.Horizontal) Priority.LocalValue))
     (cast Control panel))))

;; Makes the controls for a view.
(: (-> (App %model %m) (View %m) (Live %m)))
(defun (mount app v)
  (def kind (view-kind v))
  (def control (make-control kind))
  (def live (Live (control control) (view v) (children (mutablevec))))
  (loop (:for p (view-props v)) (:do (set-prop! control kind p)))
  (listen! app live kind)
  (loop (:for child (view-children v))
        (:do (def c (mount app child))
             (mutablevec-add! (.children live) c)
             (.Add (panel-children (cast Panel control)) (.control c))))
  live)

;; Changes the controls of `live` to show `next`. Gives `live` itself, or new
;; controls when the kind is another.
(: (-> (App %model %m) (Live %m) (View %m) (Live %m)))
(defun (patch! app live next)
  (def old (.view live))
  (def kind (view-kind next))
  (if (not (= (view-kind old) kind))
      (mount app next)
      (begin
        (patch-props! (.control live) kind (view-props old) (view-props next))
        (record-set! live (view next))
        (when (stack? kind)
          (patch-children! app live (view-children next)))
        live)))

;; Children are matched by their place: the first with the first, and so on.
;; Those past the end of the shorter list are added or removed.
(: (-> (App %model %m) (Live %m) (Vec (View %m)) void))
(defun (patch-children! app live views)
  (def kids (.children live))
  (def controls (panel-children (cast Panel (.control live))))
  (def n (vec-length views))
  (loop (:for i (range 0 (min n (mutablevec-length kids))))
        (:do (def was (mutablevec-ref kids i))
             (def now (patch! app was (vec-ref views i)))
             (unless (eq? now was)
               (mutablevec-set! kids i now)
               (.set_Item controls i (.control now)))))
  (loop (:while (> (mutablevec-length kids) n))
        (:do (ignore (mutablevec-pop! kids))
             (.RemoveAt controls (mutablevec-length kids))))
  (loop (:for i (range (mutablevec-length kids) n))
        (:do (def c (mount app (vec-ref views i)))
             (mutablevec-add! kids c)
             (.Add controls (.control c)))))

;; 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 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. 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 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.))
  (ignore (setup-with-lifetime (use-platform-detect (configure (fun () (Application.))))
                               lifetime))
  (.Add (app-styles current-app) (FluentTheme. (clr-default)))
  (def w (Window.))
  (window-title! w title)
  (ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty width-property)
                     (cast Object width) Priority.LocalValue))
  (ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty height-property)
                     (cast Object height) Priority.LocalValue))
  (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"))))