flake.lock

@@ -25,11 +25,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1730785428,
+        "lastModified": 1730531603,
-        "narHash": "sha256-Zwl8YgTVJTEum+L+0zVAWvXAGbWAuXHax3KzuejaDyo=",
+        "narHash": "sha256-Dqg6si5CqIzm87sp57j5nTaeBbWhHFaVyG7V6L8k3lY=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "4aa36568d413aca0ea84a1684d2d46f55dbabad7",
+        "rev": "7ffd9ae656aec493492b44d0ddfb28e79a1ea25d",
         "type": "github"
       },
       "original": {

nix/sync-music.nix

@@ -2,8 +2,7 @@
   sbcl,
   lib,
   writeText,
-  cuetools,
+  ffmpeg,
-  ffmpeg-headless,
   makeWrapper,
 }: let
   sync-music = sbcl.buildASDFSystem rec {
@@ -14,7 +13,6 @@
     lispLibs = with sbcl.pkgs; [
       alexandria
       babel
-      cl-ppcre
       fset
       lparallel
       pathname-utils
@@ -28,8 +26,7 @@
     ];
 
     runtimeInputs = [
-      cuetools
+      ffmpeg
-      ffmpeg-headless
     ];
 
     buildScript = writeText "build-sync-music.lisp" ''

sync-music.asd

@@ -6,7 +6,6 @@
                (:file "sync-music" :depends-on ("package" "utils")))
   :depends-on (#:alexandria
                #:babel
-               #:cl-ppcre
                #:fset
                #:lparallel
                #:pathname-utils

sync-music/actions.lisp

@@ -4,10 +4,7 @@
   (target nil :type pathname))
 (defstruct (copy-action (:include action))
   (origin nil :type pathname))
-(defstruct (copy-flac-action (:include copy-action))
+(defstruct (copy-flac-action (:include copy-action)))
-  (start nil :type (or string null))
-  (end nil :type (or string null))
-  (metadata nil :type (soft-alist-of string string)))
 (defstruct (copy-meta-action (:include copy-action)))
 (defstruct (delete-action (:include action)))
 (defstruct (directory-action (:include action)))
