;; 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"))