(use test srfi-1 clojurian-syntax persistent-hash-map)

(test-begin)

(test-group "map-add, map-delete, map-contains?, map-equal?"
  (let loop ((m1 (persistent-map))
             (m2 (map->transient-map (persistent-map)))
             (i 0))
    (if (< i 100)
        (loop (map-add m1 i i) (map-add! m2 i i) (add1 i))
        (let ((m2 (persist-map! m2)))
          (test 100 (map-size m1))
          (test 100 (map-size m2))
          (test-assert (map-equal? m1 m2))
          (let loop ((i 0))
            (when (< i 100)
              (test i (map-ref m1 i))
              (test i (map-ref m2 i))
              (test-assert (map-contains? m1 i))
              (test-assert (map-contains? m2 i))
              (loop (add1 i))))
          ;; (test-assert (= (map vector (range 100) (range 100)) (sort-by first (seq m1))))
          ;; (test-assert (= (map vector (range 100) (range 100)) (sort-by first (seq m2))))
          (test-assert (not (map-contains? (map-delete m1 3) 3)))))))


(define (10x10-map)
  (apply map-add
         (persistent-map)
         (fold-right cons* '() (iota 10) (iota 10))))

(test-group "map-delete"
  (let ((m (map-delete (10x10-map) 3 5 7)))
    (test 7 (map-size m))
    (test-assert (map-equal? m (persistent-map 0 0 1 1 2 2 4 4 6 6 8 8 9 9)))))

(test-group "transient maps"
  (let ((tm (map->transient-map (10x10-map))))
    (let loop ((tm tm) (ks '(3 5 7)))
      (if (null? ks)
          (let ((m (persist-map! tm)))
            (test 7 (map-size m))
            (test-assert (map-equal? m (persistent-map 0 0 1 1 2 2 4 4 6 6 8 8 9 9))))
          (loop (map-delete! tm (car ks))
                (cdr ks)))))

  (let ((tm (map->transient-map (map-delete (10x10-map) 3 5 7))))
    (for-each (lambda (k)
                (test k (map-ref tm k)))
              '(0 1 2 4 6 8 9))
    (let ((m (persist-map! tm)))
      (test 2 (handle-exceptions e 2 (map-delete! tm 1) 1))
      (test 2 (handle-exceptions e 2 (map-add! tm 10 10) 1))
      (test 2 (handle-exceptions e 2 (persist-map! tm) 1))
      (test 2 (handle-exceptions e 2 (map-size tm) 1))
      (test-assert (map-equal? m (persistent-map 0 0 1 1 2 2 4 4 6 6 8 8 9 9))))))

(test-group "map-reduce"
  (test 499500 (map-reduce + 0 (apply persistent-map (iota 1000)))))

(test-group "map-keys, map-values"
  (let ((m (persistent-map 'foo 1 'bar 2 'baz 3)))
    (test-assert (lset= eq? '(foo bar baz) (map-keys m)))
    (test-assert (lset= eq? '(1 2 3) (map-values m)))))


(test-group "hash collisions"

  (define (find-colliding-keys count from)
    (let* ((nums (iota count from))
           (hashes (map hash nums)))
      (let loop ((numhs (map cons nums hashes)))
        (if (pair? numhs)
            (let* ((numh (car numhs))
                   (collision (find (lambda (n)
                                      (= (cdr numh) (cdr n)))
                                    (cdr numhs))))
              (if collision
                  (values (car numh) (car collision))
                  (loop (cdr numhs))))
            (values #f #f)))))
  
  (receive (key-a key-b) (find-colliding-keys 100 -50)
    (if (not key-a)
        (print "WARNING: Skipping key collision test as no colliding keys could be found")
        (let ((m (apply persistent-map (iota 100 50))))
          (let ((m (map-add m key-a 1 key-b 2)))
            (test 52 (map-size m))
            (test 1 (map-ref m key-a))
            (test 2 (map-ref m key-b))
            (test 1 (map-ref (map-delete m key-b) key-a))
            (test 2 (map-ref (map-delete m key-a) key-b)))
          (let ((tm (map->transient-map m)))
            (map-add! tm key-a 1)
            (map-add! tm key-b 2)
            (test 1 (map-ref tm key-a))
            (test 2 (map-ref tm key-b))
            (map-delete! tm key-a)
            (test 51 (map-size tm))
            (test 2 (map-ref tm key-b)))))))

(test-group "map-merge"
  (let ((m (map-merge (persistent-map 1 2 3 4)
                      (persistent-map 1 3 5 6))))
    (test 3 (map-ref m 1))
    (test 4 (map-ref m 3))
    (test 6 (map-ref m 5))))

(test-group "map-ref-in, map-update-in"
  (let ((m (-> (persistent-map 'foo (persistent-map 'bar 1))
               (map-update-in '(foo bar) + 1)
               (map-update-in '(foo baz qux) (lambda (x) (or x 9))))))
    (test 2 (map-ref-in m '(foo bar)))
    (test 9 (map-ref-in m '(foo baz qux)))))

(test-end)

(test-exit)