From 22e08f6aff9c23d5bf3e80983159d07a656beb57 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Fri, 16 Sep 2022 08:43:56 -0500
Subject: Modify: the way the cache of newest oneliners is built/maintained

---
 src/main.lisp | 40 +++++++++++++++++++++++++++-------------
 src/util.lisp |  2 ++
 2 files changed, 29 insertions(+), 13 deletions(-)

(limited to 'src')

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))))
-- 
cgit v1.2.3