hablo/src/HTML.hs

45 lines
1.5 KiB
Haskell

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module HTML (
generate
) where
import Article(Article(..))
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 (page)
import Lucid (renderTextT)
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"
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 {featured = []}) = return ()
generateCollection collection =
flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
(renderTextT $ page articlesList) >>= liftIO . TextIO.writeFile filePath
generate :: ReaderT Blog IO ()
generate = do
asks articles >>= generateArticles . Map.elems
Collection.getAll >>= mapM_ generateCollection