(module test-table mzscheme

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

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

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

  (define (test-table)
    (make-test-suite "Tables"
      (test-table-kind "Ordered" (curry table:sexp->ordered datum-compare))
      (test-table-kind "Hashed" (curry table:sexp->hashed datum-hash datum=?))
      (test-table-kind "Unordered" (curry table:sexp->unordered datum=?))))

  (define (test-table-kind name table)
    (make-test-suite (format "Table: ~a" name)
      (make-test-suite "sexp"
        (make-test-case "empty"
          (assert datum-bindings=? (table:to-sexp (table null)) null))
        (make-test-case "1,2,3"
          (assert datum-bindings=?
                  (table:to-sexp (table '([1 A] [2 B] [3 C])))
                  '([1 A] [2 B] [3 C]))))
      (make-test-suite "alist"
        (make-test-case "empty"
          (assert equal?
                  (table:to-alist (table null))
                  (map (lambda (pair) (cons (first pair) (second pair)))
                       (table:to-sexp (table null)))))
        (make-test-case "1,2,3"
          (assert equal?
                  (table:to-alist (table '([1 A] [2 B] [3 C])))
                  (map (lambda (pair) (cons (first pair) (second pair)))
                       (table:to-sexp (table '([1 A] [2 B] [3 C])))))))
      (make-test-suite "keys"
        (make-test-case "empty"
          (assert equal?
                  (table:keys (table null))
                  (map first (table:to-sexp (table null)))))
        (make-test-case "1,2,3"
          (assert equal?
                  (table:keys (table '([1 A] [2 B] [3 C])))
                  (map first (table:to-sexp (table '([1 A] [2 B] [3 C])))))))
      (make-test-suite "values"
        (make-test-case "empty"
          (assert equal?
                  (table:values (table null))
                  (map second (table:to-sexp (table null)))))
        (make-test-case "1,2,3"
          (assert equal?
                  (table:values (table '([1 A] [2 B] [3 C])))
                  (map second (table:to-sexp (table '([1 A] [2 B] [3 C])))))))
      (make-test-suite "insert"
        (make-test-case "1,3 + 2"
          (assert datum-bindings=?
                  (table:to-sexp (table:insert 2 'B (table '([1 A] [3 C]))))
                  '([1 A] [2 B] [3 C])))
        (make-test-case "1,2,3 + 2"
          (assert datum-bindings=?
                  (table:to-sexp (table:insert 2 'X (table '([1 A] [2 B] [3 C]))))
                  '([1 A] [2 X] [3 C]))))
      (make-test-suite "remove"
        (make-test-case "present"
          (assert datum-bindings=?
                  (table:to-sexp (table:remove 2 (table '([1 A] [2 B] [3 C]))))
                  '([1 A] [3 C])))
        (make-test-case "absent"
          (assert datum-bindings=?
                  (table:to-sexp (table:remove 4 (table '([1 A] [2 B] [3 C]))))
                  '([1 A] [2 B] [3 C]))))
      (make-test-suite "update"
        (make-test-case "present"
          (assert
           datum-bindings=?
           (table:to-sexp (table:update 1 + (table '([1 10] [2 20] [3 30]))))
           '([1 11] [2 20] [3 30])))
        (make-test-case "absent"
          (assert
           datum-bindings=?
           (table:to-sexp (table:update 4 + (table '([1 10] [2 20] [3 30]))))
           '([1 10] [2 20] [3 30]))))
      (make-test-suite "update/value"
        (make-test-case "present"
          (assert
           datum-bindings=?
           (table:to-sexp
            (table:update/value 1 symbol->string (table '([1 A] [2 B] [3 C]))))
           '([1 "A"] [2 B] [3 C])))
        (make-test-case "absent"
          (assert
           datum-bindings=?
           (table:to-sexp
            (table:update/value 4 symbol->string (table '([1 A] [2 B] [3 C]))))
           '([1 A] [2 B] [3 C]))))
      (make-test-suite "update/insert"
        (make-test-case "present"
          (assert
           datum-bindings=?
           (table:to-sexp
            (table:update/insert 1 + 10 (table '([1 10] [2 20] [3 30]))))
           '([1 11] [2 20] [3 30])))
        (make-test-case "absent"
          (assert
           datum-bindings=?
           (table:to-sexp
            (table:update/insert 4 + 40 (table '([1 10] [2 20] [3 30]))))
           '([1 10] [2 20] [3 30] [4 40]))))
      (make-test-suite "update/insert/value"
        (make-test-case "present"
          (assert
           datum-bindings=?
           (table:to-sexp
            (table:update/insert/value 1 symbol->string 'A
                                       (table '([1 A] [2 B] [3 C]))))
           '([1 "A"] [2 B] [3 C])))
        (make-test-case "absent"
          (assert
           datum-bindings=?
           (table:to-sexp
            (table:update/insert/value 4 symbol->string 'D
                                       (table '([1 A] [2 B] [3 C]))))
           '([1 A] [2 B] [3 C] [4 D]))))
      (make-test-suite "select"
        (make-test-case "singleton"
          (let*-values ([(key value) (table:select (table '([1 A])))])
            (assert datum=? key 1)
            (assert datum=? value 'A))))
      (make-test-suite "select/key"
        (make-test-case "singleton"
          (let* ([key (table:select/key (table '([1 A])))])
            (assert datum=? key 1))))
      (make-test-suite "select/value"
        (make-test-case "singleton"
          (let* ([value (table:select/value (table '([1 A])))])
            (assert datum=? value 'A))))
      (make-test-suite "lookup"
        (make-test-case "a in a,b,c"
          (assert = (table:lookup "a" (table '(["a" 1] ["b" 2] ["c" 3]))) 1))
        (make-test-case "a in b,c"
          (assert-false (table:lookup "a" (table '(["b" 2] ["c" 3])))))
        (make-test-case "success override"
          (assert eq?
                  (table:lookup 1 (table '([1 one] [2 two] [3 three]))
                                (lambda () 'failure)
                                (lambda (any) 'success))
                  'success))
        (make-test-case "failure override"
          (assert eq?
                  (table:lookup 4 (table '([1 one] [2 two] [3 three]))
                                (lambda () 'failure)
                                (lambda (any) 'success))
                  'failure)))
      (make-test-suite "lookup/key"
        (make-test-case "present"
          (assert-equal? (table:lookup/key 1 (table '([1 A] [2 B] [3 C]))) 1))
        (make-test-case "absent"
          (assert-equal? (table:lookup/key 4 (table '([1 A] [2 B] [3 C]))) #f))
        (make-test-case "success override"
          (assert-equal?
           (table:lookup/key 1 (table '([1 A] [2 B] [3 C]))
                             (lambda () 'failure)
                             (lambda (k v) 'success))
           'success))
        (make-test-case "failure override"
          (assert-equal?
           (table:lookup/key 4 (table '([1 A] [2 B] [3 C]))
                             (lambda () 'failure)
                             (lambda (k v) 'success))
           'failure)))
      (make-test-suite "empty?"
        (make-test-case "true"
          (assert-true (table:empty? (table null))))
        (make-test-case "false"
          (assert-false (table:empty? (table '([1 A] [2 B] [3 C]))))))
      (make-test-suite "clear"
        (make-test-case "1,2,3"
          (assert-true
           (table:empty? (table:clear (table '([1 A] [2 B] [3 C])))))))
      (make-test-suite "fold"
        (make-test-case "1,2,3"
          (assert-equal?
           (table:fold (lambda (key value sexp)
                         (append sexp (list (list key value))))
                       null
                       (table '([1 A] [2 B] [3 C])))
           (table:to-sexp (table '([1 A] [2 B] [3 C]))))))
      (make-test-suite "fold/key"
        (make-test-case "1,2,3"
          (assert-equal?
           (table:fold/key (lambda (key keys)
                             (append keys (list key)))
                           null
                           (table '([1 A] [2 B] [3 C])))
           (table:keys (table '([1 A] [2 B] [3 C]))))))
      (make-test-suite "fold/value"
        (make-test-case "1,2,3"
          (assert-equal?
           (table:fold/value (lambda (value values)
                               (append values (list value)))
                             null
                             (table '([1 A] [2 B] [3 C])))
           (table:values (table '([1 A] [2 B] [3 C]))))))
      (make-test-suite "map"
        (make-test-case "1:10,2:20,3:30 => 1:11,2:22,3:33"
          (assert datum-bindings=?
                  (table:to-sexp (table:map +
                                          (table '([1 10] [2 20] [3 30]))))
                  '([1 11] [2 22] [3 33]))))
      (make-test-suite "map/key"
        (make-test-case "1:1,2:4,3:9"
          (assert datum-bindings=?
                  (table:to-sexp (table:map/key (lambda (n) (* n n))
                                              (table '([1 #f] [2 #f] [3 #f]))))
                  '([1 1] [2 4] [3 9]))))
      (make-test-suite "map/value"
        (make-test-case "1A2B3C => 1'A'2'B'3'C'"
          (assert datum-bindings=?
                  (table:to-sexp (table:map/value symbol->string
                                                (table '([1 A] [2 B] [3 C]))))
                  '([1 "A"] [2 "B"] [3 "C"]))))
      (make-test-suite "for-each"
        (make-test-case "1,2,3"
          (let* ([vec (vector #f #f #f)])
            (table:for-each (lambda (key value)
                              (vector-set! vec (- key 1) value))
                            (table '([1 A] [2 B] [3 C])))
            (assert-equal? vec (vector 'A 'B 'C)))))
      (make-test-suite "for-each/key"
        (make-test-case "1,2,3"
          (let* ([vec (vector #f #f #f)])
            (table:for-each/key (lambda (key)
                                  (vector-set! vec (- key 1) #t))
                                (table '([1 A] [2 B] [3 C])))
            (assert-equal? vec (vector #t #t #t)))))
      (make-test-suite "for-each/value"
        (make-test-case "1,2,3"
          (let* ([vec (vector #f #f #f)])
            (table:for-each/value (lambda (value)
                                    (vector-set! vec (- value 1) #t))
                                  (table '([A 1] [B 2] [C 3])))
            (assert-equal? vec (vector #t #t #t)))))
      (make-test-suite "filter"
        (make-test-case "1:4,2:3,3:2,4:1 => 1:4,2:3"
          (assert datum-bindings=?
                  (table:to-sexp
                   (table:filter < (table '([1 4] [2 3] [3 2] [4 1]))))
                  '([1 4] [2 3]))))
      (make-test-suite "filter/key"
        (make-test-case "1,2,3,4 => 2,4"
          (assert datum-bindings=?
                  (table:to-sexp
                   (table:filter/key even? (table '([1 A] [2 B] [3 C] [4 D]))))
                  '([2 B] [4 D]))))
      (make-test-suite "filter/value"
        (make-test-case "1,2,3,4 => 2,4"
          (assert datum-bindings=?
                  (table:to-sexp
                   (table:filter/value even?
                                       (table '([A 1] [B 2] [C 3] [D 4]))))
                  '([B 2] [D 4]))))
      (make-test-suite "all?"
        (make-test-case "none"
          (assert-false (table:all? < (table '([1 1] [2 2] [3 3])))))
        (make-test-case "some"
          (assert-false (table:all? < (table '([1 0] [2 2] [3 4])))))
        (make-test-case "all"
          (assert-true (table:all? < (table '([1 2] [2 3] [3 4]))))))
      (make-test-suite "all?/key"
        (make-test-case "none"
          (assert-false (table:all?/key symbol?
                                          (table '([1 A] [2 B] [3 C])))))
        (make-test-case "some"
          (assert-false (table:all?/key symbol?
                                          (table '([1 A] [B 2] [C C])))))
        (make-test-case "all"
          (assert-true (table:all?/key symbol?
                                         (table '([A 1] [B 2] [C 3]))))))
      (make-test-suite "all?/value"
        (make-test-case "none"
          (assert-false (table:all?/value number?
                                            (table '([1 A] [2 B] [3 C])))))
        (make-test-case "some"
          (assert-false (table:all?/value number?
                                            (table '([1 A] [B 2] [C C])))))
        (make-test-case "all"
          (assert-true (table:all?/value number?
                                           (table '([A 1] [B 2] [C 3]))))))
      (make-test-suite "any?"
        (make-test-case "none"
          (assert-false (table:any? < (table '([1 1] [2 2] [3 3])))))
        (make-test-case "some"
          (assert-true (table:any? < (table '([1 0] [2 2] [3 4])))))
        (make-test-case "all"
          (assert-true (table:any? < (table '([1 2] [2 3] [3 4]))))))
      (make-test-suite "any?/key"
        (make-test-case "none"
          (assert-false (table:any?/key symbol?
                                          (table '([1 A] [2 B] [3 C])))))
        (make-test-case "some"
          (assert-true (table:any?/key symbol?
                                        (table '([1 A] [B 2] [C C])))))
        (make-test-case "all"
          (assert-true (table:any?/key symbol?
                                         (table '([A 1] [B 2] [C 3]))))))
      (make-test-suite "any?/value"
        (make-test-case "none"
          (assert-false (table:any?/value number?
                                            (table '([1 A] [2 B] [3 C])))))
        (make-test-case "some"
          (assert-true (table:any?/value number?
                                          (table '([1 A] [B 2] [C C])))))
        (make-test-case "all"
          (assert-true (table:any?/value number?
                                           (table '([A 1] [B 2] [C 3]))))))
      (make-test-suite "subtable?"
        (make-test-case "is subtable"
          (assert-true (table:subtable? datum=?
                                        (table '([A 1] [B 2]))
                                        (table '([A 1] [B 2] [C 3])))))
        (make-test-case "missing key"
          (assert-false (table:subtable? datum=?
                                         (table '([A 1] [B 2]))
                                         (table '([B 2] [C 3])))))
        (make-test-case "bad binding"
          (assert-false (table:subtable? datum=?
                                         (table '([A 1] [B 2] [C 3]))
                                         (table '([A 1] [B 4] [C 3]))))))
      (make-test-suite "equal?"
        (make-test-case "is equal"
          (assert-true (table:equal? datum=?
                                     (table '([A 1] [B 2] [C 3]))
                                     (table '([A 1] [B 2] [C 3])))))
        (make-test-case "missing key"
          (assert-false (table:equal? datum=?
                                      (table '([A 1] [B 2] [C 3]))
                                      (table '([A 1] [B 2])))))
        (make-test-case "extra key"
          (assert-false (table:equal? datum=?
                                      (table '([A 1] [B 2]))
                                      (table '([A 1] [B 2] [C 3])))))
        (make-test-case "bad binding"
          (assert-false (table:equal? datum=?
                                      (table '([A 1] [B 2] [C 3]))
                                      (table '([A 1] [B 4] [C 3]))))))
      ))

  )