From 8aeabd81cd7aa5d1227d24eb3f81c34ebab57184 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Wed, 2 Nov 2022 10:09:40 -0500
Subject: Add: user pages and links to user pages in playlists

---
 home.lisp     | 37 ++++++++++++++++++++++++++++++-------
 playlist.lisp | 16 ++++++++++++----
 vampire.lisp  |  1 +
 3 files changed, 43 insertions(+), 11 deletions(-)

diff --git a/home.lisp b/home.lisp
index 71fe31c..5df6aed 100644
--- a/home.lisp
+++ b/home.lisp
@@ -21,18 +21,22 @@
   (format nil "/playlist/~a"
           (key pl)))
 
-(defun create-playlist-listing (parent)
-  (dolist (pl (user-playlists (session-user parent)))
+(defun create-playlist-listing (parent &optional user)
+  (dolist (pl (user-playlists (or user (session-user parent))))
     (with-clog-create parent
         (div (:bind pl-item)
              (div ()
                   (playlist-explore-card (pl))
                   (button (:content "delete" :bind btn))))
-      (set-on-click
-       btn
-       (thunk*
-         (destroy-playlist pl)
-         (destroy pl-item))))))
+      (cond
+        ((eq user (session-user parent)) 
+         (set-on-click
+          btn
+          (thunk*
+            (destroy-playlist pl)
+            (destroy pl-item))))
+        (t
+         (destroy btn))))))
 
 (defun create-invite-list-item (invite-list invite)
   (with-clog-create invite-list
@@ -88,4 +92,23 @@
                      (new-playlist-form ())
                      (invite-control ()))))))
 
+(defun user-key-from-url (url)
+  (first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url)))))))
+
+(defun user-listing-page (body)
+  (when-let* ((user-id
+               (user-key-from-url (url (location body))))
+              (user
+               (object-with-key user-id)))
+    (include-style body)
+    (with-clog-create body
+        (div ()
+             (navigation-header ())
+             (div (:class "row")
+                  (div ()
+                       (section (:h3 :content (format nil "Playlists by ~a"
+                                                      (user-name user))))
+                       (div (:class "row")
+                            (playlist-listing (user)))))))))
+
 
diff --git a/playlist.lisp b/playlist.lisp
index 5ff57bd..3ddffda 100644
--- a/playlist.lisp
+++ b/playlist.lisp
@@ -400,6 +400,9 @@
         (dolist (editor (playlist-editors playlist))
           (create-editor-item editor))))))
 
+(defun url-to-user (user)
+  (format nil "/user/~a" (key user)))
+
 (defun playlist-key-from-url (url)
   (first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url)))))))
 
@@ -424,7 +427,8 @@
                                   (form-element (:text :bind input))
                                   (:span (:content " -- "))
                                   (:span (:bind dur-elem :content (secs-to-hms (playlist-duration pl)))))
-                         (p (:content (format nil "by ~a" (user-name (playlist-user pl)))))
+                         (a (:link (url-to-user (playlist-user pl))
+                             :content (format nil "by ~a" (user-name (playlist-user pl)))))
                          (p (:bind collaborators-elem))
                          (track-listing (pl))))
                (div (:class "row")
@@ -437,9 +441,13 @@
               (display title-elem) "inline")
 
         (when (playlist-editors pl)
-          (setf (text collaborators-elem)
-                (format nil "with help from ~{~a~^, ~}"
-                        (mapcar #'user-name (playlist-editors pl)))))
+          (setf (inner-html collaborators-elem)
+                (with-output-to-string (out)
+                  (princ "with help from " out)
+                  (loop for (u . more) on (playlist-editors pl)
+                        do  (format out "<a href='/user/~a'>~a</a>"
+                                    (key u) (user-name u))
+                        when more do (princ ", " out)))))
         
         (when (editorp ctl)
           (setf (attribute title-elem "title") "Click to edit the title.")
diff --git a/vampire.lisp b/vampire.lisp
index 185ec57..751e1b1 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -53,6 +53,7 @@
               :extended-routing t
               :static-root (static-directory config))
   (set-on-new-window (when-logged-in? 'user-home-page) :path "/home")
+  (set-on-new-window (when-logged-in? 'user-listing-page) :path "/user")
   (set-on-new-window 'login-page :path "/login")
   (set-on-new-window (when-logged-in? 'playlist-page) :path "/playlist")
   (set-on-new-window 'new-accout-page :path "/new-account")
-- 
cgit v1.2.3