(in-package :cl-xdg-trash)

(declaim (ftype (function () (or integer null)) getuid))
(defun getuid ()
  "Return the current user's UID, or nil if it cannot be determined."
  #+sbcl (sb-posix:getuid)
  #-(or sbcl) nil)

(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
                xdg-data-home))
(defun xdg-data-home (&key homedir)
  (let ((env (uiop:getenv "XDG_DATA_HOME")))
    (cond
      (env (uiop:parse-native-namestring
            (pathname env) :ensure-directory t))
      ((not homedir)
       (merge-pathnames #P".local/share/"
                        (user-homedir-pathname)))
      ((pathnamep homedir)
       (merge-pathnames #P".local/share/"
                        (uiop:ensure-directory-pathname homedir)))
      (t
       (merge-pathnames #P".local/share/"
                        (uiop:parse-native-namestring homedir
                                                      :ensure-directory t))))))

(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
                user-home-trash-directory))
(defun user-home-trash-directory (&key homedir)
  (merge-pathnames #P"Trash/" (xdg-data-home :homedir homedir)))

(declaim (ftype (function ((or string pathname)) list) find-trash-dirs-for-toplevel))
(defun find-trash-dirs-for-toplevel (toplevel)
  "List the trash directories that exist under TOPLEVEL."
  (let ((top-path (ensure-nonwild-pathname toplevel :ensure-directory t))
        found)
    (let ((dir (merge-pathnames #P".Trash" top-path)))
      (when (uiop:directory-exists-p dir)
        (push dir found)))
    (let ((uid (getuid)))
      (when uid
        (let ((dir (merge-pathnames (pathname (format nil ".Trash-~D" uid))
                                    top-path)))
          (when (uiop:directory-exists-p dir)
            (push dir found)))))
    found))

(declaim (ftype (function () list) list-toplevel-trash-directories))
(defun list-toplevel-trash-directories ()
  "List all known trash directories other than the user's trash directory."
  (mapcan 'find-trash-dirs-for-toplevel (list-mountpoints)))

(declaim (ftype (function () list) list-trash-directories))
(defun list-trash-directories ()
  "List all known trash directories."
  (cons (user-home-trash-directory) (list-toplevel-trash-directories)))

(declaim (ftype (function ((or pathname string) &key (:include-self t)) t)
                path-in-home-directory-p))
(defun path-in-home-directory-p (path &key include-self)
  "Return non-nil if PATH is in the user's home directory (or is the user's home
directory)."
  (let ((path (ensure-nonwild-pathname path :ensure-directory t))
        (home (user-homedir-pathname)))
    (or (and include-self (uiop:pathname-equal path home))
        (uiop:subpathp path home))))

(declaim (ftype (function ((or pathname string)) pathname)
                trash-directory-for-file))
(defun trash-directory-for-file (path)
  "Return the trash directory into which PATH should be trashed."
  (let* ((res-path (ensure-nonwild-pathname path))
         (root (find-filesystem-root res-path)))
    (or (and (path-in-home-directory-p res-path)
             (uiop:pathname-equal (find-filesystem-root (user-homedir-pathname))
                                  root)
             (car (find-trash-dirs-for-toplevel root)))
        (user-home-trash-directory))))

(declaim (ftype (function ((or pathname string)) t) trash-file))
(defun trash-file (path)
  "Move PATH to the trash. Specifically, move it to the proper trash as
specified by the XDG standard."
  (let* ((path (merge-pathnames (ensure-nonwild-pathname path) (uiop:getcwd)))
         (trash-directory (trash-directory-for-file path))
         (trashinfo (make-trashinfo-for trash-directory path))
         (files-dir (ensure-directories-exist (merge-pathnames
                                               #P"files/" trash-directory)
                                              :verbose nil)))
    (rename-file path (merge-pathnames
                       (make-pathname :name (trashinfo-name trashinfo))
                       files-dir))))