Add initial version

This commit adds the first published version of the website including
the first blog post, Unix Domain Socket Forwarding with OpenSSH.

1 files changed, 208 insertions, 0 deletions

diff --git a/site.hs b/site.hs
new file mode 100644
index 0000000..fcf617d
--- /dev/null
+++ b/site.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Monad (msum)
+import Data.Time (TimeLocale, formatTime, parseTimeM, defaultTimeLocale, UTCTime)
+import Hakyll
+import System.FilePath.Posix ((</>), (<.>), splitExtension, splitFileName, takeDirectory)
+
+main :: IO ()
+main = hakyllWith hakyllConfig $ do
+  match ("images/*" .||. "files/*" .||. "robots.txt") $ do
+    route idRoute
+    compile copyFileCompiler
+
+  match "css/*" $ do
+    route idRoute
+    -- WORKAROUND: compressCssCompiler removes copyright notices
+    compile copyFileCompiler
+
+  match (fromList ["about.md", "contact.md", "privacy.md"]) $ do
+    route $ setExtension "html" `composeRoutes` appendIndex
+    let context = dropIndexHtml "url" <> defaultContext
+    compile $ pandocCompiler
+      >>= loadAndApplyTemplate "templates/direct.html" context
+      >>= loadAndApplyTemplate "templates/default.html" context
+      >>= relativizeUrls
+
+  match "posts/*" $ do
+    route $ setExtension "html" `composeRoutes` appendIndex
+    compile $ pandocCompiler
+      >>= loadAndApplyTemplate "templates/post.html" postContext
+      >>= saveSnapshot "content"
+      >>= loadAndApplyTemplate "templates/default.html" postContext
+      >>= relativizeUrls
+
+  create ["posts.html"] $ do
+    route appendIndex
+    compile $ do
+      posts <- recentFirst =<< loadAll "posts/*"
+      let archiveContext =
+            listField "posts" postContext (return posts) <>
+            constField "title" "Blog" <>
+            dropIndexHtml "url" <>
+            defaultContext
+
+      makeItem ""
+        >>= loadAndApplyTemplate "templates/posts.html" archiveContext
+        >>= loadAndApplyTemplate "templates/default.html" archiveContext
+        >>= relativizeUrls
+
+  create ["feeds/posts.rss"] $ do
+    route idRoute
+    compileFeed renderRss rfc822DateTimeFormat
+
+  create ["feeds/posts.atom"] $ do
+    route idRoute
+    compileFeed renderAtom rfc3339DateTimeFormat
+
+  create ["sitemap.xml"] $ do
+    route idRoute
+    compile $ do
+      posts <- recentFirst =<< loadAll "posts/*"
+      singles <- loadAll (fromList ["about.md", "contact.md", "privacy.md", "posts.html"])
+      let
+        pages = posts <> singles
+        sitemapContext =
+          constField "root" root <>
+          listField "pages" postContext (return pages)
+      makeItem ""
+        >>= loadAndApplyTemplate "templates/sitemap.xml" sitemapContext
+
+  match "index.html" $ do
+    route idRoute
+    compile $ do
+      posts <- recentFirst =<< loadAll "posts/*"
+      let indexContext =
+            listField "posts" postContext (return posts) <>
+            defaultContext
+
+      getResourceBody
+        >>= applyAsTemplate indexContext
+        >>= loadAndApplyTemplate "templates/default.html" indexContext
+        -- >>= relativizeUrls
+
+  match "404.html" $ do
+    route idRoute
+    compile $ pandocCompiler
+      >>= loadAndApplyTemplate "templates/default.html" defaultContext
+      >>= relativizeUrls
+
+  match "templates/*" $ compile templateBodyCompiler
+
+hakyllConfig :: Configuration
+hakyllConfig = defaultConfiguration
+  { previewPort = 8080
+  , deployCommand = "./deploy"
+  }
+
+postContext :: Context String
+postContext =
+  constField "root" root <>
+  dateField "date" "%-e %B %Y" <>
+  dateField "formalDate" "%Y-%m-%d" <>
+  dropIndexHtml "url" <>
+  defaultContext
+
+appendIndex :: Routes
+appendIndex =
+  customRoute $ append . splitExtension . toFilePath
+  where append (path, extension) = path </> "index" <.> extension
+
+dropIndexHtml :: String -> Context a
+dropIndexHtml key = mapContext transform (urlField key)
+  where
+    transform url = case splitFileName url of
+      (p, "index.html") -> takeDirectory p <> "/"
+      _ -> url
+
+root :: String
+root = "https://www.skreutz.com"
+
+feedConfiguration :: FeedConfiguration
+feedConfiguration = FeedConfiguration
+  { feedTitle = "Stefan Kreutz' Blog"
+  , feedDescription = "Random bits from a passionate software engineer."
+  , feedAuthorName = "Stefan Kreutz"
+  , feedAuthorEmail = "mail@skreutz.com"
+  , feedRoot = root
+  }
+
+type FeedRenderer = FeedConfiguration -> Context String -> [Item String] -> Compiler (Item String)
+
+-- | Compile a feed of posts with a given time format.
+compileFeed :: FeedRenderer -> [Char] -> Rules ()
+compileFeed render format = compile $ do
+  let feedContext =
+        -- Format built-in fields @published@ and @updated@.
+        -- TODO: Consider to vendor hakyll.
+        updatedField format <>
+        dateField "published" format <>
+        bodyField "description" <>
+        postContext
+  posts <- fmap (take 10) . recentFirst =<<
+    loadAllSnapshots "posts/*" "content"
+  render feedConfiguration feedContext posts
+
+-- | RFC 822 compliant date and time format.
+--
+-- This format string differs in two ways from
+-- 'Data.Time.Format.rfc822DateFormat' from package time-1.10. First, it padds
+-- days with zeros instead of spaces. Second, it uses the offset of the time
+-- zone instead of its name because RFC 822 does not define common time zone
+-- names like UTC. See
+-- https://validator.w3.org/feed/docs/warning/ProblematicalRFC822Date.html
+rfc822DateTimeFormat :: String
+rfc822DateTimeFormat = "%a, %d %b %Y %H:%M:%S %z"
+
+-- | RFC 3339 compliant date and time format.
+rfc3339DateTimeFormat :: String
+rfc3339DateTimeFormat = "%Y-%m-%dT%H:%M:%S%Ez"
+
+-- | Format field @updated@.
+--
+-- Copied from Hakyll's 'dateFieldWith'. Falls back to field @published@.
+updatedFieldWith
+  :: TimeLocale  -- ^ Output time locale
+  -> String      -- ^ Format to use on the date
+  -> Context a   -- ^ Resulting context
+updatedFieldWith locale format = field "updated" $ \i -> do
+  time <- getUpdatedUTC locale $ itemIdentifier i
+  return $ formatTime locale format time
+
+-- | Format field @updated@.
+--
+-- Copied from Hakyll's 'dateField'. Falls back to field @published@.
+updatedField
+  :: String      -- ^ Format to use on the date
+  -> Context a   -- ^ Resulting context
+updatedField = updatedFieldWith defaultTimeLocale
+
+-- | Parse field @updated@.
+--
+-- Copied from Hakyll's 'getItemUTC'. Falls back to field @published@.
+getUpdatedUTC
+  :: (MonadMetadata m, MonadFail m)
+  => TimeLocale        -- ^ Output time locale
+  -> Identifier        -- ^ Input page
+  -> m UTCTime         -- ^ Parsed UTCTime
+getUpdatedUTC locale id' = do
+  metadata <- getMetadata id'
+  let tryField k fmt = lookupString k metadata >>= parseTime' fmt
+  maybe empty' return $ msum $
+    [ tryField "updated" fmt | fmt <- formats ] ++
+    [ tryField "published" fmt | fmt <- formats ]
+  where
+    empty'     = fail $ "getUpdatedUTC: could not parse time for " ++ show id'
+    parseTime' = parseTimeM True locale
+    formats    =
+      [ "%a, %d %b %Y %H:%M:%S %Z"
+      , "%a, %d %b %Y %H:%M:%S"
+      , "%Y-%m-%dT%H:%M:%S%Z"
+      , "%Y-%m-%dT%H:%M:%S"
+      , "%Y-%m-%d %H:%M:%S%Z"
+      , "%Y-%m-%d %H:%M:%S"
+      , "%Y-%m-%d"
+      , "%B %e, %Y %l:%M %p"
+      , "%B %e, %Y"
+      , "%b %d, %Y"
+      ]