ambrevar/storage: Replace own `parent' with pathname-utils:parent.
parent
9ded15843d
commit
3549a9461e
|
@ -10,9 +10,8 @@
|
||||||
(in-package ambrevar/storage)
|
(in-package ambrevar/storage)
|
||||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
(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 :alex :alexandria)
|
||||||
(trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))
|
(trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum)
|
||||||
|
(trivial-package-local-nicknames:add-package-local-nickname :path :pathname-utils))
|
||||||
;; TODO: Use pathname-utils to simplify code.
|
|
||||||
|
|
||||||
(defun roots (&optional (prefix "/media/"))
|
(defun roots (&optional (prefix "/media/"))
|
||||||
(sera:filter (sera:op (str:starts-with? prefix _))
|
(sera:filter (sera:op (str:starts-with? prefix _))
|
||||||
|
@ -144,19 +143,13 @@ If DESTINATION ends with '.gpg', it gets GPG-encrypted."
|
||||||
:test #'string=
|
:test #'string=
|
||||||
:key #'basename))
|
:key #'basename))
|
||||||
|
|
||||||
(defun parent (path)
|
|
||||||
"Return the parent directory of PATH."
|
|
||||||
(if (uiop:directory-pathname-p path)
|
|
||||||
(uiop:pathname-parent-directory-pathname path)
|
|
||||||
(uiop:pathname-directory-pathname path)))
|
|
||||||
|
|
||||||
(defun depth (file parent)
|
(defun depth (file parent)
|
||||||
(if (uiop:pathname-equal file parent)
|
(if (uiop:pathname-equal file parent)
|
||||||
0
|
0
|
||||||
(unless (uiop:pathname-equal (parent file) file)
|
(unless (uiop:pathname-equal (path:parent file) file)
|
||||||
(or (when (uiop:pathname-equal (parent file) parent)
|
(or (when (uiop:pathname-equal (path:parent file) parent)
|
||||||
1)
|
1)
|
||||||
(alex:when-let ((level (depth (parent file) parent)))
|
(alex:when-let ((level (depth (path:parent file) parent)))
|
||||||
(1+ level))))))
|
(1+ level))))))
|
||||||
|
|
||||||
(export-always 'list-projects)
|
(export-always 'list-projects)
|
||||||
|
|
Loading…
Reference in New Issue