47 lines
1.7 KiB
Haskell
47 lines
1.7 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module HTML (
|
|
generate
|
|
) where
|
|
|
|
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 (HasContent, htmlDocument)
|
|
import Lucid (renderTextT)
|
|
import Markdown (Markdown(..), MarkdownContent(..))
|
|
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"
|
|
|
|
generateMarkdown :: (HasContent a, MarkdownContent a) => [a] -> ReaderT Blog IO ()
|
|
generateMarkdown = mapM_ $ \content -> do
|
|
let relativePath = Markdown.path (getMarkdown content) <.> "html"
|
|
filePath <- (</> relativePath) <$> (asks $Blog.path.$root)
|
|
(renderTextT $ htmlDocument content) >>= liftIO . TextIO.writeFile filePath
|
|
|
|
generateCollection :: Collection -> ReaderT Blog IO ()
|
|
generateCollection (Collection {featured = []}) = return ()
|
|
generateCollection collection =
|
|
flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
|
|
(renderTextT $ htmlDocument articlesList)
|
|
>>= liftIO . TextIO.writeFile filePath
|
|
|
|
generate :: ReaderT Blog IO ()
|
|
generate = do
|
|
asks articles >>= generateMarkdown . Map.elems
|
|
Collection.getAll >>= mapM_ generateCollection
|
|
asks pages >>= generateMarkdown . Map.elems
|