e3aefcbf364c

Cache Uniprot results on the filesystem

This will make only the first `(run-tests)` on a given computer take forever,
instead of the first `(run-tests)` of a given Lisp session.  It will also
hopefully make the Uniprot folks not hate me.
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 24 Jan 2020 23:05:16 -0500
parents 0a5694fe577c
children 86d92162dc1f
branches/tags (none)
files src/utils.lisp

Changes

--- a/src/utils.lisp	Fri Jan 24 22:42:19 2020 -0500
+++ b/src/utils.lisp	Fri Jan 24 23:05:16 2020 -0500
@@ -433,24 +433,43 @@
 
 
 ;;;; Uniprot ------------------------------------------------------------------
-(defvar *uniprot-cache* (make-hash-table :test #'equal))
+(defparameter *cache-dir*
+  (_ (or (uiop:getenv "XDG_CACHE_HOME")
+         (format nil "~A/.cache" (uiop:getenv "HOME")))
+    (string-right-trim "/" _)
+    (format nil "~A/sjl-rosalind/" _)))
+
+(defun cache-path (key)
+  (concatenate 'string *cache-dir* key))
+
+(defun cachedp (key)
+  (probe-file (cache-path key)))
 
-(defmacro get-cached (key cache expr)
-  (once-only (key cache)
-    (with-gensyms (value)
-      `(if-found (,value (gethash ,key ,cache))
-         ,value
-         (setf (gethash ,key ,cache) ,expr)))))
+(defun getcache (key)
+  (with-open-file (s (cache-path key))
+    (read s)))
+
+(defun setcache (key value)
+  (ensure-directories-exist *cache-dir*)
+  (let ((*print-readably* t))
+    (with-open-file (s (cache-path key) :direction :output)
+      (print value s)))
+  value)
+
+(defmacro ensure-cached (key expr)
+  (once-only (key)
+    `(if (cachedp ,key)
+       (getcache ,key)
+       (setcache ,key ,expr))))
 
 (defun uniprot-url (id)
   (format nil "http://www.uniprot.org/uniprot/~A.fasta" id))
 
 (defun uniprot (id)
-  (get-cached id *uniprot-cache*
-              (_ (uniprot-url id)
-                drakma:http-request
-                read-fasta-into-alist
-                first)))
+  (ensure-cached id (_ (uniprot-url id)
+                      drakma:http-request
+                      read-fasta-into-alist
+                      first)))
 
 
 ;;;; Output -------------------------------------------------------------------