Add: download and play tracks

2 files changed, 76 insertions, 106 deletions

diff --git a/downloader.lisp b/downloader.lisp
index 246bf29..3142277 100644
--- a/downloader.lisp
+++ b/downloader.lisp
@@ -2,23 +2,26 @@
 
 (in-package #:vampire)
 
-(defvar *dl-cluster*
-  nil)
+(defvar *dl-cluster*)
+(defvar *media-directory*)
 
-(defun start-downloader-service (&key (count 5))
-  (setf *dl-cluster* (or *dl-cluster* (legion:make-cluster count 'run-job)))
+(defun start-downloader-service (config)
+  (let ((media-dir
+          (merge-pathnames "media/" (static-directory config)))) 
+    (ensure-directories-exist media-dir)
+    (setf *dl-cluster* (legion:make-cluster (downloader-threads config)
+                                            (lambda (job) (funcall job media-dir)))))
   (legion:start *dl-cluster*))
 
-(defun run-job (thunk)
-  (funcall thunk))
-
 (defun add-fetch-track-job (url ok err)
+  "URL is a url to some audio track. OK is a function that accepts a
+  TRACK instance. ERR is a function accepting an error condition"
   (legion:add-job
    *dl-cluster*
-   (lambda ()
-     (if-let (track (download-media url))
-       (funcall ok track)
-       (funcall err url)))))
+   (lambda (media-dir)
+     (handler-case
+         (funcall ok (download-media url media-dir))
+       (error (e) (funcall err e))))))
 
 (defun trackinfo-file (dir name)
   (merge-pathnames
@@ -53,22 +56,24 @@
        :duration dur
        :thumb-url url))))
 
-(defun download-media (url)
+(defun download-media (url media-dir)
+  "Download media and create a new track from its audio source, moving
+   the raw audio to the media-dir when done."
   (with-temp-dir (tmpdir)
-    (handler-case
-        (let* ((tmpname
-                 (default-name "media"))
-               (trackinfo-file
-                 (trackinfo-file tmpdir tmpname)))
-          (uiop:run-program 
-           (format nil "youtube-dl --write-info-json -x -o \"~a/~a.%(ext)s\" ~a"
-                   tmpdir tmpname url))
-          (when (uiop:file-exists-p trackinfo-file)
-            (let  ((info
-                     (trackinfo trackinfo-file)))
-              (new-track
-               (trackmedia-file tmpdir)
-               info))))
-      (error (e)
-        (format t "ERROR: ~a~%" e)
-        nil))))
+    (let* ((tmpname
+             (default-name "media"))
+           (trackinfo-file
+             (trackinfo-file tmpdir tmpname)))
+      (uiop:run-program 
+       (format nil "youtube-dl --write-info-json -x -o \"~a/~a.%(ext)s\" ~a"
+               tmpdir tmpname url))
+      (let* ((info
+               (trackinfo trackinfo-file))
+             (downloaded
+               (trackmedia-file tmpdir))
+             (file
+               (merge-pathnames (format nil "~a.~a"
+                                        (nuid) (pathname-type downloaded))
+                                media-dir)))
+        (uiop:copy-file downloaded file)
+        (new-track file info)))))
diff --git a/vampire.lisp b/vampire.lisp
index 03b8830..e7ce96d 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -28,13 +28,16 @@
 (defclass/bknr playlist (keyed)
   ((title :with :std (default-name "playlist"))
    (tracks editors :with :std (list))
-   (cover :with :std nil :doc "A url to the cover of this album.")
+   (cover-image :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")))
+(defmethod initialize-instance :after ((pl playlist) &key)
+  (pushnew pl (user-playlists (playlist-user pl)) :test #'eq))
+
+(defclass/bknr track (keyed)
+  ((source file title artist album thumb-url duration codec :with)
+   (playlists :with :std (list) :doc "A list of playlists in which this track appears")))
 
 (defclass/bknr user (keyed)
   ((name :with :std "")
@@ -43,12 +46,6 @@
 
 ;;; 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)
@@ -65,48 +62,6 @@
     (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 append-track (pl tr)
@@ -119,16 +74,14 @@
 
 (defun new-playlist (user &key title)
   (with-transaction ()
-    (push (make-playlist user :title title)
-          (user-playlists user))))
+    (make-instance 'playlist :title title :user user)))
 
 (defun new-track (file trackinfo)
   "Trackinfo is a plist containing information about the track to create."
   (with-transaction ()
-    (apply #'bknr.datastore:make-blob-from-file
-           file
-           'track
-           trackinfo)))
+    (let ((track (apply #'make-instance 'track trackinfo)))
+      (setf (track-file track) (namestring file))
+      track)))
 
 ;;; CLIENT
 
@@ -178,19 +131,28 @@
            (setf (url (location (connection-body parent)))
                  url)))))))
 
+(defun media-url-path (track)
+  (format nil "/media/~a.~a"
+          (pathname-name (track-file track))
+          (pathname-type (track-file track))))
+
+(create-audio )
+
 (defun create-track-listing (parent playlist &rest args)
   (declare (ignorable args))
   (dolist (track (playlist-tracks playlist))
     (with-clog-create parent
-        (div ()
+        (div (:bind view)
              (section (:h4 :content (track-title track)))
              (img (:bind thumb))
-             (audio (:source  :bind audio))
-             (p (:content "|>")))
+             (audio (:source (media-url-path track) :controls nil :bind audio)))
+      (set-on-click
+       view
+       (alambda
+           (play-media audio)))
       (if (track-thumb-url track)
         (setf (url-src thumb) (track-thumb-url track)
-              (height thumb) "100px")
-        (setf ( ))))))
+              (height thumb) "100px")))))
 
 (defun create-track-form (parent playlist &rest args)
   (declare (ignorable args))
@@ -211,15 +173,17 @@
                 (notice
                   (create-p notice-area :content (format nil "... Fetching ~a" url))))
            (setf (value url-input) "")
-           (if-let (track (download-media url))
-             (progn
-               (append-track playlist track)
-               (reload (location (connection-body parent))))
-             (progn
-               (alert (window (connection-body parent))
-                      (format nil "Error while fetching track at: ~%~a"
-                              url))))
-           (remove-from-dom notice))))))
+           (add-fetch-track-job
+            url
+            (lambda (track)
+              (append-track playlist track)
+              (reload (location (connection-body parent))))
+            (lambda (err)
+              (remove-from-dom notice)
+              (format t "Error: ~a~%" err)
+              (alert (window (connection-body parent))
+                     (format nil "Error whiel fetching track at: ~a~%"
+                             url)))))))))
 
 (defun playlist-page (body)
   (when-let* ((listid
@@ -268,14 +232,15 @@
   (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))))
+   :subsystems (list (make-instance 'bknr.datastore:store-object-subsystem))))
 
 (defun start (config)
   (setf *config* config)
   (initialize-database config )
-  (start-downloader-service)
-  (initialize 'main)
+  (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")
@@ -284,5 +249,5 @@
 (defun hacking-start ()
   (start (make-instance
           'config
-          :media-directory (merge-pathnames "vampire-media/" (user-homedir-pathname))
+          :static-directory (merge-pathnames "vampire-static/" (user-homedir-pathname))
           :datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname)))))