2019-02-02 23:23:05 +01:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module HTML (
|
|
|
|
generate
|
|
|
|
) where
|
|
|
|
|
|
|
|
import Article(Article(..))
|
2019-02-03 22:56:21 +01:00
|
|
|
import ArticlesList (ArticlesList(..))
|
2020-05-08 15:51:25 +02:00
|
|
|
import Blog (Blog(..), Path(..))
|
2020-03-25 19:47:28 +01:00
|
|
|
import Collection (Collection(..))
|
|
|
|
import qualified Collection (getAll)
|
2019-02-02 23:23:05 +01:00
|
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
2020-03-25 19:47:28 +01:00
|
|
|
import Control.Monad.Reader (ReaderT, asks)
|
|
|
|
import qualified Data.Map as Map (elems)
|
2019-02-02 23:23:05 +01:00
|
|
|
import qualified Data.Text.Lazy.IO as TextIO (writeFile)
|
2019-12-21 12:50:38 +01:00
|
|
|
import DOM (page)
|
2020-03-25 19:47:28 +01:00
|
|
|
import Lucid (renderTextT)
|
2019-02-07 17:51:06 +01:00
|
|
|
import Pretty ((.$))
|
2019-02-03 22:56:21 +01:00
|
|
|
import System.FilePath.Posix ((</>), (<.>))
|
2019-02-02 23:23:05 +01:00
|
|
|
|
2020-05-08 15:51:25 +02:00
|
|
|
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"
|
2019-02-03 22:56:21 +01:00
|
|
|
|
|
|
|
generateArticles :: [Article] -> ReaderT Blog IO ()
|
|
|
|
generateArticles = mapM_ $ \article -> do
|
2020-03-25 19:47:28 +01:00
|
|
|
baseDir <- (</>) <$> (asks $path.$root) <*> (asks $path.$articlesPath)
|
2019-02-04 15:50:35 +01:00
|
|
|
(renderTextT $ page article)
|
2019-02-15 18:07:59 +01:00
|
|
|
>>= liftIO . TextIO.writeFile (baseDir </> key article <.> "html")
|
2019-02-03 22:56:21 +01:00
|
|
|
|
|
|
|
generateCollection :: Collection -> ReaderT Blog IO ()
|
2020-05-08 15:51:25 +02:00
|
|
|
generateCollection (Collection {featured = []}) = return ()
|
|
|
|
generateCollection collection =
|
|
|
|
flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
|
|
|
|
(renderTextT $ page articlesList) >>= liftIO . TextIO.writeFile filePath
|
2019-02-02 23:23:05 +01:00
|
|
|
|
|
|
|
generate :: ReaderT Blog IO ()
|
|
|
|
generate = do
|
2020-03-25 19:47:28 +01:00
|
|
|
asks articles >>= generateArticles . Map.elems
|
|
|
|
Collection.getAll >>= mapM_ generateCollection
|