;;; Copyright (C) 2006, 2008 Magnus Henoch
;;;
;;; This program 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 2 of the
;;; License, or (at your option) any later version.
;;;
;;; This program 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
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

(in-package :darcs)

(defun equal-list (predicate a b)
  "Return true if lists A and B are equal according to PREDICATE.
That is, they have the same length, and for each corresponding
pair of elements PREDICATE returns true."
  (and (= (length a) (length b))
       (catch 'not-equal
	 (mapc (lambda (x y)
		 (unless (funcall predicate x y)
		   (throw 'not-equal nil)))
	       a b)
	 t)))

(defgeneric equal-patch (a b &optional really)
  (:documentation "Return true if patches A and B are equal.
If REALLY is false, consider named patches with the same name
to be equal, regardless of content."))

(defmethod equal-patch ((a patch) (b patch) &optional really)
  "If there are no methods for comparing A and B, they are not equal."
  (declare (ignore really))
  nil)

(defmethod equal-patch :around ((a file-patch) (b file-patch) &optional really)
  "Compare two file patches.
Two file patches can be equal only if they are of the same type and
patch the same file."
  (declare (ignore really))
  (when (and (eq (class-of a) (class-of b))
	     (equal (patch-filename a) (patch-filename b)))
    (call-next-method)))

(defmethod equal-patch ((a file-patch) (b file-patch) &optional really)
  "Compare two simple file patches.
If the :around method proceeds to call us, and there is no more specific
method, then we have two ADD-FILE-PATCHes or RM-FILE-PATCHES, which are
equal."
  (declare (ignore really))
  t)

(defmethod equal-patch ((a hunk-patch) (b hunk-patch) &optional really)
  "Compare two hunk patches."
  (declare (ignore really))
  (flet ((compare (accessor)
	   ;; We use equalp, to make it descend into the vaguely
	   ;; string-like arrays.
	   (equalp (funcall accessor a) (funcall accessor b))))
    (and (compare #'hunk-line-number)
	 (compare #'hunk-old-lines)
	 (compare #'hunk-new-lines))))

(defmethod equal-patch ((a directory-patch) (b directory-patch) &optional really)
  "Compare two directory add/remove patches."
  (declare (ignore really))
  (and (eq (type-of a) (type-of b))
       (equal (patch-directory a) (patch-directory b))))

(defmethod equal-patch ((a token-replace-patch) (b token-replace-patch) &optional really)
  "Compare two token replacing patches."
  (declare (ignore really))
  (flet ((compare (accessor)
	   ;; Here we use string=.
	   (string= (funcall accessor a) (funcall accessor b))))
    (and (compare #'token-regexp) 
	 (compare #'old-token)
	 (compare #'new-token))))

(defmethod equal-patch ((a binary-patch) (b binary-patch) &optional really)
  "Compare two binary patches."
  (declare (ignore really))
  (and (equalp (binary-oldhex a) (binary-oldhex b))
       (equalp (binary-newhex a) (binary-newhex b))))

(defmethod equal-patch ((a merger-patch) (b merger-patch) &optional really)
  "Compare two merger patches."
  (and (string= (merger-version a) (merger-version b))
       (eql (merger-inverted a) (merger-inverted b))
       (equal-patch (merger-first a) (merger-first b) really)
       (equal-patch (merger-second a) (merger-second b) really)))