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.

99 lines
3.0KB

  1. {-# LANGUAGE OverloadedStrings #-}
  2. import Hakyll
  3. import Data.Monoid ((<>))
  4. import Data.List (sortBy,isSuffixOf)
  5. import System.FilePath.Posix (takeBaseName,takeDirectory,(</>))
  6. import GHC.IO.Encoding
  7. main :: IO ()
  8. main = do
  9. setLocaleEncoding utf8
  10. hakyll $ do
  11. match "humans.txt" $ do
  12. route idRoute
  13. compile copyFileCompiler
  14. match "css/*" $ do
  15. route idRoute
  16. compile compressCssCompiler
  17. match (fromList ["about.md", "contact.md"]) $ do
  18. route $ cleanRoute
  19. compile $ pandocCompiler
  20. >>= loadAndApplyTemplate "templates/default.html" ctx
  21. >>= relativizeUrls
  22. >>= cleanIndexUrls
  23. match "archive.md" $ do
  24. route $ cleanRoute
  25. compile $ pandocCompiler
  26. >>= loadAndApplyTemplate "templates/archive.html" ctx
  27. >>= relativizeUrls
  28. >>= cleanIndexUrls
  29. compile $ do
  30. posts <- recentFirst =<< loadAll "posts/*"
  31. let archiveCtx =
  32. listField "posts" postCtx (return posts) <>
  33. ctx
  34. pandocCompiler
  35. >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
  36. >>= loadAndApplyTemplate "templates/default.html" archiveCtx
  37. >>= relativizeUrls
  38. >>= cleanIndexUrls
  39. match "posts/*" $ do
  40. route $ cleanRoute
  41. compile $ pandocCompiler
  42. >>= loadAndApplyTemplate "templates/post.html" postCtx
  43. >>= loadAndApplyTemplate "templates/default.html" postCtx
  44. >>= relativizeUrls
  45. >>= cleanIndexUrls
  46. >>= cleanIndexHtmls
  47. match "index.html" $ do
  48. route idRoute
  49. compile $ do
  50. posts <- recentFirst =<< loadAll "posts/*"
  51. let indexCtx =
  52. listField "posts" postCtx (return posts) <>
  53. defaultContext
  54. getResourceBody
  55. >>= applyAsTemplate indexCtx
  56. >>= loadAndApplyTemplate "templates/default.html" indexCtx
  57. >>= relativizeUrls
  58. >>= cleanIndexUrls
  59. >>= cleanIndexHtmls
  60. match "templates/*" $ compile templateBodyCompiler
  61. ctx :: Context String
  62. ctx = defaultContext
  63. postCtx :: Context String
  64. postCtx =
  65. (dateField "date" "%B %e, %Y") <> ctx
  66. cleanRoute :: Routes
  67. cleanRoute = customRoute createIndexRoute
  68. where
  69. createIndexRoute ident =
  70. takeDirectory p </> takeBaseName p </> "index.html"
  71. where p = toFilePath ident
  72. cleanIndexUrls :: Item String -> Compiler (Item String)
  73. cleanIndexUrls = return . fmap (withUrls cleanIndex)
  74. cleanIndexHtmls :: Item String -> Compiler (Item String)
  75. cleanIndexHtmls = return . fmap (replaceAll pattern replacement)
  76. where
  77. pattern = "/index.html"
  78. replacement = const "/"
  79. cleanIndex :: String -> String
  80. cleanIndex url
  81. | idx `isSuffixOf` url = take (length url - length idx) url
  82. | otherwise = url
  83. where idx = "index.html"