aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-10-24 15:31:19 -0500
committerColin Okay <colin@cicadas.surf>2022-10-24 15:31:19 -0500
commitc3d7abc48bf6081b1538037eaff8b25cb3e9389f (patch)
treeb94d8af88e5e3d93ed25fc7b8507a126bd107807
parent2c75d6215600ca527fe5273183e8be2d2629a2e2 (diff)
Hacking: various
-rw-r--r--vampire.lisp241
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)))))