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