summaryrefslogtreecommitdiff
path: root/Biz/Devalloc.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Devalloc.hs')
-rw-r--r--Biz/Devalloc.hs97
1 files changed, 75 insertions, 22 deletions
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index f2e514d..3584104 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -54,7 +54,7 @@ import Biz.Test ((@=?))
import qualified Biz.Test as Test
import qualified CMark as Cmark
import qualified CMark.Lucid as Cmark
-import Clay (em, px, rem)
+import Clay (em, px, rem, sec, (?))
import qualified Clay
import qualified Control.Exception as Exception
import Crypto.JOSE.JWK (JWK)
@@ -453,47 +453,95 @@ htmlApp cooks kp cfg jwk oAuthArgs =
let yellow = "#ffe000"
let black = "#1d2d35" -- really a dark blue
Biz.Look.fuckingStyle
+
Biz.Look.whenDark <| do
- "body" Clay.? do
+ "body" ? do
Clay.backgroundColor black
+
+ "a:link" <> "a:visited" ? do
+ Clay.textDecorationColor Clay.white
+ Clay.color Clay.white
+ "a:hover" ? do
+ Clay.textDecorationColor yellow
+
Biz.Look.whenLight <| do
- "body" Clay.? do
+ "body" ? do
+ Clay.color black
+ "a:link" <> "a:visited" ? do
+ Clay.textDecorationColor black
Clay.color black
- "body" Clay.? Biz.Look.fontStack
- "nav" Clay.? do
+ "a:hover" ? do
+ Clay.textDecorationColor yellow
+
+ "body" ? Biz.Look.fontStack
+ -- "a:link" <> "a:visited" <> "a:hover"
+ "a" ? do
+ Clay.transition "all" (sec 0.2) Clay.ease 0
+ Clay.transitionProperties
+ [ "text-decoration-color",
+ "text-decoration-thickness",
+ "text-decoration-width"
+ ]
+ Clay.textDecoration Clay.underline
+ Biz.Look.textDecorationThickness (em 0.1)
+ Biz.Look.textDecorationWidth (em 0.1)
+ "a:hover" ? do
+ Clay.textDecorationColor yellow
+ Clay.textDecoration Clay.underline
+ Biz.Look.textDecorationThickness (em 0.2)
+ Biz.Look.textDecorationWidth (em 0.2)
+ "nav" ? do
Clay.display Clay.flex
Clay.justifyContent Clay.spaceBetween
- "nav > ul" Clay.? do
+ "nav > ul" ? do
Clay.display Clay.flex
Clay.justifyContent Clay.flexEnd
- Clay.listStyleType <| Clay.none
+ Clay.listStyleType Clay.none
Clay.margin (Clay.px 0) 0 0 0
- "nav > ul > li" Clay.? do
+ "nav > ul > li" ? do
Clay.padding 0 (px 5) 0 (px 5)
- "#home" Clay.? do
- "h1" Clay.? do
+
+ "#home" ? do
+ Clay.textAlign Clay.center
+ "h1" ? do
Clay.fontSize (Clay.rem 3)
- "h1, h2" Clay.? do
+ "h1, h2" ? do
Clay.textAlign Clay.center
- "section" Clay.? do
+ "section" ? do
Clay.padding (rem 3) 0 (rem 3) 0
- "a#try-button" <> "a#try-button:visited" Clay.? do
+ "a#try-button" <> "a#try-button:visited" ? do
+ Clay.transition "all" (sec 0.2) Clay.ease 0
+ Clay.transitionProperties
+ ["color", "background-color", "border-color"]
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.borderWidth (px 1)
+ Clay.borderStyle Clay.solid
+ Clay.borderColor black
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
+ "small" ? do
Clay.fontSize (px 10)
- "a#try-button:hover" Clay.? do
+ "a#try-button:hover" ? do
+ Clay.borderColor yellow
Clay.color yellow
Clay.backgroundColor black
+
+ "#selectRepo" ? do
+ "ul" ? do
+ Clay.listStyleType Clay.none
+ "li" ? do
+ Clay.borderBottomWidth (px 1)
+ Clay.borderBottomColor "#999" -- TODO: more subtle gradient?
+ Clay.borderBottomStyle Clay.solid
+ Clay.padding (em 1.5) 0 (em 1.5) 0
}
-- | The front page pitch. Eventually I'd like to load the content from markdown
@@ -625,20 +673,25 @@ instance Lucid.ToHtml SelectRepo where
toHtmlRaw = Lucid.toHtml
toHtml (SelectRepo user repos) = do
Lucid.header_ <| Lucid.toHtml <. nav <| Just user
- Lucid.main_ <| do
+ Lucid.main_ [Lucid.id_ "selectRepo"] <| do
Lucid.h2_ "Select a repo to analyze"
- Lucid.ul_ <| forM_ (Vector.toList repos) <| \repo ->
- Lucid.li_
- <. Lucid.a_
+ Lucid.ul_ <| Lucid.toHtml <| mapM_ displayRepo (Vector.toList repos)
+ where
+ displayRepo :: GitHub.Repo -> Lucid.Html ()
+ displayRepo repo =
+ Lucid.li_ <| do
+ 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
+ <. Lucid.h3_
+ <. Lucid.toHtml
+ <. GitHub.untagName
+ <| GitHub.repoName repo
+ maybe mempty (Lucid.p_ <. Lucid.toHtml) (GitHub.repoDescription repo)
-- * parts