;;; Copyright 2022 Christine Lemmer-Webber
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-module (test-taste-of-goblins)
  #:use-module (goblins)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 regex)
  #:use-module (taste-of-goblins))

(test-begin "test-taste-of-goblins")

(define am (make-actormap))
(define-syntax-rule (am-run body ...)
  (actormap-churn-run!
   am
   (lambda ()
     body ...)))

#|
#+BEGIN_SRC wisp
  ;; define with next argument *not* in parentheses
  ;; defines an ordinary variable
  REPL> define gary
  _____   spawn ^greeter "Gary"
#+END_SRC

#+BEGIN_SRC wisp
  REPL> $ gary "Alice"
  ;; => "Hello Alice, my name is Gary!"
#+END_SRC
|#

(define gary
  (am-run
   (spawn ^greeter "Gary")))

(test-equal "Hello Alice, my name is Gary!"
  (am-run
   ($ gary "Alice")))


#|
#+BEGIN_SRC wisp :tangle taste-of-goblins.w
  define (^cell bcom val)
    methods            ; syntax for first-argument-symbol-based dispatch
      (get)            ; takes no arguments
        . val          ; returns current value
      (set new-val)    ; takes one argument, new-val
        bcom : ^cell bcom new-val  ; become a cell with the new value
#+END_SRC

#+BEGIN_SRC wisp
  REPL> define chest
  _____   spawn ^cell "sword"
  REPL> $ chest 'get
  ;; => "sword"
  REPL> $ chest 'set "gold"
  REPL> $ chest 'get
  ;; => "gold" 
#+END_SRC
|#


(define chest
  (am-run
   (spawn ^cell "sword")))

