Fully functional nav' :: [(Route, Html)] -> Component Html

Responsive nav (molecule). On screen < M, it shows a hamburger in the
top right which displays a full screen modal nav, and on screen > M it
displays a one-line nav.
This commit is contained in:
Etienne Werly 2023-07-07 22:38:25 +02:00
parent f8d5cfc404
commit dffa10fd93
8 changed files with 127 additions and 15 deletions

View file

@ -31,6 +31,7 @@ library
Kit.Atoms.ButtonLink
Kit.Atoms.Container
Kit.Atoms.Fonts
Kit.Atoms.FullScreenModal
Kit.Atoms.Hamburger
Kit.Atoms.Header
Kit.Atoms.Image
@ -47,6 +48,7 @@ library
Kit.Molecules.CardFooter
Kit.Molecules.CardHeader
Kit.Molecules.DefaultCss
Kit.Molecules.Nav
Kit.Molecules.ProfileBio
Kit.Molecules.ProfileContent
Kit.Molecules.ProfilePic

View file

@ -0,0 +1,31 @@
module Kit.Atoms.FullScreenModal
( fullScreenModal
, showFullScreenModal
, selectFullScreenModal
) where
import Clay as C
import Components
import Data.Text ( pack )
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
fullScreenModal :: String -> Component (Html -> Html)
fullScreenModal id = do
addCss css
addCss cssForId
return $ H.div H.! class_ "full-screen-modal" H.! A.id (stringValue id)
where
css = C.div # byClass "full-screen-modal" ? do
backgroundColor white
position fixed
top <> left $ nil
C.width <> C.height $ pct 100
transition "all" (sec 0.3) easeInOut (sec 0)
cssForId = selectFullScreenModal id ? transform (translate (pct (-150)) nil)
showFullScreenModal :: Css
showFullScreenModal = transform (translate nil nil)
selectFullScreenModal :: String -> Selector
selectFullScreenModal id = C.div # byClass "full-screen-modal" # byId (pack id)

View file

@ -1,4 +1,8 @@
module Kit.Atoms.Hamburger where
module Kit.Atoms.Hamburger
( hamburger
, onHamburgerChecked
, selectHamburger
) where
import Clay as C
import Components
@ -9,9 +13,10 @@ import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import Utils.Clay
hamburger :: Int -> Component Html
hamburger :: String -> Component Html
hamburger id = do
addCss css
addCss cssForId
return $ do
H.input H.! A.type_ "checkbox" H.! A.id hamId
H.label
@ -25,10 +30,8 @@ hamburger id = do
<*> pure mempty
where
hamId = textValue hamId'
hamId' = pack $ "hamburger" <> show id
hamId' = pack $ "hamburger" <> id
css = do
C.input # byId hamId' ? do
display none
byClass "hamburger" & do
C.width <> C.height $ huge
display flex
@ -44,12 +47,18 @@ hamburger id = do
transformOrigin [nil, nil]
byClass "bottom" & do
transformOrigin [nil, pct 100]
cssForId = do
C.input # byId hamId' ? do
display none
onHamburgerChecked id |~ byClass' "hamburger" ? do
C.div ? backgroundColor (secondary @ 50)
byClass' "top" ? transform (rotate (deg 45))
byClass' "bottom" ? transform (rotate (deg (-45)))
byClass' "middle" ? transform (scaleY 0)
onHamburgerChecked :: Int -> Selector
onHamburgerChecked id =
C.input # byId (pack $ "hamburger" <> show id) # C.checked
onHamburgerChecked :: String -> Selector
onHamburgerChecked id = C.input # byId (pack $ "hamburger" <> id) # C.checked
selectHamburger :: String -> Selector
selectHamburger id =
C.label # byClass "hamburger" # ("for" @= pack ("hamburger" <> id))

View file

@ -12,7 +12,7 @@ import Utils.Clay
css :: Css
css = C.header ? do
paddingTop <> paddingBottom $ huge
paddingTop huge
backgroundColor $ primary @ 90
borderTop regular solid (primary @ 30)
textAlign center

59
src/Kit/Molecules/Nav.hs Normal file
View file

@ -0,0 +1,59 @@
module Kit.Molecules.Nav
( nav'
) where
import Clay as C
import Components
import Control.Applicative
import Kit.Atoms.BreakpointQueries
import Kit.Atoms.FullScreenModal
import Kit.Atoms.Hamburger
import Kit.Atoms.Link
import Kit.Constants.Spacing as S
import Routes
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import Utils.Clay
nav' :: [(Route, Html)] -> Component Html
nav' x = do
addCss css
mconcat
[ H.nav H.! class_ "screenM-up" <$> links
, H.div
H.! class_ "mobile-menu"
<$> ( hamburger "MobileMenu"
<> (fullScreenModal "mobile-menu-modal" <*> (H.nav <$> links))
)
]
where
links =
H.ul
. mconcat
<$> (fmap H.li <$> liftA2 (zipWith ($)) (traverse a' routes) (pure names))
routes = fst <$> x
names = snd <$> x
css = do
C.nav ? do
marginTop huge
C.ul ? do
listStyleType none
C.li ? do
uniform padding regular
breakpointM $ display inline
C.div # byClass "mobile-menu" ? do
position absolute
top <> right $ S.large
breakpointM $ display none
onHamburgerChecked "MobileMenu" |~ selectHamburger "MobileMenu" ? do
position fixed
top <> right $ S.large
zIndex 1
onHamburgerChecked "MobileMenu"
|~ selectFullScreenModal "mobile-menu-modal"
? showFullScreenModal
C.nav # byClass "screenM-up" ? do
display none
textAlign end
breakpointM $ do
display inline

View file

@ -4,15 +4,24 @@ import Components
import Info
import Kit.Atoms.Container
import Kit.Atoms.Header
import Kit.Molecules.Nav
import Kit.Molecules.ProfileBio
import Kit.Molecules.ProfileContent
import Kit.Molecules.ProfilePic
import Routes
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
]
profileHeader =
header'
<*> ( container
<*> mconcat
[ profilePic "avatar.smol.png" "my face"
, profileContent author description
, profileBio bio
]
<> n
)
where n = nav' [(Home, "Home"), (Archive, "Archive")]

View file

@ -30,7 +30,7 @@ indexBody :: Component Html
indexBody =
profileHeader
<> (section' <.> bricklayer <*> mconcat
[pure "$for(pages)$", blogCard dummy, pure "$endfor$", hamburger 0]
[pure "$for(pages)$", blogCard dummy, pure "$endfor$"]
)
indexCtx :: Tags -> [Item String] -> Context String

View file

@ -7,6 +7,7 @@ import GHC.Exts ( IsString(..) )
data Route = Home
| Blog
| Archive
| Post String
| Tag String
| Img String
@ -19,6 +20,7 @@ instance IsString Route where
path :: Route -> String
path Home = "/"
path Blog = "/posts"
path Archive = "/tags"
path (Post postId ) = "/posts/" <> postId
path (Tag tag ) = "/tags/#" <> tag
path (Img fileName) = "/assets/img/" <> fileName