;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of "NOVA":  NOVA = search + COCOMO tools
; Copyright, 2008, Tim Menzies tim@menzies.us
;
; NOVA is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; NOVA is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; You should have received a copy of the GNU General Public License
; a long with NOVA.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :wvu-lib-test.lift)


(define-condition ensure-alist-key-failed-error (test-condition)
  ((key :initform "" 
        :accessor key
        :initarg :key)
   (alist :initform "" 
          :accessor alist
          :initarg :alist)))

(define-condition ensure-alist-has-key-failed-error (ensure-alist-key-failed-error)
  ()
  (:report (lambda (c s)
             (format s "Ensure key-in-alist failed: ~s not in ~s ~@[(~a)~]" 
		     (key c) (alist c) (message c)))))

(define-condition ensure-alist-has-no-key-failed-error (ensure-alist-key-failed-error)
  ()
  (:report (lambda (c s)
             (format s "Ensure key-not-in-alist failed: ~s in ~s ~@[(~a)~]" 
		     (key c) (alist c) (message c)))))

(defun ensure-alist-key (condition-type negate? key alist test test-specified-p report arguments)
  "used by ensure-alist-has-key and ensure-alist-has-no-key"
  (let ((gblock (gensym "BLOCK-"))
        (gtest (gensym "TEST-"))
        (gkey (gensym "KEY-"))
        (galist (gensym "ALIST-")))
    ;;as-lambda is a hack because i couldn't handle both cases
    ;; of when the use would pass test as test-fn or #'test-fn
    (labels ((as-lambda (fn)
               (let ((gx1 (gensym))
                     (gx2 (gensym)))
                 `(lambda (,gx1 ,gx2)
                    (,@(if (symbolp fn)
                           (list fn)
                           `(funcall ,fn))
                       ,gx1 ,gx2)))))
      `(block ,gblock
         (flet ((,gtest (,gkey ,galist)
                  (if (null ,galist)
                      ,negate?
                      (assoc ,gkey ,galist
                             ,(if negate?
                                  :test-not
                                  :test)
                             ,(if test-specified-p
                                  (as-lambda test)
                                  (as-lambda lift:*lift-equality-test*))))))
           
           (if (,gtest ,key ,alist)
               t
               (let ((condition (make-condition ',condition-type
                                                :key ,key
                                                :alist ',alist
                                                ,@(when report
                                                        `(:message (format nil ,report ,@arguments))))))
                 (if (find-restart 'ensure-failed)
                   (invoke-restart 'ensure-failed condition)
                   (warn condition)))))))))  

(defmacro ensure-alist-has-key (key alist &key (test nil test-specified-p) report arguments)
  "If ensure-alist-has-key checks if the list contains the specified key,
then it will generate a test failure if it *IS NOT* found.
`test` is used to check if the key *IS* in the alist.
You can use the `report` and `arguments` keyword parameters
to customize the report generated in test results. See [ensure][] for more
details."
  (ensure-alist-key 'ensure-alist-has-key-failed-error nil
                    key alist test test-specified-p
                    report arguments))


(defmacro ensure-alist-has-no-key (key alist &key (test nil test-specified-p) report arguments)
  "If ensure-alist-has-no-key checks if the list contains the specified key,
then it will generate a test failure if it *IS* found.
`test` is used to check if the key *IS NOT* in the alist.
You can use the `report` and `arguments` keyword parameters
to customize the report generated in test results. See [ensure][] for more
details."
  (ensure-alist-key 'ensure-alist-has-no-key-failed-error t
                    key alist test test-specified-p
                    report arguments))