jadedctrl/ mirror-img
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

Replace our RELATIVE-PATHNAME with PATHNAME-UTIL’s

This commit is contained in:
Jaidyn Ann 2024-05-31 14:44:33 -05:00
parent e2f2f38f01
commit 74acf3fa2d
2 changed files with 2 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
mirror-img.asd
View File

@ -4,7 +4,7 @@
:version "0.1"
:license "GPLv3"
:author "Jaidyn Ann <jadedctrl@posteo.at>"
:depends-on (:dexador :lquery :split-sequence)
:depends-on (:dexador :lquery :pathname-utils :split-sequence)
:components ((:file "src/mirror-img"))
:in-order-to ((test-op (test-op "mirror-img/tests"))
(build-op (build-op "mirror-img/unix"))))

57
src/mirror-img.lisp
View File

@ -108,7 +108,7 @@ to mirror it."
DOWNLOAD-DIR, and URL-DIR."
(format nil "~A~A"
url-dir
(relative-pathname download-dir pathname)))
(pathname-utils:relative-pathname download-dir pathname)))
@ -204,58 +204,3 @@ That is, 443 is implied by HTTPS, so nil is returned; but 998 wouldn’t be impl
"Given a pathname, return the entirety of the file leaf.
That is, everything following the last directory name."
(car (last (split-sequence:split-sequence #\/ (namestring pathname)))))
;; pathname pathname → pathname
(defun relative-pathname (from pathname)
"Create a relative pathname leading from the pathname FROM to PATHNAME.
By default, FROM is the current working directory."
(let* ((dir-str
(reduce (lambda (a b)
(format nil "~A/~A" a b))
(cdr (relative-pathname-directory pathname from))))
(dir-pathname
(pathname (format nil "~A/" dir-str))))
(merge-pathnames dir-pathname
(pathname (pathname-leaf pathname)))))
;; pathname pathname → list
(defun relative-pathname-directory (pathname &optional (from (uiop/os:getcwd)))
"Given a PATHNAME, create a relative PATHNAME-DIRECTORY-style list from the
perspective of the FROM pathname (the current working directory, by default).
Returns something along the lines of '(:RELATIVE “..” “DAD”)"
(let* ((from (cdr (pathname-directory from)))
(to (cdr (pathname-directory pathname)))
(from+to (list-lengths nil from to))
(to-append (list)))
(append
(list :relative)
(remove-if
#'not
(loop for from-dir in (car from+to)
for to-dir in (cadr from+to)
collect
(cond ((equal from-dir to-dir)
nil)
((not from-dir)
to-dir)
(to-dir
(setq to-append (append to-append (list to-dir)))
"..")
('T
".."))))
to-append)))
;; object list … list → list(-of-lists)
(defun list-lengths (padding &rest lists)
"Equalize the lengths of LISTS, by padding the tail-end of smaller lists with
the PADDING object."
(let ((target-length
(apply #'max (mapcar #'length lists))))
(mapcar
(lambda (lst)
(append
lst
(loop for i
upto (- target-length (length lst) 1)
collect padding)))
lists)))