diff options
| -rw-r--r-- | keyed.lisp | 6 | ||||
| -rw-r--r-- | model.lisp | 96 | ||||
| -rw-r--r-- | playlist.lisp | 72 | ||||
| -rw-r--r-- | user.lisp | 72 | ||||
| -rw-r--r-- | vampire.asd | 3 | ||||
| -rw-r--r-- | vampire.lisp | 34 |
6 files changed, 179 insertions, 104 deletions
@@ -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)) |