Add Rib.Extra.OpenGraph

CHANGELOG.md

@@ -10,6 +10,7 @@
   - API exposes the CLI parser (`optparse-applicative`) for user-level composition
   - Add `Rib.Parser.Pandoc.getToC` returning rendered Table of contents for a Pandoc document
   - `Rib.Extra.CSS`: add `googleFonts` and `stylesheet`
+  - Add `Rib.Extra.OpenGraph` for Open Graph protocol
 - Bug fixes:
   - `routeUrl`: Fix incorrect substitution of "foo-index.html" with "foo-"
 

rib.cabal

@@ -31,6 +31,7 @@ library
         Rib.Route
         Rib.Shake
         Rib.Extra.CSS
+        Rib.Extra.OpenGraph
     other-modules:
         Rib.Server
     hs-source-dirs: src

src/Rib/Extra/OpenGraph.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Meta tags for The Open Graph protocol: https://ogp.me/
+module Rib.Extra.OpenGraph
+  ( OpenGraph (..),
+  )
+where
+
+import Lucid
+import Lucid.Base (makeAttribute)
+import Relude
+import qualified Text.URI as URI
+
+-- The OpenGraph metadata
+--
+-- This type can be directly rendered to HTML using `toHTML`.
+data OpenGraph
+  = OpenGraph
+      { _openGraph_title :: Text,
+        _openGraph_author :: Text,
+        _openGraph_description :: Maybe Text,
+        _openGraph_siteName :: Text,
+        _openGraph_type :: Text, -- TODO: ADT (different types with their own properties)
+        _openGraph_image :: Maybe URI.URI
+      }
+  deriving (Eq, Show)
+
+instance ToHtml OpenGraph where
+  toHtmlRaw = toHtml
+  toHtml OpenGraph {..} = do
+    meta' "author" _openGraph_author
+    meta' "description" `mapM_` _openGraph_description
+    metaOg "title" _openGraph_title
+    metaOg "site_name" _openGraph_siteName
+    metaOg "type" _openGraph_type
+    whenJust _openGraph_image $ \uri -> do
+      if isJust (URI.uriScheme uri)
+        then metaOg "image" $ URI.render uri
+        else error $ "OGP image URL must be absolute. This URI is not: " <> URI.render uri
+    where
+      -- Open graph meta element
+      metaOg k v =
+        meta_
+          [ makeAttribute "property" $ "og:" <> k,
+            content_ v
+          ]
+      meta' k v = meta_ [name_ k, content_ v]