clover/app/Main.hs

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