From 3b76863b673e14bbb20d2fb81de727c72259b25e Mon Sep 17 00:00:00 2001 From: jamie Date: Thu, 23 Oct 2025 11:43:03 +0100 Subject: refactor: neaten up source tree --- ssg/Main.hs | 151 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ssg/ssg.cabal | 15 ++++++ 2 files changed, 166 insertions(+) create mode 100644 ssg/Main.hs create mode 100644 ssg/ssg.cabal (limited to 'ssg') 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 + +-------------------------------------------------------------------------------- diff --git a/ssg/ssg.cabal b/ssg/ssg.cabal new file mode 100644 index 0000000..c22ef58 --- /dev/null +++ b/ssg/ssg.cabal @@ -0,0 +1,15 @@ +name: ssg +version: 0.1.0.0 +build-type: Simple +cabal-version: >= 1.10 + +executable site + main-is: Main.hs + build-depends: base == 4.* + , filepath + , hakyll == 4.16.* + , hakyll-sass == 0.2.* + , template-haskell == 2.21.* + , process == 1.6.25.* + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 -- cgit v1.3.1