;; 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/app.bjo — an app driven through its real controls. ;; ;; bjo run tests/app.bjo ;; ;; 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. (import (std prelude)) (import (std simpletest)) (import (bjogui view)) (import (bjogui app)) (import/class (Object (: System.Object)) (Interactive (: Avalonia.Interactivity.Interactive)) (RoutedEvent (: Avalonia.Interactivity.RoutedEvent)) (RoutedEventArgs (: Avalonia.Interactivity.RoutedEventArgs (-> RoutedEvent RoutedEventArgs))) (TextBlock (: Avalonia.Controls.TextBlock)) (TextBox (: Avalonia.Controls.TextBox)) (ContentControl (: Avalonia.Controls.ContentControl)) (CheckBox (: Avalonia.Controls.CheckBox)) (ToggleButton (: Avalonia.Controls.Primitives.ToggleButton)) (InputElement (: Avalonia.Input.InputElement)) (StackPanel (: Avalonia.Controls.StackPanel)) (Panel (: Avalonia.Controls.Panel)) (Controls (: Avalonia.Controls.Controls)) ((Nullable %a) (: System.Nullable)) (AvaloniaObject (: Avalonia.AvaloniaObject)) (AvaloniaProperty (: Avalonia.AvaloniaProperty)) (Priority (: Avalonia.Data.BindingPriority)) (Disposable (: System.IDisposable))) (import/extern (click-event (: Avalonia.Controls.Button.ClickEvent #:get)) (is-checked-property (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedProperty #:get)) (set-value (: Avalonia.AvaloniaObject.SetValue (-> AvaloniaObject AvaloniaProperty Object Priority Disposable))) (raise-event (: Avalonia.Interactivity.Interactive.RaiseEvent (-> Interactive RoutedEventArgs void))) (block-text (: Avalonia.Controls.TextBlock.Text (-> TextBlock string) #:get)) (box-text (: Avalonia.Controls.TextBox.Text (-> TextBox string) #:get)) (box-text! (: Avalonia.Controls.TextBox.Text (-> TextBox string void) #:set)) (caret (: Avalonia.Controls.TextBox.CaretIndex (-> TextBox int) #:get)) (caret! (: Avalonia.Controls.TextBox.CaretIndex (-> TextBox int void) #:set)) (checked (: Avalonia.Controls.Primitives.ToggleButton.IsChecked (-> ToggleButton (Nullable bool)) #:get)) (enabled? (: Avalonia.Input.InputElement.IsEnabled (-> InputElement bool) #:get)) (content (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object) #:get)) (children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get)) (count (: Avalonia.Controls.Controls.Count (-> Controls int) #:get))) ;; --------------------------------------------------------------------------- ;; The program under test ;; --------------------------------------------------------------------------- (type (: Msg (Union Inc Dec (: Typed string) (: Shout bool) Reset))) (type (: Model (Record (: count int) (: name string) (: loud bool)))) (: update (-> Msg Model Model)) (defun (update msg m) (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))))) (: greeting (-> Model string)) (defun (greeting m) (def hello #"hello, ${(.name m)}") (if (.loud m) (string-upcase hello) hello)) (: view (-> Model (View Msg))) (defun (view m) (column #:spacing 4.0 (text #"count: ${(.count m)}") (row (button "+" Inc) (button "-" Dec #:enabled (> (.count m) 0))) (text-input (.name m) Typed #:placeholder "name") (checkbox "shout" (.loud m) Shout) (text (greeting m) #:size 20.0) ;; A line for each count over 2, to check that children come and go. (apply column (vec->array (vec-map (fun (i) (text #"line ${i}")) (->vec (range 0 (max 0 (- (.count m) 2))))))))) ;; --------------------------------------------------------------------------- ;; The test ;; --------------------------------------------------------------------------- (defun (main) (def/mutable roots 0) (def app (start-app (Model (count 0) (name "") (loud #f)) update view (fun (c) (set! roots (+ roots 1))))) (defun (at path) (app-control-at app path)) (defun (label path) (block-text (cast TextBlock (at path)))) (defun (click path) (raise-event (cast Interactive (at path)) (RoutedEventArgs. (cast RoutedEvent click-event)))) (expect "the root is shown once" roots 1) (expect "the first view" (label '(0)) "count: 0") (expect "a button's label" (written (content (cast ContentControl (at '(1 0))))) "+") (expect "a disabled button" (enabled? (cast InputElement (at '(1 1)))) #f) ;; --- clicks --------------------------------------------------------------- (def counter (at '(0))) (click '(1 0)) (expect "a click is a message" (label '(0)) "count: 1") (expect "and the model has it" (.count (app-model app)) 1) (expect "the button is enabled again" (enabled? (cast InputElement (at '(1 1)))) #t) (expect "the control is the same one" (eq? counter (at '(0))) #t) (click '(1 1)) (expect "the other button" (label '(0)) "count: 0") ;; --- text input ----------------------------------------------------------- (def input (cast TextBox (at '(2)))) (box-text! input "Ada") (expect "typing is a message" (.name (app-model app)) "Ada") (expect "the greeting follows" (label '(4)) "hello, Ada") (caret! input 1) (app-dispatch! app Inc) (expect "a patch keeps the caret" (caret input) 1) (expect "and the text" (box-text input) "Ada") (app-dispatch! app (Typed "Grace")) (expect "a new model sets the text" (box-text input) "Grace") (expect "without a message of its own" (.name (app-model app)) "Grace") ;; --- checkbox ------------------------------------------------------------- (def check (cast ToggleButton (at '(3)))) ;; A click on a checkbox toggles it in a method Avalonia calls for a ;; pointer, not for a raised Click. The test sets it as that method does. (ignore (set-value (cast AvaloniaObject check) (cast AvaloniaProperty is-checked-property) (cast Object #t) Priority.LocalValue)) (expect "a toggle is a message" (.loud (app-model app)) #t) (expect "the checkbox shows it" (.GetValueOrDefault (checked check)) #t) (expect "the greeting is loud" (label '(4)) "HELLO, GRACE") ;; --- children come and go ------------------------------------------------- (def lines (cast Panel (at '(5)))) (expect "no lines yet" (count (children lines)) 0) (app-dispatch! app Inc) (app-dispatch! app Inc) (app-dispatch! app Inc) (expect "two lines" (count (children lines)) 2) (expect "the second line" (label '(5 1)) "line 1") (app-dispatch! app Dec) (expect "one line" (count (children lines)) 1) (app-dispatch! app Reset) (expect "no lines" (count (children lines)) 0) (expect "reset clears the text" (box-text input) "") (expect "and the checkbox" (.GetValueOrDefault (checked check)) #f) (expect "the root was never replaced" roots 1) (println "bjogui ok"))