From 1068b16a672419e2cb32f9fca244ac3b9fc6bacd Mon Sep 17 00:00:00 2001 From: etienne Date: Mon, 3 Jul 2023 16:21:46 +0200 Subject: [PATCH] Changed Prop's cssMap from Map String Css to IntMap String. The cssMap now contains the rendered css together with its hash. That way there is no need to give a component a name, and css is rendered along the way and carried as a string. --- app/Main.hs | 6 ++---- src/Components.hs | 26 +++++++++++--------------- src/Kit/Atoms/Button.hs | 2 +- src/Kit/Atoms/ButtonLink.hs | 2 +- src/Kit/Atoms/Container.hs | 2 +- src/Kit/Atoms/Header.hs | 2 +- src/Kit/Atoms/Image.hs | 9 +++------ src/Kit/Atoms/Link.hs | 2 +- src/Kit/Atoms/Section.hs | 4 ++-- src/Kit/Atoms/Stylesheet.hs | 2 +- src/Kit/Molecules/Bricklayer.hs | 2 +- src/Kit/Molecules/CardBody.hs | 2 +- src/Kit/Molecules/CardFooter.hs | 2 +- src/Kit/Molecules/CardHeader.hs | 2 +- src/Kit/Molecules/ProfileBio.hs | 2 +- src/Kit/Molecules/ProfileContent.hs | 2 +- src/Kit/Molecules/ProfilePic.hs | 2 +- src/Kit/Molecules/Tag.hs | 4 ++-- src/Kit/Organisms/Card.hs | 2 +- 19 files changed, 34 insertions(+), 43 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 9b27cd3..5b38b65 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,16 +2,14 @@ module Main ( main ) where -import Data.Hashable +import Data.Hashable ( hash ) import Data.String import Hakyll -import Text.Blaze.Html import Components import Core.Compilers import Core.Render ( ) -import Core.Rules import Routes import Utils.FileTree import Utils.Routes @@ -30,7 +28,7 @@ assets :: [FilePath] assets = map tail . getPaths . getAssets $ resources allCss :: String -allCss = show . getCss $ resources +allCss = getCss resources css :: Compiler (Item String) css = makeItem allCss diff --git a/src/Components.hs b/src/Components.hs index 4bbcff7..67da511 100644 --- a/src/Components.hs +++ b/src/Components.hs @@ -1,6 +1,5 @@ module Components ( Prop(..) - , prop , Component(..) , new , (<.>) @@ -12,21 +11,17 @@ module Components , getAssets ) where -import Clay ( Css - , compact - , renderWith - ) +import Clay ( Css ) +import Core.Render ( ) import Core.Writer -import qualified Data.Map as Map -import Data.Text.Lazy ( unpack ) +import Data.Hashable ( hash ) +import qualified Data.IntMap as Map import Routes -import Text.Blaze.Html -import Text.Blaze.Html.Renderer.String import Utils.FileTree -- |Props are data on top of a component's html. They are aggregated when components are combined. The choice of structures for Prop ensures that there is no duplicate at compile time (e.g. the css of a button used 5 times is only rendered once.) data Prop = Prop - { cssMap :: Map.Map String Css + { cssMap :: Map.IntMap String , assetsTree :: FileTree } @@ -40,11 +35,12 @@ instance Monoid Prop where type Component = Writer Prop -prop :: String -> Css -> Prop -prop name css = Prop (Map.singleton name css) mempty -- |Add a name and css to a Prop. -addCss :: String -> Css -> Component () -addCss name css = tell $ Prop (Map.singleton name css) mempty +addCss :: Css -> Component () +addCss css = tell $ Prop (Map.singleton cssHash cssString) mempty + where + cssString = show css + cssHash = hash cssString -- |Add an asset to the Prop's tree. addAsset :: FilePath -> Component () @@ -58,7 +54,7 @@ getBody :: Component a -> a getBody = fst . runWriter -- |Get a Component's Css -getCss :: Component a -> Css +getCss :: Component a -> String getCss = mconcat . map snd . Map.toList . cssMap . snd . runWriter -- |Get a Component's assets tree diff --git a/src/Kit/Atoms/Button.hs b/src/Kit/Atoms/Button.hs index a3bccf0..6cb190b 100644 --- a/src/Kit/Atoms/Button.hs +++ b/src/Kit/Atoms/Button.hs @@ -15,5 +15,5 @@ css = C.button ? do buttonWithText :: Component (Html -> Html) buttonWithText = do - addCss "buttonWithText" css + addCss css return H.button diff --git a/src/Kit/Atoms/ButtonLink.hs b/src/Kit/Atoms/ButtonLink.hs index 448e736..840add3 100644 --- a/src/Kit/Atoms/ButtonLink.hs +++ b/src/Kit/Atoms/ButtonLink.hs @@ -33,5 +33,5 @@ css = C.a # byClass "button" ? do buttonLink :: Route -> Component (Html -> Html) buttonLink ref = do - addCss "buttonLink" css + addCss css return $ buttonLinkHtml ref diff --git a/src/Kit/Atoms/Container.hs b/src/Kit/Atoms/Container.hs index 00f3ba6..f21bb8b 100644 --- a/src/Kit/Atoms/Container.hs +++ b/src/Kit/Atoms/Container.hs @@ -14,5 +14,5 @@ css = element ".container" ? do container :: Component (Html -> Html) container = do - addCss "container" css + addCss css return $ H.div H.! class_ "container" diff --git a/src/Kit/Atoms/Header.hs b/src/Kit/Atoms/Header.hs index 8275810..9380533 100644 --- a/src/Kit/Atoms/Header.hs +++ b/src/Kit/Atoms/Header.hs @@ -21,5 +21,5 @@ css = C.header ? do header' :: Component (Html -> Html) header' = do - addCss "header" css + addCss css return H.header diff --git a/src/Kit/Atoms/Image.hs b/src/Kit/Atoms/Image.hs index 91ea1e9..23a082d 100644 --- a/src/Kit/Atoms/Image.hs +++ b/src/Kit/Atoms/Image.hs @@ -20,7 +20,7 @@ baseCss = C.img ? do img' :: FilePath -> String -> Component Html img' file description = do - addCss "img" baseCss + addCss baseCss addAsset' $ Img file return $ H.img H.! A.src (stringValue . path . Img $ file) H.! A.alt (stringValue description) @@ -30,20 +30,17 @@ imgWithShape :: Shape -> FilePath -> String -> Component Html imgWithShape Square file description = img' file description imgWithShape Circle file description = do - addCss "img circle" - (C.img # byClass "circle" ? uniform borderRadius (pct 50)) + addCss (C.img # byClass "circle" ? uniform borderRadius (pct 50)) return (H.! class_ "circle") <*> img' file description imgWithShape Rounded file description = do - addCss "img rounded" - (C.img # byClass "rounded" ? uniform borderRadius (pct 10)) + addCss (C.img # byClass "rounded" ? uniform borderRadius (pct 10)) return (H.! class_ "rounded") <*> img' file description imgWithShape Drop file description = do addCss - "img drop" (C.img # byClass "drop" ? borderRadius (pct 50) (pct 50) (pct 50) (pct 10) ) return (H.! class_ "drop") diff --git a/src/Kit/Atoms/Link.hs b/src/Kit/Atoms/Link.hs index 657f781..a75fad1 100644 --- a/src/Kit/Atoms/Link.hs +++ b/src/Kit/Atoms/Link.hs @@ -20,5 +20,5 @@ css = C.a ? do a' :: Route -> Component (Html -> Html) a' ref = do - addCss "link" css + addCss css return $ H.a H.! A.href (stringValue . path $ ref) diff --git a/src/Kit/Atoms/Section.hs b/src/Kit/Atoms/Section.hs index bc89224..19ed108 100644 --- a/src/Kit/Atoms/Section.hs +++ b/src/Kit/Atoms/Section.hs @@ -22,7 +22,7 @@ css = do section' :: Component (Html -> Html) section' = do - addCss "section" css - return $ H.section + addCss css + return H.section <.> container <.> pure (H.div H.! class_ "section-inner") diff --git a/src/Kit/Atoms/Stylesheet.hs b/src/Kit/Atoms/Stylesheet.hs index 9df42d2..1ea7c00 100644 --- a/src/Kit/Atoms/Stylesheet.hs +++ b/src/Kit/Atoms/Stylesheet.hs @@ -10,5 +10,5 @@ import Text.Blaze.Html5.Attributes stylesheet :: Route -> Css -> Component Html stylesheet route css = do - addCss (path route) css + addCss css return $ link ! rel "stylesheet" ! (href . stringValue . path $ route) diff --git a/src/Kit/Molecules/Bricklayer.hs b/src/Kit/Molecules/Bricklayer.hs index 1cb9fb8..5b6b585 100644 --- a/src/Kit/Molecules/Bricklayer.hs +++ b/src/Kit/Molecules/Bricklayer.hs @@ -21,5 +21,5 @@ css = element ".bricklayer" ? do bricklayer :: Component (Html -> Html) bricklayer = do - addCss "Bricklayer" css + addCss css return $ H.div H.! class_ "bricklayer" diff --git a/src/Kit/Molecules/CardBody.hs b/src/Kit/Molecules/CardBody.hs index f901da0..b2586a3 100644 --- a/src/Kit/Molecules/CardBody.hs +++ b/src/Kit/Molecules/CardBody.hs @@ -10,5 +10,5 @@ import Text.Blaze.Html5.Attributes as A cardBody :: Component (Html -> Html) cardBody = do - addCss "CardBody" (element ".card-body" ? C.width (pct 100)) + addCss (element ".card-body" ? C.width (pct 100)) return $ H.div H.! class_ "card-body" diff --git a/src/Kit/Molecules/CardFooter.hs b/src/Kit/Molecules/CardFooter.hs index ef759a0..67b31a7 100644 --- a/src/Kit/Molecules/CardFooter.hs +++ b/src/Kit/Molecules/CardFooter.hs @@ -19,5 +19,5 @@ css = element ".card-footer" ? do cardFooter :: Component (Html -> Html) cardFooter = do - addCss "CardFooter" css + addCss css return $ (H.div H.! class_ "card-footer") . H.p diff --git a/src/Kit/Molecules/CardHeader.hs b/src/Kit/Molecules/CardHeader.hs index 2b27bc5..1e369da 100644 --- a/src/Kit/Molecules/CardHeader.hs +++ b/src/Kit/Molecules/CardHeader.hs @@ -22,6 +22,6 @@ css = element ".card-header" ? do cardHeader :: Route -> Component (Html -> Html) cardHeader route = do - addCss "CardHeader" css + addCss css return $ H.div H.! class_ "card-header" <.> a' route diff --git a/src/Kit/Molecules/ProfileBio.hs b/src/Kit/Molecules/ProfileBio.hs index 448dfa8..52585b9 100644 --- a/src/Kit/Molecules/ProfileBio.hs +++ b/src/Kit/Molecules/ProfileBio.hs @@ -21,5 +21,5 @@ css = byClass "profile-bio" & do profileBio :: String -> Component Html profileBio bio = do - addCss "profileBio" css + addCss css return $ H.div H.! class_ "profile-bio" $ H.p (toHtml bio) diff --git a/src/Kit/Molecules/ProfileContent.hs b/src/Kit/Molecules/ProfileContent.hs index 476835d..77ee830 100644 --- a/src/Kit/Molecules/ProfileContent.hs +++ b/src/Kit/Molecules/ProfileContent.hs @@ -17,7 +17,7 @@ css = byClass "profile-content" & do profileContent :: String -> String -> Component Html profileContent auth desc = do - addCss "profileContent" css + addCss css return $ H.div H.! class_ "profile-content" diff --git a/src/Kit/Molecules/ProfilePic.hs b/src/Kit/Molecules/ProfilePic.hs index e719fa4..b096eca 100644 --- a/src/Kit/Molecules/ProfilePic.hs +++ b/src/Kit/Molecules/ProfilePic.hs @@ -22,6 +22,6 @@ css = byClass "profile-pic" & do profilePic :: FilePath -> String -> Component Html profilePic file altText = do - addCss "profilePic" css + addCss css return $ H.div H.! class_ "profile-pic" <*> imgWithShape Rounded file altText diff --git a/src/Kit/Molecules/Tag.hs b/src/Kit/Molecules/Tag.hs index 70efae7..176bad4 100644 --- a/src/Kit/Molecules/Tag.hs +++ b/src/Kit/Molecules/Tag.hs @@ -31,12 +31,12 @@ linkCss = C.a # byClass "tag" # hover ? do tagSpan :: String -> Component (Html -> Html) tagSpan tag = do - addCss "tagSpan" css + addCss css return $ H.span H.! class_ "tag" H.! A.id (stringValue tag) tagLink :: Route -> Component (Html -> Html) tagLink ref = do - addCss "tagLink" linkCss + addCss linkCss return (H.! class_ "tag") <.> a' ref diff --git a/src/Kit/Organisms/Card.hs b/src/Kit/Organisms/Card.hs index ecfe447..7fce14a 100644 --- a/src/Kit/Organisms/Card.hs +++ b/src/Kit/Organisms/Card.hs @@ -42,7 +42,7 @@ css = C.article # byClass "card" ? do blogCard :: PostProp -> Component Html blogCard prop = do - addCss "blogCard" css + addCss css return $ H.article H.! class_ "card" <*> mconcat [ cardHeader (postRoute prop) <*> pure (postTitle prop)