(module test-set mzscheme

  (require "../private/require.ss")
  (require-contracts)
  (require-schemeunit)
  (require-etc)
  (require-lists)

  (require "../private/datum.ss"
           (prefix set: "../set.ss"))

  (provide/contract
   [test-set (-> test-suite?)])

  (define (test-set)
    (make-test-suite "Sets"
      (test-set-kind "Ordered" (curry set:make-ordered datum-compare))
      (test-set-kind "Hashed" (curry set:make-hashed datum-hash datum=?))
      (test-set-kind "Unordered" (curry set:make-unordered datum=?))
      ))

  (define (test-set-kind name set)
    (make-test-suite (format "Set: ~a" name)
      (make-test-suite "elements"
        (make-test-case "empty"
          (assert datum-list=? (set:elements (set)) null))
        (make-test-case "1,2,3"
          (assert datum-list=? (set:elements (set 1 2 3)) (list 1 2 3))))
      (make-test-suite "insert"
        (make-test-case "1,3 + 2"
          (assert datum-list=?
                  (set:elements (set:insert 2 (set 1 3)))
                  (list 1 2 3)))
        (make-test-case "1,2,3 + 2"
          (assert datum-list=?
                  (set:elements (set:insert 2 (set 1 2 3)))
                  (list 1 2 3)))
        (make-test-case "a,b,c + a"
          (let* ([a "a"]
                 [a* (string-copy a)]
                 [elems (set:elements (set:insert a* (set a)))])
            (assert = (length elems) 1
                    "Inserting a duplicate changed set size.")
            (assert-false
             (eq? (first elems) a)
             "Inserted duplicate; original value remains.")
            (assert-true
             (eq? (first elems) a*)
             "Inserted duplicate; new value not found."))))
      (make-test-suite "lookup"
        (make-test-case "a in a,b,c"
          (let* ([a "a"]
                 [b "b"]
                 [c "c"]
                 [a* (string-copy a)])
            (assert eq?
                    (set:lookup a* (set a b c))
                    a)))
        (make-test-case "a in b,c"
          (assert-false (set:lookup "a" (set "b" "c"))))
        (make-test-case "success override"
          (assert-equal?
           (set:lookup 1 (set 1 2 3)
                       (lambda () 'failure)
                       (lambda (elem) (cons 'success elem)))
           (cons 'success 1)))
        (make-test-case "failure override"
          (assert-equal?
           (set:lookup 4 (set 1 2 3)
                       (lambda () 'failure)
                       (lambda (elem) (cons 'success elem)))
           'failure)))
      (make-test-suite "remove"
        (make-test-case "present"
          (assert datum-list=?
                  (set:elements (set:remove 2 (set 1 2 3)))
                  (list 1 3)))
        (make-test-case "absent"
          (assert datum-list=?
                  (set:elements (set:remove 4 (set 1 2 3)))
                  (list 1 2 3))))
      (make-test-suite "empty?"
        (make-test-case "true"
          (assert-true (set:empty? (set))))
        (make-test-case "false"
          (assert-false (set:empty? (set 1 2 3)))))
      (make-test-suite "clear"
        (make-test-case "1,2,3"
          (assert-true (set:empty? (set:clear (set 1 2 3))))))
      (make-test-suite "size"
        (make-test-case "empty"
          (assert = (set:size (set)) 0))
        (make-test-case "1,2,3"
          (assert = (set:size (set 1 2 3)) 3)))
      (make-test-suite "member?"
        (make-test-case "true"
          (assert-true (set:member? 2 (set 1 2 3))))
        (make-test-case "false"
          (assert-false (set:member? 4 (set 1 2 3)))))
      (make-test-suite "fold"
        (make-test-case "1,2,3"
          (assert datum-list=?
                  (set:fold cons null (set 1 2 3))
                  (list 1 2 3))))
      (make-test-suite "map"
        (make-test-case "A,B,C"
          (assert datum-list=?
                  (set:elements (set:map symbol->string (set 'A 'B 'C)))
                  (list "A" "B" "C")))
        (make-test-case "overlap"
          (assert datum-list=?
                  (set:elements (set:map (lambda (n) (* n n)) (set -1 0 1 2)))
                  (list 0 1 4))))
      (make-test-suite "for-each"
        (make-test-case "1,2,3"
          (let* ([elems null])
            (set:for-each (lambda (elem) (set! elems (cons elem elems)))
                          (set 1 2 3))
            (assert datum-list=? elems (list 1 2 3)))))
      (make-test-suite "filter"
        (make-test-case "numbers"
          (assert datum-list=?
                  (set:elements (set:filter number?
                                            (set 1 2 3 'a 'b 'c "A" "B" "C")))
                  (list 1 2 3))))
      (make-test-suite "all?"
        (make-test-case "all"
          (assert-true (set:all? number? (set 1 2 3 4))))
        (make-test-case "some"
          (assert-false (set:all? even? (set 1 2 3 4))))
        (make-test-case "none"
          (assert-false (set:all? negative? (set 1 2 3 4)))))
      (make-test-suite "any?"
        (make-test-case "all"
          (assert-true (set:any? number? (set 1 2 3 4))))
        (make-test-case "some"
          (assert-true (set:any? even? (set 1 2 3 4))))
        (make-test-case "none"
          (assert-false (set:any? negative? (set 1 2 3 4)))))
      (make-test-suite "union"
        (make-test-case "1,3+2,4"
          (assert datum-list=?
                  (set:elements (set:union (set 1 3) (set 2 4)))
                  (list 1 2 3 4)))
        (make-test-case "1,2,3+2,3,4"
          (assert datum-list=?
                  (set:elements (set:union (set 1 2 3) (set 2 3 4)))
                  (list 1 2 3 4)))
        (make-test-case "override"
          (let* ([a1 "a"]
                 [a2 (string-copy a1)]
                 [elems
                  (set:elements
                   (set:union (set a1) (set a2)
                              (lambda (one two)
                                (assert eq? one a1)
                                (assert eq? two a2)
                                (string-copy one))))])
            (assert equal? elems (list "a"))
            (assert-false (eq? (car elems) a1))
            (assert-false (eq? (car elems) a2)))))
      (make-test-suite "intersection"
        (make-test-case "1,3&2,4"
          (assert datum-list=?
                  (set:elements (set:intersection (set 1 3) (set 2 4)))
                  null))
        (make-test-case "1,2,3&2,3,4"
          (assert datum-list=?
                  (set:elements (set:intersection (set 1 2 3) (set 2 3 4)))
                  (list 2 3)))
        (make-test-case "override"
          (let* ([b1 "b"]
                 [b2 (string-copy b1)]
                 [elems
                  (set:elements
                   (set:intersection (set "a" b1)
                                     (set b2 "c")
                                     (lambda (one two)
                                       (assert eq? one b1)
                                       (assert eq? two b2)
                                       (string-copy one))))])
            (assert equal? elems (list "b"))
            (assert-false (eq? (car elems) b1))
            (assert-false (eq? (car elems) b2)))))
      (make-test-suite "difference"
        (make-test-case "1,3-2,4"
          (assert datum-list=?
                  (set:elements (set:difference (set 1 3) (set 2 4)))
                  (list 1 3)))
        (make-test-case "1,2,3-2,3,4"
          (assert datum-list=?
                  (set:elements (set:difference (set 1 2 3) (set 2 3 4)))
                  (list 1))))
      (make-test-suite "select"
        (make-test-case "empty set"
          (assert-exn exn:fail? (lambda () (set:select (set)))))
        (make-test-case "singleton set"
          (assert datum=?
                  (set:select (set 1))
                  1))
        (make-test-case "1,2,3"
          (assert-true
           (let* ([elem (set:select (set 1 2 3))])
             (or (= elem 1)
                 (= elem 2)
                 (= elem 3))))))
      (make-test-suite "subset?"
        (make-test-case "A subset B"
          (assert-true (set:subset? (set 1 2) (set 1 2 3))))
        (make-test-case "A equal B"
          (assert-true (set:subset? (set 1 2 3) (set 1 2 3))))
        (make-test-case "A superset B"
          (assert-false (set:subset? (set 1 2 3) (set 1 2))))
        (make-test-case "A disjoint B"
          (assert-false (set:subset? (set 1 2 3) (set 4 5 6))))
        (make-test-case "A overlaps B"
          (assert-false (set:subset? (set 1 2 3) (set 2 3 4)))))
      (make-test-suite "equal?"
        (make-test-case "A subset B"
          (assert-false (set:equal? (set 1 2) (set 1 2 3))))
        (make-test-case "A equal B"
          (assert-true (set:equal? (set 1 2 3) (set 1 2 3))))
        (make-test-case "A superset B"
          (assert-false (set:equal? (set 1 2 3) (set 1 2))))
        (make-test-case "A disjoint B"
          (assert-false (set:equal? (set 1 2 3) (set 4 5 6))))
        (make-test-case "A overlaps B"
          (assert-false (set:equal? (set 1 2 3) (set 2 3 4)))))))

  )