Hacking: various

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)))))