From 135fd30b32befdce5f883264b1d846a5f35875f5 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <srid@srid.ca>
Date: Wed, 10 Jul 2019 21:50:48 -0400
Subject: [PATCH] WIP: example: use Lucid (except for pandoc)

---
 example/Main.hs | 63 +++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 59 insertions(+), 4 deletions(-)

diff --git a/example/Main.hs b/example/Main.hs
index 5876a1b..a0a15a0 100644
--- a/example/Main.hs
+++ b/example/Main.hs
@@ -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")