Fix colors and structure HTML better

My qutebrowser dark filter messed up my colors. Also now I'm using  header and
main HTML elements.

2 files changed, 62 insertions, 44 deletions

diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index aa61975..f2e514d 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -450,7 +450,15 @@ htmlApp cooks kp cfg jwk oAuthArgs =
             .> pure,
       css =
         return <. toStrict <. Clay.render <| do
+          let yellow = "#ffe000"
+          let black = "#1d2d35" -- really a dark blue
           Biz.Look.fuckingStyle
+          Biz.Look.whenDark <| do
+            "body" Clay.? do
+              Clay.backgroundColor black
+          Biz.Look.whenLight <| do
+            "body" Clay.? do
+              Clay.color black
           "body" Clay.? Biz.Look.fontStack
           "nav" Clay.? do
             Clay.display Clay.flex
@@ -469,19 +477,23 @@ htmlApp cooks kp cfg jwk oAuthArgs =
               Clay.textAlign Clay.center
             "section" Clay.? do
               Clay.padding (rem 3) 0 (rem 3) 0
-            "#try-button" Clay.? do
+            "a#try-button" <> "a#try-button:visited" Clay.? do
               Clay.padding (em 0.5) (em 1) (em 0.5) (em 1)
               Clay.display Clay.flex
               Clay.flexDirection Clay.column
               Clay.margin (em 3) Clay.auto 0 Clay.auto
               Clay.width (px 250)
-              Clay.backgroundColor "#ffe000"
+              Clay.backgroundColor yellow
+              Clay.color black
               Clay.textDecoration Clay.none
               Clay.justifyContent Clay.center
               Clay.alignItems Clay.center
               Clay.fontWeight Clay.bold
               "small" Clay.? do
                 Clay.fontSize (px 10)
+            "a#try-button:hover" Clay.? do
+              Clay.color yellow
+              Clay.backgroundColor black
     }
 
 -- | The front page pitch. Eventually I'd like to load the content from markdown
@@ -497,7 +509,7 @@ instance Lucid.ToHtml Home where
         h1 "Know your codebase."
         h1 "Know your team."
         p "Devalloc analyzes your codebase trends, finds patterns in how your developers work, and protects against tech debt."
-        p "Just hook it up to your CI system - it will warn you when it finds a problem."
+        p "Just hook it up to your CI system - Devalloc warns you when it finds a problem."
         Lucid.toHtml <| tryButton oAuthArgs
       section <| do
         h2 "Identify blackholes in your codebase"
@@ -532,12 +544,13 @@ newtype UserHome = UserHome User
 instance Lucid.ToHtml UserHome where
   toHtmlRaw = Lucid.toHtml
   toHtml (UserHome user) = do
-    Lucid.toHtml <| nav <| Just user
-    Lucid.h1_ <. Lucid.toHtml <| "Welcome, " <> email <> "!"
-    Lucid.p_
-      <| Lucid.a_
-        [Lucid.linkHref_ "/" <| fieldLink selectRepo]
-        "Analyze one of your repos"
+    Lucid.header_ <| Lucid.toHtml <| nav <| Just user
+    Lucid.main_ <| do
+      Lucid.h1_ <. Lucid.toHtml <| "Welcome, " <> email <> "!"
+      Lucid.p_
+        <| Lucid.a_
+          [Lucid.linkHref_ "/" <| fieldLink selectRepo]
+          "Analyze one of your repos"
     where
       UserEmail email = userEmail user
 
@@ -611,23 +624,21 @@ data SelectRepo = SelectRepo User (Vector GitHub.Repo)
 instance Lucid.ToHtml SelectRepo where
   toHtmlRaw = Lucid.toHtml
   toHtml (SelectRepo user repos) = do
