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:
parent
f8d5cfc404
commit
dffa10fd93
8 changed files with 127 additions and 15 deletions
|
@ -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
|
||||
|
|
31
src/Kit/Atoms/FullScreenModal.hs
Normal file
31
src/Kit/Atoms/FullScreenModal.hs
Normal 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)
|
|
@ -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))
|
||||
|
|
|
@ -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
59
src/Kit/Molecules/Nav.hs
Normal 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
|
|
@ -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")]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue