123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135 |
- module Main where
-
- import Control.Concurrent (threadDelay)
- import Control.Monad
- import Data.Aeson
- import qualified Data.Map as M
- import qualified Data.Text as T
- import Path ( parseAbsDir
- , toFilePath
- )
- import Path.IO ( copyDirRecur )
- import System.Console.ArgParser
- import System.Directory
- import System.FilePath
- import System.FSNotify
- import Text.Pandoc
-
- import Build ( buildRawPost
- , buildIndexPage
- , buildRSSFeed
- , buildPostListing
- , buildPostListingItem
- )
- import CLI ( argParser
- , Config
- , Config(..)
- )
- import Post ( parsePost
- , parsePosts
- , renderPost
- , renderPosts
- , RawPost
- , RichPost
- )
- import Read ( readIndexTemplate
- , readPostTemplate
- , readRSSTemplate
- , readPostContents
- )
- import Templates ( defaultIndexTemplate
- , defaultPostTemplate
- )
- import Utils ( errorsAndResults
- , lookupMeta'
- , makeFullFilePath
- , sortByDate
- )
- import Write ( writeIndexPage
- , writePost
- , writeRSSFeed
- )
-
- setUpBuildDirectory :: FilePath -> IO ()
- setUpBuildDirectory path = do
- buildPathExists <- doesDirectoryExist path
- when buildPathExists $ removeDirectoryRecursive path
- createDirectory path
- createDirectory $ joinPath [path, "posts"]
-
- copyAssetsDir :: FilePath -> FilePath -> IO ()
- copyAssetsDir root build = do
- sourcePath <- parseAbsDir $ joinPath [root, "assets"]
- destPath <- parseAbsDir $ joinPath [build, "assets"]
- sourcePathExists <- doesDirectoryExist $ toFilePath sourcePath
- when sourcePathExists $ copyDirRecur sourcePath destPath
-
- build :: FilePath -> Bool -> IO ()
- build dir drafts = do
- cwd <- getCurrentDirectory
- root <- if dir == "." then makeAbsolute cwd else makeAbsolute dir
- build <- makeAbsolute $ joinPath [root, "build"]
- indexTemplate <- readIndexTemplate root
- postTemplate <- readPostTemplate root
- rssTemplate <- readRSSTemplate root
- postContents <- readPostContents root drafts
- let (parseErrors, parsedPosts) = errorsAndResults $ parsePosts postContents
- case parseErrors of
- [] ->
- let (renderErrors, renderedPosts) =
- errorsAndResults $ renderPosts postTemplate parsedPosts
- in case renderErrors of
- [] -> do
- setUpBuildDirectory build
- mapM_ (writePost build) renderedPosts
- case buildIndexPage indexTemplate parsedPosts of
- Left err -> putStrLn err
- Right indexPage -> writeIndexPage build indexPage
- case buildRSSFeed rssTemplate parsedPosts of
- Left err -> putStrLn err
- Right rssFeed -> writeRSSFeed build rssFeed
- copyAssetsDir root build
- _ -> putStrLn $ unlines $ map show renderErrors
- _ -> putStrLn $ unlines $ map show parseErrors
-
- handleEvent :: FilePath -> Bool -> Event -> IO ()
- handleEvent dir drafts _event = do
- putStrLn "Rebuilding"
- build dir drafts
-
- watch :: FilePath -> Bool -> IO ()
- watch dir drafts = do
- withManager $ \mgr -> do
- putStrLn "Watching..."
- watchTree
- mgr
- dir
- (const True)
- (handleEvent dir drafts)
- forever $ threadDelay 1000000
-
- new :: String -> IO ()
- new name = do
- path <- makeAbsolute name
- directoryExists <- doesDirectoryExist path
- if directoryExists
- then putStrLn $ "Error: Directory " ++ name ++ " already exists"
- else do
- createDirectory path
- createDirectory $ joinPath [path, "posts"]
- createDirectory $ joinPath [path, "drafts"]
- createDirectory $ joinPath [path, "templates"]
- writeFile (joinPath [path, "templates", "_index.html"])
- defaultIndexTemplate
- writeFile (joinPath [path, "templates", "_post.html"]) defaultPostTemplate
-
- run :: Config -> IO ()
- run config = case config of
- (Build dir drafts) -> build dir drafts
- (Watch dir drafts) -> watch dir drafts
- (New name ) -> new name
-
- main :: IO ()
- main = do
- config <- argParser
- runApp config run
|