-    Lucid.toHtml <. nav <| Just user
-    Lucid.h1_ <. Lucid.toHtml <| "Welcome, " <> email <> "!"
-    Lucid.h2_ "Select a repo to analyze"
-    Lucid.ul_ <| forM_ (Vector.toList repos) <| \repo ->
-      Lucid.li_
-        <. Lucid.a_
-          [ Lucid.linkHref_ "/"
-              <| fieldLink
-                githubAnalysis
-                (GitHub.untagName <| GitHub.simpleOwnerLogin <| GitHub.repoOwner repo)
-                (GitHub.untagName <| GitHub.repoName repo)
-          ]
-        <. Lucid.toHtml
-        <. GitHub.untagName
-        <| GitHub.repoName repo
-    where
-      UserEmail email = userEmail user
+    Lucid.header_ <| Lucid.toHtml <. nav <| Just user
+    Lucid.main_ <| do
+      Lucid.h2_ "Select a repo to analyze"
+      Lucid.ul_ <| forM_ (Vector.toList repos) <| \repo ->
+        Lucid.li_
+          <. Lucid.a_
+            [ Lucid.linkHref_ "/"
+                <| fieldLink
+                  githubAnalysis
+                  (GitHub.untagName <| GitHub.simpleOwnerLogin <| GitHub.repoOwner repo)
+                  (GitHub.untagName <| GitHub.repoName repo)
+            ]
+          <. Lucid.toHtml
+          <. GitHub.untagName
+          <| GitHub.repoName repo
 
 -- * parts
 
@@ -679,8 +690,8 @@ data AnalysisDisplay = AnalysisDisplay User Analysis
 instance Lucid.ToHtml AnalysisDisplay where
   toHtmlRaw = Lucid.toHtml
   toHtml (AnalysisDisplay user anal) = do
-    Lucid.toHtml <. nav <| Just user
-    Lucid.toHtml anal
+    Lucid.header_ <| Lucid.toHtml <. nav <| Just user
+    Lucid.main_ <| Lucid.toHtml anal
 
 -- | The result of analyzing a git repo.
 data Analysis = Analysis
@@ -706,22 +717,21 @@ instance Lucid.ToHtml Analysis where
   toHtml = render .> Lucid.toHtml
     where
       render :: Analysis -> Lucid.Html ()
-      render Analysis {..} =
-        Lucid.div_ <| do
-          Lucid.h1_ "Analysis Results"
-          Lucid.h3_ "Total score:"
-          Lucid.p_ <| Lucid.toHtml <| Text.pack <| show score
-          Lucid.h3_ <| Lucid.toHtml <| "Total files: " <> tshow totalFiles
-          Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen blackholes <> " blackholes:"
-          Lucid.ul_ <| do
-            mapM_ (Lucid.toHtml .> Lucid.li_) blackholes
-          Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen liabilities <> " liabilities:"
-          Lucid.ul_ <| do
-            mapM_ (Lucid.toHtml .> Lucid.li_) liabilities
-          Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen stale <> " stale files:"
-          Lucid.ul_ <| do
-            forM_ stale <| \(path, days) ->
-              Lucid.li_ <| Lucid.toHtml <| path <> " (" <> show days <> " days)"
+      render Analysis {..} = do
+        Lucid.h1_ "Analysis Results"
+        Lucid.h3_ "Total score:"
+        Lucid.p_ <| Lucid.toHtml <| Text.pack <| show score
+        Lucid.h3_ <| Lucid.toHtml <| "Total files: " <> tshow totalFiles
+        Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen blackholes <> " blackholes:"
+        Lucid.ul_ <| do
+          mapM_ (Lucid.toHtml .> Lucid.li_) blackholes
+        Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen liabilities <> " liabilities:"
+        Lucid.ul_ <| do
+          mapM_ (Lucid.toHtml .> Lucid.li_) liabilities
+        Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen stale <> " stale files:"
+        Lucid.ul_ <| do
+          forM_ stale <| \(path, days) ->
+            Lucid.li_ <| Lucid.toHtml <| path <> " (" <> show days <> " days)"
       slen = Text.pack <. show <. length
       tshow = Text.pack <. show
 
diff --git a/Biz/Look.hs b/Biz/Look.hs
index 51224a9..c2ef55e 100644
--- a/Biz/Look.hs
+++ b/Biz/Look.hs
@@ -9,7 +9,9 @@ module Biz.Look
     fuckingStyle,
     -- | Clay.Media extensions
     prefersLight,
+    whenLight,
     prefersDark,
+    whenDark,
     noColorPreference,
     -- | Font
     fontStack,
@@ -59,6 +61,12 @@ noColorPreference =
     "prefers-color-scheme"
     (Just (Clay.value ("no-preference" :: Text)))
 
+whenDark :: Css -> Css
+whenDark = query Clay.all [prefersDark]
+
+whenLight :: Css -> Css
+whenLight = query Clay.all [prefersLight]
+
 -- | The stylesheet from <https://perfectmotherfuckingwebsite.com> ported to
 -- Clay.
 fuckingStyle :: Css