#lang imperative-syndicate/test-implementation
;; See .../racket/syndicate/examples/actor/example-partial-retraction.rkt
;; TODO: deal with permissible permutations in the output

(test-case
    [(struct ready (what) #:prefab)
     (struct entry (key val) #:prefab)

     (spawn (assert (ready 'listener))
            (on (asserted (entry $key _))
                (printf "key ~v asserted\n" key)
                (until (retracted (entry key _))
                  (on (asserted (entry key $value))
                      (printf "add binding: ~v -> ~v\n" key value))
                  (on (retracted (entry key $value))
                      (printf "del binding: ~v -> ~v\n" key value)))
                (printf "key ~v retracted\n" key)))

     (spawn (assert (ready 'other-listener))
            (during (entry $key _)
              (printf "(other-listener) key ~v asserted\n" key)
              (on-stop (printf "(other-listener) key ~v retracted\n" key))
              (during (entry key $value)
                (printf "(other-listener) ~v ---> ~v\n" key value)
                (on-stop (printf "(other-listener) ~v -/-> ~v\n" key value)))))

     (define (pause)
       (displayln "pause")
       (define token (gensym 'pause)) ;; FIXME:: If we use the same token every time, need epochs!
       (until (asserted (ready token))
         (assert (ready token))))

     (spawn* (until (asserted (ready 'listener)))
             (until (asserted (ready 'other-listener)))
             (assert! (entry 'a 1))
             (assert! (entry 'a 2))
             (assert! (entry 'b 3))
             (assert! (entry 'c 33))
             (assert! (entry 'a 4))
             (assert! (entry 'a 5))
             (pause)
             (retract! (entry 'a 2))
             (retract! (entry 'c 33))
             (assert! (entry 'a 9))
             (pause)
             (local-require "../../bag.rkt")
             (for [(a (in-bag (current-adhoc-assertions)))]
               (match a
                 [(entry 'a _) (retract! a)]
                 [_ (void)]))
             ;; ^ (retract! (entry 'a ?))
             (pause))]
  no-crashes
  ;; To properly test this, we need something closer to real
  ;; regular-expressions-with-interleave over output lines:
  #;(expected-output (list "pause"
                         "pause")
                   (set "(other-listener) key 'a asserted"
                        "(other-listener) key 'c asserted"
                        "(other-listener) key 'b asserted")
                   (set "(other-listener) 'a ---> 4"
                        "(other-listener) 'a ---> 1"
                        "(other-listener) 'a ---> 2"
                        "(other-listener) 'a ---> 5"
                        "(other-listener) 'c ---> 33"
                        "(other-listener) 'b ---> 3")
                   (set "key 'a asserted"
                        "key 'c asserted"
                        "key 'b asserted")
                   (set "add binding: 'a -> 4"
                        "add binding: 'a -> 1"
                        "add binding: 'a -> 2"
                        "add binding: 'a -> 5"
                        "add binding: 'c -> 33"
                        "add binding: 'b -> 3")
                   (list "pause")
                   (set "del binding: 'a -> 2"
                        "del binding: 'c -> 33"
                        "add binding: 'a -> 9")
                   (set "key 'c retracted")
                   (set "(other-listener) 'a ---> 9"
                        "(other-listener) 'a -/-> 2"
                        "(other-listener) 'c -/-> 33"
                        "(other-listener) key 'c retracted")
                   (set "del binding: 'a -> 1"
                        "del binding: 'a -> 9"
                        "del binding: 'a -> 5"
                        "del binding: 'a -> 4")
                   (set "key 'a retracted")
                   (set "(other-listener) 'a -/-> 1"
                        "(other-listener) 'a -/-> 9"
                        "(other-listener) 'a -/-> 5"
                        "(other-listener) 'a -/-> 4")
                   (set "(other-listener) key 'a retracted")
                   (set "del binding: 'b -> 3")
                   (set "key 'b retracted")
                   (set "(other-listener) 'b -/-> 3")
                   (set "(other-listener) key 'b retracted")))
