#lang imperative-syndicate/test-implementation
;; Uhoh! The current (2018-05-02) scheme for relaying between
;; dataspaces instantiates each pattern when a matching assertion
;; appears and then relays the result on via an ordinary assertion.
;; However, this is probably wrong! If one inner observer monitors
;;
;;     (inbound (x _ $y))
;;
;; while another monitors
;;
;;     (inbound (x $z _))
;;
;; then the second one will see a literal `(discard)` for `z`!

(assertion-struct researcher (name topic))

(define no-mention-of-discard
  (lambda ()
    (not (memf (lambda (line) (string-contains? line "#s(discard)"))
               (collected-lines)))))

(define-syntax-rule (correct-topics-and-researchers)
  (expected-output-set "Added researcher: Alice"
                       "Added researcher: Eve"
                       "Added researcher: Tony"
                       "Added topic: Bicycling"
                       "Added topic: Computering"
                       "Added topic: Cryptography"
                       "Added topic: Evil"))

(test-case
    [(spawn #:name 'tony
            (assert (researcher "Tony" "Computering"))
            (assert (researcher "Tony" "Bicycling")))
     (spawn #:name 'alice
            (assert (researcher "Alice" "Cryptography"))
            (assert (researcher "Alice" "Bicycling")))
     (spawn #:name 'eve
            (assert (researcher "Eve" "Cryptography"))
            (assert (researcher "Eve" "Computering"))
            (assert (researcher "Eve" "Evil")))

     (dataspace #:name 'inner-dataspace
                (spawn #:name 'all-topics
                       (during (inbound (researcher _ $topic))
                         (on-start (printf "Added topic: ~a\n" topic))
                         (on-stop (printf "Removed topic: ~a\n" topic))))
                (spawn #:name 'all-researchers
                       (during (inbound (researcher $name _))
                         (on-start (printf "Added researcher: ~a\n" name))
                         (on-stop (printf "Removed researcher: ~a\n" name)))))]
  no-crashes
  no-mention-of-discard
  (correct-topics-and-researchers))

(test-case
    ;; This one is just like the one above, but doesn't have the
    ;; nested dataspace, so the right answers are given.
    [(spawn #:name 'tony
            (assert (researcher "Tony" "Computering"))
            (assert (researcher "Tony" "Bicycling")))
     (spawn #:name 'alice
            (assert (researcher "Alice" "Cryptography"))
            (assert (researcher "Alice" "Bicycling")))
     (spawn #:name 'eve
            (assert (researcher "Eve" "Cryptography"))
            (assert (researcher "Eve" "Computering"))
            (assert (researcher "Eve" "Evil")))

     (spawn #:name 'all-topics
            (during (researcher _ $topic)
              (on-start (printf "Added topic: ~a\n" topic))
              (on-stop (printf "Removed topic: ~a\n" topic))))
     (spawn #:name 'all-researchers
            (during (researcher $name _)
              (on-start (printf "Added researcher: ~a\n" name))
              (on-stop (printf "Removed researcher: ~a\n" name))))]
  no-crashes
  no-mention-of-discard
  (correct-topics-and-researchers))