tA's crappy blog
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

site.hs 4.9KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159
  1. {-# LANGUAGE OverloadedStrings #-}
  2. import Data.Monoid ((<>))
  3. import Data.List (sortBy,isSuffixOf)
  4. import Data.Typeable
  5. import GHC.IO.Encoding
  6. import Hakyll
  7. import Hakyll.Favicon (faviconsRules, faviconsField)
  8. import System.FilePath.Posix (takeBaseName,takeDirectory,(</>))
  9. main :: IO ()
  10. main = do
  11. -- Set the encoding so w3c doesnt complain
  12. setLocaleEncoding utf8
  13. hakyll $ do
  14. -- Generate the favicons
  15. faviconsRules "icons/favicon.svg"
  16. -- Straight copying of files
  17. match (fromList ["humans.txt", "robots.txt", "fonts/*"]) $ do
  18. route idRoute
  19. compile copyFileCompiler
  20. -- CSS needs to be compiled and minified
  21. match "css/*" $ do
  22. route idRoute
  23. compile compressCssCompiler
  24. -- Load pages that need to be formatted
  25. match (fromList ["about.md", "contact.md"]) $ do
  26. route $ cleanRoute
  27. compile $ pandocCompiler
  28. >>= loadAndApplyTemplate "templates/default.html" ctx
  29. >>= relativizeUrls
  30. >>= cleanIndexUrls
  31. -- Render Atom + Rss feeds
  32. create ["atom.xml"] $ do
  33. route idRoute
  34. (compileFeed renderAtom)
  35. create ["rss.xml"] $ do
  36. route idRoute
  37. (compileFeed renderRss)
  38. -- Compile the templates
  39. match "templates/*" $ compile templateBodyCompiler
  40. -- Compile the archive page and post list
  41. match "archive.md" $ do
  42. route $ cleanRoute
  43. compile $ pandocCompiler
  44. >>= loadAndApplyTemplate "templates/archive.html" ctx
  45. >>= relativizeUrls
  46. >>= cleanIndexUrls
  47. compile $ do
  48. posts <- recentFirst =<< loadAll "posts/*"
  49. let archiveCtx =
  50. listField "posts" postCtx (return posts) <>
  51. ctx
  52. pandocCompiler
  53. >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
  54. >>= loadAndApplyTemplate "templates/default.html" archiveCtx
  55. >>= relativizeUrls
  56. >>= cleanIndexUrls
  57. -- Compile and load posts
  58. match "index.md" $ do
  59. route $ setExtension "html"
  60. compile $ pandocCompiler
  61. >>= loadAndApplyTemplate "templates/index.html" ctx
  62. >>= relativizeUrls
  63. >>= cleanIndexUrls
  64. compile $ do
  65. posts <- (return . (take 5))
  66. =<< recentFirst
  67. =<< loadAll "posts/*"
  68. let indexCtx =
  69. listField "posts" postCtx (return posts) <> ctx
  70. pandocCompiler
  71. >>= applyAsTemplate indexCtx
  72. >>= loadAndApplyTemplate "templates/index.html" indexCtx
  73. >>= loadAndApplyTemplate "templates/default.html" indexCtx
  74. >>= relativizeUrls
  75. >>= cleanIndexUrls
  76. -- Compile posts + save snapshots for the web feeds
  77. match "posts/*" $ do
  78. route $ cleanRoute
  79. compile $ pandocCompiler
  80. >>= loadAndApplyTemplate "templates/post.html" postCtx
  81. >>= saveSnapshot "content"
  82. >>= loadAndApplyTemplate "templates/default.html" postCtx
  83. >>= relativizeUrls
  84. >>= cleanIndexUrls
  85. >>= cleanIndexHtmls
  86. -- Agnememnon the Fuck-Upperer - Conquerer of Small Type Declarations
  87. compileFeed ::
  88. (FeedConfiguration
  89. -> Context String
  90. -> [Item String]
  91. -> Compiler (Item String)
  92. ) -> Rules ()
  93. -- For those left alive, this abstracts out creating
  94. -- Atom and RSS feeds
  95. compileFeed f = compile $ do
  96. let feedCtx = postCtx <>
  97. bodyField "description"
  98. posts <- fmap (take 10) . recentFirst
  99. =<< loadAllSnapshots "posts/*" "content"
  100. f feedConfig feedCtx posts
  101. -- The configuration for our Atom/RSS feeds
  102. feedConfig :: FeedConfiguration
  103. feedConfig = FeedConfiguration {
  104. feedTitle = "Regular Flolloping"
  105. , feedDescription = "tA's Blog"
  106. , feedAuthorName = "Shaun Kerr"
  107. , feedAuthorEmail = "s@p7.co.nz"
  108. , feedRoot = "https://regularflolloping.com"
  109. }
  110. -- Our default context for pages
  111. ctx :: Context String
  112. ctx = defaultContext <>
  113. faviconsField
  114. -- Default context for posts
  115. postCtx :: Context String
  116. postCtx =
  117. (dateField "date" "%B %e, %Y") <> ctx
  118. -- Functions to convert pages to /name/index.html
  119. cleanRoute :: Routes
  120. cleanRoute = customRoute createIndexRoute
  121. where
  122. createIndexRoute ident =
  123. takeDirectory p </> takeBaseName p </> "index.html"
  124. where p = toFilePath ident
  125. cleanIndexUrls :: Item String -> Compiler (Item String)
  126. cleanIndexUrls = return . fmap (withUrls cleanIndex)
  127. cleanIndexHtmls :: Item String -> Compiler (Item String)
  128. cleanIndexHtmls = return . fmap (replaceAll pattern replacement)
  129. where
  130. pattern = "/index.html"
  131. replacement = const "/"
  132. cleanIndex :: String -> String
  133. cleanIndex url
  134. | idx `isSuffixOf` url = take (length url - length idx) url
  135. | otherwise = url
  136. where idx = "index.html"