rss feed and robots.txt

app/Config.hs

@@ -4,7 +4,7 @@ outputDir :: String
 outputDir = "publish"
 
 assetGlobs :: [String]
-assetGlobs = ["static//*"]
+assetGlobs = ["static//*", "robots.txt"]
 
 -- CAN ONLY BE TYPST DOCS UNLESS YOU CHANGE THINGS AT THE `pages` RULE in `Main.hs
 pagePaths :: [String]

app/Main.hs

@@ -11,12 +11,16 @@ import Config
 import Control.Monad (forM, when)
 import qualified Data.HashMap.Strict as HM
 import Data.List (sortOn)
+import Data.Maybe (fromJust)
 import qualified Data.Ord as Ord
 import qualified Data.Text as T
+import Deriving.Aeson
+import Deriving.Aeson.Stock (Vanilla)
 import Development.Shake (Action, Rules, (%>), (|%>), (~>))
 import qualified Development.Shake as Shake
 import Development.Shake.FilePath ((</>))
 import qualified Development.Shake.FilePath as FP
+import qualified Development.Shake.FilePath as Shake
 import Templates
 import Types
 import Utilities
@@ -79,7 +83,14 @@ pages =
     let metaSrc = indexHtmlTypstMetaPath target
     html <- typstToHtml src
     meta <- yamlToPost metaSrc
-    let page = Page (postTitle meta) html
+    time <- Utilities.now
+    let page =
+          Page
+            { pageTitle = postTitle meta,
+              pageContent = html,
+              pageNow = time,
+              pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target
+            }
     applyTemplateAndWrite "default.html" page target
     Shake.putInfo $ "Built " <> target <> " from " <> src
 
@@ -111,8 +122,14 @@ typstPost src = do
   post <- readTypstPost src
   let rPost = fromPost post
   postHtml <- applyTemplate "post.html" rPost
-
-  let page = Page (postTitle post) postHtml
+  time <- Utilities.now
+  let page =
+        Page
+          { pageTitle = rPostTitle rPost,
+            pageContent = postHtml,
+            pageNow = time,
+            pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target
+          }
   applyTemplateAndWrite "default.html" page target
   Shake.putInfo $ "Built " <> target <> " from " <> src
 
@@ -126,7 +143,14 @@ markdownPost src = do
   -- Shake.putInfo $ show . toJSON $ rPost
   postHtml <- applyTemplate "post.html" rPost
 
-  let page = Page (postTitle post) postHtml
+  time <- Utilities.now
+  let page =
+        Page
+          { pageTitle = rPostTitle rPost,
+            pageContent = postHtml,
+            pageNow = time,
+            pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target
+          }
   applyTemplateAndWrite "default.html" page target
   Shake.putInfo $ "Built " <> target <> " from " <> src
 
@@ -140,7 +164,14 @@ home =
         <$> forM postPaths readPost
     let posts' = map fromPost posts
     html <- applyTemplate "home.html" $ HM.singleton "posts" posts'
-    let page = Page (T.pack "Home") html
+    time <- Utilities.now
+    let page =
+          Page
+            { pageTitle = T.pack "Home",
+              pageContent = html,
+              pageNow = time,
+              pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target
+            }
     applyTemplateAndWrite "default.html" page target
     Shake.putInfo $ "Built " <> target
 
@@ -151,17 +182,31 @@ postList =
     posts <- sortOn (Ord.Down . postDate) <$> forM postPaths readPost
     let posts' = map fromPost posts
     html <- applyTemplate "posts.html" $ HM.singleton "posts" posts'
-    let page = Page (T.pack "Blog Posts") html
+    time <- Utilities.now
+    let page =
+          Page
+            { pageTitle = T.pack "Blog Posts",
+              pageContent = html,
+              pageNow = time,
+              pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target
+            }
     applyTemplateAndWrite "default.html" page target
     Shake.putInfo $ "Built " <> target
 
+data Rss = Rss
+  { now :: T.Text,
+    posts :: [RenderedPost]
+  }
+  deriving (Show, Generic)
+  deriving (ToJSON) via Vanilla Rss
+
 rss :: Rules ()
 rss =
   outputDir </> "index.xml" %> \target -> do
     postPaths <- getPublishedPosts
-    posts <- sortOn (Ord.Down . postDate) <$> forM postPaths readPost
-    -- TODO: change this to actually have it's own type for things like updated
-    applyTemplateAndWrite "feed.xml" (HM.singleton "posts" posts) target
+    posts <- map fromPost . sortOn (Ord.Down . postDate) <$> forM postPaths readPost
+    time <- Utilities.now
+    applyTemplateAndWrite "feed.xml" (Rss time posts) target
 
     Shake.putInfo $ "Built " <> target
 

app/Templates.hs

@@ -10,7 +10,7 @@ import Development.Shake.FilePath ((</>))
 import GHC.Stack (HasCallStack)
 import qualified Text.Mustache as Mus
 import qualified Text.Mustache.Compile as Mus
-import Types (Post (postAuthor, postContent, postDate, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostIsoDate, rPostLink, rPostTags, rPostTitle))
+import Types (Post (postAuthor, postContent, postDate, postDescription, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostId, rPostIsoDate, rPostLink, rPostSummary, rPostTags, rPostTitle))
 import Utilities
 
 applyTemplate :: (HasCallStack, (ToJSON a)) => String -> a -> Action Text
@@ -55,5 +55,8 @@ fromPost post =
       rPostDate = postDate post,
       rPostIsoDate = postDate post >>= parseDate,
       rPostContent = postContent post,
-      rPostLink = postLink post
+      rPostLink = postLink post,
+      -- maybe can replace non-acceptable chars with - but unclear is exactly one - is allowed or now https://www.iana.org/assignments/urn-informal/urn-1
+      rPostId = T.pack . ("urn:urn-1:" ++) . filter (\c -> elem c "abcdefghijklmnopqrstuvwxyz0123456789") . T.unpack . T.toLower . postTitle $ post,
+      rPostSummary = postDescription post
     }

app/Types.hs

@@ -5,7 +5,14 @@ import Deriving.Aeson
 import Deriving.Aeson.Stock (PrefixedSnake)
 
 -- pageSection is what css class should be specified in a style html element, I would do an enum but I foresee that being a mistake
-data Page = Page {pageTitle :: Text, pageContent :: Text, pageNow :: Text, pageSection :: Text}
+data Page = Page
+  { pageTitle :: Text,
+    pageContent :: Text,
+    -- build time
+    pageNow :: Text,
+    -- css class for page section
+    pageSection :: Text
+  }
   deriving (Show, Generic)
   deriving (ToJSON) via PrefixedSnake "page" Page
 
@@ -31,7 +38,7 @@ data Post = Post
     postDate :: Maybe Text,
     postContent :: Maybe Text,
     postLink :: Maybe Text,
-    postSummary :: Maybe Text,
+    postDescription :: Maybe Text,
     postDraft :: Maybe Bool
   }
   deriving (Show, Generic)

app/Utilities.hs

@@ -8,6 +8,7 @@ import Data.List (find)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time
+import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Yaml.Aeson
 import Development.Shake (Action)
 import qualified Development.Shake as Shake
@@ -99,6 +100,9 @@ runPandoc action =
   Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
     >>= either (fail . show) return
 
+now :: Action T.Text
+now = Shake.liftIO $ fmap (T.pack . iso8601Show) getCurrentTime
+
 markdownToPost :: FilePath -> Action Post
 markdownToPost path = do
   content <- Shake.readFile' path