aboutsummaryrefslogtreecommitdiffhomepage
path: root/model.lisp
blob: b88bd91dbfa66eced9540683dae7975feaf25081 (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
;;;; 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 pwhash :with)))

(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 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 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)))