hsmusic/hsmusic.lisp

(ql:quickload '(:alexandria :cl-yaml :cl-json :yason))
(defpackage :hsmusic
  (:use :common-lisp :alexandria))
(in-package :hsmusic)

(defpackage :track)

(defparameter tracks
  (loop for path in (directory #p"hsmusic-data/album/*.yaml")
        appending
        (let* ((parsed (yaml:parse path :multi-document-p t))
               (album  (gethash "Album" (cadr parsed))))
         (loop for entry in parsed 
               when (and (not (symbolp entry)) (gethash "Track" entry))
                 collect (progn (setf (gethash "Album" entry) album)
                                entry)))))

(defun tracks-with-name (name)
  (loop for track in tracks
        when (equal name (gethash "Track" track))
          collect track))

; does a macro really make sense like come on
; w/e
(defmacro apply-regices (target &body regices)
  (with-gensyms (new)
    `(let ((,new (copy-array ,target)))
       ,@(loop for (from to) in regices
              collecting `(setf ,new (ppcre:regex-replace-all ,from ,new ,to)))
       ,new)))

(defun default-href (name)
  (apply-regices (string-downcase name)
    (" " "-")

    ("&"   "-and-")
    ("\\+" "-plus-")
    ("%"   "-percent-")

    ("(\\b[^\\s-.]{2,})\\."   "\\1-")
    ("/\\.([^\\s-.]{2,})\\b"  "-\\1")

    ("[/@#$%*()_=,[\\]{}|\\\\;:<>?`~]" "-")

    ("[áâäàå]" "a")
    ("[çč]"    "c")
    ("[éêëè]"  "e")
    ("[íîïì]"  "i")
    ("[óôöò]"  "o")
    ("[úûüù]"  "u")

    ("[^a-z0-9-]" "")

    ("-{2,}" "-")

    ("^-+|-+$" "")))

(defun track->href (track)
  (or (gethash "Directory" track)
      (default-href (gethash "Track" track))))

(defun href->url (href)
  (format nil "https://hsmusic.wiki/track/~a" href))

(defun track->url (track)
  (href->url (track->href track)))

; let's just store the href because that's unambiguous and links are desirable anyway

; string name -> href 
; so we don't have to research over and over
; there's ambiguity here! so consult only when not given a track:! 
(defparameter hrefs (make-hash-table :test 'equal))

; TODO: logically flawed
(defparameter href->track-table (make-hash-table))

(loop for track in tracks
      ; works? no. e.g. Buy NAK Sell DOOF has a Directory but is referred to without track:
      ; track: is a disambiguator
      ; how do we decide which one is "canon" then? idk! no clue. help
      ; tomorrow problem
      unless (gethash "Directory" track) 
        do (let ((href (intern (track->href track) :track)))
             (setf (gethash (gethash "Track" track) hrefs) href)
             (setf (gethash href href->track-table) track)))

(defun track-name->href (name)
  (if (string= (ignore-errors (subseq name 0 6)) "track:")
      (intern (subseq name 6) :track)
      (gethash name hrefs)))

(defun href->track (href)
  (gethash href href->track-table))

; a -> b <-> a references b
; screw it! let's use symbols. why not? (LKFDSJKFDJ)
; it's a finite set it's FINE
(defparameter -> (make-hash-table))
(defparameter <- (make-hash-table))

(loop for track in tracks
      do (let ((from-name (intern (track->href track) :track)))
           (loop for ref in (append (gethash "Referenced Tracks" track) (gethash "Sampled Tracks" track))
                 do (let ((to-name (track-name->href ref)))
                      (when (not to-name) (print ref))
                      (if (eq from-name to-name)
                          (format t "https://hsmusic.wiki/track/~a~%" from-name)
                          (progn
                            (unionf (gethash from-name ->)   (list to-name))
                            (unionf (gethash   to-name <-) (list from-name))))))))

(defun tree (src from depth)
  (let ((succs (gethash from src)))
    (if (and (plusp depth) (consp succs))
        (list from (mapcar (lambda (x) (tree src x (- depth 1))) succs))
        from)))

(defun ->tree (from depth)
  (tree -> (track-name->href from) depth))

(defun <-tree (from depth)
  (tree <- (track-name->href from) depth))

(defun pp-tree (tree &key (stream t) (indent 0) (indent-increment 2))
  (let ((ind (make-string indent :initial-element #\ )))
    (if (symbolp tree)
        (format stream "~a~a~%" ind tree)
        (destructuring-bind (from tos) tree
          (format stream "~a~a~%" ind from)
          (loop for to in tos
                do (pp-tree to :stream stream
                               :indent (+ indent indent-increment)
                               :indent-increment indent-increment))))))

(defun archive (url)
  (sb-ext:run-program
   "/usr/bin/env"
   (list "curl" "--insecure" "-F" (format nil "url=~a" "url=") "-F" "capture_all=on" url)))

(defparameter exif (yason:parse #p"/home/mbk/Music/exif-data.json"))

(defun track->path (track)
  (loop for e in exif
        when (and (equal (gethash "Title" e) (gethash "Track" track))
                  (equal (gethash "Album" e) (gethash "Album" track)))
          do (return-from track->path (pathname (gethash "SourceFile" e)))))

; TODO: <- & higher-order
; reversed bc personal preference :]
(defun ->m3u (from &optional (depth 413) (stream t))
  (dolist (href (reverse (flatten (->tree from depth))))
    (let ((path (track->path (href->track href))))
      (when path (format stream "~a~%" path)))))

(defun ->link-list (from &optional (depth 413) (stream t))
  (dolist (href (reverse (flatten (->tree from depth))))
    (format stream "~a~%" (href->url href))))