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.

Main.hs 5.6KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135
  1. module Main where
  2. import Control.Concurrent (threadDelay)
  3. import Control.Monad
  4. import Data.Aeson
  5. import qualified Data.Map as M
  6. import qualified Data.Text as T
  7. import Path ( parseAbsDir
  8. , toFilePath
  9. )
  10. import Path.IO ( copyDirRecur )
  11. import System.Console.ArgParser
  12. import System.Directory
  13. import System.FilePath
  14. import System.FSNotify
  15. import Text.Pandoc
  16. import Build ( buildRawPost
  17. , buildIndexPage
  18. , buildRSSFeed
  19. , buildPostListing
  20. , buildPostListingItem
  21. )
  22. import CLI ( argParser
  23. , Config
  24. , Config(..)
  25. )
  26. import Post ( parsePost
  27. , parsePosts
  28. , renderPost
  29. , renderPosts
  30. , RawPost
  31. , RichPost
  32. )
  33. import Read ( readIndexTemplate
  34. , readPostTemplate
  35. , readRSSTemplate
  36. , readPostContents
  37. )
  38. import Templates ( defaultIndexTemplate
  39. , defaultPostTemplate
  40. )
  41. import Utils ( errorsAndResults
  42. , lookupMeta'
  43. , makeFullFilePath
  44. , sortByDate
  45. )
  46. import Write ( writeIndexPage
  47. , writePost
  48. , writeRSSFeed
  49. )
  50. setUpBuildDirectory :: FilePath -> IO ()
  51. setUpBuildDirectory path = do
  52. buildPathExists <- doesDirectoryExist path
  53. when buildPathExists $ removeDirectoryRecursive path
  54. createDirectory path
  55. createDirectory $ joinPath [path, "posts"]
  56. copyAssetsDir :: FilePath -> FilePath -> IO ()
  57. copyAssetsDir root build = do
  58. sourcePath <- parseAbsDir $ joinPath [root, "assets"]
  59. destPath <- parseAbsDir $ joinPath [build, "assets"]
  60. sourcePathExists <- doesDirectoryExist $ toFilePath sourcePath
  61. when sourcePathExists $ copyDirRecur sourcePath destPath
  62. build :: FilePath -> Bool -> IO ()
  63. build dir drafts = do
  64. cwd <- getCurrentDirectory
  65. root <- if dir == "." then makeAbsolute cwd else makeAbsolute dir
  66. build <- makeAbsolute $ joinPath [root, "build"]
  67. indexTemplate <- readIndexTemplate root
  68. postTemplate <- readPostTemplate root
  69. rssTemplate <- readRSSTemplate root
  70. postContents <- readPostContents root drafts
  71. let (parseErrors, parsedPosts) = errorsAndResults $ parsePosts postContents
  72. case parseErrors of
  73. [] ->
  74. let (renderErrors, renderedPosts) =
  75. errorsAndResults $ renderPosts postTemplate parsedPosts
  76. in case renderErrors of
  77. [] -> do
  78. setUpBuildDirectory build
  79. mapM_ (writePost build) renderedPosts
  80. case buildIndexPage indexTemplate parsedPosts of
  81. Left err -> putStrLn err
  82. Right indexPage -> writeIndexPage build indexPage
  83. case buildRSSFeed rssTemplate parsedPosts of
  84. Left err -> putStrLn err
  85. Right rssFeed -> writeRSSFeed build rssFeed
  86. copyAssetsDir root build
  87. _ -> putStrLn $ unlines $ map show renderErrors
  88. _ -> putStrLn $ unlines $ map show parseErrors
  89. handleEvent :: FilePath -> Bool -> Event -> IO ()
  90. handleEvent dir drafts _event = do
  91. putStrLn "Rebuilding"
  92. build dir drafts
  93. watch :: FilePath -> Bool -> IO ()
  94. watch dir drafts = do
  95. withManager $ \mgr -> do
  96. putStrLn "Watching..."
  97. watchTree
  98. mgr
  99. dir
  100. (const True)
  101. (handleEvent dir drafts)
  102. forever $ threadDelay 1000000
  103. new :: String -> IO ()
  104. new name = do
  105. path <- makeAbsolute name
  106. directoryExists <- doesDirectoryExist path
  107. if directoryExists
  108. then putStrLn $ "Error: Directory " ++ name ++ " already exists"
  109. else do
  110. createDirectory path
  111. createDirectory $ joinPath [path, "posts"]
  112. createDirectory $ joinPath [path, "drafts"]
  113. createDirectory $ joinPath [path, "templates"]
  114. writeFile (joinPath [path, "templates", "_index.html"])
  115. defaultIndexTemplate
  116. writeFile (joinPath [path, "templates", "_post.html"]) defaultPostTemplate
  117. run :: Config -> IO ()
  118. run config = case config of
  119. (Build dir drafts) -> build dir drafts
  120. (Watch dir drafts) -> watch dir drafts
  121. (New name ) -> new name
  122. main :: IO ()
  123. main = do
  124. config <- argParser
  125. runApp config run