lisp-scripts/sync-music/actions.lisp

(in-package #:sync-music)

(defstruct action
  (target nil :type pathname))
(defstruct (copy-action (:include action))
  (origin nil :type pathname))
(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)))

(defgeneric action-describe (action &optional s)
  (:documentation "Format to stream S a single line describing ACTION in brief."))
(defgeneric action-perform (action &optional queue)
  (:documentation "Perform ACTION.

Pushes status message about this action to QUEUE if given."))
(defgeneric action-perform-describe (action)
  (:documentation "Status message, as printed during ACTION-PERFORM."))

(defmethod action-describe ((a copy-action) &optional s)
  (format s "[C] `~A` -> `~A`~%" (copy-action-origin a) (action-target a)))
(defmethod action-describe ((a delete-action) &optional s)
  (format s "[D] `~A`~%" (action-target a)))
(defmethod action-describe ((a directory-action) &optional s)
  (format s "[M] `~A`~%" (action-target a)))

(defmethod action-perform ((a copy-action) &optional queue)
  (declare (ignore queue))
  (uiop:copy-file (copy-action-origin a) (action-target a)))

(defmethod action-perform ((a copy-flac-action) &optional queue)
  (declare (ignore queue))
  (uiop:run-program
   `("ffmpeg" "-n"
              "-filter_threads" "1"
              "-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*
              ,(uiop:native-namestring (action-target a)))))

(defmethod action-perform ((a copy-meta-action) &optional queue)
  (declare (ignore queue))
  (let (buf)
    (with-open-file (input
                     (copy-action-origin a)
                     :element-type 'octet)
      (setf buf (make-array (file-length input) :element-type 'octet))
      (read-sequence buf input))
    (setf buf (replace-text-buffer buf ".flac" ".opus"))
    (setf buf (replace-text-buffer buf ".wav" ".opus"))
    (with-open-file (output
                     (action-target a)
                     :element-type 'octet
                     :direction :output)
      (write-sequence buf output))))

(defmethod action-perform ((a delete-action) &optional queue)
  (declare (ignore queue))
  (delete-file (action-target a)))

(defmethod action-perform ((a directory-action) &optional queue)
  (declare (ignore queue))
  (ensure-directories-exist (action-target a)))

(defmethod action-perform :before ((a action) &optional queue)
  (when queue
    (lparallel.queue:push-queue (action-perform-describe a) queue)))

(defmethod action-perform-describe ((a copy-action))
  (format nil "Copying `~A` to `~A`..." (copy-action-origin a) (action-target a)))
(defmethod action-perform-describe ((a copy-meta-action))
  (format nil "Modifying `~A` to `~A`..." (copy-action-origin a) (action-target a)))
(defmethod action-perform-describe ((a copy-flac-action))
  (format nil "Converting `~A` to `~A`..." (copy-action-origin a) (action-target a)))
(defmethod action-perform-describe ((a delete-action))
  (format nil "Deleting `~A`..." (action-target a)))
(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
(defmethod fset:compare ((a1 action) (a2 action))
  (fset:compare-slots a1 a2 #'action-target))