Header integration.

Responsive large profile header, still needs more styling and nav, but
functional.

app/Main.hs

@@ -51,3 +51,7 @@ main = hakyll $ do
   create [cssHash] $ do
     route $ constRoute "css/default.css"
     compile css
+
+  match "assets/img/*" $ do
+    route idRoute
+    compile copyFileCompiler

etienne-moqueur.cabal

@@ -23,22 +23,29 @@ library
       Core.Render
       Core.Routers
       Css.Default
+      Info
       Kit.Atoms.BreakpointQueries
       Kit.Atoms.Button
       Kit.Atoms.ButtonLink
       Kit.Atoms.Container
       Kit.Atoms.Fonts
       Kit.Atoms.Header
+      Kit.Atoms.Image
       Kit.Atoms.Stylesheet
       Kit.Atoms.Typography
       Kit.Constants.Breakpoints
       Kit.Constants.Colors
       Kit.Constants.Spacing
       Kit.Molecules.DefaultCss
+      Kit.Molecules.ProfileBio
+      Kit.Molecules.ProfileContent
+      Kit.Molecules.ProfilePic
       Kit.Organisms.Head
+      Kit.Organisms.ProfileHeader
       Kit.Templates.Index
       Kit.Templates.Post
       Routes
+      Utils.Clay
   other-modules:
       Paths_etienne_moqueur
   hs-source-dirs:

src/Core/Components.hs

@@ -1,6 +1,8 @@
 module Core.Components
