diff options
| -rw-r--r-- | vampire.lisp | 241 |
1 files changed, 220 insertions, 21 deletions
diff --git a/vampire.lisp b/vampire.lisp index 33c1ab2..c83f129 100644 --- a/vampire.lisp +++ b/vampire.lisp @@ -22,31 +22,230 @@ :index-type string-unique-index :index-reader object-with-key))) -(defclass/bknr content (keyed) - ((title :with :std "") +(defclass/bknr playlist (keyed) + ((title :std (default-name "playlist")) + (tracks editors :with :std (list)) + (cover :with :std nil :doc "A url to the cover of this album.") (user :with - :ri - :std (error "A USER is required to have created the content.") - :index-type hash-index - :index-reader content-by-user))) + :std (error "A USER is required to have created the content.")))) -(defclass/bknr playlist (content) - ((tracks editors :with :std (list)))) - -(defclass/bknr track (content) - ((source media artist album :with) - (playlists :with :std (list) :doc "Playlists in which this track appears.") - (status :a :with - :std :uninitialized - :doc ":uninitialized, :acquiring, :available, :error-aquiring"))) +(defclass/bknr track (bknr.datastore:blob keyed) + ((source title artist album thumb-url duration codec :with) + (playlists :std (list) :doc "A list of playlists in which this track appears"))) (defclass/bknr user (keyed) ((name :with :std "") - (pw pwhash :with ) - (playlists :with :std (list) :doc "Playlists made by this user"))) + (playlists :with :std (list)) + (pw pwhash :with))) + +;;; RESOURCE ACCESS OPERATIONS + +(defun make-playlist (user &key (title (default-name "playlist"))) + (make-instance 'playlist :user user :title title)) + +(defun track-with-source (source &key (test 'string-equal)) + (find source (store-objects-with-class 'track) :test test :key 'track-source)) + +(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 add-editor (playlist user) + (pushnew user (playlist-editors playlist) :test #'eq)) + +(defun remove-editor (playlist user) + (setf (playlist-editors playlist) + (delete user (playlist-editors playlist) :test #'eq))) + +(defgeneric can-edit-p (thing user)) + +(defmethod can-edit-p ((pl playlist) user) + (or + (eq user (content-user user)) + (member user (playlist-editors pl) :test #'eq))) + +(defmethod can-edit-p ((tr track) user) + (loop for pl in (track-playlists tr) + thereis (can-edit-p pl user))) + +(defun delete-track (tr) + "Deletes a track and ensures it is removed from playlists that + include it." + (loop for pl in (track-playlists tr) + do (setf (playlist-tracks pl) + (delete tr (playlist-tracks pl) :test #'eq))) + (bknr.datastore:delete-object tr)) + +(defun delete-playlist (pl) + (loop for tr in (playlist-tracks pl) + do (remove-track-from-list ) + + do (setf (track-playlists tr) (delete pl (track-playlists tr)))) + (bknr.datastore:delete-object pl)) + +(defun ownerp (user content) + (eq user (content-user content))) + +(defun set-owner (user &rest contents) + (dolist (content contents) + (setf (content-user content) user))) + +;;; TRANSACTIONS + +(defun new-user (&key name) + (with-transaction () + (make-instance 'user :name name))) + +(defun new-playlist (user &key title) + (with-transaction () + (make-playlist user :title title))) + +(defun new-track (trackinfo) + "Trackinfo is a plist containing information about the track to create." + (with-transaction () + (apply #'bknr.datastore:make-blob-from-file + (first trackinfo) + :class 'track + (cdr trackinfo)))) + +;;; 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)) + (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?list=~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 (content-title pl) :bind pl-link)))) + (set-on-click + pl-link + (alambda + (setf (url (location (connection-body parent))) + url))))))) + +(defun create-track-listing (parent playlist &rest args) + (declare (ignorable args)) + (with-clog-create parent + (p (:content "a track list coming soon... ")))) + +(defun create-track-form (parent playlist &rest args) + (declare (ignorable args)) + (with-clog-create parent + (div () + (section (:h3 :content "Add Track")) + (label (:content "Paste URL: " :bind url-label)) + (form-element (:text :bind url-input)) + (label (:content "Track Title:"))) + (label-for url-label url-input) + (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ"))) + +(defun playlist-page (body) + (when-let* ((listid + (form-data-item (form-get-data body) "list")) + (playlist + (object-with-key listid))) + (with-clog-create body + (div () + (section (:h2 :content (content-title playlist))) + (track-listing (playlist)) + (track-form (playlist)))))) + +(defun user-page (body) + (let ((user (session-user body))) + (with-clog-create body + (div () + (p (:content (format nil "Welcome ~a" (user-name user)))) + (new-playlist-form ()) + (playlist-listing ()))))) + +(defun login-page (body) + (with-clog-create body + (div () + (p (:content "LOGIN")) + (form-element (:text :bind name)) + (button (:bind btn :content "Click here to log in"))) + (set-on-click + btn + (lambda (obj) + (declare (ignore obj)) + (let ((u (new-user :name (value name)))) + (setf (user-key (window body)) (key u)) + (setf (url (location body)) "/")))))) + +(defun main (body) + (if (session-user body) + (setf (url (location body)) "/user") + (setf (url (location body)) "/login"))) + +;;; STARTUP + +(defun initialize-database (config) + (ensure-directories-exist (datastore-directory config)) + (make-instance + 'bknr.datastore:mp-store + :directory (datastore-directory config) + :subsystems (list (make-instance 'bknr.datastore:store-object-subsystem) + (make-instance 'bknr.datastore:blob-subsystem)))) -(defclass/std media (bknr.datastore:blob) - ((track :with)) - (:metaclass persistent-class)) +(defun start (config) + (setf *config* config) + (initialize-database config ) + (start-downloader-service) + (initialize 'main) + (set-on-new-window 'user-page :path "/user") + (set-on-new-window 'login-page :path "/login") + (set-on-new-window 'playlist-page :path "/playlist") + (open-browser)) -;;; RESOURCE ACCESS PROTOCOL +(defun hacking-start () + (start (make-instance + 'config + :media-directory (merge-pathnames "vampire-media/" (user-homedir-pathname)) + :datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname))))) |