;; lib/relations/tests/bulk.sx — extension: bulk lifecycle (relate-many,
;; unrelate-node cascade cleanup).

(define relations-bk-pass 0)
(define relations-bk-fail 0)
(define relations-bk-failures (list))

(define
  relations-bk-check!
  (fn
    (name got expected)
    (if
      (= got expected)
      (set! relations-bk-pass (+ relations-bk-pass 1))
      (do
        (set! relations-bk-fail (+ relations-bk-fail 1))
        (append!
          relations-bk-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))

(define
  relations-bk-subset?
  (fn
    (xs ys)
    (cond
      ((= (len xs) 0) true)
      ((relations-member? (first xs) ys)
        (relations-bk-subset? (rest xs) ys))
      (else false))))

(define
  relations-bk-set=?
  (fn
    (xs ys)
    (and
      (= (len xs) (len ys))
      (relations-bk-subset? xs ys)
      (relations-bk-subset? ys xs))))

(define
  relations-bk-run-all!
  (fn
    ()
    (do
      (let
        ((db (relations-build-db (list))))
        (do
          (relations-relate-many!
            db
            (list
              (list (quote a) (quote b) (quote parent))
              (list (quote a) (quote c) (quote parent))
              (list (quote x) (quote a) (quote parent))
              (list (quote a) (quote m) (quote member))))
          (relations-bk-check!
            "relate-many: parent children of a"
            (relations-bk-set=?
              (relations-children-of db (quote a) (quote parent))
              (list (quote b) (quote c)))
            true)
          (relations-bk-check!
            "relate-many: member child of a"
            (relations-bk-set=?
              (relations-children-of db (quote a) (quote member))
              (list (quote m)))
            true)
          (relations-bk-check!
            "relate-many: x is a parent of a"
            (relations-bk-set=?
              (relations-parents-of db (quote a) (quote parent))
              (list (quote x)))
            true)
          (relations-unrelate-node! db (quote a))
          (relations-bk-check!
            "after cleanup: a has no parent children"
            (relations-children-of db (quote a) (quote parent))
            (list))
          (relations-bk-check!
            "after cleanup: a has no parent parents"
            (relations-parents-of db (quote a) (quote parent))
            (list))
          (relations-bk-check!
            "after cleanup: a has no member children"
            (relations-children-of db (quote a) (quote member))
            (list))
          (relations-bk-check!
            "after cleanup: x no longer points at a"
            (relations-children-of db (quote x) (quote parent))
            (list))))
      (let
        ((db (relations-build-db (list (relations-rel (quote a) (quote b) (quote parent)) (relations-rel (quote c) (quote d) (quote parent))))))
        (do
          (relations-unrelate-node! db (quote a))
          (relations-bk-check!
            "cleanup leaves unrelated edge intact"
            (relations-bk-set=?
              (relations-children-of db (quote c) (quote parent))
              (list (quote d)))
            true)
          (relations-bk-check!
            "cleanup removed the a edge"
            (relations-children-of db (quote a) (quote parent))
            (list))))
      (let
        ((db (relations-build-db (list (relations-rel (quote a) (quote b) (quote parent))))))
        (do
          (relations-unrelate-node! db (quote nobody))
          (relations-bk-check!
            "cleanup of unknown node is a no-op"
            (relations-bk-set=?
              (relations-children-of db (quote a) (quote parent))
              (list (quote b)))
            true)))
      (do
        (relations/load! (list))
        (relations/relate-many!
          (list
            (list (quote o) (quote i1) (quote member))
            (list (quote o) (quote i2) (quote member))))
        (relations-bk-check!
          "api relate-many"
          (relations-bk-set=?
            (relations/children (quote o) (quote member))
            (list (quote i1) (quote i2)))
          true)
        (relations/unrelate-node! (quote o))
        (relations-bk-check!
          "api unrelate-node"
          (relations/children (quote o) (quote member))
          (list))
        (relations/load! (list))))))

(define
  relations-bulk-tests-run!
  (fn
    ()
    (do
      (set! relations-bk-pass 0)
      (set! relations-bk-fail 0)
      (set! relations-bk-failures (list))
      (relations-bk-run-all!)
      {:failures relations-bk-failures :total (+ relations-bk-pass relations-bk-fail) :passed relations-bk-pass :failed relations-bk-fail})))