diff options
| -rw-r--r-- | Biz/Devalloc.hs | 98 | ||||
| -rw-r--r-- | Biz/Look.hs | 8 |
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 |