-  ( Component(..)
+  ( Html
+  , Component(..)
   , new
+  , (<.>)
   ) where
 
 import           Clay                           ( Css(..)
@@ -27,3 +29,6 @@ new name css html = do
   cssMap <- get
   put (Map.insert name css cssMap)
   return html
+
+(<.>) :: Applicative f => f (b -> c) -> f (a -> b) -> f (a -> c)
+(<.>) = (<*>) . ((.) <$>)

src/Info.hs

@@ -0,0 +1,17 @@
+module Info
+  ( author
+  , description
+  , bio
+  , mail
+  ) where
+
+author, description, bio, mail :: String
+
+author = "Etienne Werly"
+
+description = "My personal website"
+
+bio =
+  "Self taught in computer science, using Linux since 2013 and self hosting since 2020, I am taking a new turn to web development after a start as a mathematics teacher."
+
+mail = "etienne@moqueur.chat"

src/Kit/Atoms/ButtonLink.hs

@@ -9,6 +9,7 @@ import           Kit.Constants.Colors
 import           Routes
 import           Text.Blaze.Html5              as H
 import           Text.Blaze.Html5.Attributes   as A
+import           Utils.Clay
 
 -- |Create a link with a button shape. Takes the route and inner content as arguments.
 buttonLinkHtml :: Route -> Html -> Html
@@ -20,7 +21,7 @@ css = C.a # byClass "button" ? do
   padding (C.em 0.35) (C.em 1.2) (C.em 0.35) (C.em 1.2)
   border (C.em 0.1) solid (grays @ 60)
   margin (C.em 0) (C.em 0.3) (C.em 0.3) (C.em 0)
-  borderRadius (pct 4) (pct 4) (pct 4) (pct 4)
+  uniform borderRadius (pct 4)
   boxSizing borderBox
   textDecoration none
   textAlign center
@@ -30,6 +31,5 @@ css = C.a # byClass "button" ? do
     color (grays @ 100)
     backgroundColor (grays @ 70)
 
-
 buttonLink :: Route -> Html -> Component Html
 buttonLink ref = new "buttonLink" css . buttonLinkHtml ref

src/Kit/Atoms/Header.hs

@@ -1,17 +1,23 @@
 module Kit.Atoms.Header
-  ( Kit.Atoms.Header.header
+  ( header'
   ) where
 
 import           Clay                          as C
 import           Core.Components
+import           Kit.Atoms.BreakpointQueries
 import           Kit.Constants.Colors
+import           Kit.Constants.Spacing
 import           Text.Blaze.Html5              as H
+import           Utils.Clay
 
 css :: Css
 css = C.header ? do
-  paddingTop <> paddingBottom $ px 30
-  backgroundColor $ grays @ 90
-  borderTop (px 10) solid (primary @ 20)
+  paddingTop <> paddingBottom $ huge
+  backgroundColor $ primary @ 90
+  borderTop regular solid (primary @ 30)
+  textAlign center
+  breakpointM $ textAlign start
 
-header :: Component (Html -> Html)
-header = new "header" css H.header
+
+header' :: Component (Html -> Html)
+header' = new "header" css H.header

src/Kit/Atoms/Image.hs

@@ -0,0 +1,47 @@
+module Kit.Atoms.Image
+  ( Shape(..)
+  , img'
+  , imgWithShape
+  ) where
+
+import           Clay                          as C
+import           Core.Components
+import           Routes
+import           Text.Blaze.Html5              as H
+import           Text.Blaze.Html5.Attributes   as A
+import           Utils.Clay
+
+data Shape = Square | Circle | Rounded | Drop
+
+
+baseCss :: Css
+baseCss = C.img ? do
+  maxWidth (pct 100)
+
+img' :: FilePath -> String -> Component Html
+img' file description =
+  new "img" baseCss
+    $   H.img
+    H.! A.src (stringValue . path . Img $ file)
+    H.! A.alt (stringValue description)
+
+
+imgWithShape :: Shape -> FilePath -> String -> Component Html
+imgWithShape Square file description = img' file description
+imgWithShape Circle file description =
+  new "img circle"
+      (C.img # byClass "circle" ? uniform borderRadius (pct 50))
+      (H.! class_ "circle")
+    <*> img' file description
+imgWithShape Rounded file description =
+  new "img rounded"
+      (C.img # byClass "rounded" ? uniform borderRadius (pct 10))
+      (H.! class_ "rounded")
+    <*> img' file description
+imgWithShape Drop file description =
+  new
+      "img drop"
+      (C.img # byClass "drop" ? borderRadius (pct 50) (pct 50) (pct 50) (pct 10)
+      )
+      (H.! class_ "drop")
+    <*> img' file description

src/Kit/Molecules/ProfileBio.hs

@@ -0,0 +1,24 @@
+module Kit.Molecules.ProfileBio
+  ( profileBio
+  ) where
+
+import           Clay                          as C
+import           Core.Components
+import           Kit.Atoms.BreakpointQueries
+import           Kit.Constants.Colors
+import           Text.Blaze.Html5              as H
+import           Text.Blaze.Html5.Attributes   as A
+
+css :: Css
+css = byClass "profile-bio" & do
+  float none
+  C.width (pct 100)
+  textAlign center
+  color $ grays @ 50
+  breakpointM $ do
+    display inlineBlock
+    C.width (C.em 20)
+
+profileBio :: String -> Component Html
+profileBio bio =
+  new "profileBio" css $ H.div H.! class_ "profile-bio" $ H.p (toHtml bio)

src/Kit/Molecules/ProfileContent.hs

@@ -0,0 +1,25 @@
+module Kit.Molecules.ProfileContent
+  ( profileContent
+  ) where
+
+import           Clay                          as C
+import           Core.Components
+import           Kit.Constants.Colors
+import           Text.Blaze.Html5              as H
+import           Text.Blaze.Html5.Attributes   as A
+
+css :: Css
+css = byClass "profile-content" & do
+  display inlineBlock
+  marginRight (px 30)
+  C.hgroup ? do
+    borderLeft (px 10) solid $ secondary @ 50
+
+profileContent :: String -> String -> Component Html
+profileContent auth desc =
+  new "profileContent" css
+    $   H.div
+    H.! class_ "profile-content"
+    $   H.hgroup
+    $   H.h1 (toHtml auth)
+    <>  H.p (toHtml desc)

src/Kit/Molecules/ProfilePic.hs

@@ -0,0 +1,25 @@
+module Kit.Molecules.ProfilePic
+  ( profilePic
+  ) where
+
+import           Clay                          as C
+import           Core.Components
+import           Kit.Atoms.BreakpointQueries
+import           Kit.Atoms.Image
+import           Text.Blaze.Html5              as H
+import           Text.Blaze.Html5.Attributes   as A
+
+css :: Css
+css = byClass "profile-pic" & do
+  C.width (px 180)
+  float none
+  margin nil auto nil auto
+  breakpointM $ do
+    float floatLeft
+    marginRight (px 30)
+    display block
+
+profilePic :: FilePath -> String -> Component Html
+profilePic file altText =
+  new "profilePic" css (H.div H.! class_ "profile-pic")
+    <*> imgWithShape Rounded file altText

src/Kit/Organisms/ProfileHeader.hs

@@ -0,0 +1,18 @@
+module Kit.Organisms.ProfileHeader where
+
+import           Core.Components
+import           Info
+import           Kit.Atoms.Container
+import           Kit.Atoms.Header
+import           Kit.Molecules.ProfileBio
+import           Kit.Molecules.ProfileContent
+import           Kit.Molecules.ProfilePic
+import           Text.Blaze.Html5              as H
+import           Text.Blaze.Html5.Attributes   as A
+
+profileHeader :: Component Html
+profileHeader = header' <.> container <*> mconcat
+  [ profilePic "avatar.smol.png" "my face"
+  , profileContent author description
+  , profileBio bio
+  ]

src/Kit/Templates/Index.hs

@@ -7,19 +7,16 @@ import           Core.Components
 import           Core.Render                    ( putHtml )
 import           Kit.Atoms.Button
 import           Kit.Atoms.ButtonLink
-import           Kit.Atoms.Container
-import           Kit.Atoms.Header              as K
 import           Kit.Organisms.Head
+import           Kit.Organisms.ProfileHeader
 import           Routes
 import           Text.Blaze.Html5              as H
                                          hiding ( main )
+import           Text.Blaze.Html5.Attributes   as A
 
 indexBody :: Component Html
-indexBody = mconcat
-  [ K.header <*> (container <*> pure (h1 "My site"))
-  , buttonWithText "Click!"
-  , buttonLink Blog "All posts"
-  ]
+indexBody =
+  mconcat [profileHeader, buttonWithText "Click!", buttonLink Blog "All posts"]
 
 indexTemplate :: Component Html
 indexTemplate =

src/Routes.hs

@@ -7,16 +7,18 @@ import           GHC.Exts                       ( IsString(..) )
 
 data Route = Home
             | Blog
-            | DefaultStylesheet
             | Post String
+            | Img String
+            | DefaultStylesheet
             | ExternalRoute String
 
 instance IsString Route where
   fromString = ExternalRoute
 
 path :: Route -> String
-path Home                   = "/"
-path Blog                   = "/posts"
-path DefaultStylesheet      = "/css/default.css"
-path (Post          postId) = "/posts/" <> postId
-path (ExternalRoute addr  ) = addr
+path Home                 = "/"
+path Blog                 = "/posts"
+path (Post postId  )      = "/posts/" <> postId
+path (Img  fileName)      = "/assets/img/" <> fileName
+path DefaultStylesheet    = "/css/default.css"
+path (ExternalRoute addr) = addr

src/Utils/Clay.hs

@@ -0,0 +1,10 @@
+module Utils.Clay
+  ( uniform
+  ) where
+
+import           Clay
+import           Control.Monad                  ( join )
+
+-- |Takes a function with signature a -> a -> a -> a -> b and makes it signature a -> b with the argument repeated 4 times.
+uniform :: (a -> a -> a -> a -> b) -> (a -> b)
+uniform = join . join . join