path: root/vampire.lisp

;;;; vampire.lisp

(in-package #:vampire)

;;; SYSTEM CONFIG COMPONENT

(defvar *config* nil)

(defclass/std config ()
  ((datastore-directory :ir
    :std #P"/srv/parasite/store/")
   (port :ir
    :std 4919)
   (media-directory :ir
    :std #P"/srv/parasite/media/")))

;;; RESOURCE MODEL

(defclass/bknr keyed ()
  ((key
    :r :std (nuid)
    :index-type string-unique-index
    :index-reader object-with-key)))

(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
         :std (error "A USER is required to have created the content."))))

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

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

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