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)) "/")))
+
+