blob: 42142ed544579236adb5e34b8a1de1b0835feb1e (
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
|
;;;; model.lisp
(in-package :vampire)
(defclass/bknr keyed ()
((key :r :std (nuid)
:index-type string-unique-index
:index-reader object-with-key)))
(defclass/bknr user (keyed)
((name :with
:index-type string-unique-index
:index-reader user-with-name)
(playlists :with :std (list))
(pwsalt :with :std (nuid))
(pwhash :with)))
(defclass/bknr invite (keyed)
((maker :r :std nil)
(uses-remaining :std nil)))
(defclass/bknr playlist (keyed)
((title :with :std (default-name "playlist"))
(tracks editors :with :std (list))
(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."))))
(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")))
;;; MODEL OPERATIONS
(defun can-edit-p (user playlist)
(or (eq (playlist-user playlist) user)
(member user (playlist-editors playlist) :test #'eq)))
(defun invite-by-code (code)
"Returns NIL if CODE is an invalid invite code. Returns the INVITE
instance otherwise"
(when-let (obj (object-with-key code))
(and (typep obj 'invite)
(or (null (uses-remaining obj))
(plusp (uses-remaining obj)))
obj)))
(defun user-with-key (key)
(when-let (obj (object-with-key key))
(when (typep obj 'user)
obj)))
(defun login-user (username password)
(when-let (user (user-with-name username))
(with-slots (pwhash pwsalt) user
(when (equalp pwhash (hash-string password pwsalt))
user))))
(defun last-change (obj)
(slot-value obj 'bknr.datastore::last-change))
(defun recent-playlists (&optional (count 10))
(take count
(sort (copy-seq (store-objects-with-class 'playlist))
#'>
:key #'last-change)))
(defun playlist-duration (pl)
(reduce #'+
(playlist-tracks pl)
:key 'track-duration
:initial-value 0))
(defun add-track (tr pl &optional (n -1))
(setf (playlist-tracks pl)
(insert-nth tr n (playlist-tracks pl))))
(defun remove-nth-from-playlist (pl n)
(multiple-value-bind (newlist track)
(remove-nth n (playlist-tracks pl) t)
(setf (playlist-tracks pl) newlist
(track-playlists track) (delete pl (track-playlists track)
:test #'eq :count 1))))
(defun track-with-source (source)
(find source (store-objects-with-class 'track) :test #'string-equal :key 'track-source))
;;; TRANSACTIONS
(defun new-user (&key name)
(with-transaction ()
(make-instance 'user :name name)))
(defun use-invite-with-code (code username pw)
(with-transaction ()
(when-let (invite (invite-by-code code))
(when (uses-remaining invite)
(decf (uses-remaining invite))
(unless (plusp (uses-remaining invite))
(bknr.datastore:delete-object invite)))
(let ((user (make-instance 'user :name username)))
(setf (user-pwhash user)
(hash-string pw (user-pwsalt user)))
user))))
(defun append-track (pl tr)
(with-transaction ()
(add-track tr pl)))
(defun delete-track-at (pl pos)
(when-let (tr (nth pos (playlist-tracks pl)))
(with-transaction ()
(setf (playlist-tracks pl)
(delete tr (playlist-tracks pl)))
t)))
(defun swap-tracks (pl n m)
(unless (or (minusp (min m n))
(>= (max m n) (length (playlist-tracks pl)) ))
(with-transaction ()
(setf (playlist-tracks pl)
(nswap (playlist-tracks pl) n m)))))
(defun new-track (file trackinfo)
"Trackinfo is a plist containing information about the track to create."
(with-transaction ()
(let ((track (apply #'make-instance 'track trackinfo)))
(setf (track-file track) (namestring file))
track)))
(defun new-playlist (user &key title)
(with-transaction ()
(make-instance 'playlist :title title :user user)))
(defun update-playlist-title (playlist title)
(with-transaction ()
(setf (playlist-title playlist) title)))
|
