|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165 |
- {-# LANGUAGE OverloadedStrings #-}
-
- import Data.Monoid ((<>))
- import Data.List (sortBy,isSuffixOf)
- import Data.Typeable
- import GHC.IO.Encoding
- import Hakyll
- import Hakyll.Favicon (faviconsRules, faviconsField)
- import System.FilePath.Posix (takeBaseName,takeDirectory,(</>))
-
-
- main :: IO ()
- main = do
-
- -- Set the encoding so w3c doesnt complain
- setLocaleEncoding utf8
- hakyllWith rfConf $ do
-
- -- Generate the favicons
- faviconsRules "icons/favicon.svg"
-
- -- Straight copying of files
- match (fromList ["humans.txt", "robots.txt", "fonts/*"]) $ do
- route idRoute
- compile copyFileCompiler
-
- -- CSS needs to be compiled and minified
- match "css/*" $ do
- route idRoute
- compile compressCssCompiler
-
- -- Load pages that need to be formatted
- match (fromList ["about.md", "contact.md"]) $ do
- route $ cleanRoute
- compile $ pandocCompiler
- >>= loadAndApplyTemplate "templates/default.html" ctx
- >>= relativizeUrls
- >>= cleanIndexUrls
-
- -- Render Atom + Rss feeds
- create ["atom.xml"] $ do
- route idRoute
- (compileFeed renderAtom)
-
- create ["rss.xml"] $ do
- route idRoute
- (compileFeed renderRss)
-
- -- Compile the templates
- match "templates/*" $ compile templateBodyCompiler
-
- -- Compile the archive page and post list
- match "archive.md" $ do
- route $ cleanRoute
- compile $ do
- posts <- recentFirst =<< loadAll "posts/*"
- let archiveCtx =
- listField "posts" postCtx (return posts) <>
- ctx
- pandocCompiler
- >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
- >>= loadAndApplyTemplate "templates/default.html" archiveCtx
- >>= relativizeUrls
- >>= cleanIndexUrls
-
- -- Compile and load posts
- match "index.md" $ do
- route $ setExtension "html"
- compile $ pandocCompiler
- >>= loadAndApplyTemplate "templates/index.html" ctx
- >>= relativizeUrls
- >>= cleanIndexUrls
-
- compile $ do
- posts <- (return . (take 5))
- =<< recentFirst
- =<< loadAll "posts/*"
- let indexCtx =
- listField "posts" postCtx (return posts) <> ctx
- pandocCompiler
- >>= applyAsTemplate indexCtx
- >>= loadAndApplyTemplate "templates/index.html" indexCtx
- >>= loadAndApplyTemplate "templates/default.html" indexCtx
- >>= relativizeUrls
- >>= cleanIndexUrls
-
- -- Compile posts + save snapshots for the web feeds
- match "posts/*" $ do
- route $ cleanRoute
- compile $ pandocCompiler
- >>= loadAndApplyTemplate "templates/post.html" postCtx
- >>= saveSnapshot "content"
- >>= loadAndApplyTemplate "templates/default.html" postCtx
- >>= relativizeUrls
- >>= cleanIndexUrls
- >>= cleanIndexHtmls
-
- -- Set the input/output directories
- rfConf :: Configuration
- rfConf = defaultConfiguration
- { destinationDirectory = "_http"
- , storeDirectory = "_store"
- , tmpDirectory = "_tmp"
- , providerDirectory = "_input"
- }
-
-
- -- Agnememnon the Fuck-Upperer - Conquerer of Small Type Declarations
- compileFeed ::
- (FeedConfiguration
- -> Context String
- -> [Item String]
- -> Compiler (Item String)
- ) -> Rules ()
- -- For those left alive, this abstracts out creating
- -- Atom and RSS feeds
- compileFeed f = compile $ do
- let feedCtx = postCtx <>
- bodyField "description"
- posts <- fmap (take 10) . recentFirst
- =<< loadAllSnapshots "posts/*" "content"
- f feedConfig feedCtx posts
-
- -- The configuration for our Atom/RSS feeds
- feedConfig :: FeedConfiguration
- feedConfig = FeedConfiguration {
- feedTitle = "Regular Flolloping"
- , feedDescription = "tA's Blog"
- , feedAuthorName = "Shaun Kerr"
- , feedAuthorEmail = "s@p7.co.nz"
- , feedRoot = "https://regularflolloping.com"
- }
-
- -- Our default context for pages
- ctx :: Context String
- ctx = defaultContext <>
- faviconsField
-
- -- Default context for posts
- postCtx :: Context String
- postCtx =
- (dateField "date" "%B %e, %Y") <> ctx
-
- -- Functions to convert pages to /name/index.html
- cleanRoute :: Routes
- cleanRoute = customRoute createIndexRoute
- where
- createIndexRoute ident =
- takeDirectory p </> takeBaseName p </> "index.html"
- where p = toFilePath ident
-
- cleanIndexUrls :: Item String -> Compiler (Item String)
- cleanIndexUrls = return . fmap (withUrls cleanIndex)
-
- cleanIndexHtmls :: Item String -> Compiler (Item String)
- cleanIndexHtmls = return . fmap (replaceAll pattern replacement)
- where
- pattern = "/index.html"
- replacement = const "/"
-
- cleanIndex :: String -> String
- cleanIndex url
- | idx `isSuffixOf` url = take (length url - length idx) url
- | otherwise = url
- where idx = "index.html"
|