Added browse by packages

1 files changed, 101 insertions, 20 deletions

diff --git a/fussy.lisp b/fussy.lisp
index 842902f..3d06fcf 100644
--- a/fussy.lisp
+++ b/fussy.lisp
@@ -209,6 +209,8 @@ returns a list of those names."
                     (or (search term (symbol-name name) :test #'char-equal)
                         (search term description :test #'char-equal))))))))
 
+
+
 (defun search-themes (terms &key sort-by)
   (remove-if-not
    (apply #'a:conjoin (mapcar #'theme-mentions-anywhere terms))
@@ -219,6 +221,14 @@ returns a list of those names."
 
 (defun theme-package (theme) (gethash theme *theme->packages*))
 
+(defun search-packages (terms &key sort-by)
+  ;; slow but I get to recycle
+  (remove-duplicates
+   (mapcar #'theme-package (search-themes terms :sort-by sort-by))
+   :test #'eq))
+
+(defun all-packages () (db:store-objects-with-class 'theme-pkg))
+
 (defun reindex-themes-by-package ()
   (let ((table (make-hash-table :test #'equal)))
     (dolist (pkg (all-theme-packages))
@@ -412,7 +422,9 @@ that they are not loaded during image gen.")
 (defun nav ()
   (html:with-html
     (:nav
-     (:a :href "/" (:h1 "FUSSY")))))
+     (:a :href "/" (:h1 "FUSSY"))
+     (:a :href "/" (:h4 "Browse by theme"))
+     (:a :href "/packages" (:h4 "Browse by theme package")))))
 
 (defun page-nav (page page-count &optional terms)
   "relative pagination nav to current page."
@@ -447,6 +459,16 @@ that they are not loaded during image gen.")
           (:a :href (url-path theme) (:h4 theme)
               (theme-preview-image theme)))))
 
+(defun package-preview-card (pkg)
+  (let ((themes (themes-in-package pkg)))
+   (html:with-html
+     (:div :class "card"
+           (:a :href (url-path pkg)
+               (:h4 (package-namestring pkg) " - " (length themes) " variants")
+               (theme-preview-image
+                (first (themes-in-package pkg))))))))
+
+
 (defun style ()
   (html:with-html
     (:link :rel "stylesheet" :type "text/css" :href "/css/style.css")))
@@ -524,7 +546,7 @@ html, body {
   width: 300px;
 }
 
-h1 {
+h1, h2, h3, h4 {
   text-align: center;
 }
 
@@ -576,6 +598,17 @@ h1 {
   "Parses a space separated list for search terms and returns a list."
   (when terms (str:split-omit-nulls #\space terms)))
 
+(defun page-count (things)
+  (ceiling (/ (cond ((numberp things) things)
+                    ((listp things) (length things))
+                    (t (error "cant count that")))
+              +themes-per-page+)))
+
+(defun get-page (page things)
+  (a:subseq* things
+             (* page +themes-per-page+)
+             (* (1+ page) +themes-per-page+)))
+
 (lzb:defendpoint* :get "/" ((page an-integer) (terms a-search-query)) ()
   "The landing page"
   (let* ((page
@@ -585,11 +618,9 @@ h1 {
                (search-themes terms :sort-by (complement #'package-version<=))
                (all-themes :sort-by (complement #'package-version<=))))
          (page-count
-           (ceiling (/ (length all-themes) +themes-per-page+)))
+           (page-count all-themes))
          (themes
-           (a:subseq* all-themes
-                      (* page +themes-per-page+)
-                      (* (1+ page) +themes-per-page+))))
+           (get-page page all-themes)))
     (html:with-html-string
       (:doctype)
       (:html
@@ -599,16 +630,8 @@ h1 {
        (:body
         (:div :class "main"
               (nav)
-              (:div :class "center header"
-                     (:p
-                      "Emacs Themes Gallery for your Daily Procrastination Needs." (:br)
-                      "Showing " (write-to-string (length all-themes)) " themes." (:br)
-                      "Newer themes, or newly updated themes, are shown first"))
-              (:div :class "search"
-               (:form :method "GET" :action "/"
-                      (:label :for "terms")
-                      (:input :name "terms" :value (format nil "~{~a ~}" terms))
-                      (:button :type "submit" "search")))
+              (gallery-header (length all-themes) "themes")
+              (search-form "/" terms)
               (when (< 1 page-count)
                 (page-nav page page-count terms))
               (:div :class "container"
@@ -618,6 +641,57 @@ h1 {
                     (when (< 1 page-count)
                       (page-nav page page-count terms)))))))))
 
+(defun search-form (endpoint terms)
+  (html:with-html
+    (:div :class "search"
+          (:form :method "GET" :action endpoint
+                 (:label :for "terms")
+                 (:input :name "terms" :value (format nil "~{~a ~}" terms))
+                 (:button :type "submit" "search")))    ))
+
+(defun gallery-header (count what)
+  (html:with-html 
+    (:div :class "center header"
+          (:p
+           "Emacs Themes Gallery for your Daily Procrastination Needs." (:br)
+           "Showing " (write-to-string count) " " what "." (:br)
+           "Newest first."))))
+
+(lzb:defendpoint* :get "/packages" ((page an-integer) (terms a-search-query)) ()
+  "Browse the packages"
+  (let* ((page
+           (or page 0))
+         (all-packages
+           (if terms
+               (search-packages terms :sort-by (complement #'package-version<=))
+               ;; temporary hack b/c of a bug with non-updated themes
+               (search-packages '("theme") :sort-by (complement #'package-version<=))
+               ;;(all-theme-packages (complement #'package-version<=))
+               ))
+         (page-count
+           (ceiling (/ (length all-packages) +themes-per-page+)))
+         (packages
+           (get-page page all-packages)))
+    (html:with-html-string
+      (:doctype)
+      (:html
+       (:head
+        (:title "Fussy - Packages")
+        (style))
+       (:body
+        (:div :class "main"
+              (nav)
+              (gallery-header (length all-packages) "theme packages")
+              (search-form "/packages" terms)
+              (when (< 1 page-count)
+                (page-nav page page-count terms))
+              (:div :class "container"
+                    (dolist (pkg packages)
+                      (package-preview-card pkg)))
+              (:div :class "footer"
+                    (when (< 1 page-count)
+                      (page-nav page page-count terms)))))))))
+
 (defun a-package (string)
   (a:if-let (pkg
              (theme-pkg-with-name
@@ -636,7 +710,11 @@ h1 {
   "The page endpoint for a theme package"
   (let ((themes
           (themes-in-package pkg))
-        (page
+        (page(:div :classa "search"
+                    (:form :method "GET" :action "/"
+                           (:label :for "terms")
+                           (:input :name "terms" :value (format nil "~{~a ~}" terms))
+                           (:button :type "submit" "search")))
           (or page 0)))
     (html:with-html-string
       (:doctype)
@@ -665,6 +743,9 @@ h1 {
               (when (< +themes-per-page+ (length themes))
                 (page-nav page (floor (/ (length themes) +themes-per-page+))))))))))
 
+
+
+
 (lzb:defendpoint* :get "/theme/:pkg a-package:/:theme a-theme:" () ()
   "The page for a particular theme showing its previews for different prog langs"
   (unless (member theme (themes-in-package pkg) :test #'string-equal)
@@ -680,9 +761,9 @@ h1 {
       (:div :class "main"
             (nav)
             (:div :class "center header"
-             (:h2 theme)
-             (:p "A theme in the package "
-                 (:a :href (url-path pkg) (package-namestring pkg))))
+                  (:h2 theme)
+                  (:p "A theme in the package "
+                      (:a :href (url-path pkg) (package-namestring pkg))))
             (:div :class "container"
                   (dolist (variant (mapcar #'pathname-name (image-files-for-theme theme)))
                     (theme-preview-image theme variant))))))))