This site has continuously evolved since I made the first commit while procrastinating my undergrad dissertation,
commit 632cb1f0c97c07fb99b48192444397e56ea5310f
Author: Ryan Gibb <redacted>
Date: Fri Jan 22 11:27:55 2021 +0000
Initial commit
diff --git a/index.html b/index.html
new file mode 100644
index 0000000..557db03--- /dev/null
+++ b/index.html
@@ -0,0 +1 @@
+Hello World
I started off writing plain HTML, then switching to writing in markdown and using pandoc to convert to HTML, and gradually accumulated bash scripts and makefiles to add more functionality, such as generating an Atom feed. This became unmaintainable and at the start of 2025 I overhauled it to use the Hakyll static site generator There’s a few drafts in the git repository which I don’t want to make public yet, so I include the source code used to generate this website below. It’s quite particular to my needs – Hakyll give you a big bag of tools which you can compose in your own way – but it may be useful as a reference.
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (filterM, forM, liftM, (>=>))
import Control.Monad.IO.Class (liftIO)
import qualified Data.Char as C
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Monoid (mappend)
import qualified Data.Text as T
import Data.Time (UTCTime (UTCTime))
import Data.Time.Format (formatTime, parseTimeM)
import Data.Time.Locale.Compat (defaultTimeLocale)
import Hakyll
import Hakyll.Images (Image, loadImage, scaleImageCompiler)
import System.Directory (doesFileExist)
import System.FilePath (takeBaseName)
import Text.Blaze.Html (toHtml, toValue, (!))
import Text.Blaze.Html.Renderer.String (renderHtml)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Pandoc
import Text.Pandoc.Highlighting (pygments)
import Text.Pandoc.Lua (applyFilter)
=
indexFiles "static/home.org"
.||. "static/articles.org"
.||. "static/logs.org"
.||. "static/news.org"
.||. "static/index.org"
.||. "static/photos.org"
=
tagFiles "static/projects.org"
.||. "static/research.org"
.||. "static/technology.org"
= "static/**.md" .||. "static/**.org"
htmlFiles
= htmlFiles .&&. complement indexFiles .&&. complement tagFiles
postFiles
= "static/photos/*"
photoFiles
= "static/photos/*.jpg" .||. "static/photos/*.png"
photoImageFiles
= fromRegex "static/[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9].*"
logFiles
= postFiles .&&. complement logFiles
articleFiles
dateFormat :: String
= "%a %e %b %Y"
dateFormat
feedConfiguration :: FeedConfiguration
=
feedConfiguration FeedConfiguration
= "ryan.freumh.org",
{ feedTitle = "ryan.freumh.org",
feedDescription = "Ryan Gibb",
feedAuthorName = "ryan@freumh.org",
feedAuthorEmail = "https://ryan.freumh.org"
feedRoot
}
main :: IO ()
= hakyll $ do
main <- buildTags postFiles (fromCapture "*.html")
tags
$ do
match tagFiles
route idRoute
compile tagCompiler
$ \tag pattern -> do
tagsRules tags
route idRoute$ do
compile let title = titleCase tag
let file = "static/" ++ tag ++ ".org"
<- recentFirst =<< filterM isPublished =<< loadAll pattern
posts let ctx =
"title" title
constField `mappend` listField "posts" (postContext dateFormat dateFormat tags) (return posts)
`mappend` defaultContext
<- unsafeCompiler $ doesFileExist file
exists if exists
then do
<- load $ fromFilePath file
body
makeItem (itemBody body)>>= applyAsTemplate (indexContext posts (postContext dateFormat dateFormat tags))
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
else
""
makeItem >>= loadAndApplyTemplate "templates/tag.html" ctx
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
"static/home.org" $ do
match $ staticRoute `composeRoutes` setExtension "html"
route $ do
compile <- fmap (take 5) . recentFirst =<< filterM isPublished =<< loadAll postFiles
posts
indexCompiler posts (postContext dateFormat dateFormat tags)
"static/articles.org" $ do
match $ staticRoute `composeRoutes` setExtension "html"
route $ do
compile <- recentFirst =<< filterM isPublished =<< loadAll articleFiles
posts
indexCompiler posts (postContext dateFormat dateFormat tags)
"static/logs.org" $ do
match $ staticRoute `composeRoutes` setExtension "html"
route $ do
compile -- so that we pick up published from the title in postContext
<- reverse <$> loadAllSnapshots logFiles "feed"
posts
indexCompiler posts (postContext dateFormat dateFormat tags)
"static/news.org" $ do
match $ staticRoute `composeRoutes` setExtension "html"
route $ do
compile <- recentFirst =<< filterM isPublished =<< loadAll postFiles
posts
indexCompiler posts (postContext dateFormat dateFormat tags)
"static/index.org" $ do
match $ staticRoute `composeRoutes` setExtension "html"
route $ do
compile <- filterM isNotDraft =<< loadAll (htmlFiles .&&. complement "static/index.org")
posts
indexCompiler posts (postContext dateFormat dateFormat tags)
"static/photos.org" $ do
match $ staticRoute `composeRoutes` setExtension "html"
route $ do
compile <- recentFirst =<< (loadAll (photoFiles .&&. hasNoVersion) :: Compiler [Item CopyFile])
photos
indexCompiler photos photoContext
$ do
matchMetadata articleFiles isNotDraftMeta $ staticRoute `composeRoutes` setExtension "html"
route $ postCompiler tags "templates/post.html"
compile
$ do
matchMetadata logFiles isNotDraftMeta $ staticRoute `composeRoutes` setExtension "html"
route $ postCompiler tags "templates/log.html"
compile
"atom.xml"] $ do
create [
route idRoute$ do
compile let feedContext = postContext dateFormat "%Y-%m-%dT%H:%M:%S%Q%Ez" tags `mappend` bodyField "content"
<- recentFirst =<< filterM isPublished =<< loadAllSnapshots postFiles "feed"
posts <- loadBody "templates/atom.xml"
atomTemplate <- loadBody "templates/atom-item.xml"
atomItemTemplate
renderAtomWithTemplates atomTemplate atomItemTemplate feedConfiguration feedContext posts
"sitemap.xml"] $ do
create [
route idRoute$ do
compile <- loadAll htmlFiles
posts let sitemapCtx =
"posts" (urlField "loc" `mappend` (postContext dateFormat dateFormat tags)) (return posts)
listField `mappend` constField "root" "https://ryan.freumh.org"
`mappend` defaultContext
""
makeItem >>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx
"404.md" $ do
match $ setExtension "html"
route $ do
compile
getResourceBody>>= loadAndApplyTemplate "templates/default.html" defaultContext
$ do
match photoFiles
route staticRoute
compile copyFileCompiler
$ version "thumbnail" $ do
match photoImageFiles $ gsubRoute "static/photos" (const "photos/thumb")
route $ do
compile
loadImage>>= scaleImageCompiler 10000 768
"static/**" isNotDraftMeta $ do
matchMetadata
route staticRoute
compile copyFileCompiler
"static/*.css" $ do
match
route staticRoute
compile compressCssCompiler
"ieee-with-url.csl" $
match
compile cslCompiler
"references.bib" $
match
compile biblioCompiler
"templates/*" $
match
compile templateBodyCompiler
staticRoute :: Routes
= gsubRoute "static/" (const "")
staticRoute
indexCompiler :: [Item a] -> Context a -> Compiler (Item String)
= do
indexCompiler posts context
getResourceBody>>= transformRender
>>= applyAsTemplate (indexContext posts context)
>>= linkCompiler
>>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
tagCompiler :: Compiler (Item String)
= do
tagCompiler
getResourceBody>>= bibRender "ieee-with-url.csl" "references.bib"
>>= linkCompiler
>>= relativizeUrls
postCompiler :: Tags -> Identifier -> Compiler (Item String)
= do
postCompiler tags template
getResourceBody>>= saveSnapshot "body"
>>= bibRenderFeed "ieee-with-url.csl" "references.bib"
>>= loadAndApplyTemplate template (postContext dateFormat dateFormat tags)
>>= linkCompiler
>>= saveSnapshot "feed"
getResourceBody>>= saveSnapshot "body"
>>= bibRender "ieee-with-url.csl" "references.bib"
>>= loadAndApplyTemplate template (postContext dateFormat dateFormat tags)
>>= linkCompiler
>>= loadAndApplyTemplate "templates/default.html" (postContext dateFormat dateFormat tags)
>>= relativizeUrls
linkCompiler :: Item String -> Compiler (Item String)
= pure . fmap (withUrls rewriteLinks)
linkCompiler
readerOptions :: ReaderOptions
=
readerOptions
def= foldr enableExtension pandocExtensions [Ext_citations, Ext_smart]
{ readerExtensions
}
writerOptions :: WriterOptions
=
writerOptions
def= enableExtension Ext_smart pandocExtensions,
{ writerExtensions = Just pygments,
writerHighlightStyle = Citeproc
writerCiteMethod
}
transformRender :: Item String -> Compiler (Item String)
=
transformRender
renderPandocWithTransformM defaultHakyllReaderOptions defaultHakyllWriterOptions pandocTransform
bibRender :: String -> String -> Item String -> Compiler (Item String)
= do
bibRender cslFileName bibFileName pandoc <- load $ fromFilePath cslFileName
csl <- load $ fromFilePath bibFileName
bib let transform =
withItemBodyPandoc (Meta meta) bs) ->
( \(pure $
Pandoc
Meta $ M.insert "link-citations" (MetaBool True) meta)
(
bs
)>=> processPandocBiblios csl [bib]
>=> withItemBody pandocTransform
renderPandocItemWithTransformM readerOptions writerOptions transform pandoc
bibRenderFeed :: String -> String -> Item String -> Compiler (Item String)
= do
bibRenderFeed cslFileName bibFileName pandoc <- load $ fromFilePath cslFileName
csl <- load $ fromFilePath bibFileName
bib let transform =
withItemBodyPandoc (Meta meta) bs) ->
( \(pure $
Pandoc
Meta $ M.insert "link-citations" (MetaBool True) meta)
(
bs
)>=> processPandocBiblios csl [bib]
>=> withItemBody pandocTransformFeed
renderPandocItemWithTransformM readerOptions writerOptions transform pandoc
pandocTransform :: Pandoc -> Compiler Pandoc
=
pandocTransform
unsafeCompiler. runIOorExplode
. ( applyFilter def [] "scripts/anchor-links.lua"
>=> applyFilter def [] "scripts/elem-ids.lua"
>=> applyFilter def [] "scripts/footnote-commas.lua"
)
pandocTransformFeed :: Pandoc -> Compiler Pandoc
=
pandocTransformFeed
unsafeCompiler. runIOorExplode
. ( applyFilter def [] "scripts/elem-ids.lua"
>=> applyFilter def [] "scripts/footnote-commas.lua"
)
postContext :: String -> String -> Tags -> Context String
=
postContext titleDateFormat dateFormat tags "prev" (adjacentLogField (-1) dateFormat)
field `mappend` field "next" (adjacentLogField 1 dateFormat)
`mappend` dateFieldFromTitle "title" titleDateFormat
`mappend` dateField "published" dateFormat
`mappend` myDateField "updated" dateFormat
`mappend` myTagsField "tags" tags
`mappend` defaultContext
photoContext :: Context a
=
photoContext "title" dateFormat
dateField `mappend` dateField "published" dateFormat
`mappend` urlField "url"
`mappend` pathField "path"
`mappend` titleField "title"
`mappend` thumbnailField "thumb"
`mappend` videoField "video"
indexContext :: [Item a] -> Context a -> Context String
=
indexContext posts itemContext "posts" itemContext (return posts)
listField `mappend` defaultContext
myDateField :: String -> String -> Context String
=
myDateField name format $ \item -> do
field name <- getMetadata (itemIdentifier item)
metadata let date :: Maybe UTCTime
= lookupString name metadata >>= parseTimeM True defaultTimeLocale "%Y-%m-%d"
date case date of
Nothing -> noResult ""
Just date -> return $ formatTime defaultTimeLocale format date
dateFieldFromTitle :: String -> String -> Context String
=
dateFieldFromTitle key format $ \item ->
field key case dateFromTitle item of
Nothing -> noResult ""
Just date ->
return $ formatTime defaultTimeLocale format date
thumbnailField :: String -> Context a
= field key $ \item -> do
thumbnailField key <- getRoute (itemIdentifier item)
mRoute case mRoute of
Nothing -> noResult ""
Just url ->
if ".mp4" `L.isSuffixOf` url
then noResult ""
else
return $
$
T.unpack "photos/" "photos/thumb/" (T.pack url)
T.replace
videoField :: String -> Context a
= field key $ \item -> do
videoField key <- getRoute (itemIdentifier item)
mRoute case mRoute of
Nothing -> noResult ""
Just url ->
if ".mp4" `L.isSuffixOf` url
then
return $
$
T.unpack "static/photos/" "photos/" (T.pack url)
T.replace else noResult ""
myTagsField :: String -> Tags -> Context String
= field key $ \item -> do
myTagsField key tags <- getTags $ itemIdentifier item
tags' if null tags'
then noResult ""
else do
<- forM tags' $ \tag -> do
links <- getRoute $ tagsMakeId tags tag
route' return $ simpleRenderLink tag route'
return $ renderHtml $ mconcat . L.intersperse ", " $ catMaybes links
renderTag :: String -> Maybe FilePath -> Maybe H.Html
Nothing = Nothing
renderTag _ Just filePath) =
renderTag tag (Just $
! A.href (toValue $ toUrl filePath) $
H.a
toHtml tag
isPublished :: Item a -> Compiler Bool
= do
isPublished item <- getMetadata (itemIdentifier item)
metadata case lookupString "published" metadata of
Just value -> return (value /= "false")
Nothing -> return (isJust (dateFromTitle item))
isNotDraft :: Item a -> Compiler Bool
= do
isNotDraft item <- getMetadata (itemIdentifier item)
metadata return $ isNotDraftMeta metadata
isNotDraftMeta :: Metadata -> Bool
= do
isNotDraftMeta metadata case lookupString "published" metadata of
Just value -> value /= "false"
Nothing -> True
dateFromTitle :: Item a -> Maybe UTCTime
=
dateFromTitle item let filePath = toFilePath (itemIdentifier item)
= takeBaseName filePath
title in parseTimeM True defaultTimeLocale "%Y-%m-%d" title
rewriteLinks :: String -> String
rewriteLinks url-- Only rewrite relative/local links
| "://" `T.isInfixOf` turl = url
| otherwise = T.unpack . replaceExt ".md" ".html" . replaceExt ".org" ".html" $ turl
where
= T.pack url
turl
replaceExt :: T.Text -> T.Text -> T.Text -> T.Text
=
replaceExt oldExt newExt url let (base, fragment) = T.breakOn "#" url
in (if oldExt `T.isSuffixOf` base then T.replace oldExt newExt base else base) `mappend` fragment
adjacentLogField :: Int -> String -> Item String -> Compiler String
= do
adjacentLogField offset format item <- loadAllSnapshots logFiles "body" :: Compiler [Item String]
posts let adjacent = getAdjacentLog posts item offset
case adjacent of
Nothing -> noResult ""
Just a -> do
<- getRoute (itemIdentifier a)
mroute let filePath = toFilePath (itemIdentifier item)
= takeBaseName filePath
title = fmap (formatTime defaultTimeLocale format) (dateFromTitle a)
date = fromMaybe title date
label return $ maybe "" (\r -> "<a href=\"" ++ r ++ "\">" ++ label ++ "</a>") mroute
getAdjacentLog :: [Item a] -> Item b -> Int -> Maybe (Item a)
=
getAdjacentLog posts current offset case L.elemIndex (itemIdentifier current) (map itemIdentifier posts) of
Nothing -> Nothing
Just idx ->
let newIndex = idx + offset
in if newIndex >= 0 && newIndex < length posts
then Just (posts !! newIndex)
else Nothing
titleCase :: String -> String
: xs) = C.toUpper x : map C.toLower xs titleCase (x
The directory tree looks something like,
./ieee-with-url.csl
./references.bib
./scripts/anchor-links.lua
./scripts/elem-ids.lua
./scripts/footnote-commas.lua
./static/about.org
./static/articles.org
./static/home.org
./static/index.org
./static/logs.org
./static/news.org
./static/papers.org
./static/photos.org
./static/research.org
./static/keys
./static/code.css
./static/style.css
./static/favicon.ico
./static/rss.svg
./static/2023-10-09.md
./static/2023-10-16.md
./static/2023-10-23.md
./static/...
./static/fonts/...
./static/images/...
./static/papers/...
./static/photos/...
./static/resources/...
./templates/atom-item.xml
./templates/atom.xml
./templates/default.html
./templates/log.html
./templates/post-list-tags.html
./templates/post-list.html
./templates/post.html
./templates/sitemap.xml
./templates/tag.html