(in-package :hu.caleb.test)
            
(def-suite :hu.caleb.destructure :in :hu.caleb)
(in-suite :hu.caleb.destructure)

(defmacro destructure-test (name lambda-list form &key bindings evaluates)
  (let ((expected-bindings-hash (make-hash-table))
        (expected-evaluates nil)
        (test-name (intern (concatenate 'string  "DESTRUCTURE-" (symbol-name name)))))
    
    (loop for (var . value) in bindings
          do (setf (gethash var expected-bindings-hash) value))

    (loop for (arglist . form) in evaluates
          do (push (cons arglist form) expected-evaluates))

    `(test ,test-name
       (let* ((result-bindings-hash (make-hash-table))
              (result-evaluates ())
              (binder (lambda (var value) (setf (gethash var result-bindings-hash) value)))
              (evaluator (lambda (arglist form) (push (cons arglist form) result-evaluates))))
                           
         (hu.caleb::destructure evaluator binder ',lambda-list ',form :allow-destructure t)
         (is (equalp result-bindings-hash ,expected-bindings-hash))
         (is (eq (set-difference result-evaluates ',expected-evaluates :test 'equalp) nil))))))


(destructure-test simple-required (a) (1)
                  :bindings ((a . 1)))

(destructure-test two-required (a b) (1 2)
                  :bindings ((a . 1)
                             (b . 2)))
 
(destructure-test simple-optional-1 (a &optional b) (1)
                  :bindings ((a . 1))
                  :evaluates ((b . nil)))

(destructure-test simple-optional-2 (a &optional b) (1 2)
                  :bindings ((a . 1) (b . 2)))

(destructure-test simple-optional-3 (a &optional (b 'cica)) (1)
                  :bindings ((a . 1))
                  :evaluates ((b . 'cica)))

(destructure-test simple-optional-4 (a &optional (b 'cica)) (1 2)
                  :bindings ((a . 1) (b . 2)))

(destructure-test simple-rest-1 (a &rest rest) (1 2 3)
                  :bindings ((a . 1) (rest . (2 3))))

(destructure-test simple-keyword-1 (&key foo bar) (:foo 1 :bar 2)
                  :bindings ((foo . 1) (bar . 2)))

(destructure-test simple-keyword-2 (&key (foo 4)) ()
                 :evaluates ((foo . 4)))

(destructure-test simple-keyword-3 (&key (foo 4)) (:foo 5)
                 :bindings ((foo . 5)))

(destructure-test simple-keyword-4 (&key (foo 4 foo-bound)) (:foo 1)
                 :bindings ((foo . 1) (foo-bound . t)))

(destructure-test simple-keyword-5 (&key (foo 4 foo-bound)) ()
                 :evaluates ((foo . 4))
                 :bindings ((foo-bound . nil)))

(destructure-test optional-destructure-1 (&optional ((a b) '(3 4))) ((1 2))
                  :bindings ((a . 1) (b . 2)))

(destructure-test optional-destructure-2 (&optional ((a b) '(3 4))) ()
                  :evaluates (((a b) . '(3 4))))