Add+Move: user and model files, moved code into files

6 files changed, 179 insertions, 104 deletions

diff --git a/keyed.lisp b/keyed.lisp
index c9978bf..f5df135 100644
--- a/keyed.lisp
+++ b/keyed.lisp
@@ -2,8 +2,4 @@
 
 (in-package :vampire)
 
-(defclass/bknr keyed ()
-  ((key
-    :r :std (nuid)
-       :index-type string-unique-index
-       :index-reader object-with-key)))
+
diff --git a/model.lisp b/model.lisp
new file mode 100644
index 0000000..246e27f
--- /dev/null
+++ b/model.lisp
@@ -0,0 +1,96 @@
+;;;; model.lisp
+
+(in-package :vampire)
+
+(defclass/bknr keyed ()
+  ((key
+    :r :std (nuid)
+       :index-type string-unique-index
+       :index-reader object-with-key)))
+
+(defclass/bknr user (keyed)
+  ((name :with :std "")
+   (playlists :with :std (list))
+   (pw pwhash :with)))
+
+(defclass/bknr playlist (keyed)
+  ((title :with :std (default-name "playlist"))
+   (tracks editors :with :std (list))
+   (cover-image :with :std nil :doc "A url to the cover of this album.")
+   (user :with
+         :std (error "A USER is required to have created the content."))))
+
+(defmethod initialize-instance :after ((pl playlist) &key)
+  (pushnew pl (user-playlists (playlist-user pl)) :test #'eq))
+
+
+(defclass/bknr track (keyed)
+  ((source file title artist album thumb-url duration codec :with)
+   (playlists :with :std (list) :doc "A list of playlists in which this track appears")))
+
+
+;;; MODEL OPERATIONS
+
+(defun user-with-key (key)
+  (when-let (obj (object-with-key key))
+    (when (typep obj 'user)
+      obj)))
+
+(defun playlist-duration (pl)
+  (reduce #'+
+          (playlist-tracks pl)
+          :key 'track-duration 
+          :initial-value 0))
+
+(defun add-track (tr pl &optional (n -1))
+  (setf (playlist-tracks pl)
+        (insert-nth tr n (playlist-tracks pl))))
+
+(defun remove-nth-from-playlist (pl n)
+  (multiple-value-bind (newlist track)
+      (remove-nth n (playlist-tracks pl) t) 
+    (setf (playlist-tracks pl) newlist
+          (track-playlists track) (delete pl (track-playlists track)
+                                          :test #'eq :count 1))))
+
+(defun track-with-source (source)
+  (find source (store-objects-with-class 'track) :test #'string-equal :key 'track-source))
+
+;;; TRANSACTIONS
+
+(defun new-user (&key name)
+  (with-transaction ()
+    (make-instance 'user :name name)))
+
+(defun append-track (pl tr)
+  (with-transaction ()
+    (add-track tr pl)))
+
+(defun delete-track-at (pl pos)
+  (when-let (tr (nth pos (playlist-tracks pl)))
+    (with-transaction ()
+      (setf (playlist-tracks pl)
+            (delete tr (playlist-tracks pl)))
+      t)))
+
+(defun swap-tracks (pl n m)
+  (unless (or (minusp (min m n))
+              (>= (max m n) (length (playlist-tracks pl)) ))
+    (with-transaction ()
+      (setf (playlist-tracks pl)
+            (nswap (playlist-tracks pl) n m)))))
+
+(defun new-track (file trackinfo)
+  "Trackinfo is a plist containing information about the track to create."
+  (with-transaction ()
+    (let ((track (apply #'make-instance 'track trackinfo)))
+      (setf (track-file track) (namestring file))
+      track)))
+
+(defun new-playlist (user &key title)
+  (with-transaction ()
+    (make-instance 'playlist :title title :user user)))
+
+(defun update-playlist-title (playlist title)
+  (with-transaction ()
+    (setf (playlist-title playlist) title)))
diff --git a/playlist.lisp b/playlist.lisp
index 64b03ef..82b796f 100644
--- a/playlist.lisp
+++ b/playlist.lisp
@@ -2,78 +2,6 @@
 
 (in-package :vampire)
 
-;;; MODEL
-
-(defclass/bknr playlist (keyed)
-  ((title :with :std (default-name "playlist"))
-   (tracks editors :with :std (list))
-   (cover-image :with :std nil :doc "A url to the cover of this album.")
-   (user :with
-         :std (error "A USER is required to have created the content."))))
-
-(defmethod initialize-instance :after ((pl playlist) &key)
-  (pushnew pl (user-playlists (playlist-user pl)) :test #'eq))
-
-(defclass/bknr track (keyed)
-  ((source file title artist album thumb-url duration codec :with)
-   (playlists :with :std (list) :doc "A list of playlists in which this track appears")))
-
-;;; OPERATIONS
-
-(defun playlist-duration (pl)
-  (reduce #'+
-          (playlist-tracks pl)
-          :key 'track-duration 
-          :initial-value 0))
-
-(defun add-track (tr pl &optional (n -1))
-  (setf (playlist-tracks pl)
-        (insert-nth tr n (playlist-tracks pl))))
-
-(defun remove-nth-from-playlist (pl n)
-  (multiple-value-bind (newlist track)
-      (remove-nth n (playlist-tracks pl) t) 
-    (setf (playlist-tracks pl) newlist
-          (track-playlists track) (delete pl (track-playlists track)
-                                          :test #'eq :count 1))))
-
-(defun track-with-source (source)
-  (find source (store-objects-with-class 'track) :test #'string-equal :key 'track-source))
-;;; TRANSACTIONS
-
-(defun append-track (pl tr)
-  (with-transaction ()
-    (add-track tr pl)))
-
-(defun delete-track-at (pl pos)
-  (when-let (tr (nth pos (playlist-tracks pl)))
-    (with-transaction ()
-      (setf (playlist-tracks pl)
-            (delete tr (playlist-tracks pl)))
-      t)))
-
-(defun swap-tracks (pl n m)
-  (unless (or (minusp (min m n))
-              (>= (max m n) (length (playlist-tracks pl)) ))
-    (with-transaction ()
-      (setf (playlist-tracks pl)
-            (nswap (playlist-tracks pl) n m)))))
-
-(defun new-track (file trackinfo)
-  "Trackinfo is a plist containing information about the track to create."
-  (with-transaction ()
-    (let ((track (apply #'make-instance 'track trackinfo)))
-      (setf (track-file track) (namestring file))
-      track)))
-
-(defun new-playlist (user &key title)
-  (with-transaction ()
-    (make-instance 'playlist :title title :user user)))
-
-(defun update-playlist-title (playlist title)
-  (with-transaction ()
-    (setf (playlist-title playlist) title)))
-
 ;;; CLIENT STATE 
 
 (defclass/std playlist-ctl ()
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)) "/")))
+
+
diff --git a/vampire.asd b/vampire.asd
index 6dc0aa3..5c7b936 100644
--- a/vampire.asd
+++ b/vampire.asd
@@ -17,6 +17,7 @@
                (:file "definition-macros")
                (:file "utilities")
                (:file "downloader")
-               (:file "keyed")
+               (:file "model")
+               (:file "user")
                (:file "playlist")
                (:file "vampire")))
diff --git a/vampire.lisp b/vampire.lisp
index cf6accc..85eed95 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -19,29 +19,21 @@
 
 ;;; RESOURCE MODEL
 
-(defclass/bknr user (keyed)
-  ((name :with :std "")
-   (playlists :with :std (list))
-   (pw pwhash :with)))
+
 
 ;;; TRANSACTIONS
 
-(defun new-user (&key name)
-  (with-transaction ()
-    (make-instance 'user :name name)))
+
 
 ;;; CLIENT
 
-(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)
-  (object-with-key (user-key (window (connection-body clog-obj)))))
+
+
+
+
 
 (defun create-new-playlist-form (parent &rest args)
   (declare (ignorable args))
@@ -78,16 +70,6 @@
            (setf (url (location (connection-body parent)))
                  url)))))))
 
-
-(defun user-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)) "/")))
-
 (defun login-page (body)
   (with-clog-create body
       (div ()
@@ -104,7 +86,7 @@
 
 (defun main (body)
   (if (session-user body)
-      (setf (url (location body)) "/user")
+      (setf (url (location body)) "/home")
       (setf (url (location body)) "/login")))
 
 ;;; STARTUP
@@ -123,7 +105,7 @@
   (initialize 'main
               :extended-routing t
               :static-root (static-directory config))
-  (set-on-new-window 'user-page :path "/user")
+  (set-on-new-window 'user-home-page :path "/home")
   (set-on-new-window 'login-page :path "/login")
   (set-on-new-window 'playlist-page :path "/playlist")
   (open-browser))