(test-equal "sword"
  (am-run
   ($ chest 'get)))

(am-run ($ chest 'set "gold"))

(test-equal "gold"
  (am-run
   ($ chest 'get)))

#|
#+BEGIN_SRC wisp
  REPL> define julius
  _____   spawn ^cgreeter "Julius"
  REPL> $ julius 'get-times-called
  ;; => 0
  REPL> $ julius 'greet "Gaius"
  ;; => "[1] Hello Gaius, my name is Julius!"
  REPL> $ julius 'greet "Brutus"
  ;; => "[2] Hello Brutus, my name is Julius!"
  REPL> $ julius 'get-times-called
  ;; => 2
#+END_SRC
|#

(define julius (am-run (spawn ^cgreeter "Julius")))
(test-equal 0
  (am-run ($ julius 'get-times-called)))
(test-equal "[1] Hello Gaius, my name is Julius!"
  (am-run ($ julius 'greet "Gaius")))
(test-equal "[2] Hello Brutus, my name is Julius!"
  (am-run ($ julius 'greet "Brutus")))
(test-equal 2
  (am-run ($ julius 'get-times-called)))

#|
#+BEGIN_SRC wisp
REPL> <- julius 'greet "Lear"
;; => #<promise>
#+END_SRC
|#

(test-assert (local-promise-refr?
              (am-run
               (<- julius 'greet "Lear"))))

#|
#+BEGIN_SRC wisp
  REPL> on (<- julius 'greet)
  _____   lambda (got-back)
  _____     format #t "Heard back: ~a\n"
  _____            . got-back
  ;; Prints out, at some point in the future:
  ;;   Heard back: [3] Hello Lear, my name is Julius!
#+END_SRC
|#

(test-equal "Heard back: [4] Hello Lear, my name is Julius!\n"
  (with-output-to-string
    (lambda ()
      (am-run
       (on (<- julius 'greet "Lear")
           (lambda (got-back)
             (format #t "Heard back: ~a\n"
                     got-back)))))))

#|
#+BEGIN_SRC wisp
  REPL> define (^broken-bob _bcom)
  _____   lambda ()
  _____     error "Yikes, I broke!"
  REPL> define broken-bob
  _____   spawn ^broken-bob
  REPL> on (<- broken-bob)
  _____    lambda (what-did-bob-say)
  _____      format #t "Bob says: ~a\n" what-did-bob-say
  _____    #:catch
  _____    lambda (err)
  _____      format #t "Got an error: ~a\n" err  
  _____    #:finally
  _____    lambda ()
  _____      display "Whew, it's over!\n"  
  ;; Prints out at some point in the future:
  ;;   Got an error: <error ...>
  ;;   Whew, it's over!
#+END_SRC
|#

(define (^broken-bob _bcom)
  (lambda ()
    (error "Yikes, I broke!")))

(define broken-bob
  (am-run
   (spawn ^broken-bob)))

;; some kludgery here both to capture output and to
;; nullify reported errors
(define captured-broken-output
  (parameterize ((current-error-port (%make-void-port "w")))
    (with-output-to-string
      (lambda ()
        (am-run
         (on (<- broken-bob)
             (lambda (what-did-bob-say)
               (format #t "Bob says: ~a\n" what-did-bob-say))
             #:catch
             (lambda (err)
               (format #t "Got an error: ~a\n" err))
             #:finally
             (lambda ()
               (display "Whew, it's over!\n"))))))))

(test-assert (string-match "^Got an error:.*\nWhew, it's over!\n$"
                           captured-broken-output))

#|
#+BEGIN_SRC wisp
REPL> define horatio
_____   spawn ^borked-cgreeter "Horatio"
REPL> $ horatio 'get-times-called
;; => 0
REPL> $ horatio 'greet "Hamlet"
;; pk debug: (before-incr 0)
;; pk debug: (after-incr 1)
;; ice-9/boot-9.scm:1685:16: In procedure raise-exception:
;;   Yikes
;; Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
#+END_SRC
|#

(define horatio
  (am-run
   (spawn ^borked-cgreeter "Horatio")))
(test-equal 0
  (am-run ($ horatio 'get-times-called)))
(test-error #t (parameterize ((current-error-port (%make-void-port "w"))
                              (current-output-port (%make-void-port "w")))
                 (am-run ($ horatio 'greet "Hamlet"))))

#|
#+BEGIN_SRC wisp
REPL> $ horatio 'get-times-called
;; => 0
#+END_SRC
|#

(test-equal 0
  (am-run ($ horatio 'get-times-called)))

#|
#+BEGIN_SRC wisp
  ;; Interaction on machine A
  REPL> define fork-motors
  _____   spawn ^car-factory "Fork"
#+END_SRC
|#

(define fork-motors
  (am-run
   (spawn ^car-factory "Fork")))

;;; Okay, in theory this next part happens across vats or machines,
;;; but we'll accept continuing to use our actormap churning as
;;; sufficient for now.

#|
#+BEGIN_SRC wisp
  ;; Interaction on machine B, communicating with fork-motors on A
  REPL> define car-vow
  _____   <- fork-motors 'make-car "Explorist" "blue"
#+END_SRC
|#

(define car-vow
  (am-run
   (<- fork-motors 'make-car "Explorist" "blue")))

#|
#+BEGIN_SRC wisp
  ;; Interaction on machine B, communicating with A
  REPL> on car-vow                  ; B->A: first resolve the car-vow
  _____   lambda (our-car)          ; A->B: car-vow resolved as our-car
  _____     on (<- our-car 'drive)  ; B->A: now we can message our-car
  _____       lambda (val)          ; A->B: result of that message
  _____         format #t "Heard: ~a\n" val
  ; prints (eventually):
  ;   Heard: *Vroom vroom!*  You drive your blue Fork Explorist!
#+END_SRC
|#

(test-equal "Heard: *Vroom vroom!*  You drive your blue Fork Explorist!\n"
  (with-output-to-string
    (lambda ()
      (am-run
       (on car-vow
           (lambda (our-car)
             (on (<- our-car 'drive)
                 (lambda (val)
                   (format #t "Heard: ~a\n" val)))))))))

#|
#+BEGIN_SRC wisp
  ;; Interaction on machine B, communicating with A
  REPL> on (<- car-vow 'drive)     ; B->A: send message to future car
  _____   lambda (val)             ; A->B: result of that message
  _____     format #t "Heard: ~a\n" val
  ; prints (eventually):
  ;   Heard: *Vroom vroom!*  You drive your blue Fork Explorist!
#+END_SRC
|#

(test-equal "Heard: *Vroom vroom!*  You drive your blue Fork Explorist!\n"
  (with-output-to-string
    (lambda ()
      (am-run
       (on (<- car-vow 'drive)
           (lambda (val)
             (format #t "Heard: ~a\n" val)))))))


#|
#+BEGIN_SRC wisp
  REPL> define forked-motors
  _____   spawn ^borked-car-factory "Forked"
  REPL> define car-vow
  _____   <- forked-motors 'make-car "Exploder" "red"
  REPL> define drive-noise-vow
  _____   <- car-vow 'drive
  REPL> on drive-noise-vow
  _____    lambda (val)
  _____      format #t "Heard: ~a\n" val
  _____    #:catch
  _____    lambda (err)
  _____      format #t "Caught: ~a\n" err
  ; prints (eventually):
  ;   Caught: <error...>
#+END_SRC
|#

(define forked-motors
  (am-run
   (spawn ^borked-car-factory "Forked")))
(define captured-exploder-output
  (parameterize ((current-error-port (%make-void-port "w")))
    (with-output-to-string
      (lambda ()
        (am-run
         (define car-vow
           (<- forked-motors 'make-car "Exploder" "red"))
         (define drive-noise-vow
           (<- car-vow 'drive))
         (on drive-noise-vow
             (lambda (val)
               (format #t "Heard: ~a\n" val))
             #:catch
             (lambda (err)
               (format #t "Caught: ~a\n" err))))))))
(test-assert (string-match "^Caught:.*"
                           captured-exploder-output))

(test-end "test-taste-of-goblins")