You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

191 lines
6.2 KiB

2 years ago
(defpackage :etascrobbler
(:use :cl))
(in-package :etascrobbler)
(setf (cl-who:html-mode) :html5)
(defvar *title* "etascrobbler")
;; Copied from TVL's panettone, with thanks to grfn
(defmacro render (() &body body)
`(who:with-html-output-to-string (*standard-output* nil :prologue t)
:lang "en"
(:title (who:esc *title*))
(:link :rel "stylesheet" :type "text/css" :href "//")
(:link :rel "stylesheet" :type "text/css" :href "//")
(:meta :name "viewport"
:content "width=device-width,initial-scale=1"))
:class "site-header"
:class "wrapper"
:class "site-title"
:href "/"
:src "//"
:alt "η")
" (eta)")
:class "site-nav"
:class "trigger"
:class "page-content"
:class "wrapper"
(defun get-last-scrobble ()
(get "SELECT artist, title, ts FROM plays ORDER by ts DESC LIMIT 1")
(when (sqlite:step-statement get)
(values-list (tq::column-values get)))))
(defun count-all-scrobbles ()
(count "SELECT COUNT(*) FROM plays")
(sqlite:step-statement count)
(sqlite:statement-column-value count 0)))
(hunchentoot:define-easy-handler (validate-token :uri "/1/validate-token") ()
(setf (hunchentoot:content-type*) "application/json")
'((:code . 200)
(:message . "token probably valid")
(:valid . t)
(:user . "eta"))))
(defun insert-play (artist title ts &optional additional-info)
(insert "INSERT INTO plays (artist, title, additional_info, ts) VALUES (?, ?, ?, ?)")
(tq::bind-parameters insert artist title additional-info ts)
(sqlite:step-statement insert)))
(defun get-all-artists ()
11 months ago
(get "SELECT artist, COUNT(*) FROM plays GROUP BY artist ORDER BY artist ASC")
2 years ago
while (sqlite:step-statement get)
11 months ago
collect (cons
(sqlite:statement-column-value get 0)
(sqlite:statement-column-value get 1)))))
2 years ago
(defmacro cassoc (item alist)
`(cdr (assoc ,item ,alist)))
(defparameter *ok* "{\"status\": \"ok\"}")
(defvar *nowplaying* nil)
(defvar *nowplaying-ts* 0)
(hunchentoot:define-easy-handler (now-playing :uri "/now-playing.json") ()
(unless *nowplaying*
(setf (hunchentoot:return-code*) hunchentoot:+http-not-found+)
(return-from now-playing "nope"))
(setf (hunchentoot:content-type*) "application/json")
`((:artist . ,(car *nowplaying*))
(:track . ,(cdr *nowplaying*))
(:since . ,(- (get-universal-time) *nowplaying-ts*)))))
(hunchentoot:define-easy-handler (submit-listens :uri "/1/submit-listens") ()
((fail (e)
(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+)
(format *error-output* "womp: ~A~%" e)
(return-from submit-listens e)))
(let* ((json
(hunchentoot:raw-post-data :force-text t))
(error (e) (fail (format nil "bad: ~A" e)))))
(payload (or (first (cassoc :payload json))
(fail "no payload provided")))
(track-meta (or (cassoc :track--metadata payload)
(fail "no track metadata provided")))
(artist-name (cassoc :artist--name track-meta))
(track-name (cassoc :track--name track-meta))
(listen-type (cassoc :listen--type json)))
(setf (hunchentoot:content-type*) "application/json")
(format *error-output* "~&[~A] ~A — ~A~%" listen-type artist-name track-name)
(when (string= listen-type "playing_now")
(setf *nowplaying-ts* (get-universal-time))
(setf *nowplaying* (cons artist-name track-name)))
(unless (string= listen-type "single")
(return-from submit-listens *ok*))
(cassoc :artist--name track-meta)
(cassoc :track--name track-meta)
(cassoc :listened--at payload)
(prin1-to-string (cassoc :additional--info track-meta)))
(hunchentoot:define-easy-handler (root :uri "/") ()
(render ()
"now playing")
"This shows what I was last listening to on any of my devices, and the song before that. "
"This tiny webapp has observed "
(who:esc (princ-to-string (count-all-scrobbles))))
" songs being played so far.")
"This site is very beta. More information should be added shortly!")
(when *nowplaying*
(who:with-html-output (*standard-output*)
:class "book-meta"
:class "book-title"
"🎵 "
(who:esc (car *nowplaying*))
" — "
(who:esc (cdr *nowplaying*))))))
(multiple-value-bind (artist title)
(when artist
(who:with-html-output (*standard-output*)
"Previously: ")
(who:esc artist)
" — "
(who:esc title)))))
11 months ago
(let* ((artists (get-all-artists))
(len (length artists)))
2 years ago
(who:with-html-output (*standard-output*)
:class "detail"
"Artists ("
11 months ago
(who:fmt "~D" len))
" total): "
for (artist . count) in artists
for i from 1
when (> count 10)
do (princ "<b>")
when (> count 100)
do (princ "<span style=\"color: #6b55d4;\">")
do (who:esc artist)
when (> count 10)
do (princ "</b>")
when (> count 100)
do (princ "</span>")
unless (eql len i)
do (princ " &middot; ")
2 years ago
(defun main ()
(make-instance 'hunchentoot:easy-acceptor
11 months ago
:address "::"
2 years ago
:port 4242))
11 months ago
(loop (sleep 1)))