random theme browsing

1 files changed, 17 insertions, 2 deletions

diff --git a/fussy.lisp b/fussy.lisp
index d37890b..122d9b9 100644
--- a/fussy.lisp
+++ b/fussy.lisp
@@ -424,7 +424,8 @@ that they are not loaded during image gen.")
     (:nav
      (:a :href "/" (:h1 "FUSSY"))
      (:a :href "/themes" (:h4 "Browse by theme"))
-     (:a :href "/" (:h4 "Browse by theme package")))))
+     (:a :href "/" (:h4 "Browse by theme package"))
+     (random-theme-link))))
 
 (defun page-nav (page page-count &optional terms)
   "relative pagination nav to current page."
@@ -658,12 +659,26 @@ h1, h2, h3, h4 {
            (:a :href "https://melpa.org" "MELPA.") (:br)
            "Newest first."))))
 
+(defun random-theme-link ()
+  (html:with-html
+    (:div :class "center" (:a :href "/random-theme" "Random Theme"))))
+
 (defun redirect-to (location)
   "Set the lazybones response header and response code for redirecting to LOCATION.
 This procedure will error if lazybones:*request* is not currently bound."
   (setf (lzb:response-header :location) location
-	(lzb:response-code) "303"))
+	(lzb:response-code) 303)
+  "")
+
+(defun select-random (xs)
+  (elt xs (random (length xs))))
+
+(defun random-theme-url ()
+  (url-path (select-random (all-themes))))
 
+(lzb:defendpoint* :get "/random-theme" () ()
+  "Return a random theme url"
+  (redirect-to (random-theme-url)))
 
 (lzb:defendpoint* :get "/" ((page an-integer) (terms a-search-query)) ()
   "Browse the packages"