;;; Copyright (C) 2007, 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 pending-filename (repodir)
  "Get the name of the file containing \"pending\" patches for REPODIR."
  (upath-subdir repodir '("_darcs" "patches") "pending"))

(defun read-pending (repodir)
  "Read the \"pending\" patches of REPODIR."
  (let ((pending-file (pending-filename repodir)))
    (when (probe-file pending-file)
      (read-patch-from-file pending-file :compressed nil))))

(defun write-pending (repodir patch)
  "Write PATCH to the \"pending\" file in REPODIR.
The previous file is overwritten."
  (declare (type (or null composite-patch) patch))
  (if (and patch (patches patch))
      (with-open-file (out (pending-filename repodir)
			   :direction :output :element-type '(unsigned-byte 8)
			   :if-exists :supersede)
	(write-patch patch out))
      (delete-file (pending-filename repodir))))

(defun add-to-pending (repodir patch)
  "Add PATCH to the list of \"pending\" patches in REPODIR."
  (let ((pending (read-pending repodir)))
    (when (null pending)
      (setf pending (make-instance 'composite-patch)))
    (setf (patches pending) (append (patches pending) (list patch)))
    (write-pending repodir pending)))

(defun remove-matching-from-pending (repodir patches)
  "Remove PATCHES from the list of \"pending\" patches in REPODIR."
  ;; Currently we only have ADD-FILE-PATCH and ADD-DIR-PATCH in
  ;; pending, which can be compared by EQUAL-PATCH.
  (let ((pending (read-pending repodir)))
    (when pending
      (setf (patches pending)
	    (nset-difference (patches pending) patches :test #'equal-patch))
      (write-pending repodir pending))))

(defun add-file (repo file)
  "Schedule FILE for recording to REPO.
FILE can be a string or a pathname denoting a relative path.
FILE can be either a file or a directory."
  (setf repo (fad:pathname-as-directory repo))
  (setf file (enough-namestring file repo))
  (let ((type
	 (if (fad:directory-exists-p 
	      (fad:pathname-as-directory (merge-pathnames file repo)))
	     :directory 
	     :file)))
    (setf file (sanitize-filename file :type type))

    (let ((pristine-file (merge-pathnames file (upath-subdir repo '("_darcs" "pristine"))))
	  (working-file (merge-pathnames file repo)))
      ;; Make sure that we can read the file
      (when (eql type :file)
	(with-open-file (s working-file :direction :input)
	  t))

      ;; XXX: does this work properly for directories?
      (when (or
	     ;; Is file/directory already committed?
	     (if (eql type :file)
		 (fad:file-exists-p pristine-file)
		 (fad:directory-exists-p pristine-file))
	     ;; Or is it already added to pending?
	     (let* ((pending (read-pending repo))
		    (patches (when pending (patches pending))))
	       (or
		(find file patches 
		      :key (lambda (p) (when (typep p 'add-file-patch) (patch-filename p)))
		      :test #'equal)
		(find file patches
		      :key (lambda (p) (when (typep p 'add-dir-patch) (patch-directory p)))
		      :test #'equal))))
	(error 'already-in-repository :repository repo :file file))
      (when (not (if (eql type :file)
		     (fad:file-exists-p working-file)
		     (fad:directory-exists-p working-file)))
	(error "~A does not exist in the working directory." (pathname-to-string file))))
    ;; XXX: check that all parent directories exist, either in pristine or in pending

    (add-to-pending
     repo 
     (if (eql type :file)
	 (make-instance 'add-file-patch :filename file)
	 (make-instance 'add-dir-patch :directory file)))))

(define-condition already-in-repository (repository-file-condition error)
  ()
  (:documentation "The file to be added already exists in the repository.")
  (:report (lambda (condition stream)
	     (format stream
		     "~A already exists in the repository in ~A."
		     (slot-value condition 'file)
		     (slot-value condition 'repository)))))