local/share/common-lisp/source/ambrevar/shell: Add finder and make-directory.

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

@@ -2,13 +2,61 @@
   (:documentation "Shell-like utilities.")
   (:nicknames #:$)
   (:use :common-lisp)
-  (:import-from #:serapeum #:export-always)
-  (:import-from #:trivial-package-local-nicknames))
+  (: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))
 
-(serapeum:export-always 'foo)
-(defun foo ()
-  17)
+(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)