(in-package #:sync-music) (defun make-file-copy-action (origin target &optional (test #'string-equal)) "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") (setf type "opus") #'make-copy-flac-action) ((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 :directory (pathname-directory target) :name (pathname-name origin) :type type :defaults target))))) (defun get-all-copy-actions (origin target &optional (depth 0)) "Recursively iterate ORIGIN for files to copy. Return a set of all copy actions as first value, and set of all directory actions that need performing in order to store the targets as second value." (check-depth (incf depth)) (let ((files (fset:empty-set)) (directories (fset:empty-set))) (unless (and *ignore-toplevel-p* (= depth 1)) (dolist (file (uiop:directory-files origin)) (when-let ((action (make-file-copy-action file target))) (fset:adjoinf files action)))) (dolist (directory (uiop:subdirectories origin)) (let ((target-directory (make-pathname :directory (append (pathname-directory target) (list (p-utils:directory-name directory)))))) (multiple-value-bind (subdir-files subdir-directories) (get-all-copy-actions directory target-directory depth) (fset:unionf files subdir-files) (fset:unionf directories subdir-directories)))) (when (and (fset:empty? directories) (fset:nonempty? files)) (fset:adjoinf directories (make-directory-action :target (pathname-normalize-unicode target)))) (values files directories))) (defun get-all-delete-actions (target &optional (depth 0)) "Recursively iterate TARGET for files to delete. Return a set of all preexisting files as first value, and set of all directories to not create as the second value." (check-depth (incf depth)) (let ((files (fset:empty-set)) (directories (fset:set (make-directory-action :target target)))) (unless (and *ignore-toplevel-p* (= depth 1)) (dolist (file (uiop:directory-files target)) (fset:adjoinf files (make-delete-action :target file)))) (dolist (directory (uiop:subdirectories target)) (multiple-value-bind (subdir-files subdir-directories) (get-all-delete-actions directory depth) (fset:unionf files subdir-files) (fset:unionf directories subdir-directories))) (values files directories))) (defun get-all-actions (origin target) "Consolidate all copy and delete actions from ORIGIN to TARGET. 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)) (all-delete all-directory-existing (get-all-delete-actions target))) (values (fset:set-difference all-copy all-delete) (if *cleanupp* (fset:set-difference all-delete all-copy) (fset:empty-set)) (fset:set-difference all-directory all-directory-existing))))) (defun perform-actions (actions &optional progress-handler) "Perform all ACTIONS in a parallelized manner. Main thread calls PROGRESS-HANDLER (if given) with the progress queue and the total task count as arguments." (let ((task-count (fset:size actions)) (channel (lparallel:make-channel)) (queue (when progress-handler (lparallel.queue:make-queue)))) (fset:do-set (action actions) (lparallel:submit-task channel #'action-perform action queue)) (when progress-handler (funcall progress-handler queue task-count)) (loop :repeat task-count :do (lparallel:receive-result channel)))) (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 (and (every #'identity (mapcar #'clean-directory (uiop:subdirectories target))) (null (uiop:directory-files target)) (uiop:delete-empty-directory target))) (defun sync-music (origin target &key confirmp progress-handler) "Get and perform all actions from ORIGIN to TARGET. Calls CONFIRMP with all the actions and only continues if it returns non-NIL. Passes PROGRESS-HANDLER to PERFORM-ACTIONS." (let ((target-directory (uiop:resolve-location (ensure-directories-exist (uiop:merge-pathnames* (uiop:ensure-directory-pathname target))))) (origin-directory (uiop:directory-exists-p origin))) (unless origin-directory (error "Music directory `~A` does not exist!" origin)) (when (or (p-utils:subpath-p target-directory origin-directory) (p-utils:subpath-p origin-directory target-directory)) (error "Cannot sync if target or origin are a direct subpath of the other.")) (multiple-value-bind (copy-actions delete-actions directory-actions) (get-all-actions origin-directory target-directory) (and confirmp (not (funcall confirmp copy-actions delete-actions directory-actions)) (return-from sync-music)) (fset:do-set (action directory-actions) (action-perform action)) (lparallel.kernel-util:with-temp-kernel ((or *worker-threads* (max (- (count-cpus) 2) 1))) (perform-actions (fset:unionf copy-actions delete-actions) progress-handler)) (when *cleanupp* (clean-directory target-directory)))))