(defpackage clash
  (:documentation "Command line interface to the XDG trashcan.")
  (:import-from #:cl-xdg-trash/trashinfo
                #:trashinfo-original-path
                #:trashinfo-trash-directory
                #:trashinfo-info-file
                #:trashinfo-name
                #:trashinfo-trashed-file
                #:trashinfo-deletion-date
                #:parse-trashinfo-file)
  (:import-from #:cl-xdg-trash/mountpoints
                #:file-or-dir-namestring
                #:ensure-nonwild-pathname)
  (:use #:cl #:clash/parse-date #:clash/format)
  (:export #:toplevel))

(in-package :clash)

;; remove extra newline at the end of the usage message
(defmethod clingon:print-usage :around (command stream &key)
  (let ((msg (with-output-to-string (str-stream)
               (call-next-method command str-stream))))
    (format stream "~A" (subseq msg 0 (1- (length msg))))))


;; Filtering
(defparameter *byte-count-suffixes* "kmgtpezyrq"
  "Metric power suffixes used in parse-byte-count.")
(defparameter *byte-count-pattern*
  (cl-ppcre:create-scanner
   (format nil "^\\s*(?(?=(?:^|[^0-9])\\.[0-9])|([0-9]+))\\.?((?<=\\.)[0-9]+)?~
                \\s*(?:(?:([kmgtpezyrq])(i)?)?B)?$\\s*")
   :extended-mode t
   :case-insensitive-mode t)
  "Regexp scanner for parse-byte-count.")

(defun make-float (int dec)
  (if (zerop dec)
      (float int)
      (+ (float int)
         (* (if (minusp int) -1 1)
            (/ (float dec)
               (expt 10 (1+ (floor (log dec 10)))))))))

(defun find-suffix-expt (suffix)
  "Find the exponent for SUFFIX."
  (1+ (or (position (coerce suffix 'character)
                    *byte-count-suffixes* :test #'equalp)
          -1)))

(defun parse-byte-count (string)
  "Parse a byte count from STRING."
  (or (ppcre:register-groups-bind
          ((#'parse-integer int dec)
           (#'find-suffix-expt power) base-two)
          (*byte-count-pattern* string :sharedp t)
        (let ((count (* (make-float (or int 0) (or dec 0))
                        (expt (if base-two 1024 1000) (or power 0)))))
          (if (and (not power) (plusp (mod count 1)))
              (error "Byte count is not a natural number: ~A" count)
              (values (floor count)))))
      (error "Not a byte count: ~S" string)))

(defun parse-byte-range (string)
  "Parse STRING, which should be range of byte counts."
  (destructuring-bind (&optional start end &rest rest)
      (uiop:split-string string :separator '(#\- #\: #\~))
    (when rest
      (error "Garbage after byte range: ~S" string))
    (cond
      ((and (plusp (length start))
            (plusp (length end)))
       (cons (parse-byte-count start)
             (parse-byte-count end)))
      ((and (plusp (length start))
            (stringp end))
       (cons (parse-byte-count start) nil))
      ((stringp end)
       (cons 0 (parse-byte-count end)))
      ((plusp (length start))
       (let ((n (parse-byte-count start)))
         (cons n n)))
      (t (error "Not a byte range: ~S" string)))))

(defun number-in-byte-ranges (num ranges)
  "Return non-nil if NUM falls within one of RANGES."
  (some (lambda (range)
          (and (>= num (car range))
               (or (not (cdr range))
                   (<= num (cdr range)))))
        ranges))

(defun print-byte-range-help (stream)
  "Print information about byte range parsing to STREAM."
  (format stream "~
Byte counts take the form of a number with an optional size suffix. Some
examples follow (all supported suffixes are listed at the end):
       \"32\" - 32 bytes
      \"51B\" - 51 bytes (space between the number and unit is optional)
     \"3.1B\" - (INVALID) fractional count of bytes
   \".3 KiB\" - 307 bytes (the .2 is rounded off)
   \"1.3 kB\" - 1300 bytes (1.3 kilobytes)
  \"5.3 MiB\" - 5300000 bytes (5.3 mebibytes)
Byte ranges take the form of one or two byte counts separated by a \"-\", \":\",
or \"~~\". If one count is given with no separator, items of exactly that size
match. Otherwise, items between the bounds of the range (inclusive of those
bounds) match. If the lower bound of a range is omitted (but the separator still
present), the lower bound is zero. If the upper bound is omitted, there is no
upper bound. Some examples:
         \"30\" - exactly 30 bytes
       \"-5TB\" - less that or equal to 5 terabytes
     \"10GiB:\" - greater than or equal to 10 gibigytes
  \"10kB-30kB\" - between 10 kilobytes and 30 kilobytes (inclusive)
Ranges are provided to commands that support them via the -S or --size-range
flags. These flags can be given any number of times and anything that lies
within at at least one range will match (that is, the union of all ranges).

The following suffixes are recognized (in additon to \"B\"):
+----------------------+----------------------+
| ~20:@<Base 10~> | ~20:@<Base 2~> |
+----------------------+----------------------+
~:{| ~20@<~:@(~A~)B - 1000^~D~> | ~@*~20@<~:@(~A~)iB - 1024^~D~> |~%~}~
+----------------------+----------------------+~%"
          (loop for c across *byte-count-suffixes*
                for i upfrom 1
                collect (list c i))))

(defun clingon-dir-options ()
  "Return some options that can be used by many commands."
  (list
   (clingon:make-option
    :list/filepath
    :key :extra-trashes
    :description "include additional trashes"
    :short-name #\c
    :long-name "include-trash")
   (clingon:make-option
    :list/filepath
    :key :ignored-trashes
    :description "ignore the given trash directory"
    :short-name #\I
    :long-name "ignore-trash")
   (clingon:make-option
    :flag
    :key :only-explicit-dirs
    :description "only use trash directories supplied with -c"
    :short-name #\E
    :long-name "explicit-trashes-only")))

(defun clingon-filtering-options ()
  "Return some options that can be used by many commands for filtering."
  (append
   (clingon-dir-options)
   (list
    (clingon:make-option
     :flag
     :key :strings
     :description "don't use regexp to match file names"
     :short-name #\s
     :long-name "strings")
    (clingon:make-option
     :flag
     :key :exact
     :description "force exact match"
     :short-name #\e
     :long-name "exact")
    (clingon:make-option
     :flag
     :key :full-path
     :description "match against full file paths"
     :short-name #\p
     :long-name "full-paths")
    (clingon:make-option
     :flag
     :key :case-insensitive
     :description "match case-insensitively"
     :short-name #\i
     :long-name "case-insensitive")
    (clingon:make-option
     :flag
     :key :invert
     :description "invert result"
     :short-name #\v
     :long-name "invert")
    (clingon:make-option
     :date-range
     :key :date-ranges
     :description "range of dates to consider in search"
     :short-name #\R
     :long-name "date-range")
    (clingon:make-option
     :flag
     :key :date-help
     :description "print information about date ranges"
     :long-name "date-help")
    (clingon:make-option
     :multi-parsed
     :key :size-ranges
     :description
     "range of file sizes to consider in search (suffixes like GB or KiB work)"
     :parser #'parse-byte-range
     :parameter "RANGE"
     :short-name #\S
     :long-name "size-range")
    (clingon:make-option
     :flag
     :key :size-help
     :description "print information about size ranges"
     :long-name "size-help"))))

(declaim (inline compare-trashinfo-to-string))
(defun compare-trashinfo-to-string (trashinfo filter full-path exact
                                    case-insensitive)
  "Compare TRASHINFO's name or path to FILTER using the provided matching
options."
  (let* ((orig-path (trashinfo-original-path trashinfo))
         (target (if full-path orig-path (file-or-dir-namestring orig-path))))
    (cond
      ((and exact case-insensitive) (equalp target filter))
      (exact (equal target filter))
      (t (search filter target :test (if case-insensitive #'equalp #'eql))))))

(declaim (inline compare-trashinfo-to-scanner))
(defun compare-trashinfo-to-scanner (trashinfo filter full-path exact)
  "Compare TRASHINFO's name or path to FILTER, which is a cl-ppcre scanner."
  (let* ((orig-path (trashinfo-original-path trashinfo))
         (target (if full-path orig-path (file-or-dir-namestring orig-path))))
    (multiple-value-bind (start end) (cl-ppcre:scan filter target)
      (and start
           (or (not exact)
               (and (= start 0) (= end (length target))))))))

(defun filter-trashinfos-by (trashinfos filter &key regexp full-path
                                                 exact case-insensitive
                                                 invert)
  "Filter the list of trashinfo objects TRASHINFOS by FILTER, which is a
string."
  (if regexp
      (let ((scanner (cl-ppcre:create-scanner
                      filter :case-insensitive-mode case-insensitive)))
        (remove-if
         (lambda (info)
           (let ((res (compare-trashinfo-to-scanner info scanner
                                                    full-path exact)))
             (or (and (not invert) (not res))
                 (and invert res))))
         trashinfos))
      (remove-if
       (lambda (info)
         (let ((res (compare-trashinfo-to-string
                     info filter full-path exact case-insensitive)))
           (or (and (not invert) (not res))
               (and invert res))))
       trashinfos)))

(defun list-nonexcluded-trash-dirs (cmd)
  "Return a list of all trash directories, except those excluded by CMD."
  (append (unless (clingon:getopt cmd :only-explicit-dirs)
            (set-difference (cl-xdg-trash:list-trash-directories)
                            (mapcar #'uiop:ensure-directory-pathname
                                    (clingon:getopt cmd :ignored-trashes))
                            :test #'uiop:pathname-equal))
          (mapcar #'ensure-nonwild-pathname
                  (clingon:getopt cmd :extra-trashes))))

(defun limit-trashinfo-dates-and-sizes-for-cmd (cmd trashinfos)
  (let ((dates (clingon:getopt cmd :date-ranges))
        (sizes (clingon:getopt cmd :size-ranges)))
    (if (and (not dates) (not sizes))
        trashinfos
        (delete-if (lambda (info)
                     (or (and dates
                              (not (timestamp-in-ranges
                                    (trashinfo-deletion-date info) dates)))
                         (and sizes
                              (not (number-in-byte-ranges
                                    (or (trashinfo-size info) 0) sizes)))))
                   trashinfos))))

(defun list-trashinfos-for-cmd (cmd)
  "List trashinfos for the command CMD."
  (let ((args (clingon:command-arguments cmd)))
    (when (cdr args)
      (clingon:print-usage-and-exit cmd t))
    (limit-trashinfo-dates-and-sizes-for-cmd
     cmd
     (if (not (car args))
         (cl-xdg-trash:list-trashed-files (list-nonexcluded-trash-dirs cmd))
         (let ((filter (car args))
               (strings (clingon:getopt cmd :strings))
               (exact (clingon:getopt cmd :exact))
               (full-path (clingon:getopt cmd :full-path))
               (case-insensitive (clingon:getopt cmd :case-insensitive))
               (invert (clingon:getopt cmd :invert)))
           (filter-trashinfos-by
            (cl-xdg-trash:list-trashed-files
             (list-nonexcluded-trash-dirs cmd))
            filter
            :regexp (not strings)
            :exact exact
            :full-path full-path
            :case-insensitive case-insensitive
            :invert invert))))))


;; Sorting
(defun clingon-sort-options ()
  "Return a list of sorting options that can be used by many commands."
  (list
   (clingon:make-option
    :flag
    :key :reverse-sort
    :description "reverse sort order"
    :short-name #\r
    :long-name "reverse-sort")
   (clingon:make-option
    :enum
    :key :sort-field
    :description "sort field"
    :short-name #\l
    :long-name "sort-field"
    :items '(("name" . :name)
             ("path" . :path)
             ("deletion-date" . :deletion-date)
             ("size" . :size))
    :initial-value "deletion-date")))

(defun sort-trashinfos-for-cmd (trashinfos cmd)
  "Sort the TRASHINFOS according to options passed to CMD."
  (multiple-value-bind (pred-fun key-fun)
      (case (clingon:getopt cmd :sort-field)
        (:name (values #'string-lessp
                       (lambda (info) (file-or-dir-namestring
                                       (trashinfo-original-path info)))))
        (:path (values #'string-lessp
                       (lambda (info)
                         (uiop:unix-namestring
                          (trashinfo-original-path info :resolve t)))))
        (:deletion-date (values
                         #'< (lambda (info) (local-time:timestamp-to-unix
                                             (trashinfo-deletion-date info)))))
        (:size (values (lambda (s1 s2)
                         ;; if finding the file's size fails, either of these
                         ;; may be nil
                         (cond
                           ((not s1) t)
                           ((not s2) nil)
                           ((< s1 s2))))
                       #'trashinfo-size)))
    (sort trashinfos
          (if (clingon:getopt cmd :reverse-sort)
              (complement pred-fun)
              pred-fun)
          :key key-fun)))


;; Formatting
(defun clingon-format-options (file-default &optional dir-default)
  "Return a list of formatting options that can be used by many commands."
  (append
   (list
    (clingon:make-option
     :flag
     :key :format-help
     :description "print information about format strings, then exit"
     :long-name "format-help")
    (clingon:make-option
     :format-string
     :key :file-format
     :directives *trashinfo-formatters*
     :description "format for printing individual trashed files"
     :short-name #\f
     :long-name "file-format"
     :initial-value file-default))
   (when dir-default
     (list
      (clingon:make-option
       :flag
       :key :directory-wise
       :description "operate on trash directories rather than on trashed files"
       :short-name #\d
       :long-name "direcotries")
      (clingon:make-option
       :flag
       :key :all-directories
       :description "even show directories that have no results"
       :short-name #\D
       :long-name "all-directories")
      (clingon:make-option
       :format-string
       :key :dir-format
       :directives *directory-formatters*
       :description "format for printing trash directories"
       :short-name #\F
       :long-name "directory-format"
       :initial-value dir-default)))))

(defun parition-trashinfos (infos)
  "Partition INFOS into a list of conses with the car being the path of the
trash directory and the cdr being it's trashinfos. As a second value, return a
list of trash directories that were present in INFOS."
  (let ((out (make-hash-table :test #'equal)))
    (loop for info in infos
          for dir = (uiop:unix-namestring (trashinfo-trash-directory info))
          do (setf (gethash dir out) (cons info (gethash dir out))))
    (loop for dir being the hash-keys of out
            using (hash-value infos)
          collect (cons dir infos) into path-and-infos
          collect dir into dirs
          finally (return (values path-and-infos dirs)))))

(defun list-objects-for-command (cmd &optional no-sort)
  "List either individual trashinfos or partitioned trashinfos for CMD."
  (let ((infos (list-trashinfos-for-cmd cmd))
        (all-dirs (clingon:getopt cmd :all-directories)))
    (cond
      ((clingon:getopt cmd :directory-wise)
       (multiple-value-bind (path-and-infos dirs) (parition-trashinfos infos)
         (nconc path-and-infos
                (mapcar #'list
                        (when all-dirs
                          (set-difference (cl-xdg-trash:list-trash-directories)
                                          dirs :test #'uiop:pathname-equal))))))
      (all-dirs (error "Can't have -D without -d"))
      (no-sort infos)
      (t (sort-trashinfos-for-cmd infos cmd)))))

(defun print-objects-for-command (cmd objs &optional (indices t) extra-action)
  "Print OBJS, a list of trashinfos or trash directories, for CMD."
  (if (clingon:getopt cmd :directory-wise)
      (format-list t (clingon:getopt cmd :dir-format) objs indices extra-action)
      (format-list t (clingon:getopt cmd :file-format) objs indices extra-action)))


;; List command
(defun list/handler (cmd)
  "Handler for the \"list\" subcommand."
  (let ((objs (list-objects-for-command cmd)))
    (print-objects-for-command cmd objs)))

(defun list/options ()
  "Return options for the \"list\" subcommand."
  (append
   (clingon-format-options "%t  %o\\n" "Found %c file%m in %p\\n")
   (clingon-filtering-options)
   (clingon-sort-options)))

(defun list/command ()
  "Return the Clingon command for the \"list\" subcommand."
  (clingon:make-command
   :name "list"
   :description "list files in trash directories"
   :usage "[options] [pattern]"
   :options (list/options)
   :handler #'list/handler))


;; Put command
(defun put/handler (cmd)
  "Handler for the \"put\" subcommand."
  (let ((no-cross-device (clingon:getopt cmd :no-cross-device))
        (ignored-dirs (clingon:getopt cmd :ignored-trashes))
        (trash-directory (clingon:getopt cmd :trash-directory)))
    (dolist (file (clingon:command-arguments cmd))
      (handler-case
          (cl-xdg-trash:trash-file file :no-cross-device no-cross-device
                                        :ignored-trash-dirs ignored-dirs
                                        :trash-directory trash-directory)
        ;; in case of an error, just notify the user and continue
        (error (e)
          (format *error-output* "~&~A~&" e))))))

(defun put/options ()
  "Return options for the \"put\" subcommand."
  (list
   (clingon:make-option
    :filepath
    :key :trash-directory
    :description "force trashing to a specific directory"
    :long-name "trash-directory")
   (clingon:make-option
    :flag
    :key :no-cross-device
    :description "don't trash files to directories on different devices"
    :short-name #\n
    :long-name "no-cross-device")))

(defun put/command ()
  "Return the Clingon command for the \"put\" subcommand"
  (clingon:make-command
   :name "put"
   :aliases '("trash")
   :description "move files to the trash"
   :usage "[-n|--no-cross-device] [--trash-directory=DIR] [files...]"
   :options (put/options)
   :handler #'put/handler))


;; Restore command
(declaim (inline single-item-list-p))
(defun single-item-list-p (list)
  "Return non-nil if LIST has only one thing."
  (and list (null (cdr list))))

(declaim (inline enumerate-range))
(defun enumerate-range (start end)
  "Enumerate all numbers between [start,end]."
  (loop for i upfrom (min start end)
          upto (max start end)
        collect i))

(defun parse-index-or-range (max string)
  "Parse the index or range of indices STRING."
  (flet ((parse (str)
           (let ((n (parse-integer str)))
             (when (or (< n 1)
                       (> n max))
               (error "Number ~D out of range [1,~D]" n max))
             (1- n))))
    (let ((parts (uiop:split-string string :separator '(#\-))))
      (destructuring-bind (start &optional end &rest rest)
          (mapcar (lambda (part) (string-trim '(#\Space #\Tab) part)) parts)
        (cond
          (rest (error "Invalid range: ~S" string))
          ((and (not (zerop (length start)))
                (not (zerop (length end))))
           (enumerate-range (parse start) (parse end)))
          ((not (zerop (length end)))
           (enumerate-range 0 (parse end)))
          ((and (not (zerop (length start))) (stringp end))
           (enumerate-range (parse start) (1- max)))
          ;; if none of the above match, it must be just a number
          (t (list (parse string))))))))

(defun prompt-for-index (stream action max &optional allow-many)
  "Prompt the user for an index between 1 and MAX to restore. With ALLOW-MANY,
return a list of many indices instead."
  (when (zerop max)
    (error "Nothing found..."))
  (format stream "~&Select ~:[indices~;index~] to ~A: "
          (or (eql 1 max) (not allow-many)) action)
  (let ((resp-string (read-line stream nil)))
    (unless resp-string
      (error "No number provided"))
    (let ((parts (uiop:split-string resp-string :separator '(#\,)))
          (out (make-hash-table :test #'eql)))
      (unless parts
        (error "No number provided"))
      (dolist (part parts)
        (dolist (n (parse-index-or-range max part))
          (setf (gethash n out) t)))
      (let ((final-list (loop for key being the hash-keys of out collect key)))
        (unless (or allow-many (single-item-list-p parts))
          (error "Only one item can be selected"))
        final-list))))

(defun prompt-yes-or-no (stream control &rest args)
  "Prompt the user for a yes or no response."
  (when control
    (apply #'format stream control args)
    (format stream "? (y/n) "))
  (let ((resp-string (read-line stream nil)))
    (when resp-string
      (member resp-string '("yes" "y" "1") :test #'equalp))))

(defun confirm-action (action count quiet)
  "Confirm with the user that ACTION is OK."
  (prompt-yes-or-no
   t "Really ~A ~@[~*the above ~]~@[~*~A~:* ~]item~P"
   action (not quiet) (or quiet (/= 1 count)) count))

(defun get-indices-for-command (action cmd only-one-flag objs)
  "Return indices for CMD."
  (let* ((max (length objs))
         (all (clingon:getopt cmd :all))
         (indices (mapcar
                   (lambda (i)
                     (when (or (< i 1)
                               (> i max))
                       (error "Index ~D out of range [1,~D]" i max))
                     (1- i))
                   (clingon:getopt cmd :indices)))
         (yes (clingon:getopt cmd :yes))
         (quiet (clingon:getopt cmd :quiet))
         (dont-prompt-only-one (clingon:getopt cmd :dont-prompt-only-one)))
    (when only-one-flag
      (when all
        (error "Can't use -a and ~A together" only-one-flag))
      (when (and indices
                 (not (single-item-list-p indices)))
        (error "Cant use multiple -n and ~A together" only-one-flag)))
    (when (and indices all)
      (error "Can't use -a and -n together"))
    (unless (or yes quiet)
      (print-objects-for-command cmd objs (or indices t)))
    (cond
      ((not objs) (unless quiet
                    (error "Nothing to do...")))
      ((and dont-prompt-only-one (single-item-list-p objs))
       (list 0))
      (all (if (or yes
                   (confirm-action action max (or yes quiet)))
               (enumerate-range 0 (1- max))
               :cancel))
      (indices (if (or yes
                       (confirm-action action (length indices)
                                       (or yes quiet)))
                   indices
                   :cancel))
      (yes (error "One of -a or -n must be passed with -y"))
      (quiet (error "One of -a or -n must be passed with -q"))
      (t (prompt-for-index t action max (not only-one-flag))))))

(defun clingon-indices-options (action)
  "Return options for prompting the user for indices."
  (list
   (clingon:make-option
    :flag
    :key :all
    :description
    (format nil "~A all things that match the pattern" action)
    :short-name #\a
    :long-name "all")
   (clingon:make-option
    :list/integer
    :key :indices
    :description
    (format nil "~A the Nth thing that matched the pattern (after sorting)"
            action)
    :short-name #\n
    :long-name "nth")
   (clingon:make-option
    :flag
    :key :dont-prompt-only-one
    :description "don't prompt if the pattern matches only one thing"
    :short-name #\O
    :long-name "dont-prompt-only-one")
   (clingon:make-option
    :flag
    :key :quiet
    :description (format nil "don't enumerate all options before ~Aing" action)
    :short-name #\q
    :long-name "quiet")
   (clingon:make-option
    :flag
    :key :yes
    :description "don't prompt, just ~A all matching things"
    :short-name #\y
    :long-name "yes")))

(defun restore/handler (cmd)
  "Handler for the \"restore\" subcommand."
  (let* ((quiet (clingon:getopt cmd :quiet))
         (no-sort (and (clingon:getopt cmd :all) quiet))
         (infos (list-objects-for-command cmd no-sort))
         (target (clingon:getopt cmd :target))
         (indices (get-indices-for-command "restore" cmd
                                           (when target "-t")
                                           infos)))
    ;; ensure we actually have a list of trashinfos
    (assert (or (null infos) (not (listp (car infos)))))
    (unless (eq indices :cancel)
      (assert (or (not target) (single-item-list-p indices)))
      (if target
          (cl-xdg-trash:restore-file (nth (car indices) infos) :target target)
          (loop with arr = (coerce infos 'vector)
                for i in indices
                do (format t "~A~%" (aref arr i))
                do (cl-xdg-trash:restore-file (aref arr i)))))))

(defun restore/options ()
  "Return options for the \"restore\" subcommand."
  (append
   (clingon-filtering-options)
   (clingon-sort-options)
   (clingon-format-options "%>#:  %t  %o\\n")
   (clingon-indices-options "restore")
   (list
    (clingon:make-option
     :filepath
     :key :target
     :description "where path to restore the file (exclusive with -a)"
     :short-name #\t
     :long-name "target"))))

(defun restore/command ()
  "Rethrn the Clingon command for the \"restore\" subcommand."
  (clingon:make-command
   :name "restore"
   :description "move files out of the trash"
   :usage "[options] [pattern]"
   :options (restore/options)
   :handler #'restore/handler))


;; Empty command
(defun empty/handler (cmd)
  "Handler for the \"empty\" subcommand."
  (let* ((dir-wise (clingon:getopt cmd :directory-wise))
         (dry-run (clingon:getopt cmd :dry-run))
         (quiet (clingon:getopt cmd :quiet))
         (no-sort (and (clingon:getopt cmd :all) quiet))
         (objs (list-objects-for-command cmd no-sort))
         (indices (get-indices-for-command "erase" cmd nil objs)))
    (unless (eq indices :cancel)
      (if dir-wise
          (loop with objs-arr = (coerce objs 'vector)
                for i in indices
                do (dolist (info (cdr (aref objs-arr i)))
                     (cl-xdg-trash:empty-file info :dry-run dry-run)))
          (loop with infos-arr = (coerce objs 'vector)
                for i in indices
                do (cl-xdg-trash:empty-file (aref infos-arr i)
                                            :dry-run dry-run))))))

(defun empty/options ()
  "Return options for the \"empty\" subcommand."
  (append
   (clingon-filtering-options)
   (clingon-sort-options)
   (clingon-format-options "%>#:  %t  %o\\n" "%>:  %p\\n")
   (clingon-indices-options "erase")
   (list
    (clingon:make-option
     :flag
     :key :dry-run
     :description "print what would happen without actually deleting anything"
     :short-name #\N
     :long-name "dry-run"))))

(defun empty/command ()
  "Return the Clingon command for the \"empty\" subcommand."
  (clingon:make-command
   :name "empty"
   :aliases '("erase" "rm")
   :description "delete files from the trash permanently"
   :options (empty/options)
   :handler #'empty/handler))


;; List trash directories command
(defun list-trashes/handler (cmd)
  "Handler for the \"list-trashes\" subcommand."
  (let* ((only-home (clingon:getopt cmd :home))
         (only-toplevel (clingon:getopt cmd :toplevel))
         (null (clingon:getopt cmd :null))
         (dirs (cond
                 ((or (and only-home only-toplevel)
                      (not (or only-home only-toplevel)))
                  (cl-xdg-trash:list-trash-directories))
                 (only-home
                  (list (cl-xdg-trash:user-home-trash-directory)))
                 (only-toplevel
                  (cl-xdg-trash:list-toplevel-trash-directories)))))
    (dolist (dir dirs)
      (format t "~A" (uiop:native-namestring dir))
      (if null
          (write-char #\Nul)
          (terpri)))))

(defun list-trashes/options ()
  "Return options for the \"list-trashes\" subcommand."
  (list
   (clingon:make-option
    :flag
    :key :home
    :description "only list the user's home trash directory"
    :short-name #\o
    :long-name "home")
   (clingon:make-option
    :flag
    :key :toplevel
    :description "only list toplevel trash directories"
    :short-name #\t
    :long-name "toplevel")
   (clingon:make-option
    :flag
    :key :null
    :description "use \\0 (null byte) instead of newline"
    :short-name #\0
    :long-name "null")))

(defun list-trashes/command ()
  "Return the Clingon command for the \"list-trashes\" subcommand."
  (clingon:make-command
   :name "list-trashes"
   :description "list known trash directories"
   :options (list-trashes/options)
   :handler #'list-trashes/handler))


;; Size command
(defun size/handler (cmd)
  "Handler for the \"size\" subcommand."
  (let* ((quiet (clingon:getopt cmd :quiet))
         (objs (list-objects-for-command cmd quiet))
         (dir-wise (clingon:getopt cmd :directory-wise))
         (base-two (clingon:getopt cmd :base-two))
         (bytes (clingon:getopt cmd :bytes))
         (total-size 0))
    (when (and bytes base-two)
      (error "Can't pass both -t and -b"))
    (flet ((sum (size)
             (when size (incf total-size size))))
      (cond
        ((and quiet dir-wise)
         (dolist (path-and-infos objs)
           (dolist (info (cdr path-and-infos))
             (sum (trashinfo-size info)))))
        (quiet
         (dolist (info objs)
           (sum (trashinfo-size info))))
        (dir-wise
         (print-objects-for-command
          cmd objs t (lambda (path-and-infos)
                       (dolist (info (cdr path-and-infos))
                         (sum (trashinfo-size info))))))
        (t
         (print-objects-for-command
          cmd objs t (lambda (info)
                       (sum (trashinfo-size info)))))))
    (format t "~@[~*Total Size: ~]~A"
            (not quiet) (if bytes
                            total-size
                            (format-size total-size base-two)))))

(defun size/options ()
  "Return options for the \"size\" subcommand."
  (append
   (clingon-filtering-options)
   (clingon-sort-options)
   (clingon-format-options "%<h %o\\n" "%<h %p\\n")
   (list
    (clingon:make-option
     :flag
     :key :base-two
     :description "use base two sizes for the final tally"
     :short-name #\t
     :long-name "base-two")
    (clingon:make-option
     :flag
     :key :bytes
     :description "print the final tally in bytes"
     :short-name #\b
     :long-name "bytes")
    (clingon:make-option
     :flag
     :key :quiet
     :description "only print the final tally"
     :short-name #\q
     :long-name "quiet"))))

(defun size/command ()
  "Return the Clingon command for the \"size\" subcommand."
  (clingon:make-command
   :name "size"
   :description "find the size of one or more trash directory"
   :options (size/options)
   :handler #'size/handler))


;; List files missing either a trashinfo or trashinfos missing a file
(defun missing-trashinfo/handler (cmd)
  "Handler for the \"missing trashinfo\" subcommand."
  (let ((dirs (list-nonexcluded-trash-dirs cmd))
        (null (clingon:getopt cmd :null)))
    (dolist (dir dirs)
      (dolist (missing
               (delete-if (lambda (path)
                            (handler-case
                                (parse-trashinfo-file
                                 dir (file-or-dir-namestring path))
                              (error () nil)))
                          (uiop:directory*
                           (merge-pathnames uiop:*wild-file-for-directory*
                                            (uiop:ensure-directory-pathname
                                             (merge-pathnames "files" dir))))))
        (format t "~A~:[~%~;~A~]" missing null #\Nul)))))

(defun missing-file/handler (cmd)
  "Handler for the \"missing file\" subcommand."
  (let ((infos (delete-if (lambda (info)
                            (probe-file (trashinfo-trashed-file info)))
                          (cl-xdg-trash:list-trashed-files
                           (list-nonexcluded-trash-dirs cmd) t)))
        (format (clingon:getopt cmd :format-string)))
    (format-list t format infos)))

(defun missing-file/options ()
  "Return options for the \"missing file\" subcommand."
  (append
   (clingon-dir-options)
   (list
    (clingon:make-option
     :flag
     :key :print-format-info
     :description "print information about format strings, then exit"
     :long-name "format-info")
    (clingon:make-option
     :format-string
     :key :format-string
     :description "format for printing each entry"
     :directives *trashinfo-formatters*
     :initial-value "%i  %c\\n"
     :short-name #\f
     :long-name "format"))))

(defun handle-toplevel-with-subcommands (cmd)
  "Handler for \"missing\" and the toplevel command."
  (let ((args (clingon:command-arguments cmd)))
    (when args
      (error "Unknown subcommand: ~S" (car args)))
    (clingon:print-usage-and-exit cmd t)))

(defun missing/command ()
  "Return the Clingon command for the \"missing\" subcommand."
  (clingon:make-command
   :name "missing"
   :description "list unrecoverable files"
   :handler #'handle-toplevel-with-subcommands
   :sub-commands
   (list (clingon:make-command
          :name "trashinfo"
          :aliases '("trashinfos" "info" "infos")
          :description "list trashed files missing their trashinfo file"
          :options (cons
                    (clingon:make-option
                     :flag
                     :key :null
                     :description "use null bytes instead of newlines"
                     :short-name #\0
                     :long-name "null")
                    (clingon-dir-options))
          :handler #'missing-trashinfo/handler)
         (clingon:make-command
          :name "file"
          :aliases '("files")
          :description "list trashinfo files missing their trashed file"
          :options (missing-file/options)
          :handler #'missing-file/handler))))


;; Toplevel command
(defun toplevel/command ()
  "Return the toplevel command."
  (clingon:make-command
   :name "clash"
   :description "command line interface to the XDG trashcan"
   :version "0.1.0"
   :license "GPL3"
   :authors '("Alexander Rosenberg <zanderpkg@pm.me>")
   :sub-commands (list (list/command)
                       (put/command)
                       (restore/command)
                       (list-trashes/command)
                       (empty/command)
                       (size/command)
                       (missing/command))
   :handler #'handle-toplevel-with-subcommands))

(defparameter *toplevel/help-option*
  (clingon:make-option
   :flag
   :key :clingon.help.flag
   :description "display usage information, then exit"
   :short-name #\h
   :long-name "help"
   :persistent t)
  "Help option to replace the default Clingon one.")

(defmethod clingon:finalize-command :after ((cmd clingon:command))
  ;; handle the various help options
  (when (clingon:getopt cmd :format-help)
    (print-clash-format-info (clingon:getopt cmd :dir-format) t)
    (error 'clingon:exit-error :code 0))
  (when (clingon:getopt cmd :date-help)
    (print-date-parsing-help t)
    (error 'clingon:exit-error :code 0))
  (when (clingon:getopt cmd :size-help)
    (print-byte-range-help t)
    (error 'clingon:exit-error :code 0)))

(defun toplevel (&optional (args () argsp))
  "Program entry point.
Args can be supplied to facilitate testing in SLIME."
  #+(and sbcl (not slynk)) (sb-ext:disable-debugger)
  (let ((clingon:*default-options* (list clingon:*default-version-flag*
                                         clingon:*default-bash-completions-flag*
                                         *toplevel/help-option*)))
    (if argsp
        (clingon:run (toplevel/command) args)
        (clingon:run (toplevel/command)))))