feat(web/panettone): Add initial styles r/1442

Take an initial crack at styling most of the Panettone application,
taking inspiration from the styles from todo.tvl.fyi and tvl.fyi itself.
This uses the LASS CSS library, after a brief attempt at using css-lite
which I ended up not going with because I don't like the library's
design very much, and also it's not compatible with sbcl's (safety
3) (some macroexpansions SETQ undeclared variables).

Change-Id: I054402e4c68ae1e99884d5164e6e2fc39d2779ff
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1350
Tested-by: BuildkiteCI
Reviewed-by: eta <eta@theta.eu.org>

5 files changed, 236 insertions, 62 deletions

diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index f906fa7a7b..b954bcec67 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -9,6 +9,7 @@ depot.nix.buildLisp.program {
     defclass-std
     easy-routes
     hunchentoot
+    lass
     local-time
     trivial-ldap
 
@@ -16,6 +17,9 @@ depot.nix.buildLisp.program {
   ];
 
   srcs = [
+    ./panettone.asd
+    ./src/packages.lisp
+    ./src/css.lisp
     ./src/panettone.lisp
   ];
 }
diff --git a/web/panettone/panettone.asd b/web/panettone/panettone.asd
new file mode 100644
index 0000000000..4d44e50fd3
--- /dev/null
+++ b/web/panettone/panettone.asd
@@ -0,0 +1,6 @@
+(asdf:defsystem "panettone"
+  :description "A simple issue tracker"
+  :serial t
+  :components ((:file "packages")
+               (:file "css")
+               (:file "pannetone")))
diff --git a/web/panettone/src/css.lisp b/web/panettone/src/css.lisp
new file mode 100644
index 0000000000..f20ddf1dd4
--- /dev/null
+++ b/web/panettone/src/css.lisp
@@ -0,0 +1,120 @@
+(in-package :panettone.css)
+(declaim (optimize (safety 3)))
+
+(defparameter color/black
+  "rgb(24, 24, 24)")
+
+(defparameter color/gray
+  "#8D8D8D")
+
+(defparameter color/primary
+  "rgb(106, 154, 255)")
+
+(defparameter color/primary-light
+  "rgb(150, 166, 200)")
+
+(defparameter color/success
+  "rgb(168, 249, 166)")
+
+(defparameter color/success-2
+  "rgb(168, 249, 166)")
+
+(defun button (selector)
+  `((,selector
+     :background-color ,color/success
+     :padding "0.5rem"
+     :text-decoration "none"
+     :transition "box-shadow" "0.15s" "ease-in-out")
+
+    ((:and ,selector :hover)
+     :box-shadow "0.25rem" "0.25rem" "0" "0" "rgba(0,0,0,0.08)")
+
+    ((:and ,selector (:or :active :focus))
+     :box-shadow "0.1rem" "0.1rem" "0" "0" "rgba(0,0,0,0.05)"
+     :outline "none"
+     :border "none"
+     :background-color ,color/success-2)))
+
+(defparameter issue-list-styles
+  `((.issue-list
+     :list-style-type "none"
+     :padding-left 0
+
+     (.issue-subject
+      :font-weight "bold")
+
+     (li
+      :padding-bottom "1rem")
+
+     ((li + li)
+      :border-top "1px" "solid" ,color/gray)
+
+     (a
+      :text-decoration "none"
+      :display "block")
+
+     ((:and a :hover)
+      :outline "none"
+
+      (.issue-subject
+       :color ,color/primary)))))
+
+(defparameter form-styles
+  `(((:or (:and input (:or (:= type "text")
+                           (:= type "password")))
+          textarea)
+     :width "100%"
+     :padding "0.5rem"
+     :outline "none"
+     :border-top "none"
+     :border-left "none"
+     :border-right "none"
+     :border-bottom "1px" "solid" ,color/gray
+     :margin-bottom "1rem")
+
+    (textarea
+     :resize "vertical")
+
+    ((:and input (:= type "submit"))
+     :-webkit-appearance "none"
+     :border "none"
+     :cursor "pointer")
+
+    ,@(button '(:and input (:= type "submit")))))
+
+(defparameter styles
+  `(,@form-styles
+    ,@issue-list-styles
+
+    (body
+     :font-family "sans-serif"
+     :color ,color/black)
+
+    (a :color "inherit")
+
+    (.content
+     :width "800px"
+     :margin "0 auto")
+
+    (header
+     :display "flex"
+     :align-items "center"
+     :border-bottom "1px" "solid" ,color/black
+     :margin-bottom "1rem"
+
+     (h1
+      :padding 0
+      :flex 1)
+
+     (.issue-number
+      :color ,color/gray
+      :font-size "1.5rem"))
+
+    ,@(button '.new-issue)
+
+    (.login-form
+     :width "300px"
+     :margin "0 auto")
+
+    (.created-by-at
+     :color ,color/gray)))
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
new file mode 100644
index 0000000000..8ebf528cca
--- /dev/null
+++ b/web/panettone/src/packages.lisp
@@ -0,0 +1,10 @@
+(defpackage panettone.css
+  (:use :cl :lass)
+  (:export :styles))
+
+(defpackage panettone
+  (:use :cl :klatre :easy-routes)
+  (:import-from :cl-prevalence :get-id)
+  (:import-from :defclass-std :defclass/std)
+  (:import-from :alexandria :if-let :when-let)
+  (:export :start-pannetone :config :main))
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index b8199034e1..288f278f12 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -1,11 +1,4 @@
-(defpackage panettone
-  (:use :cl :klatre :easy-routes)
-  (:import-from :defclass-std :defclass/std)
-  (:import-from :alexandria :if-let)
-  (:shadowing-import-from :alexandria :when-let)
-  (:export :start-panettone :main))
 (in-package :panettone)
-
 (declaim (optimize (safety 3)))
 
 ;;;
@@ -170,67 +163,100 @@ updated issue"
 (defmacro render (&body body)
   `(who:with-html-output-to-string (*standard-output* nil :prologue t)
      (:head
-      (:title (who:esc *title*)))
-     (:body ,@body)))
+      (:title (who:esc *title*))
+      (:link :rel "stylesheet" :type "text/css" :href "/main.css"))
+     (:body
+      (:div :class "content"
+            ,@body))))
 
 (defun render/login (&optional message)
   (render
-    (:h1 "Login")
-    (when message
-      (who:htm (:div.alert (who:esc message))))
-    (:form
-     :method :post :action "/login"
-     (:div
-      (:label :for "username"
-              "Username")
-      (:input :type "text"
-              :name "username"
-              :id "username"
-              :placeholder "username"))
-     (:div
-      (:label :for "password"
-              "Password")
-      (:input :type "password"
-              :name "password"
-              :id "password"
-              :placeholder "password"))
-     (:input :type "submit"
-             :value "Submit"))))
+    (:div
+     :class "login-form"
+     (:header
+      (:h1 "Login"))
+     (:main
+      :class "login-form"
+      (when message
+        (who:htm (:div :class "alert" (who:esc message))))
+      (:form
+       :method :post :action "/login"
+       (:div
+        (:label :for "username"
+                "Username")
+        (:input :type "text"
+                :name "username"
+                :id "username"
+                :placeholder "username"))
+       (:div
+        (:label :for "password"
+                "Password")
+        (:input :type "password"
+                :name "password"
+                :id "password"
+                :placeholder "password"))
+       (:input :type "submit"
+               :value "Submit"))))))
+
+(defun created-by-at (issue)
+  (who:with-html-output (*standard-output*)
+    (:span :class "created-by-at"
+           "Opened by "
+           (:span :class "username"
+                  (who:esc
+                   (or
+                    (when-let ((author (author issue)))
+                      (displayname author))
+                    "someone")))
+           " at "
+           (:span :class "timestamp"
+                  (who:esc
+                   (format-dottime (created-at issue)))))))
 
 (defun render/index (&key issues)
   (render
-    (:h1 "Issues")
-    (:a :href "/issues/new" "New Issue")
-    (:ul
-     (loop for issue in issues
-           do (who:htm
-               (:li
-                (:a :href (format nil "/issues/~A" (cl-prevalence:get-id issue))
-                    (who:esc (subject issue)))))))))
+    (:header
+     (:h1 "Issues")
+     (:a
+      :class "new-issue"
+      :href "/issues/new" "New Issue"))
+    (:main
+     (:ol
+      :class "issue-list"
+      (dolist (issue issues)
+        (let ((issue-id (get-id issue)))
+          (who:htm
+           (:li
+            (:a :href (format nil "/issues/~A" issue-id)
+                (:p
+                 (:span :class "issue-subject"
+                        (who:esc (subject issue))))
+                (:span :class "issue-number"
+                       (who:esc (format nil "#~A" issue-id)))
+                " - "
+                (created-by-at issue))))))))))
 
 (defun render/new-issue ()
   (render
-    (:h1 "New Issue")
-    (:form
-     :method :post :action "/issues"
-     (:div
-      (:label :for "subject" "Subject")
-      (:input :type :text
-              :id "subject"
-              :name "subject"
-              :placeholder "Subject"))
-
-     (:div
-      (:textarea :name "body"))
-
-     (:input :type :submit
-             :value "Create Issue"))))
-
-(defun created-by-at (issue)
-  (format nil "Opened by ~A at ~A"
-          (when-let ((author (author issue)))
-            (displayname author))
-          (format-dottime (created-at issue))))
+    (:header
+     (:h1 "New Issue"))
+    (:main
+     (:form :method "post"
+            :action "/issues"
+            :class "issue-form"
+            (:div
+             (:input :type "text"
+                     :id "subject"
+                     :name "subject"
+                     :placeholder "Subject"))
+
+            (:div
+             (:textarea :name "body"
+                        :placeholder "Description"
+                        :rows 10))
+
+            (:input :type "submit"
+                    :value "Create Issue")))))
 
 (comment
  (format nil "foo: ~A" "foo")
@@ -239,9 +265,13 @@ updated issue"
 (defun render/issue (issue)
   (check-type issue issue)
   (render
-    (:h1 (who:esc (subject issue)))
-    (:p (who:esc (created-by-at issue)))
-    (:p (who:esc (body issue)))))
+    (:header
+     (:h1 (who:esc (subject issue)))
+     (:div :class "issue-number"
+           (who:esc (format nil "#~A" (get-id issue)))))
+    (:main
+     (:p (created-by-at issue))
+     (:p (who:esc (body issue))))))
 
 (defun render/not-found (entity-type)
   (render
@@ -296,6 +326,10 @@ updated issue"
     (issue-not-found (_)
       (render/not-found "Issue"))))
 
+(defroute styles ("/main.css") ()
+  (setf (hunchentoot:content-type*) "text/css")
+  (apply #'lass:compile-and-write panettone.css:styles))
+
 (defvar *acceptor* nil
   "Hunchentoot acceptor for Panettone's web server.")