diff options
Diffstat (limited to 'Biz/Devalloc.hs')
-rw-r--r-- | Biz/Devalloc.hs | 97 |
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 |