@@ -34,22 +31,14 @@ Pushes status message about this action to QUEUE if given."))
 
 (defmethod action-perform ((a copy-flac-action) &optional queue)
   (declare (ignore queue))
-  (uiop:run-program
+  (uiop:run-program (list "ffmpeg" "-n"
-   `("ffmpeg" "-n"
                           "-filter_threads" "1"
-              "-i" ,(uiop:native-namestring (copy-action-origin a))
+                          "-i" (uiop:native-namestring (copy-action-origin a))
-              ,@(when-let ((start (copy-flac-action-start a)))
-                  `("-ss" ,(convert-timestamp start)))
-              ,@(when-let ((end (copy-flac-action-end a)))
-                  `("-to" ,(convert-timestamp end)))
-              ,@(loop :for (tag . value) :in (copy-flac-action-metadata a)
-                      :collect "-metadata"
-                      :collect (format nil "~A=~A" tag value))
                           "-c:a" "libopus"
                           "-map" "0:a"
                           "-ac" "2"
-              "-b:a" ,*opus-bitrate*
+                          "-b:a" *opus-bitrate*
-              ,(uiop:native-namestring (action-target a)))))
+                          (uiop:native-namestring (action-target a)))))
 
 (defmethod action-perform ((a copy-meta-action) &optional queue)
   (declare (ignore queue))
@@ -90,6 +79,6 @@ Pushes status message about this action to QUEUE if given."))
 (defmethod action-perform-describe ((a directory-action))
   (format nil "Ensuring `~A` exists..." (action-target a)))
 
-;; NOTE: Delete actions are equal to copy actions to the same target
+;; NOTE: delete actions are equal to copy actions to the same target
 (defmethod fset:compare ((a1 action) (a2 action))
   (fset:compare-slots a1 a2 #'action-target))

sync-music/main.lisp

@@ -29,10 +29,6 @@
    :long "depth"
    :arg-parser #'parse-integer
    :meta-var "MAX-DEPTH")
-  (:name :dumb-cue-copy-p
-   :description "blindly copy cue files instead of parsing them"
-   :short #\c
-   :long "dumb-cue-copy")
   (:name :dry-run-p
    :description "print out actions and exit"
    :short #\n
@@ -89,7 +85,6 @@
                                 *opus-bitrate*))
             (*max-depth* (or (getf options :max-depth)
                              *max-depth*))
-            (*dumb-cue-copy-p* (getf options :dumb-cue-copy-p))
             (*dry-run-p* (getf options :dry-run-p))
             (*cleanupp* (not (getf options :no-cleanup-p)))
             (*ignore-toplevel-p* (not (getf options :no-ignore-toplevel-p))))

sync-music/package.lisp

@@ -6,7 +6,6 @@
            #:*max-depth*
            #:*cleanupp*
            #:*ignore-toplevel-p*
-           #:*dumb-cue-copy-p*
            #:*general-extensions*
            #:*meta-extensions*
            #:*action-perform-output*

sync-music/sync-music.lisp

@@ -1,114 +1,23 @@
 (in-package #:sync-music)
 
 (defun make-file-copy-action (origin target &optional (test #'string-equal))
-  "Create subclass of COPY-ACTION based on the filetype of ORIGIN and TEST for equality.
+  "Create the correct subclass of COPY-ACTION based on the file extension of ORIGIN.
 
 Return the action if it exists, or NIL if the file should not be copied."
   (when-let* ((type (pathname-type origin))
               (make-action-fn
                (cond
-                 ((funcall test type "flac")
+                 ((funcall test type "flac") (setf type "opus") #'make-copy-flac-action)
-                  (setf type "opus")
+                 ((member type *meta-extensions* :test test) #'make-copy-meta-action)
-                  #'make-copy-flac-action)
+                 ((member type *general-extensions* :test test) #'make-copy-action))))
-                 ((and *dumb-cue-copy-p*
-                       (member type *meta-extensions* :test test))
-                  #'make-copy-meta-action)
-                 ((member type *general-extensions* :test test)
-                  #'make-copy-action))))
     (funcall make-action-fn
              :origin origin
              :target (pathname-normalize-unicode
-                      (make-pathname :name (pathname-name origin)
+                      (make-pathname :directory (pathname-directory target)
+                                     :name (pathname-name origin)
                                      :type type
                                      :defaults target)))))
 
-(defun get-cue-copy-actions (origin origin-files target &optional (test #'string-equal))
-  (when-let* ((cue-file (uiop:native-namestring
-                         (find-if (lambda (f)
-                                    (funcall test (pathname-type f) "cue"))
-                                  origin-files)))
-              (cue-track-count (parse-integer
-                                (uiop:run-program (list "cueprint"
-                                                        "-d" "%N"
-                                                        cue-file)
-                                                  :output :string)
-                                :junk-allowed t)))
-    (when (> cue-track-count (count-if (lambda (f)
-                                         (funcall test (pathname-type f) "flac"))
-                                       origin-files))
-      (loop :repeat cue-track-count
-            :with actions := (fset:empty-set)
-            :with album-data-raw := (uiop:run-program
-                                     (list "cueprint"
-                                           "-d" "%T\\n%02N\\n%P"
-                                           cue-file)
-                                     :output :lines)
-            :with track-data-raw := (uiop:run-program
-                                     (list "cueprint"
-                                           "-t" "%f\\n%t\\n%02n\\n%p\\n%c\\n%g\\n"
-                                           cue-file)
-                                     :output :lines)
-            :with break-start-data-raw := (uiop:run-program
-                                           (list "cuebreakpoints"
-                                                 "--append-gaps"
-                                                 cue-file)
-                                           :output :lines)
-            :with break-end-data-raw := (uiop:run-program
-                                         (list "cuebreakpoints"
-                                               "--prepend-gaps"
-                                               cue-file)
-                                         :output :lines)
-            ;; HACK: Determine if track 1 has pregap based on breakpoint count
-            :with track-1-pregap-p := (< (length break-start-data-raw)
-                                         (length break-end-data-raw))
-            :for origin-file-name := (let* ((raw-file (pop track-data-raw))
-                                            (dot (position #\. raw-file :from-end t)))
-                                       (subseq raw-file 0 dot))
-            :for origin-file := (make-pathname :name origin-file-name
-                                               :type "flac"
-                                               :defaults origin)
-            :for track-title := (first track-data-raw)
-            :for track-number := (second track-data-raw)
-            :for data-raw := (append album-data-raw
-                                     (loop :repeat 5
-                                           :collect (pop track-data-raw)))
-            :for metadata := (mapcar #'cons
-                                     '("ALBUM"
-                                       "TRACKTOTAL"
-                                       "ALBUMARTIST"
-                                       "TITLE"
-                                       "TRACKNUMBER"
-                                       "ARTIST"
-                                       "COMPOSER"
-                                       "GENRE")
-                                     data-raw)
-            :for metadata-filtered := (delete-if (compose #'emptyp #'cdr) metadata)
-            :for previous-action := nil :then current-action
-            :for output-file-name := (substitute #\! #\/ (format nil
-                                                                 "~A - ~A"
-                                                                 track-number
-                                                                 track-title))
-            :for current-action := (make-copy-flac-action
-                                    :origin origin-file
-                                    :target (pathname-normalize-unicode
-                                             (make-pathname :name output-file-name
-                                                            :type "opus"
-                                                            :defaults target))
-                                    :metadata metadata-filtered)
-            :do (fset:adjoinf actions current-action)
-            :with previous-file
-            :do (cond
-                  ((equal previous-file origin-file-name)
-                   (setf (copy-flac-action-start current-action) (pop break-start-data-raw))
-                   (setf (copy-flac-action-end previous-action) (pop break-end-data-raw)))
-                  (t
-                   (unless (uiop:file-exists-p origin-file)
-                     (return))
-                   (when track-1-pregap-p
-                     (setf (copy-flac-action-start current-action) (pop break-end-data-raw)))
-                   (setf previous-file origin-file-name)))
-            :finally (return actions)))))
-
 (defun get-all-copy-actions (origin target &optional (depth 0))
   "Recursively iterate ORIGIN for files to copy.
 
@@ -118,13 +27,9 @@ actions that need performing in order to store the targets as second value."
   (let ((files (fset:empty-set))
         (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*)
-                                        (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)))
-              (fset:adjoinf files action))))))
+          (fset:adjoinf files action))))
     (dolist (directory (uiop:subdirectories origin))
       (let ((target-directory
               (make-pathname :directory (append (pathname-directory target)
@@ -186,7 +91,7 @@ total task count as arguments."
 
 (defun clean-directory (target)
   "Delete all empty folders and folders containing only empty folders in TARGET."
-  ;; NOTE: Want (every #'clean-directory ...) but without short-circuiting
+  ;; NOTE: want (every #'clean-directory ...) but without short-circuiting
   (and (every #'identity
               (mapcar #'clean-directory (uiop:subdirectories target)))
        (null (uiop:directory-files target))

sync-music/utils.lisp

@@ -10,17 +10,12 @@
   "Whether to perform remove actions and delete empty folders.")
 (defvar *ignore-toplevel-p* t
   "Whether to ignore files at the top level.")
-(defvar *dumb-cue-copy-p* nil
-  "Whether to blindly copy cue files rather than parse them.")
 
 (defparameter *general-extensions* '("mp3" "ogg" "opus")
   "General file extensions that should be copied over.")
 (defparameter *meta-extensions* '("cue" "m3u" "m3u8")
   "File extensions where *.flac text needs to be replaced.")
 
-(defparameter *timestamp-scanner* (ppcre:create-scanner "^(\\d+):(\\d{2})\\.(\\d{2})$")
-  "Scan for a cuetools position.")
-
 (defun maybe-normalize-unicode (s)
   (if (stringp s) (uax-15:normalize s :nfc) s))
 
@@ -32,29 +27,6 @@
                  :type (maybe-normalize-unicode (pathname-type p))
                  :defaults p))
 
-(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)
-    `(when (>= ,unit ,unit-max)
-       (multiple-value-bind (,div ,rem)
-           (floor ,unit ,unit-max)
-         (setf ,unit ,rem)
-         (incf ,next-unit ,div))
-       ,(when next-max
-          `(handle-overflow (,next-unit ,next-max) ,@args)))))
-
-(defun convert-timestamp (s)
-  "Convert cuetools position MM:SS.FF to ffmpeg duration MM:SS.m."
-  (let* ((all-times (nth-value 1 (ppcre:scan-to-strings *timestamp-scanner* s)))
-         (hours 0)
-         (minutes (parse-integer (aref all-times 0)))
-         (seconds (parse-integer (aref all-times 1)))
-         (frames (parse-integer (aref all-times 2)))
-         (millis (round (* frames 1000) 75)))
-    (handle-overflow (millis 1000) (seconds 60) (minutes))
-    (handle-overflow (minutes 60) (hours))
-    (format nil "~D:~2,'0D:~2,'0D.~3,'0D" hours minutes seconds millis)))
-
 (defun vector-nconc-extend (v1 v2 &key (start 0) end)
   "Like vector-append-extend, but using another vector.