(ql:quickload '(:alexandria :cl-yaml :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))))