refactor: Listening history to data-model + frame player favorites sync
- Refactor listening history functions to use data-model interface: - record-listen, get-listening-history, get-listening-stats - get-top-artists, clear-listening-history, get-listening-activity - Updated API endpoints to use dm:field - Refactor get-user-avatar to use data-model - Add postMessage sync between front page and frame player for favorites - Add credentials:include to frame player fetch calls for session cookies
This commit is contained in:
parent
ccce10db50
commit
eb03947f7f
|
|
@ -89,74 +89,110 @@
|
||||||
;;; Listening History - Per-user track play history
|
;;; Listening History - Per-user track play history
|
||||||
;;; ==========================================================================
|
;;; ==========================================================================
|
||||||
|
|
||||||
(defun sql-escape-string (str)
|
(defun get-recent-listen (user-id track-title)
|
||||||
"Escape a string for SQL by doubling single quotes"
|
"Check if user has listened to this track in the last 60 seconds"
|
||||||
(if str
|
(when (and user-id track-title)
|
||||||
(cl-ppcre:regex-replace-all "'" str "''")
|
;; Get recent listens and check timestamps manually since data-model
|
||||||
""))
|
;; doesn't support interval comparisons directly
|
||||||
|
(let ((recent (dm:get "listening_history"
|
||||||
|
(db:query (:and (:= 'user-id user-id)
|
||||||
|
(:= 'track_title track-title)))
|
||||||
|
:amount 1
|
||||||
|
:sort '(("listened-at" :DESC)))))
|
||||||
|
(when recent
|
||||||
|
(let* ((listen (first recent))
|
||||||
|
(listened-at (dm:field listen "listened-at")))
|
||||||
|
;; Check if within 60 seconds (listened-at is a timestamp)
|
||||||
|
(when listened-at
|
||||||
|
(let ((now (get-universal-time))
|
||||||
|
(listen-time (if (integerp listened-at)
|
||||||
|
listened-at
|
||||||
|
(get-universal-time))))
|
||||||
|
(< (- now listen-time) 60))))))))
|
||||||
|
|
||||||
(defun record-listen (user-id &key track-id track-title (duration 0) (completed nil))
|
(defun record-listen (user-id &key track-id track-title (duration 0) (completed nil))
|
||||||
"Record a track listen in user's history. Can use track-id or track-title.
|
"Record a track listen in user's history. Can use track-id or track-title.
|
||||||
Prevents duplicate entries for the same track within 60 seconds."
|
Prevents duplicate entries for the same track within 60 seconds."
|
||||||
(with-db
|
(when (and user-id (or track-id track-title))
|
||||||
;; Check for recent duplicate (same user + same title within 60 seconds)
|
;; Check for recent duplicate
|
||||||
(let ((recent-exists
|
(unless (get-recent-listen user-id track-title)
|
||||||
(when track-title
|
(let ((listen (dm:hull "listening_history")))
|
||||||
(postmodern:query
|
(setf (dm:field listen "user-id") user-id)
|
||||||
(:raw (format nil "SELECT 1 FROM listening_history WHERE \"user-id\" = ~a AND track_title = '~a' AND \"listened-at\" > NOW() - INTERVAL '60 seconds' LIMIT 1"
|
(setf (dm:field listen "listen-duration") (or duration 0))
|
||||||
user-id (sql-escape-string track-title)))
|
(setf (dm:field listen "completed") (if completed 1 0))
|
||||||
:single))))
|
(when track-id
|
||||||
(unless recent-exists
|
(setf (dm:field listen "track-id") track-id))
|
||||||
(if track-id
|
(when track-title
|
||||||
(postmodern:query
|
(setf (dm:field listen "track_title") track-title))
|
||||||
(:raw (format nil "INSERT INTO listening_history (\"user-id\", \"track-id\", track_title, \"listen-duration\", completed) VALUES (~a, ~a, ~a, ~a, ~a)"
|
(dm:insert listen)))))
|
||||||
user-id track-id
|
|
||||||
(if track-title (format nil "'~a'" (sql-escape-string track-title)) "NULL")
|
|
||||||
duration (if completed 1 0))))
|
|
||||||
(when track-title
|
|
||||||
(postmodern:query
|
|
||||||
(:raw (format nil "INSERT INTO listening_history (\"user-id\", track_title, \"listen-duration\", completed) VALUES (~a, '~a', ~a, ~a)"
|
|
||||||
user-id (sql-escape-string track-title) duration (if completed 1 0))))))))))
|
|
||||||
|
|
||||||
(defun get-listening-history (user-id &key (limit 20) (offset 0))
|
(defun get-listening-history (user-id &key (limit 20) (offset 0))
|
||||||
"Get user's listening history - works with title-based history"
|
"Get user's listening history - works with title-based history"
|
||||||
(with-db
|
(when user-id
|
||||||
(postmodern:query
|
(dm:get "listening_history" (db:query (:= 'user-id user-id))
|
||||||
(:raw (format nil "SELECT _id, \"listened-at\", \"listen-duration\", completed, track_title, \"track-id\" FROM listening_history WHERE \"user-id\" = ~a ORDER BY \"listened-at\" DESC LIMIT ~a OFFSET ~a"
|
:amount limit
|
||||||
user-id limit offset))
|
:skip offset
|
||||||
:alists)))
|
:sort '(("listened-at" :DESC)))))
|
||||||
|
|
||||||
(defun get-listening-stats (user-id)
|
(defun get-listening-stats (user-id)
|
||||||
"Get aggregate listening statistics for a user"
|
"Get aggregate listening statistics for a user"
|
||||||
(with-db
|
(when user-id
|
||||||
(let ((stats (postmodern:query
|
(let* ((history (dm:get "listening_history" (db:query (:= 'user-id user-id))))
|
||||||
(:raw (format nil "SELECT COUNT(*), COALESCE(SUM(\"listen-duration\"), 0) FROM listening_history WHERE \"user-id\" = ~a" user-id))
|
(tracks-played (length history))
|
||||||
:row)))
|
(total-listen-time (reduce #'+ history
|
||||||
(list :tracks-played (or (first stats) 0)
|
:key (lambda (h) (or (dm:field h "listen-duration") 0))
|
||||||
:total-listen-time (or (second stats) 0)))))
|
:initial-value 0)))
|
||||||
|
(list :tracks-played tracks-played
|
||||||
|
:total-listen-time total-listen-time))))
|
||||||
|
|
||||||
(defun get-top-artists (user-id &key (limit 5))
|
(defun get-top-artists (user-id &key (limit 5))
|
||||||
"Get user's most listened artists - extracts artist from track_title"
|
"Get user's most listened artists - extracts artist from track_title"
|
||||||
(with-db
|
(when user-id
|
||||||
;; Extract artist from 'Artist - Title' format in track_title
|
(let* ((history (dm:get "listening_history" (db:query (:= 'user-id user-id))))
|
||||||
(postmodern:query
|
(artist-counts (make-hash-table :test 'equal)))
|
||||||
(:raw (format nil "SELECT SPLIT_PART(track_title, ' - ', 1) as artist, COUNT(*) as play_count FROM listening_history WHERE \"user-id\" = ~a AND track_title IS NOT NULL GROUP BY SPLIT_PART(track_title, ' - ', 1) ORDER BY play_count DESC LIMIT ~a"
|
;; Count plays per artist
|
||||||
user-id limit))
|
(dolist (h history)
|
||||||
:alists)))
|
(let* ((title (dm:field h "track_title"))
|
||||||
|
(artist (when title
|
||||||
|
(let ((pos (search " - " title)))
|
||||||
|
(if pos (subseq title 0 pos) title)))))
|
||||||
|
(when artist
|
||||||
|
(incf (gethash artist artist-counts 0)))))
|
||||||
|
;; Convert to sorted list and take top N
|
||||||
|
(let ((sorted (sort (loop for artist being the hash-keys of artist-counts
|
||||||
|
using (hash-value count)
|
||||||
|
collect (cons artist count))
|
||||||
|
#'> :key #'cdr)))
|
||||||
|
(subseq sorted 0 (min limit (length sorted)))))))
|
||||||
|
|
||||||
(defun clear-listening-history (user-id)
|
(defun clear-listening-history (user-id)
|
||||||
"Clear all listening history for a user"
|
"Clear all listening history for a user"
|
||||||
(with-db
|
(when user-id
|
||||||
(postmodern:query
|
(let ((history (dm:get "listening_history" (db:query (:= 'user-id user-id)))))
|
||||||
(:raw (format nil "DELETE FROM listening_history WHERE \"user-id\" = ~a" user-id)))))
|
(dolist (entry history)
|
||||||
|
(dm:delete entry)))))
|
||||||
|
|
||||||
(defun get-listening-activity (user-id &key (days 30))
|
(defun get-listening-activity (user-id &key (days 30))
|
||||||
"Get listening activity aggregated by day for the last N days"
|
"Get listening activity aggregated by day for the last N days"
|
||||||
(with-db
|
(when user-id
|
||||||
(postmodern:query
|
(let* ((history (dm:get "listening_history" (db:query (:= 'user-id user-id))))
|
||||||
(:raw (format nil "SELECT DATE(\"listened-at\") as day, COUNT(*) as track_count FROM listening_history WHERE \"user-id\" = ~a AND \"listened-at\" >= NOW() - INTERVAL '~a days' GROUP BY DATE(\"listened-at\") ORDER BY day ASC"
|
(cutoff-time (- (get-universal-time) (* days 24 60 60)))
|
||||||
user-id days))
|
(day-counts (make-hash-table :test 'equal)))
|
||||||
:alists)))
|
;; Filter to recent days and count per day
|
||||||
|
(dolist (h history)
|
||||||
|
(let ((listened-at (dm:field h "listened-at")))
|
||||||
|
(when (and listened-at (> listened-at cutoff-time))
|
||||||
|
;; Convert universal time to date string
|
||||||
|
(multiple-value-bind (sec min hour day month year)
|
||||||
|
(decode-universal-time listened-at)
|
||||||
|
(declare (ignore sec min hour))
|
||||||
|
(let ((date-key (format nil "~4,'0d-~2,'0d-~2,'0d" year month day)))
|
||||||
|
(incf (gethash date-key day-counts 0)))))))
|
||||||
|
;; Convert to sorted list
|
||||||
|
(sort (loop for day being the hash-keys of day-counts
|
||||||
|
using (hash-value count)
|
||||||
|
collect (cons day count))
|
||||||
|
#'string< :key #'car))))
|
||||||
|
|
||||||
;;; ==========================================================================
|
;;; ==========================================================================
|
||||||
;;; API Endpoints for User Favorites
|
;;; API Endpoints for User Favorites
|
||||||
|
|
@ -246,13 +282,12 @@
|
||||||
(history (get-listening-history user-id)))
|
(history (get-listening-history user-id)))
|
||||||
(api-output `(("status" . "success")
|
(api-output `(("status" . "success")
|
||||||
("history" . ,(mapcar (lambda (h)
|
("history" . ,(mapcar (lambda (h)
|
||||||
`(("id" . ,(cdr (assoc :_id h)))
|
`(("id" . ,(dm:id h))
|
||||||
("track_id" . ,(cdr (assoc :track-id h)))
|
("track_id" . ,(dm:field h "track-id"))
|
||||||
("title" . ,(or (cdr (assoc :track-title h))
|
("title" . ,(dm:field h "track_title"))
|
||||||
(cdr (assoc :track_title h))))
|
("listened_at" . ,(dm:field h "listened-at"))
|
||||||
("listened_at" . ,(cdr (assoc :listened-at h)))
|
("listen_duration" . ,(dm:field h "listen-duration"))
|
||||||
("listen_duration" . ,(cdr (assoc :listen-duration h)))
|
("completed" . ,(let ((c (dm:field h "completed")))
|
||||||
("completed" . ,(let ((c (cdr (assoc :completed h))))
|
|
||||||
(and c (= 1 c))))))
|
(and c (= 1 c))))))
|
||||||
history)))))))
|
history)))))))
|
||||||
|
|
||||||
|
|
@ -303,8 +338,8 @@
|
||||||
(activity (get-listening-activity user-id :days days-int)))
|
(activity (get-listening-activity user-id :days days-int)))
|
||||||
(api-output `(("status" . "success")
|
(api-output `(("status" . "success")
|
||||||
("activity" . ,(mapcar (lambda (a)
|
("activity" . ,(mapcar (lambda (a)
|
||||||
`(("day" . ,(cdr (assoc :day a)))
|
`(("day" . ,(car a))
|
||||||
("track_count" . ,(cdr (assoc :track-count a)))))
|
("track_count" . ,(cdr a))))
|
||||||
activity)))))))
|
activity)))))))
|
||||||
|
|
||||||
;;; ==========================================================================
|
;;; ==========================================================================
|
||||||
|
|
@ -326,7 +361,7 @@
|
||||||
(relative-path (format nil "/asteroid/static/avatars/~a" new-filename)))
|
(relative-path (format nil "/asteroid/static/avatars/~a" new-filename)))
|
||||||
;; Copy from temp file to avatars directory
|
;; Copy from temp file to avatars directory
|
||||||
(uiop:copy-file temp-file-path full-path)
|
(uiop:copy-file temp-file-path full-path)
|
||||||
;; Update database
|
;; Update database - use raw SQL for single field update to avoid timestamp issues
|
||||||
(with-db
|
(with-db
|
||||||
(postmodern:query
|
(postmodern:query
|
||||||
(:raw (format nil "UPDATE \"USERS\" SET avatar_path = '~a' WHERE _id = ~a"
|
(:raw (format nil "UPDATE \"USERS\" SET avatar_path = '~a' WHERE _id = ~a"
|
||||||
|
|
@ -335,10 +370,10 @@
|
||||||
|
|
||||||
(defun get-user-avatar (user-id)
|
(defun get-user-avatar (user-id)
|
||||||
"Get the avatar path for a user"
|
"Get the avatar path for a user"
|
||||||
(with-db
|
(when user-id
|
||||||
(postmodern:query
|
(let ((user (dm:get-one "USERS" (db:query (:= '_id user-id)))))
|
||||||
(:raw (format nil "SELECT avatar_path FROM \"USERS\" WHERE _id = ~a" user-id))
|
(when user
|
||||||
:single)))
|
(dm:field user "avatar_path")))))
|
||||||
|
|
||||||
(define-api asteroid/user/avatar/upload () ()
|
(define-api asteroid/user/avatar/upload () ()
|
||||||
"Upload a new avatar image"
|
"Upload a new avatar image"
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue