blob: fc8d93fa9931dcd1df2a74095d477e95493de391 (
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
|
;;;; 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 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 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)))
|
