Refactor: updating themes

1 files changed, 31 insertions, 26 deletions

diff --git a/fussy.lisp b/fussy.lisp
index bfe31a8..2b419ee 100644
--- a/fussy.lisp
+++ b/fussy.lisp
@@ -93,9 +93,6 @@ the emacs' reader readtable."
        (theme-pkg-keywords pkg) (cdr (assoc :keywords meta-alist))))))
 
 
-(defvar *update-batch* nil
-  "Collected archive-packages in need of further processing.")
-
 (defun process-archive-theme (archive-theme)
   ;; ugg this is ugly. I hate it when code is all dense like this.
   (a:if-let (pkg
@@ -106,31 +103,31 @@ the emacs' reader readtable."
       (update-theme-pkg-from-archive-theme pkg archive-theme))
     (make-theme-pkg-from-archive-theme archive-theme)))
 
-(defun mark-theme-to-update (archive-theme)
-  (a:if-let (pkg
-             (theme-pkg-with-name
-              (archive-theme-name archive-theme)))
-    (when (not (equalp (archive-theme-version archive-theme)
-                       (theme-pkg-version pkg)))
-      (push archive-theme *update-batch*))
-    (push archive-theme *update-batch*)))   ;; 🤮
-
+(defun theme-needs-update-p (archive-theme)
+  "A theme should be updated if eithe it is new or if its version
+differs from the theme-pkg instance already in the data store."
+  (let ((pkg
+          (theme-pkg-with-name 
+           (archive-theme-name archive-theme))))
+    (not 
+     (and pkg
+          (equalp (archive-theme-version archive-theme)
+                  (theme-pkg-version pkg))))))
 
 (defun update-theme-packages ()
-  (let ((all-themes-from-archive
-          (remove-if-not #'theme-package-p (fetch-emacs-archive)))
-        (*update-batch* nil))
-    (dolist (archive-theme all-themes-from-archive)
-      (mark-theme-to-update archive-theme))
-
+  (let ((themes-to-update
+          (remove-if-not
+           (a:conjoin  #'theme-package-p #'theme-needs-update-p)
+           (fetch-emacs-archive))))
     ;; just going to let this throw an error. will either introduce a
     ;; restart-case with some restarts or something later, or will
     ;; just catch the error in the caller of update-theme-packages
-    (generate-images-for-packages
-     (mapcar #'archive-theme-name *update-batch*))
-    ;; if we didn't error: update the db
-    (dolist (archive-theme *update-batch*)
-      (process-archive-theme archive-theme))))
+    (when themes-to-update
+      (generate-images-for-packages
+       (mapcar #'archive-theme-name themes-to-update))
+      ;; if we didn't error: update the db
+      (dolist (archive-theme themes-to-update)
+        (process-archive-theme archive-theme)))))
 
 (defun all-theme-keywords ()
   (delete-duplicates
@@ -207,6 +204,9 @@ are treated as such.")
 (defun full-theme-image-directory (&optional (config *config*))
   (uiop:merge-pathnames* (theme-image-directory config) *config-directory*))
 
+(defun emacs-dot-d-directory (&optional (config *config*))
+  (uiop:merge-pathnames* ".emacs.d/" (full-theme-image-directory config)))
+
 (defun create-db ()
   (unless (boundp 'db:*store* )
     (ensure-directories-exist (full-store-directory))
@@ -219,7 +219,7 @@ are treated as such.")
   (unless config-file
     (setf config-file
           (or (uiop:getenv "FUSSY_CONFIG")
-              (asdf:system-relative-pathname :fussy "files/config.sexp"))))
+              (asdf:system-relative-pathname :fussy "config.sexp"))))
   (setf *config*
         (load-config-from-file config-file)
         *config-directory*
@@ -259,5 +259,10 @@ that they are not loaded during image gen.")
 
 
 (defun generate-images-for-packages (package-names)
-  (uiop:launch-program
-   (format-emacs-evocation-script package-names)))
+  (when package-names
+   (uiop:run-program
+    (format-emacs-evocation-script package-names))
+   ;; we delete the custom location .emacs.d directory after each run.
+   ;; I'm doing this so that 
+   (uiop:delete-directory-tree
+    (emacs-dot-d-directory) :validate t)))