--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import Hakyll
import Hakyll.Contrib.I18n
( Language
, categoryField'
, feedConfiguration
, tagsField'
, translate
, translationCompiler
, translationContext
)
import Control.Monad (mplus)
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import System.FilePath ((</>), splitExtension, splitFileName, takeDirectory)
import Text.Pandoc (Format (..), Pandoc)
import Text.Pandoc.Filter.IncludeCode (includeCode)
import Text.Pandoc.Walk (walkM)
import qualified Data.HashMap.Strict as SM (union)
import qualified GHC.IO.Encoding as E
includeCodePandocCompiler :: Compiler (Item String)
includeCodePandocCompiler =
pandocCompilerWithTransformM
defaultHakyllReaderOptions
defaultHakyllWriterOptions
(unsafeCompiler . (walkM (includeCode (Just (Format "html5")))))
main :: IO ()
main = do
E.setLocaleEncoding E.utf8
hakyll $ do
match "assets/**/*" $ do
route idRoute
compile copyFileCompiler
match "css/*" $ do
route idRoute
compile compressCssCompiler
match "*/translation.yml" $
compile translationCompiler
match ("snippets/*" .||. "*/snippets/*") $
compile getResourceBody
match ("templates/*" .&&. complement "templates/translation.yml") $
compile templateBodyCompiler
create ["index.html"] $ do
route idRoute
compile $ do
defaultTranslation <- loadBody "templates/translation.yml"
makeItem $ Redirect $ translate defaultTranslation "DEFAULT_LANGUAGE"
create ["sitemap.xml"] $ do
route idRoute
compile $ do
archives <- loadAll $ hasVersion "archive"
archivesAllLanguages <- loadAll $ hasVersion "archiveAllLanguages"
categories <- loadAll $ ("*/categories/*" .&&. hasNoVersion)
categoriesAllLanguages <- loadAll $ ("*/categories/*" .&&. hasVersion "categoryAllLanguages")
index <- loadAll $ hasVersion "index"
pages <- loadAll $ hasVersion "page"
posts <- loadAll "*/posts/*/*"
tags <- loadAll $ ("*/tags/*" .&&. hasNoVersion)
tagsAllLanguages <- loadAll $ ("*/tags/*" .&&. hasVersion "tagAllLanguages")
let context =
listField "archives" generalContext (return archives) <>
listField "archivesAllLanguages" generalContext (return archivesAllLanguages) <>
listField "categories" generalContext (return categories) <>
listField "categoriesAllLanguages" generalContext (return categoriesAllLanguages) <>
listField "index" generalContext (return index) <>
listField "pages" generalContext (return pages) <>
listField "posts" generalContext (return posts) <>
listField "tags" generalContext (return tags) <>
listField "tagsAllLanguages" generalContext (return tagsAllLanguages)
makeItem ""
>>= loadAndApplyTemplate "templates/sitemap.xml" context
>>= relativizeUrls
sequence_ $ [archives, categories, feeds, index, pages, posts, tags] <*> ["en", "fr"]
archives :: Language -> Rules ()
archives language = sequence_ $ [archives', archives''] <*> pure language where
archives' :: Language -> Rules ()
archives' language = do
categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
tags <- buildTags (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")
create [fromFilePath $ language </> "archive.html"] $ version "archive" $ do
route indexRoute
compile $ do
posts <- recentFirst =<< (loadAll $ fromGlob $ language </> "posts/*/*")
let context =
boolField "single" (const True) <>
constField "switch" ("/archive" </> language) <>
listField "posts" (postContext tags categories) (return posts) <>
generalContext
makeItem ""
>>= loadAndApplyTemplate "templates/archive.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
archives'' :: Language -> Rules ()
archives'' language = do
categories <- buildCategories "*/posts/*/*" (fromCapture $ fromGlob $ language </> "categories/*.html")
tags <- buildTags "*/posts/*/*" (fromCapture $ fromGlob $ language </> "tags/*.html")
create [fromFilePath $ language </> "archive.html"] $ version "archiveAllLanguages" $ do
route $ gsubRoute (language </> "archive") (const $ "archive" </> language) `composeRoutes` indexRoute
compile $ do
posts <- recentFirst =<< loadAll ("*/posts/*/*")
let context =
boolField "single" (const False) <>
constField "switch" ("/" ++ language </> "archive") <>
listField "posts" (postContext tags categories) (return posts) <>
generalContext
makeItem ""
>>= loadAndApplyTemplate "templates/archive.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
categories :: Language -> Rules ()
categories language = sequence_ $ [categories', categories''] <*> pure language where
categories' :: Language -> Rules ()
categories' language = do
categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
tags <- buildTags (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")
tagsRules categories $ \category pattern -> do
route indexRoute
compile $ do
posts <- recentFirst =<< loadAll pattern
let context =
boolField "single" (const True) <>
constField "switch" ("/categories" </> language </> category) <>
listField "posts" (postContext tags categories) (return posts) <>
generalContext
makeItem ""
>>= loadAndApplyTemplate "templates/category.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
categories'' :: Language -> Rules ()
categories'' language = do
categories <- buildCategories "*/posts/*/*" (fromCapture $ fromGlob $ language </> "categories/*.html")
tags <- buildTags "*/posts/*/*" (fromCapture $ fromGlob $ language </> "tags/*.html")
version "categoryAllLanguages" $ tagsRules categories $ \category pattern -> do
route $ gsubRoute (language </> "categories") (const $ "categories" </> language) `composeRoutes` indexRoute
compile $ do
posts <- recentFirst =<< loadAll pattern
let context =
boolField "single" (const False) <>
constField "switch" ("/" ++ language </> "categories" </> category) <>
listField "posts" (postContext tags categories) (return posts) <>
generalContext
makeItem ""
>>= loadAndApplyTemplate "templates/category.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
feeds :: Language -> Rules ()
feeds language = sequence_ $ [atom, rss] <*> pure language where
atom :: Language -> Rules ()
atom language = create [fromFilePath $ language </> "atom.xml"] $ do
route idRoute
compile $ do
posts <- fmap (take 10) . recentFirst =<< (loadAll $ fromGlob $ language </> "posts/*/*")
languageTranslation <- loadBody $ fromFilePath $ language </> "translation.yml"
defaultTranslation <- loadBody "templates/translation.yml"
let translation = SM.union languageTranslation defaultTranslation
context = listField "posts" generalContext (return posts) <> generalContext
renderAtom (feedConfiguration translation) generalContext posts
rss :: Language -> Rules ()
rss language = create [fromFilePath $ language </> "rss.xml"] $ do
route idRoute
compile $ do
posts <- fmap (take 10) . recentFirst =<< (loadAll $ fromGlob $ language </> "posts/*/*")
languageTranslation <- loadBody $ fromFilePath $ language </> "translation.yml"
defaultTranslation <- loadBody "templates/translation.yml"
let translation = SM.union languageTranslation defaultTranslation
context = listField "posts" generalContext (return posts) <> generalContext
renderRss (feedConfiguration translation) generalContext posts
index :: Language -> Rules ()
index language = do
categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
tags <- buildTags (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")
match (fromGlob $ language </> "index.*") $ version "index" $ do
route $ setExtension "html"
compile $ do
posts <- fmap (take 10) . recentFirst =<< (loadAll $ fromGlob $ language </> "posts/*/*")
let context = listField "posts" (postContext tags categories) (return posts) <> generalContext
pandocCompiler
>>= applyAsTemplate context
>>= loadAndApplyTemplate "templates/main.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
pages :: Language -> Rules ()
pages language = match ((fromGlob $ language </> "*.*") .&&. (complement . fromGlob $ language </> "index.*") .&&. (complement . fromGlob $ language </> "translation.yml")) $ version "page" $ do
route $ indexRoute
compile $
pandocCompiler
>>= applyAsTemplate generalContext
>>= loadAndApplyTemplate "templates/main.html" generalContext
>>= loadAndApplyTemplate "templates/default.html" generalContext
>>= relativizeUrls
posts :: Language -> Rules ()
posts language = do
categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
tags <- buildTags (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")
match (fromGlob $ language </> "posts/*/*") $ do
route indexRoute
compile $ do
let context = postContext tags categories
pandocCompiler
>>= saveSnapshot "teaser"
>>= loadAndApplyTemplate "templates/post.html" context
>>= loadAndApplyTemplate "templates/main.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
tags :: Language -> Rules ()
tags language = sequence_ $ [tags', tags''] <*> pure language where
tags' :: Language -> Rules ()
tags' language = do
categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
tags <- buildTags (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")
tagsRules tags $ \tag pattern -> do
route indexRoute
compile $ do
posts <- recentFirst =<< loadAll pattern
let context =
boolField "single" (const True) <>
constField "switch" ("/tags" </> language </> tag) <>
listField "posts" (postContext tags categories) (return posts) <>
generalContext
makeItem ""
>>= loadAndApplyTemplate "templates/tag.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
tags'' :: Language -> Rules ()
tags'' language = do
categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
tags <- buildTags (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")
version "tagAllLanguages" $ tagsRules tags $ \tag pattern -> do
route $ gsubRoute (language </> "tags") (const $ "tags" </> language) `composeRoutes` indexRoute
compile $ do
posts <- recentFirst =<< loadAll pattern
let context =
boolField "single" (const False) <>
constField "switch" ("/" ++ language </> "tags" </> tag) <>
listField "posts" (postContext tags categories) (return posts) <>
generalContext
makeItem ""
>>= loadAndApplyTemplate "templates/tag.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
indexRoute :: Routes
indexRoute = customRoute $ (\(p, _) -> p </> "index.html") . splitExtension . toFilePath
dropIndexHtml :: Context a
dropIndexHtml = mapContext transform (urlField "url")
where
transform :: FilePath -> FilePath
transform url = case splitFileName url of
(p, "index.html") -> takeDirectory p
_ -> url
customListField :: String -> String -> Context a
customListField key custom = listFieldWith key (field custom $ return . itemBody) customListField'
where
customListField' :: Item b -> Compiler [Item String]
customListField' item = do
metadata <- getMetadata $ itemIdentifier item
let customs = fromMaybe [] $
lookupStringList key metadata `mplus`
(map trim . splitAll "," <$> lookupString key metadata)
mapM makeItem customs
generalContext :: Context String
generalContext =
dropIndexHtml <>
translationContext <>
customListField "scripts" "script" <>
defaultContext
postContext :: Tags -> Tags -> Context String
postContext tags categories =
Hakyll.Contrib.I18n.categoryField' "category" categories <>
Hakyll.Contrib.I18n.tagsField' "tags" tags <>
teaserField "teaser" "teaser" <>
generalContext