Script for breaking up single-file album audio into multiple files

format-tracks.rkt

#lang racket/base
(require
 racket/string
 racket/port
 racket/system
 racket/match
 racket/format)

(module+ test
  (require
   rackunit racket/port))

;; -----------------------------------------------------------------------------
;; Utils

(define-syntax-rule (regexp-case str-expr
                                 [re formals body ...]
                                 ...
                                 [#t else-body ...])
  (let ([str str-expr])
    (cond
      [(regexp-match re str)
       => (λ (groups)
            (apply (λ formals body ...)
                   (cdr groups)))]
      ...
      [else else-body ...])))


;; -----------------------------------------------------------------------------
;; Parameters

(define current-get-info-file-path
  (make-parameter
   (λ (audio-file-path)
     (path-replace-extension audio-file-path
                             #".info"))))

(define current-get-output-dir-path
  (make-parameter
   (λ (audio-file-path)
     (path-replace-extension audio-file-path #""))))

(define current-find-album-art-path
  (make-parameter
   (λ (audio-file-path)
     (for*/first ([ext (in-list '(#".png" #".jpg" #".jpeg" #".tiff"))]
                  [path (in-value (path-replace-extension audio-file-path ext))]
                  #:when (file-exists? path))
       path))))

(define current-output-extension
  (make-parameter #".mp3"))

(define current-ffmpeg
  (make-parameter "/usr/bin/ffmpeg"))

(define (get-info-file-path af)
  ((current-get-info-file-path) af))

(define (get-output-dir-path af)
  ((current-get-output-dir-path) af))

(define (find-album-art-path af)
  ((current-find-album-art-path) af))

(define (path-add-output-extension p)
  (path-add-extension p (current-output-extension) #"."))

(module+ test
  (check-equal? (get-info-file-path "bar/foo.flac")
                (string->path "bar/foo.info"))
  (check-equal? (get-output-dir-path "bar/foo.mp3")
                (string->path "bar/foo"))
  (check-equal? (path-add-output-extension "bar/foo/one")
                (string->path "bar/foo/one.mp3")))


;; --------------------------------------------------------------------------------
;; Info files

;; meta : (hasheq symbol => string)
;; tracks : (listof track-info)
(struct album-info [meta tracks]
  #:transparent)

;; title : string
;; number start end : nat
(struct track-info [title number start end]
  #:transparent)

;; (read-album-info [port]) -> album-info
;; port : input-port
(define (read-album-info [port (current-input-port)])

  ;; #px"([0-9]+:)*[0-9]+" -> nat
  (define (time-string->seconds ts)
    (for/fold ([acc 0])
              ([part (in-list (string-split ts ":"))])
      (+ (* acc 60)
         (string->number part))))

  ; parse lines
  (define-values [tracks-unsorted meta]
    (for/fold ([tracks '()]
               [meta (hasheq)])
              ([line (in-lines port)])
      (regexp-case
       line

       [#px"^\\*\\s+([a-z]*)\\s+(.*)"
        (key value)
        (define meta* (hash-set meta
                                (string->symbol key)
                                (string-trim value)))
        (values tracks meta*)]

       [#px"^([^*].+)\\s((\\d{1,2}:)+\\d{2})"
        (title start _)
        (define track (track-info (string-trim title)
                                  #f                           ; number
                                  (time-string->seconds start) ; start
                                  #f))                         ; end
        (values (cons track tracks) meta)]

       [#t
        (values tracks meta)])))

  ; sort tracks by starting time
  (define tracks
    (sort tracks-unsorted <
          #:key track-info-start))

  ; fill in track-info-number and track-info-end
  (define tracks*
    (for/list ([t  (in-list tracks)]
               [t* (in-list (append (cdr tracks) (list #f)))]
               [i  (in-naturals 1)])
      (struct-copy track-info t
                   [number i]
                   [end (and t* (track-info-start t*))])))

  (album-info meta tracks*))

(module+ test
  (define t1 (+ 23 (* 60 1)))
  (define t2 (+ 45 (* 60 23) (* 60 60 1)))

  (check-equal?
   (with-input-from-string
     (string-append "* foo hello world\n"
                    "SO NG  1:23\n"
                    "* bar    hey   \n"
                    "SAN G     01:23:45\n"
                    "S ING     0:00\n")
     read-album-info)
   (album-info
    (hasheq 'foo "hello world"
            'bar "hey")
    (list (track-info "S ING" 1 0 t1)
          (track-info "SO NG" 2 t1 t2)
          (track-info "SAN G" 3 t2 #f)))))


;; --------------------------------------------------------------------------------
;; String manip

;; track-title->file-part : string -> string
(define (track-title->file-part title-string)
  ; remove parenthesis and the text inside of them (doesn't support nesting, but that is
  ; okay)
  (define (remove-parens s)
    (regexp-case
     s
     [#px"^(.+)[(\\[].+?[)\\]](.*)"
      (before after)
      (remove-parens (string-append (string-trim before)
                                    after))]
     [#t s]))

  ; group into words (groups of alphabetic chars)
  (define (split-words s)
    (let loop ([acc '()] [chars (string->list s)])
      (cond
        [(null? chars) (list (reverse acc))]
        ; important chars
        [(or (char-alphabetic? (car chars))
             (char-numeric? (car chars)))
         (loop (cons (car chars) acc)
               (cdr chars))]
        ; ignored chars
        [(member (car chars) '(#\'))
         (loop acc
               (cdr chars))]
        ; everything else breaks works
        [else
         (cons (reverse acc)
               (loop '() (cdr chars)))])))

  ; write chars to current-output-port in titlecase
  (define (write-titlecase chars)
    (unless (null? chars)
      (write-char (char-upcase (car chars)))
      (for ([c (in-list (cdr chars))])
        (write-char (char-downcase c)))))

  (with-output-to-string
    (λ ()
      (for-each write-titlecase
                (split-words (remove-parens title-string))))))

;; track-info -> path
(define (track-info-file-name trk)
  (path-add-output-extension
   (format "~a.~a"
           (~a (track-info-number trk)
               #:pad-string "0" #:width 2 #:align 'right)
           (track-title->file-part (track-info-title trk)))))


(module+ test
  (check-equal?
   (track-title->file-part "foo (ft. somebody) bar")
   "FooBar")
  (check-equal?
   (track-title->file-part "foo (ft. somebody) (remix)")
   "Foo")
  (check-equal?
   (track-title->file-part "the, quick: brown fox!! (ft. somebody) [remix]")
   "TheQuickBrownFox")
  (check-equal?
   (track-title->file-part "igor's theme")
   "IgorsTheme")

  (check-equal?
   (track-info-file-name
    (track-info "foo bar" 4 0 #f))
   (string->path "04.FooBar.mp3")))


;; --------------------------------------------------------------------------------
;; IO

(struct exn:fail:ffmpeg exn:fail [status output])

(define (raise-ffmpeg-error sc out)
  (make-exn:fail (format "ffmpeg process failed with status ~a" sc)
                 (current-continuation-marks)
                 sc out))

;; (clip-audio ..) -> string
;; input-file-path, output-file-path : path
;; art-file-path : (or path #f)
;; start : nat
;; end : (or nat #f)
;; meta : (hasheq symbol => string)
;; --
;; raises exn:fail:ffmpeg
(define (clip-audio #:in input-file-path
                    #:out output-file-path
                    #:art [art-file-path #f]
                    #:meta meta
                    start end)

  (define (seconds->string n)
    (format "~as" n))

  (define general-flags
    `("-y"))

  (define infile-flags
    (append `("-ss" ,(seconds->string start))
            (if end
              (list "-t" (seconds->string (- end start)))
              (list))))

  (define outfile-flags
    (append (apply append
                   (for/list ([(k v) (in-hash meta)])
                     `("-metadata:g" ,(format "~a=~a" k v))))
            (list "-map" "0"
                  "-map" "1")))

  (define-values [sp sp-out sp-in sp-err]
    (apply subprocess `(#f #f #f
                        ,(current-ffmpeg)
                        ,@general-flags
                        ,@infile-flags
                        "-i" ,(path->string input-file-path)
                        ,@(if art-file-path
                            (list "-i" (path->string art-file-path))
                            (list))
                        ,@outfile-flags
                        ,(path->string output-file-path))))

  (subprocess-wait sp)

  (define sc (subprocess-status sp))
  (define out (string-append
               (port->string sp-err)
               (port->string sp-out)))

  (if (zero? sc)
    out
    (raise-ffmpeg-error sc out)))

;; (format-tracks path) -> void
(define (format-tracks audio-file-path)
  (define info-file-path (get-info-file-path audio-file-path))
  (define art-file-path  (find-album-art-path audio-file-path))
  (define output-dir-path (get-output-dir-path audio-file-path))

  (unless (file-exists? audio-file-path)
    (error (format "audio file ~s does not exist!"
                   (path->string audio-file-path))))

  (define alb
    (with-handlers ([exn:fail:filesystem?
                     (λ (e)
                       (error (format "info file ~s does not exist!"
                                      (path->string info-file-path))))])
      (with-input-from-file info-file-path
        read-album-info)))

  (with-handlers ([exn:fail:filesystem?
                   (λ (e)
                     (error (format "output directory ~s already exists!"
                                    (path->string output-dir-path))))])
    (make-directory output-dir-path))

  ;; -----

  (define notifs (make-channel))

  (when art-file-path
    (printf "using album art: ~a\n"
            (path->string art-file-path)))

  (printf "processing ~a tracks for album ~s\n----------------------------------------\n"
          (length (album-info-tracks alb))
          (hash-ref (album-info-meta alb)
                    'album
                    "(no title given)"))

  (for ([trk (in-list (album-info-tracks alb))])

    (define dest-path
      (build-path output-dir-path
                  (track-info-file-name trk)))

    (define meta
      (hash-set* (album-info-meta alb)
                 'track (number->string (track-info-number trk))
                 'title (track-info-title trk)))

    (thread
     (λ ()
       (with-handlers ([exn:fail?
                        (λ (ex) (channel-put notifs `(failed ,trk ,ex)))])
         (clip-audio #:in audio-file-path
                     #:art art-file-path
                     #:out dest-path
                     #:meta meta
                     (track-info-start trk)
                     (track-info-end trk))
         (channel-put notifs `(ok ,trk))))))

  (let loop ([n 0])
    (when (< n (length (album-info-tracks alb)))
      (match (channel-get notifs)
        [`(failed ,trk ,ex)
         (printf "FAILED: ~s\n" (track-info-title trk))
         (with-output-to-file "log.txt"
           #:exists 'append
           (λ ()
             (match ex
               [(exn:fail:ffmpeg _ _ sc out)
                (printf "STATUS CODE: ~a\n" sc)
                (write-string out)]
               [(exn msg _)
                (write-string msg)])))

         (loop (add1 n))]

        [`(ok ,trk)
         (printf "finished ~s\n" (track-info-title trk))
         (loop (add1 n))])))

  (printf "----------------------------------------\n")
  (printf "all finished\n"))

;; =============================================================================

(module+ main
  (require racket/cmdline)

  (command-line
   #:once-each
   [("-d" "--info-file")
    info-file "Info file (defaults to audio file, with extension `.info'"
    (current-get-info-file-path (λ (_) (string->path info-file)))]
   [("-i" "--output-dir")
    info-file "Output directory (defaults to audio file with no extension"
    (current-get-output-dir-path (λ (_) (string->path info-file)))]
   [("-a" "--art")
    art-file "Album art file"
    (current-find-album-art-path (λ (_) (string->path art-file)))]

   #:args (audio-file)
   (format-tracks (string->path audio-file))))