A static site generator written in Haskell
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.

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. module Build where
  2. import Data.Aeson
  3. import qualified Data.Text as T
  4. import Data.Time
  5. import GHC.Exts ( fromList )
  6. import System.FilePath
  7. import Text.Pandoc
  8. import Post ( renderPost
  9. , RawPost
  10. , RichPost
  11. )
  12. import Utils ( escapeHTML
  13. , lookupMeta'
  14. , sortByDate
  15. )
  16. parseDay :: String -> Day
  17. parseDay = parseTimeOrError True defaultTimeLocale "%Y-%m-%d"
  18. buildRawPost :: FilePath -> IO RawPost
  19. buildRawPost path = do
  20. contents <- readFile path
  21. return (path, T.pack contents)
  22. buildIndexPage :: String -> [RichPost] -> Either String T.Text
  23. buildIndexPage layout rawPosts = case compileTemplate (T.pack layout) of
  24. Left err -> Left err
  25. Right template -> Right $ renderTemplate template (buildPostListing rawPosts)
  26. buildPostListing :: [RichPost] -> Value
  27. buildPostListing posts =
  28. let postListing = map buildPostListingItem (sortByDate posts)
  29. in object [(T.pack "posts", Array $ fromList postListing)]
  30. buildPostListingItem :: RichPost -> Value
  31. buildPostListingItem (path, Pandoc m b) =
  32. let keys = ["title", "date", "slug"]
  33. bindings = map (\key -> T.pack key .= lookupMeta' key m) keys
  34. body = case renderPost "<article>$body$</article>" (path, Pandoc m b) of
  35. Left _error -> ""
  36. Right contents -> T.unpack contents
  37. in object
  38. $ bindings
  39. ++ [ ( T.pack "link"
  40. , toJSON
  41. $ T.concat [T.pack "/posts/", lookupMeta' "slug" m, T.pack "/"]
  42. )
  43. , (T.pack "body", toJSON $ escapeHTML body)
  44. , ( T.pack "iso_date"
  45. , toJSON $ formatTime defaultTimeLocale
  46. "%a, %d %b %Y 00:00:00 +0000"
  47. (parseDay (T.unpack $ lookupMeta' "date" m))
  48. )
  49. ]
  50. buildRSSFeed :: String -> [RichPost] -> Either String T.Text
  51. buildRSSFeed layout posts = case compileTemplate (T.pack layout) of
  52. Left err -> Left err
  53. Right template -> Right $ renderTemplate template (buildPostListing posts)