Add: explore page; editor privilege views

4 files changed, 112 insertions, 59 deletions

diff --git a/explore.lisp b/explore.lisp
new file mode 100644
index 0000000..f562448
--- /dev/null
+++ b/explore.lisp
@@ -0,0 +1,32 @@
+;;; explore.lisp
+
+(in-package :vampire)
+
+(defun create-media-search-area (parent)
+  (with-clog-create parent
+      (p (:content "media search area"))))
+
+(defun create-playlist-explore-card (parent pl)
+  (with-clog-create parent
+      (div ()
+           (img (:bind thumb))
+           (section (:h4)
+                    (a (:link (url-to-playlist pl) :content (playlist-title pl)))
+                    (span (:content " -- "))
+                    (span (:content (secs-to-hms (playlist-duration pl))))))
+    (setf (maximum-width thumb) "120px")
+    (when-let (track (first (playlist-tracks pl)))
+      (setf (url-src thumb) (or (track-thumb-url track) "")))))
+
+(defun create-recent-playlists-area (parent)
+  (let* ((container (create-div parent)))
+    (dolist (pl (recent-playlists 10))
+      (create-playlist-explore-card container pl))))
+
+(defun explore-page (body)
+  (with-clog-create body
+      (div ()
+           (navigation-header ())
+                                        ;(media-search-area ())
+           (section (:h2 :content "Recent Playlists"))
+           (recent-playlists-area ()))))
diff --git a/model.lisp b/model.lisp
index fc8d93f..42142ed 100644
--- a/model.lisp
+++ b/model.lisp
@@ -36,6 +36,10 @@
 
 ;;; MODEL OPERATIONS
 
