Finish adapting everything to the new Markdown data type

This commit is contained in:
Tissevert 2020-06-08 10:34:30 +02:00
parent 1df95d5091
commit 1a2ece9dd9
4 changed files with 23 additions and 19 deletions

View file

@ -40,6 +40,6 @@ at filePath = do
fileDate <- modificationTime <$> getFileStatus filePath fileDate <- modificationTime <$> getFileStatus filePath
fmap (makeArticle (setDate tzOffset fileDate)) <$> Markdown.at filePath fmap (makeArticle (setDate tzOffset fileDate)) <$> Markdown.at filePath
preview :: Int -> Markdown -> Markdown preview :: Int -> Article -> Markdown
preview linesCount markdown@(Markdown {body}) = preview linesCount (Article markdown@(Markdown {body})) =
markdown {body = take linesCount $ body} markdown {body = take linesCount $ body}

View file

@ -1,7 +1,7 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module DOM ( module DOM (
page htmlDocument
) where ) where
import Article (Article(..)) import Article (Article(..))
@ -21,19 +21,20 @@ import Lucid (
, head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_ , head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_
, title_, toHtml, toHtmlRaw, type_, ul_ , title_, toHtml, toHtmlRaw, type_, ul_
) )
import Markdown (Markdown(..))
import Prelude hiding (head, lookup) import Prelude hiding (head, lookup)
import Pretty ((.$)) import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>)) import System.FilePath.Posix ((</>), (<.>))
type HtmlGenerator = HtmlT (ReaderT Blog IO) type HtmlGenerator = HtmlT (ReaderT Blog IO)
class HasCard a => Page a where class HasCard a => HasContent a where
content :: a -> HtmlGenerator () content :: a -> HtmlGenerator ()
instance Page Article where instance HasContent Article where
content = article True content = markdown True . Article.getMarkdown
instance Page ArticlesList where instance HasContent ArticlesList where
content al@(ArticlesList {full}) = do content al@(ArticlesList {full}) = do
preview <- Article.preview <$> (asks $skin.$previewLinesCount) preview <- Article.preview <$> (asks $skin.$previewLinesCount)
h2_ . toHtml =<< description al h2_ . toHtml =<< description al
@ -41,7 +42,7 @@ instance Page ArticlesList where
asks hasRSS >>= rssLink asks hasRSS >>= rssLink
li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink
div_ [class_ "articles"] ( div_ [class_ "articles"] (
mapM_ (article False . preview) =<< getArticles al mapM_ (markdown False . preview) =<< getArticles al
) )
where where
otherLink = otherLink =
@ -52,8 +53,8 @@ instance Page ArticlesList where
li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text
rssLink False = return () rssLink False = return ()
article :: Bool -> Article -> HtmlGenerator () markdown :: Bool -> Markdown -> HtmlGenerator ()
article raw (Article {key, body, Article.title}) = do markdown raw (Markdown {key, body, title}) = do
url <- absoluteLink . (</> key <.> extension) <$> (asks $path.$articlesPath) url <- absoluteLink . (</> key <.> extension) <$> (asks $path.$articlesPath)
article_ [id_ $ pack key] (do article_ [id_ $ pack key] (do
header_ (do header_ (do
@ -82,8 +83,8 @@ faviconLink url = link_ [rel_ "shortcut icon", href_ $ pack url, type_ "image/x-
optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator () optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator ()
optional = maybe (return ()) optional = maybe (return ())
page :: Page a => a -> HtmlGenerator () htmlDocument :: HasContent a => a -> HtmlGenerator ()
page aPage = htmlDocument someContent =
doctypehtml_ (do doctypehtml_ (do
head_ (do head_ (do
meta_ [charset_ "utf-8"] meta_ [charset_ "utf-8"]
@ -91,7 +92,7 @@ page aPage =
script_ [src_ "/js/remarkable.min.js"] empty script_ [src_ "/js/remarkable.min.js"] empty
script_ [src_ "/js/hablo.js"] empty script_ [src_ "/js/hablo.js"] empty
optional faviconLink =<< (asks $skin.$favicon) optional faviconLink =<< (asks $skin.$favicon)
optional (Card.make aPage) =<< (asks $urls.$cards) optional (Card.make someContent) =<< (asks $urls.$cards)
optional toHtmlRaw =<< (asks $skin.$head) optional toHtmlRaw =<< (asks $skin.$head)
) )
body_ (do body_ (do
@ -100,6 +101,6 @@ page aPage =
h2_ . toHtml =<< template "tagsList" [] h2_ . toHtml =<< template "tagsList" []
ul_ . mapM_ tag . Map.keys =<< asks tags ul_ . mapM_ tag . Map.keys =<< asks tags
) )
div_ [id_ "contents"] $ content aPage div_ [id_ "contents"] $ content someContent
) )
) )

View file

@ -13,8 +13,9 @@ import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT, asks) import Control.Monad.Reader (ReaderT, asks)
import qualified Data.Map as Map (elems) import qualified Data.Map as Map (elems)
import qualified Data.Text.Lazy.IO as TextIO (writeFile) import qualified Data.Text.Lazy.IO as TextIO (writeFile)
import DOM (page) import DOM (htmlDocument)
import Lucid (renderTextT) import Lucid (renderTextT)
import Markdown (Markdown(..))
import Pretty ((.$)) import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>)) import System.FilePath.Posix ((</>), (<.>))
@ -29,14 +30,15 @@ articlesLists collection@(Collection {basePath}) = [
generateArticles :: [Article] -> ReaderT Blog IO () generateArticles :: [Article] -> ReaderT Blog IO ()
generateArticles = mapM_ $ \article -> do generateArticles = mapM_ $ \article -> do
baseDir <- (</>) <$> (asks $path.$root) <*> (asks $path.$articlesPath) baseDir <- (</>) <$> (asks $path.$root) <*> (asks $path.$articlesPath)
(renderTextT $ page article) let filePath = baseDir </> key (Article.getMarkdown article) <.> "html"
>>= liftIO . TextIO.writeFile (baseDir </> key article <.> "html") (renderTextT $ htmlDocument article) >>= liftIO . TextIO.writeFile filePath
generateCollection :: Collection -> ReaderT Blog IO () generateCollection :: Collection -> ReaderT Blog IO ()
generateCollection (Collection {featured = []}) = return () generateCollection (Collection {featured = []}) = return ()
generateCollection collection = generateCollection collection =
flip mapM_ (articlesLists collection) $ \(filePath, articlesList) -> flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
(renderTextT $ page articlesList) >>= liftIO . TextIO.writeFile filePath (renderTextT $ htmlDocument articlesList)
>>= liftIO . TextIO.writeFile filePath
generate :: ReaderT Blog IO () generate :: ReaderT Blog IO ()
generate = do generate = do

View file

@ -20,6 +20,7 @@ import Data.Time (defaultTimeLocale, formatTime, rfc822DateFormat)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Lucid (Attribute, HtmlT, Term, ToHtml(..), term, renderTextT) import Lucid (Attribute, HtmlT, Term, ToHtml(..), term, renderTextT)
import Lucid.Base (makeAttribute) import Lucid.Base (makeAttribute)
import Markdown (Markdown(..))
import Pretty ((.$)) import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>)) import System.FilePath.Posix ((</>), (<.>))
@ -57,7 +58,7 @@ pubDate_ :: Term arg result => arg -> result
pubDate_ = term "pubDate" pubDate_ = term "pubDate"
articleItem :: MonadReader Blog m => String -> Article -> HtmlT m () articleItem :: MonadReader Blog m => String -> Article -> HtmlT m ()
articleItem siteURL (Article {key, metadata, title}) = articleItem siteURL (Article (Markdown {key, metadata, title})) =
item_ $ do item_ $ do
title_ $ toHtml title title_ $ toHtml title
link_ . toHtml =<< link <$> (asks $path.$articlesPath) link_ . toHtml =<< link <$> (asks $path.$articlesPath)