;;;; vampire.lisp (in-package #:vampire) ;;; SYSTEM CONFIG COMPONENT (defvar *config* nil) (defclass/std config () ((datastore-directory :ir :std #P"/srv/parasite/store/") (static-directory :ir :std #P"/srv/parasite/static/") (port :ir :std 4919) (downloader-threads :ir :std 5))) (defun config-from-file (path) "PATH should be a path to a file containing a PLIST suitable for passing as the keyword arguments to (MAKE-INSTANCE 'CONFIG ...)" (apply #'make-instance 'config (read-from-file path))) ;;; 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)) (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 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)) ;; (button (:content "Fetch Track" :bind submit-button)) ;; (div (:bind notice-area))) ;; (label-for url-label url-input) ;; (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ") ;; (set-on-click ;; submit-button ;; (alambda ;; (let* ((url ;; (value url-input)) ;; (notice ;; (create-p notice-area :content (format nil "... Fetching ~a" url)))) ;; (setf (value url-input) "") ;; (add-fetch-track-job ;; url ;; (lambda (track) ;; (remove-from-dom notice) ;; (append-track playlist track) ;; (add-track-to-listing parent track)) ;; (lambda (err) ;; (remove-from-dom notice) ;; (format t "Error: ~a~%" err) ;; (alert (window (connection-body parent)) ;; (format nil "Error while fetching track at: ~a~%" ;; 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 () (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)))) (defun start (config) (setf *config* config) (initialize-database config ) (start-downloader-service config) (initialize 'main :extended-routing t :static-root (static-directory config)) (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 :static-directory (merge-pathnames "vampire-static/" (user-homedir-pathname)) :datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname)))))