(in-package #:sync-music)

(defvar *worker-threads* nil
  "Number of worker threads to launch.")
(defvar *opus-bitrate* "96K"
  "Opus bitrate to pass to ffmpeg's -b:a flag.")
(defvar *max-depth* 8
  "Max depth to recur into folders before signalling.")
(defvar *cleanupp* t
  "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 *image-extensions* '("png" "jpg" "jpeg" "webp")
  "File extensions for image files.")
(defparameter *album-cover-names* '("cover" "front" "folder")
  "File names of album cover files.")

(defparameter *invalid-char-scanner* (ppcre:create-scanner "[\"*/:<>?\\\\|]")
  "Scan for any characters not allowed in an Android/NTFS file name.")

(defun maybe-normalize-unicode (s)
  (if (stringp s) (uax-15:normalize s :nfc) s))

(defun pathname-normalize-unicode (p)
  "Normalize the unicode for all components of PATHNAME."
  (make-pathname :directory (mapcar #'maybe-normalize-unicode
                                    (pathname-directory p))
                 :name (maybe-normalize-unicode (pathname-name p))
                 :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 ffmpeg-timestamp (frames)
  "Convert time in CD frames to ffmpeg duration H:MM:SS.m."
  (let ((hours 0)
        (minutes 0)
        (seconds 0)
        (millis (round (* frames 1000) 75)))
    (handle-overflow (millis 1000) (seconds 60) (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.

START and END are the same as in REPLACE for V2."
  (let* ((fill-pointer (fill-pointer v1))
         (new-fill-pointer (+ fill-pointer (- (or end (length v2)) start))))
    (loop :for size := (array-total-size v1)
          :while (< size new-fill-pointer)
          :do (adjust-array v1 (+ size (max (floor size 2) 10))))
    (setf (fill-pointer v1) new-fill-pointer)
    (replace v1 v2 :start1 fill-pointer :start2 start :end2 end)))

(defun replace-all-subseqs (seq subseq1 subseq2)
  "Replace all instances of SUBSEQ1 with SUBSEQ in SEQ.

Returns a new array if replacements were made and NIL otherwise."
  (loop :with seqlen := (length seq)
        :and sublen1 := (length subseq1)
        :and sublen2 := (length subseq2)
        :for prev-index := 0 :then (+ index sublen1)
        :for index := (search subseq1 seq :start2 prev-index)
        :while index
        ;; NOTE: Avoid WITH to not create an array on immediate returns
        :for out-buf := (make-array (+ seqlen
                                       (if (> sublen2 sublen1)
                                           (max (floor seqlen 2) 10)
                                           0))
                                    :element-type (array-element-type seq)
                                    :adjustable t
                                    :fill-pointer 0)
          :then out-buf
        :do (vector-nconc-extend out-buf seq :start prev-index :end index)
            (vector-nconc-extend out-buf subseq2)
        :finally (when out-buf
                   (return
                     (vector-nconc-extend out-buf seq :start prev-index)))))

(defun replace-text-buffer (buf from to)
  "Given octet array BUF, converts all instances of text FROM to TO.

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)
        :for to-buf := (babel:string-to-octets to :encoding :ascii)
          :then (intersperse 0 to-buf)
        :for replaced := (replace-all-subseqs buf from-buf to-buf)
        :when replaced
          :return replaced
        :finally (return buf)))

(define-condition exceeded-max-depth (error)
  ()
  (:report (lambda (c s)
             (declare (ignore c))
             (format s "exceeded the max directory depth"))))

(defun check-depth (depth)
  (when (= depth *max-depth*)
    (restart-case
        (error 'exceeded-max-depth)
      (ignore-max-depth ()
        :report "Continue and ignore max depth for future checks."
        (setf *max-depth* 0))
      (ignore-once ()
        :report "Ignore max depth this one time."))))