(in-package "PKGMANAGER")

(defparameter *default-conf-dir*       "/etc/pkgmanager/")

(defvar *conf-dir*   *default-conf-dir*)

(define-condition pkgmanager-error (extended-error)
  ())

(define-condition implementation-not-supported-error (pkgmanager-error)
  ())

(define-condition cmdline-error (pkgmanager-error)
  ())

;; Read and return the pkgmanager configuration (a plist)
(defun read-configuration ()
  (let ((fname (format nil "~a~a" *conf-dir* "config")))
    (when (probe-file fname)
      (with-open-file (f (format nil "~a~a" *conf-dir* "config"))
	(read f)))))

;; Persist the given configuration (a plist)
(defun write-configuration (conf)
  (with-open-file (f (format nil "~a~a" *conf-dir* "config") :direction :output :if-exists :supersede)
    (print conf f)))

(defun parse-cmdline ()
  "Do trivial cmdline parsing. Use proper parsing in the future"
  (let ((opts (list)))
    (if (= 0 (length ext:*args*))
	(setf (getf opts :command) :help)
	(let ((cmd (elt ext:*args* 0)))
	  (setf (getf opts :command) (intern (string-upcase cmd) "KEYWORD"))
	  (setf (getf opts :rest) (cdr ext:*args*))))
    opts))

(defun print-usage ()
  (print-interactive "Usage: pkgmanager <command>")
  (print-interactive "Commands:")
  (print-interactive "  sync [-f]         - synchronize installation with respect to pkgsrc and want list")
  (print-interactive "                      (use this for globally upgrading your packages)")
  (print-interactive "                      -f: do not ask for confirmation")
  (print-interactive "  install <pkgs>    - install given packge(s) and add them to wanted list")
  (print-interactive "  uninstall <pkgs>  - remove given package(s) from system, aswell as any packages")
  (print-interactive "                      depending on the packages and any packages no longer needed")
  (print-interactive "                      needed after the removal of the packages")
  (print-interactive "  show-wants        - show list of wanted packages")
  (print-interactive "  want <pkgs>       - add given package(s) to list of wanted packages")
  (print-interactive "  unwant <pkgs>     - remove given package(s) from list of wanted packages")
  (print-interactive "  flush-cache       - flush summary cache manually")
  (print-interactive "  fetch-updated     - invoke 'make fetch' on all updated packages")
  (print-interactive "  fetch-pending     - invoke 'make fetch' on all packages that will be rebuilt on sync")
  (print-interactive "  fetch-needed      - invoke 'make fetch' on all needed packages")
  (print-interactive "  help              - show this help"))

