aboutsummaryrefslogtreecommitdiffhomepage
path: root/user.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'user.lisp')
-rw-r--r--user.lisp72
1 files changed, 72 insertions, 0 deletions
diff --git a/user.lisp b/user.lisp
new file mode 100644
index 0000000..4f1db96
--- /dev/null
+++ b/user.lisp
@@ -0,0 +1,72 @@
+;;;; user.lisp
+
+(in-package :vampire)
+
+;;; CLIENT STATE
+
+(defclass/std user-ctl ()
+ ())
+
+;;; CLIENT SESSION
+
+(defparameter +user-key+ "vampire.userkey")
+
+(defun user-key (window)
+ (jonathan:parse (storage-element window :local +user-key+)))
+
+(defun (setf user-key) (val window)
+ (setf (storage-element window :local +user-key+) (jonathan:to-json val)))
+
+(defun session-user (clog-obj)
+ (user-with-key (user-key (window (connection-body clog-obj)))))
+
+;;; CLIENT CONTROL
+
+;;; CLIENT UI
+
+
+(defun create-new-playlist-form (parent &rest args)
+ (declare (ignorable args))
+ (with-clog-create parent
+ (div ()
+ (section (:h2 :content "Create New Playlist"))
+ (label (:content "Playlist Title:"))
+ (form-element (:text :bind pl-title))
+ (button (:content "Create" :bind btn)))
+ (set-on-click
+ btn
+ (alambda
+ (new-playlist (session-user parent) :title (value pl-title))
+ (reload (location (connection-body parent)))))))
+
+(defun url-to-playlist (pl location)
+ (format nil "~a//~a/playlist/~a"
+ (protocol location)
+ (host location)
+ (key pl)))
+
+(defun create-playlist-listing (parent &rest args)
+ (declare (ignorable args))
+ (dolist (pl (user-playlists (session-user parent)))
+ (let ((url
+ (url-to-playlist pl (location (connection-body parent)))))
+ (with-clog-create parent
+ (div ()
+ (section (:h4)
+ (a (:link url :content (playlist-title pl) :bind pl-link))))
+ (set-on-click
+ pl-link
+ (alambda
+ (setf (url (location (connection-body parent)))
+ url)))))))
+
+(defun user-home-page (body)
+ (if-let (user (session-user body))
+ (with-clog-create body
+ (div ()
+ (p (:content (format nil "Welcome ~a" (user-name user))))
+ (new-playlist-form ())
+ (playlist-listing ())))
+ (setf (url (location body)) "/")))
+
+