{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module HTML ( generate ) where import ArticlesList (ArticlesList(..)) import Blog (Blog(..), Path(..)) import Collection (Collection(..)) import qualified Collection (getAll) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader (ReaderT, asks) import qualified Data.Map as Map (elems) import qualified Data.Text.Lazy.IO as TextIO (writeFile) import DOM (HasContent, htmlDocument) import Lucid (renderTextT) import Markdown (Markdown(..), MarkdownContent(..)) import Pretty ((.$)) import System.FilePath.Posix ((), (<.>)) articlesLists :: Collection -> [(FilePath, ArticlesList)] articlesLists collection@(Collection {basePath}) = [ (path full, ArticlesList {collection, full}) | full <- [False, True] ] where file bool = if bool then "all" else "index" path bool = basePath file bool <.> "html" generateMarkdown :: (HasContent a, MarkdownContent a) => [a] -> ReaderT Blog IO () generateMarkdown = mapM_ $ \content -> do let relativePath = Markdown.path (getMarkdown content) <.> "html" filePath <- ( relativePath) <$> (asks $Blog.path.$root) (renderTextT $ htmlDocument content) >>= liftIO . TextIO.writeFile filePath generateCollection :: Collection -> ReaderT Blog IO () generateCollection (Collection {featured = []}) = return () generateCollection collection = flip mapM_ (articlesLists collection) $ \(filePath, articlesList) -> (renderTextT $ htmlDocument articlesList) >>= liftIO . TextIO.writeFile filePath generate :: ReaderT Blog IO () generate = do asks articles >>= generateMarkdown . Map.elems Collection.getAll >>= mapM_ generateCollection asks pages >>= generateMarkdown . Map.elems