diff options
| -rw-r--r-- | src/main.lisp | 40 | ||||
| -rw-r--r-- | src/util.lisp | 2 |
2 files changed, 29 insertions, 13 deletions
diff --git a/src/main.lisp b/src/main.lisp index 3d081b4..1917763 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -211,6 +211,13 @@ (json:write-key-value :isFlagged (if (not (null flagged-by)) t :false)) (json:write-key-value :isLocked (if lockedp t :false))))) +;;; CACHES + + +(defvar *newest-cache-size* 20) +(defvar *newest-cache* nil + "A cache of the newest oneliners") + ;;; SERVICE CONTROL (defvar *server* nil) @@ -390,14 +397,6 @@ startup process attempts to start as swank server on the provided port. (mapc #'db:delete-object expired-invites))))) -;;; EXTERNAL CACHES - -(defparameter +newest-queue-size+ 10) -(defvar *newest-queue-lock* - (bt:make-lock "newest-queue-lock")) -(defvar *newest-queue* - (make-qb +newest-queue-size+)) - ;;; API DEFINITION AND PROVISIONING (defparameter +oneliners-description+ @@ -501,8 +500,10 @@ startup process attempts to start as swank server on the provided port. :brief brief :name name :runstyle (if runstyle (a:make-keyword runstyle) :auto))))) - (bt:with-lock-held (*newest-queue-lock*) - (enqueue-qb *newest-queue* ol)) + (setf *newest-cache* + (if (< (length *newest-cache*) *newest-cache-size*) + (cons ol *newest-cache*) + (cons ol (drop-last *newest-cache*)))) ol)) (defun unflag-oneliner (oneliner) @@ -542,12 +543,25 @@ startup process attempts to start as swank server on the provided port. (when runstyle (setf (oneliner-runstyle ol) (a:make-keyword runstyle))))) - ;;; NONTRANSACTIONAL DATABASE QUERIES (defun newest-oneliners (&optional limit) - (bt:with-lock-held (*newest-queue-lock*) - (qb-look *newest-queue* :limit limit :reversep t))) + (cond + ((and *newest-cache* (<= limit (length *newest-cache*))) + (a:subseq* *newest-cache* 0 limit)) + (t + (let (newest) + (loop + for ol in (db:store-objects-with-class 'oneliner) + when (< (length newest) limit) + do (setf newest (sort (cons ol newest) #'> :key #'created-at)) + when (> (created-at ol) (created-at (first newest))) + do (setf newest + (cons ol (drop-last newest)))) + (setf *newest-cache* + (a:subseq* newest 0 *newest-cache-size*)) + newest)))) + (defun flagged-oneliners (&optional limit) (loop diff --git a/src/util.lisp b/src/util.lisp index 426acb0..2f3da03 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -81,3 +81,5 @@ when T, Puts the newest items first." (a:subseq* seq 0 limit) seq)))) +(defun drop-last (xs &optional (howmany 1)) + (reverse (nthcdr 1 (reverse xs)))) |