blob: eef75cce4a6090a7df9a79e3727651159312f122 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
;;;; 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)))))
|
