[Racket] Remove longest common prefix from a group of filenames

A common problem. You have a music album, say, it contains the following files:

drwxr-x---  2 i i     4096 Jun 13 12:25 covers
-rwxr-x---  1 i i 17495062 Oct 17  2019 Morton Feldman - Rothko Chapel + Why Patterns - 01 - Rohtko Chapel 1.mp3
-rwxr-x---  1 i i  8804855 Oct 17  2019 Morton Feldman - Rothko Chapel + Why Patterns - 02 - Rothko Chapel 2.mp3
-rwxr-x---  1 i i  5663474 Oct 17  2019 Morton Feldman - Rothko Chapel + Why Patterns - 03 - Rothko Chapel 3.mp3
-rwxr-x---  1 i i  8911852 Oct 17  2019 Morton Feldman - Rothko Chapel + Why Patterns - 04 - Rothko Chapel 4.mp3
-rwxr-x---  1 i i  5533906 Oct 17  2019 Morton Feldman - Rothko Chapel + Why Patterns - 05 - Rothko Chapel 5.mp3
-rwxr-x---  1 i i 56636104 Oct 17  2019 Morton Feldman - Rothko Chapel + Why Patterns - 06 - Why Patterns.mp3
-rwxr-x---  1 i i      444 Oct 17  2019 Morton Feldman - Rothko Chapel + Why Patterns .m3u
-rwxr-x---  1 i i      926 Oct 17  2019 Rothko Chapel + Why Patterns.CUE
-rwxr-x---  1 i i     2401 Oct 17  2019 Rothko Chapel + Why Patterns .log

Filenames are too long, which is nuisance, for mp3-players, etc. You want to make them shorter. Here I wrote an utility to do so:

 % racket remove_LCP_from_files.rkt *.mp3

(path relative old-fname Morton Feldman - Rothko Chapel + Why Patterns - 01 - Rohtko Chapel 1.mp3 new-fname: 1 - Rohtko Chapel 1.mp3)
(path relative old-fname Morton Feldman - Rothko Chapel + Why Patterns - 02 - Rothko Chapel 2.mp3 new-fname: 2 - Rothko Chapel 2.mp3)
(path relative old-fname Morton Feldman - Rothko Chapel + Why Patterns - 03 - Rothko Chapel 3.mp3 new-fname: 3 - Rothko Chapel 3.mp3)
(path relative old-fname Morton Feldman - Rothko Chapel + Why Patterns - 04 - Rothko Chapel 4.mp3 new-fname: 4 - Rothko Chapel 4.mp3)
(path relative old-fname Morton Feldman - Rothko Chapel + Why Patterns - 05 - Rothko Chapel 5.mp3 new-fname: 5 - Rothko Chapel 5.mp3)
(path relative old-fname Morton Feldman - Rothko Chapel + Why Patterns - 06 - Why Patterns.mp3 new-fname: 6 - Why Patterns.mp3)

It removed this common prefix: "Morton Feldman - Rothko Chapel + Why Patterns - 0":

And the result:

-rwxr-x---  1 i i 17495062 Oct 17  2019 1 - Rohtko Chapel 1.mp3
-rwxr-x---  1 i i  8804855 Oct 17  2019 2 - Rothko Chapel 2.mp3
-rwxr-x---  1 i i  5663474 Oct 17  2019 3 - Rothko Chapel 3.mp3
-rwxr-x---  1 i i  8911852 Oct 17  2019 4 - Rothko Chapel 4.mp3
-rwxr-x---  1 i i  5533906 Oct 17  2019 5 - Rothko Chapel 5.mp3
-rwxr-x---  1 i i 56636104 Oct 17  2019 6 - Why Patterns.mp3
-rwxr-x---  1 i i      444 Oct 17  2019 Morton Feldman - Rothko Chapel + Why Patterns .m3u
-rwxr-x---  1 i i      926 Oct 17  2019 Rothko Chapel + Why Patterns.CUE
-rwxr-x---  1 i i     2401 Oct 17  2019 Rothko Chapel + Why Patterns .log

This will also work:

 % racket remove_LCP_from_files.rkt */*.mp3

Directories supported as well.

The source code:

#lang racket
(require srfi/13)
(require file/glob)

; todo: dry run?

; because the standard "min" function takes values in argument...
(define (min-in-list l)
  (apply min l))

(define (strings-prefix-length l)
  (min-in-list (map (lambda (x) (string-prefix-length (first x) (second x))) (cartesian-product l l))))

;(strings-prefix-length (list "hello" "hell" "he can"))
;(strings-prefix-length (list "qhello" "whell" "the can"))
;(strings-prefix-length (list "hello" "hello" "hello"))

(define cmd (current-command-line-arguments))

(when (= (vector-length cmd) 0)
  (displayln "usage: racket remove_LCP_from_files.rkt *.mp3")
  (displayln "or:                                 ... path/*.mp3")
  (exit))

(define files '())

(for ([p cmd])
  (let-values ([(p-path p-filename p-something) (split-path p)])
    (set! files (cons (path->string p-filename) files))))

(when (eq? (length files) 0)
  (displayln "no files collected")
  (exit))

(when (eq? (length files) 1)
  (displayln "only a single file. not enough.")
  (exit))

(define chop-characters-from-each-filename (strings-prefix-length files))

(when (eq? chop-characters-from-each-filename 0)
  (displayln "no common prefix")
  (exit))

(for ([p cmd])
  (let-values ([(p-path p-filename p-something) (split-path p)])
    (let ([new-fname (substring (path->string p-filename) chop-characters-from-each-filename)])
      (displayln (list "path" p-path "old-fname" p-filename "new-fname:" new-fname))
      (if (eq? p-path 'relative)
          ; we are inside the path
          (rename-file-or-directory
           p-filename
           new-fname)
          (rename-file-or-directory	
           (build-path p-path p-filename)
           (build-path p-path new-fname))))))

List of my other blog posts.

Yes, I know about these lousy Disqus ads. Please use adblocker. I would consider to subscribe to 'pro' version of Disqus if the signal/noise ratio in comments would be good enough.