(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)
  (:import-from #:cl-xdg-trash/mountpoints
                #:file-or-dir-namestring)
  (:use #:cl)
  (: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
(defun clingon-filtering-options ()
  "Return some options that can be used by many commands for filtering."
  (list
   (clingon:make-option
    :flag
    :key :print-format-info
    :description "print information about format strings, then exit"
    :long-name "format-info")
   (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
    :string
    :key :format
    :description "format to print results in"
    :short-name #\f
    :long-name "format")))

(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))))
    (destructuring-bind (start &optional end &rest ignore)
        (multiple-value-list (cl-ppcre:scan filter target))
      (declare (ignore ignore))
      (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."
  (set-difference (cl-xdg-trash:list-trash-directories)
                  (clingon:getopt cmd :ignored-trashes)
                  :test #'uiop:pathname-equal))

(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))
    (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)))))


;; Formatting
(defparameter *trashinfo-formatters*
  `((#\o . ,(lambda (stream info)
              "the (o)riginal path"
              (format stream "~A" (trashinfo-original-path info))))
    (#\n . ,(lambda (stream info)
              "the original (n)ame"
              (format stream "~A" (file-or-dir-namestring
                                   (trashinfo-original-path info)))))
    (#\d . ,(lambda (stream info)
              "the trash (d)irectory"
              (format stream "~A" (trashinfo-trash-directory info))))
    (#\i . ,(lambda (stream info)
              "the trash(i)nfo file path"
              (format stream "~A" (trashinfo-info-file info))))
    (#\c . ,(lambda (stream info)
              "the (c)urrent (trashed) path"
              (format stream "~A" (trashinfo-trashed-file info))))
    (#\u . ,(lambda (stream info)
              "the time the file was trashed (in (u)TC seconds)"
              (format stream "~A" (local-time:timestamp-to-unix
                                   (trashinfo-deletion-date info)))))
    (#\t . ,(lambda (stream info)
              "the (t)ime the file was trashed (pretty-printed local time)"
              (local-time:format-timestring
               stream (trashinfo-deletion-date info)
               :format local-time:+asctime-format+)))
    (#\% . ,(lambda (stream info)
              "a liternal %"
              (declare (ignore info))
              (format stream "%")))))

(defun process-format-string (format-string)
  "Process FORMAT-STRING into a list of string and functions."
  (let ((start 0)
        out end)
    (labels ((ensure-next-char (i thing)
               (unless (< i (1- (length format-string)))
                 (error "Unterminated ~A at char ~A: ~S" thing i format-string)))
             (unknown (i thing)
               (error "Unknown ~A at char ~A: ~S" thing i format-string))
             (push-thing (thing)
               (if (null out)
                   (setq out (list thing)
                         end out)
                   (setf (cdr end) (list thing)
                         end (cdr end))))
             (push-string (str)
               (unless (zerop (length str))
                 (if (stringp (car end))
                     (setf (car end) (format nil "~A~A" (car end) str))
                     (push-thing str)))))
      (do ((i 0 (1+ i)))
          ((>= i (length format-string)))
        (case (aref format-string i)
          (#\%
           (ensure-next-char i "substitution")
           (push-string (subseq format-string start i))
           (let ((fun (cdr (assoc (aref format-string (1+ i))
                                  *trashinfo-formatters*))))
             (unless (functionp fun)
               (unknown i "substitution"))
             (push-thing fun))
           (setq start (+ i 2)
                 i (1+ i)))
          (#\\
           (ensure-next-char i "escape sequence")
           (push-string (subseq format-string start i))
           (push-string
            (case (aref format-string (1+ i))
              (#\\ "\\")
              (#\n (string #\Newline))
              (#\t (string #\Tab))
              (#\0 (string #\Nul))
              (t (unknown i "escape sequence"))))
           (setq start (+ i 2)
                 i (1+ i)))))
      (push-string (subseq format-string start))
      out)))

(defun format-trashinfo (stream format-object info)
  "Format the trashinfo INFO to STREAM accoring to FORMAT-OBJECT (which is from
process-format-string)."
  (dolist (part format-object)
    (if (stringp part)
        (format stream "~A" part)
        (funcall part stream info))))

(defun print-format-info (&optional (stream t))
  (format stream "~
Format strings use C-style and printf-style escape sequences. Each character
other than one of those with a special meaning noted below is copied to the
output verbatim. The recognized C-style escapes sequences are:
  \"\\0\" - null byte
  \"\\n\" - newline
  \"\\t\" - tab character
  \"\\\\\" - literal backslash
The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
  (dolist (entry *trashinfo-formatters*)
    (let ((char (car entry))
          (doc (documentation (cdr entry) t)))
      (format stream "  \"%~A\" - ~A~%" char doc))))


;; 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))
    :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 #'trashinfo-original-path))
        (:deletion-date (values
                         #'< (lambda (info) (local-time:timestamp-to-unix
                                             (trashinfo-deletion-date info))))))
    (sort trashinfos
          (if (clingon:getopt cmd :reverse-sort)
              (complement pred-fun)
              pred-fun)
          :key key-fun)))


;; List command
(defun list/handler (cmd)
  "Toplevel for the \"list\" subcommand."
  (if (clingon:getopt cmd :print-format-info)
      (print-format-info t)
      (let ((format (process-format-string (or (clingon:getopt cmd :format)
                                               "%t  %o\\n"))))
        (dolist (info (sort-trashinfos-for-cmd
                       (list-trashinfos-for-cmd cmd) cmd))
          (format-trashinfo t format info)))))

(defun list/options ()
  "Return options for the \"list\" subcommand."
  (append
   (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 "[pattern]"
   :options (list/options)
   :handler #'list/handler))


;; Toplevel command
(defun toplevel/options ()
  "Return the toplevel options list."
  (list
   (clingon:make-option
    :list
    :key :ignored-trashes
    :description "ignore the given trash directory"
    :long-name "ignore-trash"
    :persistent t)))

(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>")
   :options (toplevel/options)
   :sub-commands (list (list/command))
   :handler #'(lambda (cmd)
                (clingon:print-usage-and-exit cmd t))))

(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.")

(defun toplevel (&optional (args () argsp))
  "Program entry point.
Args can be supplied to facilitate testing in SLIME."
  (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)))))