56 lines
1.8 KiB
Haskell
56 lines
1.8 KiB
Haskell
{-# 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
|