bjogui/tests/app.bjo

;; 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, gui-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))))

(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m)
  (next
    (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)) gui-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"))