96 lines
3.0 KiB
Haskell
96 lines
3.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Dom (
|
|
generate
|
|
) where
|
|
|
|
import Arguments (Arguments(..), Configuration)
|
|
import Blog (Article(..), 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, keys, toList)
|
|
import Data.Ord (Down(..))
|
|
import qualified Data.Set as Set (member)
|
|
import Data.Text (pack, empty)
|
|
import Lucid
|
|
import System.Directory (createDirectoryIfMissing)
|
|
import System.FilePath.Posix ((</>))
|
|
import System.Posix.Files (modificationTime)
|
|
|
|
data Page = Page {
|
|
category :: Maybe String
|
|
, full :: Bool
|
|
, urlPath :: FilePath
|
|
, articlesFeatured :: [Article]
|
|
}
|
|
|
|
previewArticle :: Article -> Html ()
|
|
previewArticle article =
|
|
article_ (do
|
|
h1_ "Some Article"
|
|
pre_ . toHtml $ filePath article
|
|
)
|
|
|
|
showTag :: String -> Html ()
|
|
showTag tag = li_ (a_ [href_ $ pack ("/" </> tag)] $ toHtml tag)
|
|
|
|
render :: Page -> Blog -> Html ()
|
|
render (Page {category, full, articlesFeatured}) blog =
|
|
doctypehtml_ (do
|
|
head_ (do
|
|
meta_ [charset_ "utf-8"]
|
|
title_ . toHtml $ name blog
|
|
script_ [src_ "/UnitJS/async.js"] empty
|
|
script_ [src_ "/UnitJS/dom.js"] empty
|
|
)
|
|
body_ (do
|
|
div_ [id_ "header"] (return ())
|
|
div_ [id_ "navigator"] (do
|
|
h1_ "Tags"
|
|
ul_ (mapM_ showTag (Map.keys $ tags blog))
|
|
)
|
|
div_ [id_ "contents"] (do
|
|
h1_ $ toHtml pageTitle
|
|
div_ [class_ "articles"] (mapM_ previewArticle articlesFeatured)
|
|
)
|
|
)
|
|
)
|
|
where
|
|
pageTitle =
|
|
if full then "All" else "Latest" ++ " articles" ++ maybe "" (" tagged " ++) category
|
|
|
|
generateCollection :: (Maybe String, FilePath, [Article]) -> Blog -> ReaderT Configuration IO ()
|
|
generateCollection (_, _, []) _ = return ()
|
|
generateCollection (category, path, articlesFeatured) blog = do
|
|
n <- previewCount <$> ask
|
|
liftIO $ createDirectoryIfMissing False path
|
|
forM_ (pages n) $ \page ->
|
|
liftIO $ renderToFile (urlPath page) (render page blog)
|
|
where
|
|
pages n = [
|
|
Page {
|
|
category
|
|
, full = True
|
|
, urlPath = path </> "all.html"
|
|
, articlesFeatured
|
|
}
|
|
, Page {
|
|
category
|
|
, full = False
|
|
, urlPath = path </> "index.html"
|
|
, articlesFeatured = take n articlesFeatured
|
|
}
|
|
]
|
|
|
|
generate :: Blog -> ReaderT Configuration IO ()
|
|
generate blog@(Blog {articles, tags}) = do
|
|
path <- outputDir <$> ask
|
|
generateCollection (Nothing, path, sortByDate $ Map.elems articles) blog
|
|
forM_ (Map.toList tags) $ \(tag, tagged) ->
|
|
generateCollection (Just tag, path </> tag, sortByDate $ getArticles tagged) blog
|
|
where
|
|
getArticles tagged = Map.elems $ Map.filterWithKey (\k _ -> Set.member k tagged) articles
|
|
sortByDate = sortOn (Down . modificationTime . fileStatus)
|