54 lines
1.8 KiB
Haskell
54 lines
1.8 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module HTML (
|
|
generate
|
|
) where
|
|
|
|
import Article(Article(..))
|
|
import Blog (Blog(..))
|
|
import Control.Monad (forM_)
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
import Control.Monad.Reader (MonadReader(..), ReaderT)
|
|
import Data.List (sortOn)
|
|
import qualified Data.Map as Map (elems, filterWithKey, toList)
|
|
import Data.Ord (Down(..))
|
|
import qualified Data.Set as Set (member)
|
|
import qualified Data.Text.Lazy.IO as TextIO (writeFile)
|
|
import Dom (Page(..), render)
|
|
import Lucid
|
|
import System.Directory (createDirectoryIfMissing)
|
|
import System.FilePath.Posix ((</>))
|
|
import System.Posix.Files (modificationTime)
|
|
|
|
generateCollection :: (Maybe String, FilePath, [Article]) -> ReaderT Blog IO ()
|
|
generateCollection (_, _, []) = return ()
|
|
generateCollection (category, path, articlesFeatured) = do
|
|
blog <- ask
|
|
liftIO $ createDirectoryIfMissing False path
|
|
forM_ (pages $ previewArticlesCount blog) $ \(filePath, page) ->
|
|
renderTextT (render page)
|
|
>>= liftIO . TextIO.writeFile filePath
|
|
where
|
|
pages articlesCount = [
|
|
(path </> "all.html", Page {
|
|
category
|
|
, full = True
|
|
, articlesFeatured
|
|
})
|
|
, (path </> "index.html", Page {
|
|
category
|
|
, full = False
|
|
, articlesFeatured = take articlesCount articlesFeatured
|
|
})
|
|
]
|
|
|
|
generate :: ReaderT Blog IO ()
|
|
generate = do
|
|
Blog {root, articles, tags} <- ask
|
|
generateCollection (Nothing, root, sortByDate $ Map.elems articles)
|
|
forM_ (Map.toList $ tags) $ \(tag, tagged) ->
|
|
generateCollection (Just tag, root </> tag, sortByDate $ getArticles tagged articles)
|
|
where
|
|
getArticles tagged = Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged)
|
|
sortByDate = sortOn (Down . modificationTime . fileStatus)
|