Generate cards for pages

src/ArticlesList.hs

@@ -7,7 +7,6 @@ module ArticlesList (
   ) where
 
 import Article (Article)
-import Data.Text (Text, pack)
 import System.FilePath.Posix ((</>))
 
 data ArticlesList = ArticlesList {
@@ -16,29 +15,20 @@ data ArticlesList = ArticlesList {
     , featured :: [Article]
   }
 
-otherUrl :: ArticlesList -> Text
+otherUrl :: ArticlesList -> String
 otherUrl (ArticlesList {full, tagged}) =
   if full
-    then pack $ url tagged
+    then url tagged
-    else pack $ url tagged </> "all.html"
+    else url tagged </> "all.html"
   where
     url = maybe "/" ("/" </>)
 
-otherLink :: ArticlesList -> Text
+otherLink :: ArticlesList -> String
-otherLink (ArticlesList {full}) = pack $
+otherLink (ArticlesList {full}) =
   if full
     then "See only latest"
     else "See all"
 
-pageTitle :: ArticlesList -> Text
+pageTitle :: ArticlesList -> String
-pageTitle (ArticlesList {full, tagged}) = pack $
+pageTitle (ArticlesList {full, tagged}) =
   (if full then "All" else "Latest") ++ " articles" ++ maybe "" (" tagged " ++) tagged
-
-{-
-    pageTitle =
-      (if full then "All" else "Latest") ++ " articles" ++ maybe "" (" tagged " ++) category
-
-      p_ $ if full
-        then a_ [href_ . pack $ url category] "See only latest"
-        else a_ [href_ . pack $ url category </> "all.html"] "See all"
--}

src/Dom.hs

@@ -10,16 +10,23 @@ import Blog (Blog(..))
 import qualified Blog (get)
 import Control.Monad.Reader (ReaderT)
 import qualified Data.Map as Map (keys)
+import Data.Monoid ((<>))
 import Data.Text (pack, empty)
 import Lucid
+import Lucid.Base (makeAttribute)
 import System.FilePath.Posix ((</>), (<.>))
 
 type HtmlGenerator = HtmlT (ReaderT Blog IO)
 
 class Page a where
+  card :: a -> HtmlGenerator ()
   content :: a -> HtmlGenerator ()
 
 instance Page Article where
+  card (Article {title}) =
+    ("A new article on " <>) <$> Blog.get name
+    >>= makeCard title
+
   content (Article {fullContents, urlPath}) =
     article_ (do
         a_ [href_ . pack $ "/" </> urlPath <.> "md"] "Raw"
@@ -27,13 +34,27 @@ instance Page Article where
       )
 
 instance Page ArticlesList where
+  card al = do
+    blogName <- Blog.get name
+    makeCard (maybe blogName ((blogName ++ " - ") ++) $ tagged al) (pageTitle al)
+
   content al@(ArticlesList {featured}) =
     div_ [id_ "contents"] (do
-        h2_ . toHtml $ pageTitle al
+        h2_ . toHtml . pack $ pageTitle al
-        p_ . a_ [href_ $ otherUrl al] . toHtml $ otherLink al
+        p_ . a_ [href_ . pack $ otherUrl al] . toHtml . pack $ otherLink al
         div_ [class_ "articles"] (mapM_ previewArticle featured)
       )
 
+makeCard :: String -> String -> HtmlGenerator ()
+makeCard title description = do
+  blogName <- Blog.get name
+  og "title" title
+  og "description" description
+  og "image" $ "/image" </> blogName <.> "png"
+  og "site_name" blogName
+  where
+    og attribute value = meta_ [makeAttribute "property" $ "og:" <> attribute , content_ $ pack value]
+
 previewArticle :: Article -> HtmlGenerator ()
 previewArticle (Article {urlPath, title, preview}) =
   article_ (do
@@ -65,6 +86,7 @@ page aPage =
           script_ [src_ "/UnitJS/async.js"] empty
           script_ [src_ "/UnitJS/dom.js"] empty
           script_ [src_ "/js/main.js"] empty
+          card aPage
           maybe (toHtml empty) toHtmlRaw =<< Blog.get customHead
         )
       body_ (do