75 lines
2.8 KiB
Common Lisp
75 lines
2.8 KiB
Common Lisp
(ql:quickload '(:cl-yaml :alexandria :cl-ppcre))
|
|
(defpackage :hsmusic
|
|
(:use :common-lisp :alexandria))
|
|
(in-package :hsmusic)
|
|
|
|
(defparameter tracks
|
|
(loop for path in (directory #p"hsmusic-data/album/*.yaml")
|
|
appending (loop for entry in (yaml:parse path :multi-document-p t)
|
|
when (and (not (symbolp entry)) (gethash "Track" entry))
|
|
collect entry)))
|
|
|
|
; terrible, idc
|
|
; lossy! (not surprising)
|
|
; upcase for nice interning
|
|
(defun track->href (track)
|
|
(or (gethash "Directory" track)
|
|
(let ((r (copy-array (gethash "Track" track))))
|
|
(setf r (ppcre:regex-replace-all " " r "-"))
|
|
(setf r (ppcre:regex-replace-all "&" r "and"))
|
|
(setf r (ppcre:regex-replace-all "[^a-zA-Z0-9-]" r ""))
|
|
(setf r (ppcre:regex-replace-all "-{2,}" r ""))
|
|
(setf r (ppcre:regex-replace-all "^-+|-+$" r ""))
|
|
(nstring-downcase r))))
|
|
|
|
(defun track->url (track)
|
|
(format nil "https://hsmusic.wiki/track/~a" (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))
|
|
|
|
(loop for track in tracks
|
|
do (setf (gethash (gethash "Track" track) hrefs) (track->href track)))
|
|
|
|
; 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-normalized-name track) :keyword)))
|
|
(loop for ref in (append (gethash "Referenced Tracks" track) (gethash "Sampled Tracks" track))
|
|
do (let ((to-name (intern (normalize-name ref) :keyword)))
|
|
; bodge
|
|
(unless (eq from-name to-name)
|
|
(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 -> from depth))
|
|
|
|
(defun <-tree (from depth)
|
|
(tree <- 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))))))
|