+(defun can-edit-p (user playlist)
+  (or (eq (playlist-user playlist) user)
+      (member user (playlist-editors playlist) :test #'eq)))
+
 (defun invite-by-code (code)
   "Returns NIL if CODE is an invalid invite code. Returns the INVITE
    instance otherwise"
@@ -56,6 +60,14 @@
       (when (equalp pwhash (hash-string password pwsalt))
         user))))
 
+(defun last-change (obj)
+  (slot-value obj 'bknr.datastore::last-change))
+
+(defun recent-playlists (&optional (count 10))
+  (take count
+        (sort (copy-seq (store-objects-with-class 'playlist))
+              #'>
+              :key #'last-change)))
 (defun playlist-duration (pl)
   (reduce #'+
           (playlist-tracks pl)
diff --git a/playlist.lisp b/playlist.lisp
index 8b4b4e6..938972c 100644
--- a/playlist.lisp
+++ b/playlist.lisp
@@ -218,11 +218,11 @@
         (princ " - " out))
       (princ title out))))
 
-(defun create-track-list-item (list track ctl)
+(defun create-track-list-item (list track ctl &optional editp)
   (with-clog-create list
       (list-item (:bind container)
-                 (div ()
-                      (button (:content "delete " :hidden t :bind delbtn))
+                 (div (:bind edit-controls)
+                      (button (:content "delete " :bind delbtn))
                       (button (:content "↓" :bind downbtn))
                       (button (:content "↑" :bind upbtn)))
                  (div (:bind item)
@@ -238,20 +238,26 @@
                            :track track)))
       (setf (tracks ctl)
             (insert-nth track-ctl -1 (tracks ctl) t)) 
-      (setf (visiblep delbtn) t)
-      (set-on-click delbtn (thunk* (remove-track track-ctl)))
-      (set-on-click downbtn (thunk* (move-track-down track-ctl)))
-      (set-on-click upbtn (thunk* (move-track-up track-ctl))))
+
+      (cond
+        (editp 
+         (set-on-click delbtn (thunk* (remove-track track-ctl)))
+         (set-on-click downbtn (thunk* (move-track-down track-ctl)))
+         (set-on-click upbtn (thunk* (move-track-up track-ctl))))
+        (t
+         (setf (display edit-controls) "none"))))
+
     (set-on-time-update audio 'update-now-playing-time)
     (set-on-ended audio 'advance-now-playing)
     (set-on-click item (thunk* (play-this-audio audio)))))
 
 (defun create-track-listing (parent pl)
   (when-let (ctl (cur-playlist-ctl parent))
-    (let ((ol (create-ordered-list parent)))
+    (let ((ol (create-ordered-list parent))
+          (editp (can-edit-p (session-user parent) pl)))
       (setf (pl-tracks ctl) ol)
       (dolist (track (playlist-tracks pl))
-        (create-track-list-item ol track ctl)))))
+        (create-track-list-item ol track ctl editp)))))
 
 (defun append-track-list-item (obj track)
   (when-let (ctl (cur-playlist-ctl obj))
@@ -260,39 +266,40 @@
           (secs-to-hms (playlist-duration (playlist ctl))))))
 
 (defun create-new-track-form (parent pl)
-  (with-clog-create parent
-      (div ()
-           (section (:h3 :content "Add A Track"))
-           (label (:content "Paste a URL: " :bind url-label))
-           (form-element (:text :bind url-input))
-           (button (:content "Fetch Track" :bind button))
-           (div (:bind notice-area)))
-    (label-for url-label url-input)
-    (setf (size url-input) (length "https://www.youtube.com/watch?v=dQw4w9WgXcQ"))
-    (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ")
-    (set-on-click
-     button
-     (thunk*
-         (let* ((url
-                  (value url-input))
-                (notice
-                  (create-p notice-area :content (format nil "... Fetching ~a" url)))
-                (on-ok
-                  (lambda (track)
-                    (destroy notice)
-                    (append-track pl track)
-                    (append-track-list-item parent track))))
-           (setf (value url-input) "")
-           (if-let (track (track-with-source url))
-             (funcall on-ok track)
-             (add-fetch-track-job
-              url on-ok              
-              (lambda (err)
-                (destroy notice)
-                (format t "~a" err)
-                (alert (window (connection-body parent))
-                       (format nil "Error while fetching track at: ~a~%"
-                               url))))))))))
+  (when (can-edit-p (session-user parent) pl)
+   (with-clog-create parent
+       (div ()
+            (section (:h3 :content "Add A Track"))
+            (label (:content "Paste a URL: " :bind url-label))
+            (form-element (:text :bind url-input))
+            (button (:content "Fetch Track" :bind button))
+            (div (:bind notice-area)))
+     (label-for url-label url-input)
+     (setf (size url-input) (length "https://www.youtube.com/watch?v=dQw4w9WgXcQ"))
+     (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ")
+     (set-on-click
+      button
+      (thunk*
+        (let* ((url
+                 (value url-input))
+               (notice
+                 (create-p notice-area :content (format nil "... Fetching ~a" url)))
+               (on-ok
+                 (lambda (track)
+                   (destroy notice)
+                   (append-track pl track)
+                   (append-track-list-item parent track))))
+          (setf (value url-input) "")
+          (if-let (track (track-with-source url))
+            (funcall on-ok track)
+            (add-fetch-track-job
+             url on-ok              
+             (lambda (err)
+               (destroy notice)
+               (format t "~a" err)
+               (alert (window (connection-body parent))
+                      (format nil "Error while fetching track at: ~a~%"
+                              url)))))))))))
 
 (defun playlist-key-from-url (url)
   (first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url)))))))
@@ -320,23 +327,24 @@
               (pl-dur ctl) dur-elem
               (display input) "none"
               (display title-elem) "inline")
-        
-        (set-on-blur
-         input
-         (thunk*
-           (when (plusp (length (value input)))
-             (update-playlist-title pl (value input))
-             (setf (text title-elem) (value input)))
-           (setf (display input) "none"
-                 (display title-elem) "inline")))
-        
-        (set-on-click
-         title-elem
-         (thunk*
-           (setf (value input) (text title-elem)
-                 (display title-elem) "none"
-                 (display input) "inline")
-           (focus input)))
+
+        (when (can-edit-p (session-user body) pl)
+          (set-on-blur
+           input
+           (thunk*
+             (when (plusp (length (value input)))
+               (update-playlist-title pl (value input))
+               (setf (text title-elem) (value input)))
+             (setf (display input) "none"
+                   (display title-elem) "inline")))
+          
+          (set-on-click
+           title-elem
+           (thunk*
+             (setf (value input) (text title-elem)
+                   (display title-elem) "none"
+                   (display input) "inline")
+             (focus input))))
         
         (initialize-now-playing body)))))
 
diff --git a/vampire.lisp b/vampire.lisp
index dcfb2e3..b620a2b 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -101,6 +101,7 @@
   (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")
+  (set-on-new-window (when-logged-in? 'explore-page) :path "/explore")
   (open-browser))
 
 (defun hacking-start ()