;;; Copyright (C) 2006, 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 create-repo (repodir)
  "Create an empty repository."
  (setf repodir (fad:pathname-as-directory repodir))

  ;; Create the directory if it doesn't exist, then get the absolute
  ;; path.
  (ensure-directories-exist repodir)
  (setf repodir (truename repodir))

  ;; Darcsify it.
  (prepare-new-repo repodir)
  (create-empty-pristine repodir))

;; get_cmd in Get.lhs
(defun get-repo (inrepodir outname &key (partial nil) (query nil))
  (setf outname (fad:pathname-as-directory outname))
  ;; other access methods later...
  ;; XXX: checkpoints?
  (let* ((repodir (make-upath inrepodir :truename t))
	 ;; Here we get a list of lists.  Each list represents a tag;
	 ;; the latest tag is at the head.  Each list contains patches
	 ;; in the order they are to be applied.
	 (patchinfo-list (read-repo-patch-list repodir))
	 ;; We should probably download checkpoint patches, btw...
	 (checkpoint (when partial
		       (car (last (read-checkpoint-list repodir))))))
    (let ((motd (get-preflist repodir "motd")))
      (when motd
	(format t "~{~&~A~}" motd)))

    ;; Create directories...
    (ensure-directories-exist outname)
    ;; Now that the directory exists, we can get its truename
    (setf outname (truename outname))
    (prepare-new-repo outname)
    (set-default-repo outname (upath-to-string inrepodir :truename t))

    (when checkpoint
      (format t "~&Copying checkpoint...")
      (copy-checkpoint repodir outname checkpoint)
      ;; After copying, we can read the checkpoint from OUTNAME.
      (let ((checkpoint-patch (read-checkpoint-from-repo outname checkpoint)))
	(apply-patch checkpoint-patch outname))
      (format t "done"))


    (let* ((all-patches (if checkpoint
			    ;; XXX: patchinfo-list is a list of lists now
			    (find-remaining-patches patchinfo-list checkpoint)
			    (apply #'append (reverse patchinfo-list))))
	   (patches
	    (if (or (null query) (y-or-n-p "Apply all patches?"))
		all-patches
		(select-some-patches all-patches))))
      ;; write-inventory wants patches ordered by tags, but we have
      ;;them all in a list in all-patches and patches...
      ;;(write-inventory outname patchinfo-list)
      (copy-repo-patches repodir outname patches)
      
      (format t "~&Applying patches")
      (dolist (patchinfo patches)
	(let ((patch (read-patch-from-repo outname patchinfo)))
	  (apply-patch patch outname)
	  ;; XXX: this is where we write tags to inventory correctly
	  ;; Check how darcs handles tags - rotate inventory files?
	  ;; What happens when adding patches one by one?
	  (append-inventory outname patchinfo)
	  (princ #\.)
	  (force-output)))
      (format t "~&Creating pristine")
      (create-pristine-from-tree outname)
      (format t "~&Finished getting."))))

(defun select-some-patches (patchinfo-list)
  "Interactively select some patches from PATCHINFO-LIST.
Return a new list containing the selected patches."
  (format t "~&Available patches:")
  (loop for patchinfo in patchinfo-list
     count patchinfo into i
     do (format t "~&~3@A ~A" i patchinfo))
  (format t "~&Specify inclusive start and end (NIL will do): ")
  (let ((start (read)) (end (read)))
    (if start
	(decf start)
	(setf start 0))
    (subseq patchinfo-list start end)))

(defun find-remaining-patches (patchinfo-list checkpoint)
  "Find the patches remaining after getting to CHECKPOINT."
  ;; XXX: this is incorrect; the checkpoint isn't among ordinary patches.
  (loop for tail on patchinfo-list
     when (equalp (car tail) checkpoint)
     return (cdr tail)))

(defun copy-repo-patches (from to patchinfo-list)
  "Copy patches from repository FROM to repository TO.
PATCHINFO-LIST is the list of patches in FROM to copy."
  (format t "~&Copying ~A patches" (length patchinfo-list))
  ;; Assume that TO/_darcs/patches is created
  (dolist (patch patchinfo-list)
    (let ((filename (patchinfo-make-filename patch)))
      (with-open-file (out (merge-pathnames
			    (make-pathname :directory (list :relative "_darcs" "patches")
					   :name filename)
			    to)
			   :direction :output :element-type '(unsigned-byte 8))
	(with-open-stream (in (open-upath 
			       (upath-subdir from '("_darcs" "patches") filename)
			       :binary t))
	  (fad:copy-stream in out))))
    (princ #\.)
    (force-output)))

(defun copy-checkpoint (from to checkpoint)
  "Copy CHECKPOINT from repository FROM to repository TO.
CHECKPOINT is a patchinfo naming the checkpoint."
  (let ((filename (patchinfo-make-filename checkpoint)))
    (with-open-file (out (merge-pathnames
			  (make-pathname :directory '(:relative "_darcs" "checkpoints")
					 :name filename)
			  to)
			 :direction :output :element-type '(unsigned-byte 8))
      (with-open-stream (in (open-upath
			     (upath-subdir from '("_darcs" "checkpoints") filename)
			     :binary t))
	(fad:copy-stream in out)))))