From 3a50aed59be0ca480febe4da2ea0d0d035ed639a Mon Sep 17 00:00:00 2001 From: sabadev Date: Thu, 25 Mar 2021 21:41:41 -0400 Subject: [PATCH] Added some more sophisticated styling. --- src/CssContentType.hs | 2 +- src/StyleSheet.hs | 53 +++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 52 insertions(+), 3 deletions(-) diff --git a/src/CssContentType.hs b/src/CssContentType.hs index 92018d8..0bcf3ad 100644 --- a/src/CssContentType.hs +++ b/src/CssContentType.hs @@ -11,4 +11,4 @@ instance Accept CSS where contentType _ = "text" // "css" /: ("charset", "utf-8") instance MimeRender CSS (C.Css) where - mimeRender _ val = encodeUtf8 $ C.render val + mimeRender _ val = encodeUtf8 $ C.renderWith C.compact [] val diff --git a/src/StyleSheet.hs b/src/StyleSheet.hs index 90b32ed..2683ae6 100644 --- a/src/StyleSheet.hs +++ b/src/StyleSheet.hs @@ -1,6 +1,8 @@ module StyleSheet where import Clay +import Data.Monoid +import Prelude hiding (rem) type ColorAction = Float -> Color -> Color @@ -12,14 +14,61 @@ lightStyle = makeStyle darken makeStyle :: ColorAction -> Color -> Css makeStyle colorAction themeColor = do + html ? maxWidth (pct 100) bodyStyle colorAction themeColor + paragraphStyle + codeStyle + headerStyle linkStyle colorAction themeColor bodyStyle :: ColorAction -> Color -> Css bodyStyle action themeColor = body ? do backgroundColor themeColor fontColor $ action 0.75 themeColor + fontFamily ["Helvetica"] [sansSerif] + fontWeight $ weight 300 + margin (px 0) auto auto auto + maxWidth $ rem 48 + padding (rem 0.25) (rem 0.25) (rem 0.25) (rem 0.25) + fontSize $ px 16 + +paragraphStyle :: Css +paragraphStyle = p ? do + fontSize $ rem 1 + marginBottom $ rem 1.3 linkStyle :: ColorAction -> Color -> Css -linkStyle action themeColor = a ? do - fontColor $ action 0.60 $ themeColor +. 0x40 +linkStyle action themeColor = do + let regularColor = fontColor $ action 0.60 $ themeColor +. 0x40 + let visitedColor = fontColor $ action 0.60 $ themeColor -. 0x40 + let highlightedColor = fontColor $ action 0.75 $ themeColor +. 0x50 + a ? regularColor + a # visited ? visitedColor + a # hover ? highlightedColor + a # focus ? highlightedColor + a # active ? highlightedColor + +headerStyle :: Css +headerStyle = do + h1 ? fontSize (rem 3.998) + h2 ? fontSize (rem 2.827) + h3 ? fontSize (rem 1.999) + h4 ? fontSize (rem 1.414) + h5 ? fontSize (rem 1.121) + h6 ? fontSize (rem 0.88) + small ? fontSize (em 0.707) + h1 ? largeHeaderStyle + h2 ? largeHeaderStyle + h3 ? largeHeaderStyle + where + largeHeaderStyle = do + margin (rem 1.414) (rem 0) (rem 0.5) (rem 0) + paddingBottom $ rem 0.5 + textAlign center + +codeStyle :: Css +codeStyle = do + (pre <> code) ? fontFamily ["Courier New"] [monospace] + pre ? do + padding (rem 0.5) (rem 0.5) (rem 0.5) (rem 0.5) + overflowX scroll -- 2.20.1