(defun print-db-status (db)
  (print-notice "Calculating todo...")
  (let* ((orphans (db-collect-installations db (lambda (i) (pkg-missing (installation-pkg i)))))
	 (unneeded (db-collect-packages db (bnot #'pkg-needed)))
	 (outdated (db-collect-packages db (band #'pkg-outdated-p
						 (bnot #'pkg-failed)
						 (bnot #'pkg-failed-dependency-p))))
	 (dirty (db-collect-packages db (band #'pkg-dirty-p
						 (bnot #'pkg-outdated-p)
						 (bnot #'pkg-outdated-dependency-p)
						 (bnot #'pkg-failed)
						 (bnot #'pkg-failed-dependency-p))))
	 (depoutdated (db-collect-packages db (band (bnot #'pkg-outdated-p)
						    #'pkg-outdated-dependency-p
						    (bnot #'pkg-failed)
						    (bnot #'pkg-failed-dependency-p))))
	 (missing (db-collect-packages db (band #'pkg-missing-p
						(bnot #'pkg-failed)
						(bnot #'pkg-failed-dependency-p))))
	 (failed (db-collect-packages db #'pkg-failed))
	 (depfailed (db-collect-packages db (band (bnot #'pkg-failed)
						  #'pkg-failed-dependency-p))))
    (print-interactive "The following ORPHANS will be removed: ~{~a~#[~:;, ~]~}"
		       orphans)
    (print-interactive "The following UNNEEDED packages will be removed: ~{~a~#[~:;, ~]~}"
		       unneeded)
    (print-interactive "The following UPDATED package will be rebuilt: ~{~a~#[~:;, ~]~}"
		       outdated)
    (print-interactive "The following DEPUDATED packages will be rebuilt: ~{~a~#[~:;, ~]~}"
		       depoutdated)
    (print-interactive "The following DIRTY packages will be rebuilt: ~{~a~#[~:;, ~]~}"
		       dirty)
    (print-interactive "The following MISSING packages will be installed: ~{~a~#[~:;, ~]~}"
		       missing)
    (print-interactive "The following FAILED packages will be kept back: ~{~a~#[~:;, ~]~}"
		       failed)
    (print-interactive "The following DEPFAILED packages will be kept back: ~{~a~#[~:;, ~]~}"
		       depfailed)))

(defun do-sync (opts)
  (let ((db (make-instance 'db)))
    (db-prepare (db-init db))
    (print-db-status db)
    (when (and (not (and (not (null opts)) (string= (car opts) "-f")))
	       (not (confirm "Continue?")))
      (return-from do-sync))
    (db-remove-orphans db)
    (db-remove-unneeded db)
    (let ((last-pkg nil))
      (loop as pkg = (db-next-ready-package db)
	    while pkg
	    do (if (and last-pkg (string= (pkg-dir last-pkg) (pkg-dir pkg)))
		 (progn
		   (print-warn "Package ~a is looping - marking as failed." (pkg-dir pkg))
		   (setf (pkg-failed pkg) t)
		   (update-db db))
		 (progn
		   (setf last-pkg pkg)
		   (db-upgrade-pkg db pkg)
		   (when (pkg-installation pkg)
		     (remhash (installation-name (pkg-installation pkg)) (db-is db)))
		   (update-db db)
		   (print-db-status db)))))))
  
;; Update DB after a package installation or removal
(defun update-db (db)
  (db-scan-installations db :examine-new t))

(defun do-show-wants ()
  (let ((db (db-init (make-instance 'db))))
    (print-interactive "Wanted packages:")
    (mapcar #'(lambda (p)
		(print-interactive "   ~a" p))
	    (sort (copy-list (db-wanted-packages db))
		  #'string-lessp
		  :key #'car))))

(defun do-want (pkgs)
  (let ((db (db-init (make-instance 'db))))
    (mapc #'(lambda (pkg)
	      (db-register-want db pkg))
	  pkgs)))

(defun do-unwant (pkgs)
  (let ((db (db-init (make-instance 'db))))
    (mapc #'(lambda (pkg)
	      (db-deregister-want db pkg))
	  pkgs)))

(defun do-install (pkgs)
  (do-want pkgs)
  (do-sync nil))

(defun do-uninstall (pkg-names)
  (let* ((db (db-prepare (db-init (make-instance 'db))))
	 (pkgs (remove-if #'(lambda (elt) (not elt))
			  (mapcar #'(lambda (p)
				      (let ((pkg (gethash p (db-pkgs db))))
					(if (not pkg)
					    (progn
					      (print-warn "No such package installed: ~a" p)
					      nil)
					    pkg)))
				  pkg-names)))
	 (users (db-collect-packages db #'(lambda (p)
					    (pkg-depends-on-p p pkgs))))
	 (wanted-users (remove-if #'(lambda (p)
				      (not (pkg-needed p)))
				  users)))
    (when (or (null wanted-users)
	      (progn
		(print-interactive "Uninstallting these packages will cause the following WANTED packages to be uninstalled and be marked as UNWANTED: ~a"
				   wanted-users)
		(confirm "Are you sure you want to do this?")))
      (do-unwant (mapcar #'(lambda (p) (pkg-dir p))
			 wanted-users))
      (do-unwant pkg-names)
      (do-sync nil))))

(defun do-flush-cache ()
  (let ((db (db-init (make-instance 'db) :check-mk-conf nil)))
    (print-notice "Invalidating summary cache for all packages")
    (db-invalidate-summary-cache db)))

(defun fetch (predicate)
  (let ((db (make-instance 'db)))
    (db-prepare (db-init db))
    (let ((selected (db-collect-packages db predicate)))
      (mapc #'(lambda (p)
		(db-fetch-pkg db p))
	    selected))))

(defun do-fetch-updated ()
  (fetch #'pkg-outdated-p))

(defun do-fetch-pending ()
  (fetch (bor #'pkg-outdated-p
	      #'pkg-outdated-dependency-p
	      #'pkg-missing-p)))

(defun do-fetch-needed ()
  (fetch #'pkg-needed))

(defun run ()
  (let ((fname (format nil "~ai-read-the-docs" *conf-dir*)))
    (when (not (probe-file fname))
      (print-crit "ERROR: pkgmanager is experimental and not neccessarily safe to run. You should read the ")
      (print-crit "       documentation carefully before using pkgmanager. If you want to run pkgmanager")
      (print-crit "       for real, touch this file:")
      (print-crit "          ~a" fname)
      (quit)))
  (handler-case (let* ((opts (parse-cmdline))
		       (cmd (getf opts :command)))
		  (cond
		    ((eq cmd :help) (print-usage))
		    ((eq cmd :sync) (do-sync (getf opts :rest)))
		    ((eq cmd :show-wants) (do-show-wants))
		    ((eq cmd :want) (do-want (getf opts :rest)))
		    ((eq cmd :unwant) (do-unwant (getf opts :rest)))
		    ((eq cmd :install) (do-install (getf opts :rest)))
		    ((eq cmd :uninstall) (do-uninstall (getf opts :rest)))
		    ((eq cmd :flush-cache) (do-flush-cache))
		    ((eq cmd :fetch-updated) (do-fetch-updated))
		    ((eq cmd :fetch-pending) (do-fetch-pending))
		    ((eq cmd :fetch-needed) (do-fetch-needed))
		    (t (error 'cmdline-error :message (format nil "Unknown command: ~a" (symbol-name cmd))))))
    (cmdline-error (e) (print-crit "Could not parse command line: ~a" (extended-condition-report e)))
    (user-correctable-db-error (e) (print-crit "User correctable error: ~a" (extended-condition-report e)))
    (extended-condition (c) (print-crit "An unexpected error occurred. This may be due to a bug in pkgmanager, or a system configuration issue. If you suspect a bug, or require help, please contact the author. Details about the error follows: ~a" (extended-condition-report c)))))