blob: 85eed9558a69cd41ac6df6c49291022cc02f7108 (
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
|
;;;; 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
;;; TRANSACTIONS
;;; CLIENT
(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 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)) "/home")
(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-home-page :path "/home")
(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)))))
|
