refactor: neaten up source tree

1 files changed, 151 insertions, 0 deletions

diff --git a/ssg/Main.hs b/ssg/Main.hs
new file mode 100644
index 0000000..c130c91
--- /dev/null
+++ b/ssg/Main.hs
@@ -0,0 +1,151 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE OverloadedStrings #-}
+
+import           Control.Exception
+import           Data.List
+import           Data.Maybe
+import           Data.Monoid
+import           Hakyll
+import           Hakyll.Web.Sass
+import           System.Environment
+import           System.FilePath.Posix
+import           System.Process
+
+--------------------------------------------------------------------------------
+main :: IO ()
+main = hakyll $ do
+  match "templates/*" $ compile templateBodyCompiler
+
+  match ("assets/images/*" .||. "assets/fonts/*") $ do
+    route idRoute
+    compile copyFileCompiler
+
+  match "assets/css/*" $ do
+    route $ setExtension "css"
+    let compressCssItem = fmap compressCss
+    compile (compressCssItem <$> sassCompiler)
+
+  match "posts/*" $ do
+    route prettyRoute
+    compile $
+      pandocCompiler
+        >>= loadAndApplyTemplate "templates/post.html" postCtx
+        >>= saveSnapshot "content"
+        >>= loadAndApplyTemplate "templates/default.html" postCtx
+        >>= relativizeUrls
+        >>= removeIndexHtml
+
+  match "pages/*.html" $ do
+    route prettyRoute
+    compile $
+      pandocCompiler
+        >>= loadAndApplyTemplate "templates/default.html" defaultCtx
+        >>= relativizeUrls
+        >>= removeIndexHtml
+
+  match "404.html" $ do
+    route idRoute
+    compile $
+      pandocCompiler
+        >>= loadAndApplyTemplate "templates/default.html" defaultCtx
+        -- >>= relativizeUrls
+        >>= removeIndexHtml
+
+  create ["archive.html"] $ do
+    route prettyRoute
+    compile $ do
+      posts <- recentFirst =<< loadAll "posts/*"
+      let archiveCtx =
+            listField "posts" postCtx (return posts)
+              <> constField "title" "Archives"
+              <> defaultCtx
+
+      makeItem ""
+        >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
+        >>= loadAndApplyTemplate "templates/default.html" archiveCtx
+        >>= relativizeUrls
+        >>= removeIndexHtml
+
+  match "index.html" $ do
+    route idRoute
+    compile $ do
+      posts <- recentFirst =<< loadAll "posts/*"
+      let indexCtx =
+            listField "posts" postCtx (return posts)
+              <> defaultCtx
+
+      getResourceBody
+        >>= applyAsTemplate indexCtx
+        >>= loadAndApplyTemplate "templates/default.html" indexCtx
+        >>= relativizeUrls
+        >>= removeIndexHtml
+
+  create ["atom.xml"] $ do
+    route idRoute
+    compile $ do
+      let feedCtx = postCtx <> bodyField "description"
+      posts <-
+        fmap (take 10) . recentFirst
+          =<< loadAllSnapshots "posts/*" "content"
+      renderAtom feedConfiguration feedCtx posts
+
+  create ["rss.xml"] $ do
+    route idRoute
+    compile $ do
+      let feedCtx = postCtx <> bodyField "description"
+      posts <-
+        fmap (take 10) . recentFirst
+          =<< loadAllSnapshots "posts/*" "content"
+      renderRss feedConfiguration feedCtx posts
+
+--------------------------------------------------------------------------------
+feedConfiguration :: FeedConfiguration
+feedConfiguration =
+  FeedConfiguration
+    { feedTitle = "Posts on Skiletro.com",
+      feedDescription = "Recent posts from Skiletro.com",
+      feedAuthorName = "Skiletro",
+      feedAuthorEmail = "19377854+skiletro@users.noreply.github.com", -- you're not getting my email that easily
+      feedRoot = "https://skiletro.com"
+    }
+
+--------------------------------------------------------------------------------
+
+prettyRoute :: Routes
+prettyRoute = customRoute createIndexRoute
+  where
+    createIndexRoute ident =
+      takeDirectory p </> takeBaseName p </> "index.html"
+      where
+        p = toFilePath ident
+
+removeIndexHtml :: Item String -> Compiler (Item String)
+removeIndexHtml item = return $ fmap (withUrls removeIndexStr) item
+  where
+    removeIndexStr :: String -> String
+    removeIndexStr url = case splitFileName url of
+      (dir, "index.html") | isLocal dir -> dir
+      _                                 -> url
+      where
+        isLocal uri = not ("://" `isInfixOf` uri)
+
+--------------------------------------------------------------------------------
+
+defaultCtx :: Context String
+defaultCtx = gitRevisionCtx <> defaultContext
+
+postCtx :: Context String
+postCtx = hDateCtx <> cDateCtx <> defaultCtx
+
+hDateCtx :: Context String
+hDateCtx = dateField "hdate" "%B %e, %Y"
+
+cDateCtx :: Context String
+cDateCtx = dateField "cdate" "%Y-%m-%d"
+
+gitRevisionCtx :: Context String
+gitRevisionCtx = field "revision" $ \_ -> do
+  mRevision <- unsafeCompiler $ lookupEnv "GIT_REVISION"
+  return $ fromMaybe "dev" mRevision
+
+--------------------------------------------------------------------------------