srid/rib
1
1
Fork 0
mirror of https://github.com/srid/rib.git synced 2024-11-26 13:50:31 +03:00
Code Issues Projects Releases Wiki Activity

WIP: example: use Lucid (except for pandoc)

Browse Source
This commit is contained in:
Sridhar Ratnakumar 2019-07-10 21:50:48 -04:00
parent 49936d44a4
commit 135fd30b32
1 changed files with 59 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
example/Main.hs
View File

@ -2,6 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
@ -16,8 +17,9 @@ import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import GHC.Generics
import Clay
import Clay hiding (type_)
import Reflex.Dom.Core hiding (display)
import Lucid
import Reflex.Dom.Pandoc.Document (elPandocDoc, elPandocInlines)
import qualified Reflex.Dom.Pandoc.SyntaxHighlighting as SyntaxHighlighting
@ -77,9 +79,62 @@ pageStyle = body ? do
width $ pct 50
footer ? textAlign center
-- | HTML for page type
pageWidget :: DomBuilder t m => Page -> m ()
pageWidget page = elAttr "html" ("lang" =: "en") $ do
pageWidget :: Page -> Html ()
pageWidget page = with html_ [lang_ "en"] $ do
head_ $ do
meta_ [name_ "charset", content_ "utf-8"]
meta_ [name_ "description", content_ "Sridhar's notes"]
meta_ [name_ "author", content_ "Sridhar Ratnakumar"]
meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"]
title_ pageTitle
style_ [type_ "text/css"] $ TL.toStrict $ Clay.render pageStyle
style_ [type_ "text/css"] $ TL.toStrict $ Clay.render $ SyntaxHighlighting.style
link_ [href_ semanticUiCss, rel_ "stylesheet"]
body_ $ do
with div_ [class_ "ui text container", id_ "thesite"] $ do
with div_ [class_ "ui raised segment"] $ do
with a_ [class_ "ui violet ribbon label", href_ "/"] "Srid's notes"
-- Main content
with h1_ [class_ "ui huge header"] pageTitle
case page of
Page_Index posts -> do
let (progPosts, otherPosts) =
partition ((== Just Programming) . getPandocMetaJson "category" . _post_doc) posts
with h2_ [class_ "ui header"] "Haskell & Nix notes"
postList progPosts
with h2_ [class_ "ui header"] "Other notes"
postList otherPosts
Page_Post post ->
with article_ [class_ "post"] $ do
toHtml . T.pack . show $ _post_doc post
with a_ [class_ "ui green right ribbon label", href_ "https://www.srid.ca"] "Sridhar Ratnakumar"
-- Load Google fonts at the very end for quicker page load.
forM_ googleFonts $ \f ->
link_ [href_ $ "https://fonts.googleapis.com/css?family=" <> T.replace " " "-" f, rel_ "stylesheet"]
where
semanticUiCss = "https://cdn.jsdelivr.net/npm/semantic-ui@2.4.2/dist/semantic.min.css"
pageTitle = case page of
Page_Index _ -> "Srid's notes"
Page_Post post -> postTitle post
-- Render the post title (Markdown supported)
postTitle = maybe "Untitled" (toHtml . T.pack . show) . getPandocMetaInlines "title" . _post_doc
-- Render a list of posts
postList :: [Post] -> Html ()
postList xs = with div_ [class_ "ui relaxed divided list"] $ forM_ xs $ \x ->
with div_ [class_ "item"] $ do
with a_ [class_ "header", href_ (_post_url x)] $
postTitle x
small_ $ maybe blank (toHtml . T.pack .show) $ getPandocMetaInlines "description" $ _post_doc x
-- HTML for page type
pageWidget' :: DomBuilder t m => Page -> m ()
pageWidget' page = elAttr "html" ("lang" =: "en") $ do
el "head" $ do
mapM_ (uncurry elMeta)
[ ("charset", "UTF-8")