ambevar-dotfiles/.local/share/common-lisp/source/ambrevar/shell.lisp

(uiop:define-package #:ambrevar/shell
  (:documentation "Shell-like utilities.")
  (:nicknames #:$)
  (:use #:common-lisp)
  (:use #:trivia)
  (:import-from #:serapeum #:export-always))
(in-package #:ambrevar/shell)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
  (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))

(defun assert-program (program &rest more-programs) ; TODO: Is this useful for a REPL?
  (sera:and-let* ((missing-programs
                   (delete-if #'sera:resolve-executable (cons program more-programs))))
    (error "Missing programs: ~{~a~,^, ~}" missing-programs)))

(export-always 'file-extension)
(defun file-extension (file)
  "Return the file extension.
If none, return the empty string unlike `pathname-type'."
  (or (pathname-type file)
      ""))

(export-always 'file-basename)
(defun file-basename (file)
  "Return the file basename (including the extension)."
  (apply #'str:concat (pathname-name file)
         (sera:and-let* ((ext (file-extension file)))
           `("." ,ext))))

(export-always 'match-extensions)
(defun match-extensions (extension &rest more-extensions)
  "Return a predicate for files that match on of the provided extensions.
Useful for `finder'."
  (lambda (file)
    (some (lambda (ext)
            (string= ext (pathname-type file)))
          (cons extension more-extensions))))

(export-always 'finder)
(defun finder (root &rest predicates)
  "List files in directory that satisfy all PREDICATES.
Without PREDICATES, list all files."
  (let ((result '()))
    (uiop:collect-sub*directories
     (uiop:ensure-directory-pathname root)
     (constantly t) (constantly t)
     (lambda (subdirectory)
       (setf result (nconc result
                           (let ((subfiles (uiop:directory-files subdirectory)))
                             (if predicates
                                 (delete-if (lambda (file)
                                              (notany (lambda (pred) (funcall pred file))
                                                      predicates))
                                            subfiles)
                                 subfiles))))))
    result))

(export-always 'make-directory)
(defun make-directory (path)
  "Including parents."
  (uiop:ensure-all-directories-exist (list (uiop:ensure-directory-pathname path)))
  path)

(defun terminate-process-with-group (process-info)
  ;; TODO: Is it possible to kill a group without pkill, maybe with osicat?
  (when (uiop:process-alive-p process-info)
    (uiop:run-program
     (list "pkill" "-TERM" "-g"         ;TODO: -KILL instead?
           (format nil "~a" (osicat-posix:getpgid (uiop:process-info-pid process-info)))))
    (uiop:terminate-process process-info)))

(defvar *process-list* '()
  "List of processes started from `run'.")

(export-always 'terminate-dangling-processes)
(defun terminate-dangling-processes ()
  (mapc #'terminate-process-with-group *process-list*)
  ;; TODO: Maybe don't flush the list in case some processes failed to be terminated.
  ;; Use -KILL to fix this?
  (setf *process-list* nil))

(defun %run (command &key (output :stream) (error-output *error-output*))
  (assert-program "pkill")              ; For `terminate-process-with-group'.
  (flet ((cleanup (process-info)
           (push process-info *process-list*)
           (uiop:wait-process process-info)))
    (setf command (if (listp command)
                      (mapcar #'princ-to-string (alex:flatten command))
                      command))
    ;; TODO: Use :stream directly in launch-program and get stream from
    ;; process-info to avoid repeating the launch-program call.
    (match output
      (:stream
       (nth-value
        0
        (uiop:stripln
         (with-output-to-string (out)
           (let ((process-info (uiop:launch-program command
                                                    :output out
                                                    :error-output error-output)))
             (cleanup process-info))))))

      (out
       (let ((process-info (uiop:launch-program command
                                                :output (match out
                                                          (t *standard-output*)
                                                          (o o))
                                                :error-output error-output)))
         (cleanup process-info))))))

(export-always 'run)
(defun run (command &rest args)
  "Run arguments in a safe manner.
If on interrupt process gets forked to the background, call
`terminate-dangling-processes'.
Output is sent to `*standard-output*'.
Arguments are automatically converted to strings with `format'.
Lists are automatically flattened."
  (%run (cons command args) :output t))

(export-always 'run*)
(defun run* (command &rest args)
  "Same as `run' but return output as a string."
  (%run (cons command args)))

(export-always 'sh)
(defun sh (shell-command)
  "Like `run' but for shell commands."
  (%run shell-command :output t))

(export-always 'sh*)
(defun sh* (shell-command)
  "Like `sh' but return output as a string."
  (%run shell-command))

(export-always 'disk-usage)
(defun disk-usage (files)
  "Return disk usage of FILES in octets.
As a second value, return a list of (FILE SIZE) pairs, biggest file first."
  (let ((pairs (mapcar (lambda (f)
                         (list f (or (trivial-file-size:file-size-in-octets f)
                                     0)))
                       files)))
    (values
     (reduce #'+ (mapcar #'second pairs))
     (sort
      pairs
      #'> :key #'second))))