style: sync-music: stop :using alexandria and serapeum

This commit is contained in:
eriedaberrie 2025-02-11 16:25:26 +00:00
parent 5553352671
commit 305da96244
6 changed files with 65 additions and 62 deletions

View file

@ -7,7 +7,7 @@
(defstruct (copy-flac-action (:include copy-action))
(start nil :type (or integer null))
(length nil :type (or integer null))
(metadata nil :type (soft-alist-of string string)))
(metadata nil :type (s:soft-alist-of string string)))
(defstruct (copy-meta-action (:include copy-action)))
(defstruct (delete-action (:include action)))
(defstruct (directory-action (:include action)))
@ -38,9 +38,9 @@ Pushes status message about this action to QUEUE if given."))
`("ffmpeg" "-n"
"-filter_threads" "1"
"-i" ,(uiop:native-namestring (copy-action-origin a))
,@(when-let ((start (copy-flac-action-start a)))
,@(a:when-let ((start (copy-flac-action-start a)))
`("-ss" ,(ffmpeg-timestamp start)))
,@(when-let ((length (copy-flac-action-length a)))
,@(a:when-let ((length (copy-flac-action-length a)))
`("-t" ,(ffmpeg-timestamp length)))
,@(loop :for (tag . value) :in (copy-flac-action-metadata a)
:collect "-metadata"
@ -53,10 +53,10 @@ Pushes status message about this action to QUEUE if given."))
(defmethod action-perform ((a copy-meta-action) &optional queue)
(declare (ignore queue))
(let ((buf (read-file-into-byte-vector (copy-action-origin a))))
(let ((buf (a:read-file-into-byte-vector (copy-action-origin a))))
(setf buf (replace-text-buffer buf ".flac\"" ".opus\""))
(setf buf (replace-text-buffer buf ".wav\"" ".opus\""))
(write-byte-vector-into-file buf (action-target a))))
(a:write-byte-vector-into-file buf (action-target a))))
(defmethod action-perform ((a delete-action) &optional queue)
(declare (ignore queue))

View file

@ -2,7 +2,7 @@
(defmacro with-read-file ((var path) &body body)
"Bind VAR to the result of an fopen on PATH while executing BODY."
(once-only (path)
(a:once-only (path)
`(let ((,var (fopen (uiop:native-namestring ,path) "r")))
(declare (dynamic-extent ,var))
(when (cffi:null-pointer-p ,var)
@ -16,7 +16,7 @@
Only works on Unix systems with a /dev/fd/ filesystem."
#+unix
(with-gensyms (old-stderr)
(a:with-gensyms (old-stderr)
`(progn
(finish-output *error-output*)
(let ((,old-stderr (dup +stderr-fileno+)))
@ -32,11 +32,11 @@ Only works on Unix systems with a /dev/fd/ filesystem."
If TYPE is :FILE, use cue_parse_file with fopen on DATA. If TYPE is :STRING,
use cue_parse_string directly."
(once-only (data)
(a:once-only (data)
`(let ((,var (with-ignore-stderr
,(ecase type
(:file
(with-gensyms (file)
(a:with-gensyms (file)
`(with-read-file (,file ,data)
(cue-parse-file ,file))))
(:string
@ -73,6 +73,6 @@ use cue_parse_string directly."
"Ensure a null value returned by a libcue function is NIL."
(unless (etypecase val
(null t)
(string (emptyp val))
(string (a:emptyp val))
(integer (minusp val)))
val))

View file

@ -1,5 +1,5 @@
(uiop:define-package #:sync-music/cli
(:use #:cl #:alexandria :serapeum #:sync-music)
(:use #:cl #:sync-music)
(:export #:main))
(in-package #:sync-music/cli)

View file

@ -39,7 +39,8 @@
#:track-get-index))
(uiop:define-package #:sync-music/libcue
(:use #:cl #:alexandria #:serapeum #:sync-music/libcue-ffi)
(:use #:cl #:sync-music/libcue-ffi)
(:local-nicknames (#:a #:alexandria))
(:export #:with-cue
#:get-rem
#:get-cd-text
@ -64,8 +65,10 @@
#:ensure-nonempty))
(uiop:define-package #:sync-music
(:use #:cl #:alexandria #:serapeum)
(:local-nicknames (#:p-utils #:org.shirakumo.pathname-utils)
(:use #:cl)
(:local-nicknames (#:a #:alexandria)
(#:s #:serapeum)
(#:p-utils #:org.shirakumo.pathname-utils)
(#:libcue #:sync-music/libcue))
(:export #:*worker-threads*
#:*opus-bitrate*

View file

@ -5,7 +5,7 @@
Use TEST for file extension equality. Return the action if it exists, or NIL
if the file should not be copied."
(when-let* ((type (pathname-type origin))
(a:when-let* ((type (pathname-type origin))
(make-action-fn
(cond
((funcall test type "flac")
@ -30,7 +30,7 @@ if the file should not be copied."
ORIGIN-FILES is just a list of all files in ORIGIN. Use TEST for file
extension equality."
(when-let ((cue-file (find-if (lambda (f)
(a:when-let ((cue-file (find-if (lambda (f)
(funcall test (pathname-type f) "cue"))
origin-files)))
(libcue:with-cue (cd :file cue-file)
@ -124,7 +124,7 @@ extension equality."
(defun get-image-copy-action (origin-files target &optional (test #'string-equal))
"Determine which image file to copy from ORIGIN-FILES, if any."
(when-let ((image-files (remove-if (lambda (f)
(a:when-let ((image-files (remove-if (lambda (f)
(let ((f-type (pathname-type f)))
(notany (lambda (type)
(funcall test f-type type))
@ -159,14 +159,14 @@ actions that need performing in order to store the targets as second value."
(directories (fset:empty-set)))
(unless (and *ignore-toplevel-p* (= depth 1))
(let ((origin-files (uiop:directory-files origin)))
(if-let ((cue-copy-actions (and (not *dumb-cue-copy-p*)
(a:if-let ((cue-copy-actions (and (not *dumb-cue-copy-p*)
(get-cue-copy-actions origin origin-files target))))
(fset:unionf files cue-copy-actions)
(dolist (file (uiop:directory-files origin))
(when-let ((action (make-file-copy-action file target)))
(a:when-let ((action (make-file-copy-action file target)))
(fset:adjoinf files action))))
(unless (fset:empty? files)
(when-let ((image-action (get-image-copy-action origin-files target)))
(a:when-let ((image-action (get-image-copy-action origin-files target)))
(fset:adjoinf files image-action)))))
(dolist (directory (uiop:subdirectories origin))
(let ((target-directory
@ -205,7 +205,7 @@ directories to not create as the second value."
Return a set of all copy actions as first value, all delete actions as second
value, and all directories that should be created as the third value."
(let ((*max-depth* *max-depth*))
(mvlet ((all-copy all-directory (get-all-copy-actions origin target))
(s:mvlet ((all-copy all-directory (get-all-copy-actions origin target))
(all-delete all-directory-existing (get-all-delete-actions target)))
(values
(fset:set-difference all-copy all-delete)
@ -266,7 +266,7 @@ Passes PROGRESS-HANDLER to PERFORM-ACTIONS."
(t
(setf lparallel:*kernel*
(lparallel:make-kernel (or *worker-threads*
(max (- (count-cpus) 2) 1))))
(max (- (s:count-cpus) 2) 1))))
(unwind-protect
(run)
(lparallel:end-kernel :wait t)))))

View file

@ -42,7 +42,7 @@
(defmacro handle-overflow ((unit unit-max) (next-unit &optional next-max) &rest args)
"Handle integer overflow from UNIT with maximum UNIT-MAX into NEXT-UNIT."
(with-gensyms (div rem)
(a:with-gensyms (div rem)
`(when (>= ,unit ,unit-max)
(multiple-value-bind (,div ,rem)
(floor ,unit ,unit-max)
@ -103,9 +103,9 @@ Returns a new array if replacements were made and NIL otherwise."
Tries to take into account different character sizes."
(loop :repeat 3
:for from-buf := (babel:string-to-octets from :encoding :ascii)
:then (intersperse 0 from-buf)
:then (s:intersperse 0 from-buf)
:for to-buf := (babel:string-to-octets to :encoding :ascii)
:then (intersperse 0 to-buf)
:then (s:intersperse 0 to-buf)
:for replaced := (replace-all-subseqs buf from-buf to-buf)
:when replaced
:return replaced