{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module HTML ( generate ) where import Article(Article(..)) import ArticlesList (ArticlesList(..)) import Blog (Blog(..), Path(..), Skin(..)) 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 (page) import Lucid (renderTextT) import Pretty ((.$)) import System.FilePath.Posix ((), (<.>)) articlesLists :: Monad m => Collection -> ReaderT Blog m [(FilePath, ArticlesList)] articlesLists (Collection {articlesFeatured, basePath, tag}) = do limit <- take <$> (asks $skin.$previewArticlesCount) return [ (basePath "index" <.> "html", ArticlesList { tagged = tag , full = False , featured = limit articlesFeatured }) , (basePath "all" <.> "html", ArticlesList { tagged = tag , full = True , featured = articlesFeatured }) ] generateArticles :: [Article] -> ReaderT Blog IO () generateArticles = mapM_ $ \article -> do baseDir <- () <$> (asks $path.$root) <*> (asks $path.$articlesPath) (renderTextT $ page article) >>= liftIO . TextIO.writeFile (baseDir key article <.> "html") generateCollection :: Collection -> ReaderT Blog IO () generateCollection (Collection {articlesFeatured = []}) = return () generateCollection aCollection = do articlesLists aCollection >>= (mapM_ $ \(filePath, articlesList) -> (renderTextT $ page articlesList) >>= liftIO . TextIO.writeFile filePath ) generate :: ReaderT Blog IO () generate = do asks articles >>= generateArticles . Map.elems Collection.getAll >>= mapM_ generateCollection