aboutsummaryrefslogtreecommitdiffhomepage
path: root/vampire.lisp
blob: 2e8f50666c1600c452430ee4e2e4d202a811490f (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
;;;; 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
     (thunk*
       (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
         (thunk*
           (setf (url (location (connection-body parent)))
                 url)))))))

(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 redirect-to-root (body)
  (setf (url (location body)) "/"))

(defun when-logged-in? (fn)
  (<?> 'session-user fn 'redirect-to-root))

(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")
  (set-on-new-window 'new-accout-page :path "/new-account")
  (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)))))