19-blog-generator.hell

-- This is a copy of the script that generates my blog.

-- Dependencies:
--
-- hell-2024-02-07
-- pandoc-3.1.11.1

-- Main entry point just generates the complete blog every time.
--
--
main = Main.generate

-- The posts are listed under ./posts in this format:
--
-- dijkstra-haskell-java.markdown
-- reasoning-violently.md
-- god-mode.markdown
-- emacs-mail.markdown
--
-- .md or .markdown files, the extension doesn't matter.
--
generate = do
  posts <- Main.generatePosts
  Main.generateArchive posts
  Main.generateRSS posts

-- Write out posts/$post/index.html per $post.
--
generatePosts = do
  posts <- Directory.listDirectory "posts"
  Text.putStrLn $ Text.concat ["Generating ", Show.show (List.length posts), " posts ..."]
  Async.pooledForConcurrently posts \post -> do
    contents <- Text.readFile $ Text.concat ["posts/", post]
    Maybe.maybe
      (Error.error "Couldn't parse the article!")
      (\(date, title) -> do
        rendered <- Main.render post
        Monad.return (post, date, title, rendered))
      $ Main.parse contents

-- Generate the /posts/ page.
--
generateArchive = \posts -> do
  Text.putStrLn "Generating archive ..."
  let rows =
        Text.concat
          $ List.map
            (\(post, date, title, content) ->
              Text.concat [
                 "<tr><td><a href='",
                 Main.filename post,
                 "'>",
                 Main.strip title,
                 "</td><td>",
                 date,
                 "</td></tr>"
               ])
            $ List.reverse
            $ List.sortOn (\(post, date, title, content) -> date)
            $ posts
  let table = Text.concat [
        "---\n",
        "title: Archive\n",
        "---\n",
        "<table id='archive' style='line-height:2em'>",
        rows,
        "</table>"
        ]
  (out, err) <-
    Text.readProcess_
      $ Text.setStdin table
      $ Process.proc "pandoc" ["--standalone","--template","templates/posts.html"]
  Text.writeFile "webroot/posts/index.html" out

-- Contents of an article looks like this:
--
-- ---
-- date: 2011-04-10
-- title: ‘amb’ operator and the list monad
-- description: ‘amb’ operator and the list monad
-- author: Chris Done
-- tags: haskell, designs
-- ---
--
-- We're only interested in the date and the title. The rest is
-- redundant.
--
parse = \article -> do
  sansPrefix <- Text.stripPrefix "---" article
  let (preamble, _content) = Text.breakOn "---" sansPrefix
  let lines = Text.splitOn "\n" preamble
  let pairs = List.map (\line -> do let (key, value) = Text.breakOn ":" line
                                    (key, Text.strip (Text.drop 1 value)))
                       lines
  date <- List.lookup "date" pairs
  title <- List.lookup "title" pairs
  Monad.return (date, title)

-- A post consists of a date, title and markdown.
--
-- Rendering them is easy, just run pandoc and apply an HTML template.
render = \post -> do
  let targetDir =
        Text.concat ["webroot/posts/", Main.filename post]
  let targetFile = Text.concat [targetDir, "/index.html"]
  (out, err) <- Text.readProcess_ (Process.proc "pandoc" ["--standalone","--template","templates/post.html",Text.concat ["posts/", post]])
  Directory.createDirectoryIfMissing Bool.True targetDir
  Text.writeFile targetFile out
  Monad.return out

-- Filename stripped of .md/.markdown.
filename = \post -> Text.replace ".md" "" (Text.replace ".markdown" "" post)

-- Strip out quotes from "foo".
strip = \title ->
  Maybe.maybe title Function.id do
    title' <- Text.stripPrefix "\"" title
    Text.stripSuffix "\"" title'

-- Generate the /rss.xml page.
--
generateRSS = \posts0 -> do
  let posts1 = List.reverse $ List.sortOn (\(post, date, title, content) -> date) posts0
  posts <- Monad.forM posts1 \(post, date, title, content) -> do
    date' <- Text.readProcessStdout_ $ Text.setStdin date $ Process.proc "date" ["-R", "-f", "/dev/stdin"]
    Monad.return (post, date', title, content)
  Text.putStrLn "Generating rss.xml ..."
  let items =
        Text.unlines
          $ List.map
            (\(post, date, title, content) ->
              Text.concat [
                 "<item>",
                 "<title><![CDATA[", Main.strip title, "]]></title>",
                 "<link>https://chrisdone.com/posts/", Main.filename post, "</link>",
                 "<guid>https://chrisdone.com/posts/", Main.filename post, "</guid>",
                 "<description><![CDATA[", content, "]]></description>",
                 "<pubDate>", date, "</pubDate>",
                 "<dc:creator>Chris Done</dc:creator>",
                 "</item>"
               ])
            posts
  let xml = Text.unlines [
        "<?xml version=\"1.0\" encoding=\"utf-8\"?>",
        "<rss version=\"2.0\" xmlns:atom=\"http://www.w3.org/2005/Atom\" xmlns:dc=\"http://purl.org/dc/elements/1.1/\">",
        "<channel>",
        "<title>Chris Done's Blog</title>",
        "<link>https://chrisdone.com</link>",
        "<description><![CDATA[Blog all about programming, especially in Haskell since 2008!]]></description>",
        "<atom:link href=\"https://chrisdone.com/rss.xml\" rel=\"self\" type=\"application/rss+xml\" />",
        "<lastBuildDate>Wed, 22 Dec 2021 00:00:00 UT</lastBuildDate>",
        items,
        "</channel>",
        "</rss>"
        ]
  Text.writeFile "webroot/rss.xml" xml