diff --git a/src/Article.hs b/src/Article.hs index 4522839..dd2acfc 100644 --- a/src/Article.hs +++ b/src/Article.hs @@ -40,6 +40,6 @@ at filePath = do fileDate <- modificationTime <$> getFileStatus filePath fmap (makeArticle (setDate tzOffset fileDate)) <$> Markdown.at filePath -preview :: Int -> Markdown -> Markdown -preview linesCount markdown@(Markdown {body}) = +preview :: Int -> Article -> Markdown +preview linesCount (Article markdown@(Markdown {body})) = markdown {body = take linesCount $ body} diff --git a/src/DOM.hs b/src/DOM.hs index a37dbe9..38755d4 100644 --- a/src/DOM.hs +++ b/src/DOM.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module DOM ( - page + htmlDocument ) where import Article (Article(..)) @@ -21,19 +21,20 @@ import Lucid ( , head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_ , title_, toHtml, toHtmlRaw, type_, ul_ ) +import Markdown (Markdown(..)) import Prelude hiding (head, lookup) import Pretty ((.$)) import System.FilePath.Posix ((), (<.>)) type HtmlGenerator = HtmlT (ReaderT Blog IO) -class HasCard a => Page a where +class HasCard a => HasContent a where content :: a -> HtmlGenerator () -instance Page Article where - content = article True +instance HasContent Article where + content = markdown True . Article.getMarkdown -instance Page ArticlesList where +instance HasContent ArticlesList where content al@(ArticlesList {full}) = do preview <- Article.preview <$> (asks $skin.$previewLinesCount) h2_ . toHtml =<< description al @@ -41,7 +42,7 @@ instance Page ArticlesList where asks hasRSS >>= rssLink li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink div_ [class_ "articles"] ( - mapM_ (article False . preview) =<< getArticles al + mapM_ (markdown False . preview) =<< getArticles al ) where otherLink = @@ -52,8 +53,8 @@ instance Page ArticlesList where li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text rssLink False = return () -article :: Bool -> Article -> HtmlGenerator () -article raw (Article {key, body, Article.title}) = do +markdown :: Bool -> Markdown -> HtmlGenerator () +markdown raw (Markdown {key, body, title}) = do url <- absoluteLink . ( key <.> extension) <$> (asks $path.$articlesPath) article_ [id_ $ pack key] (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 = maybe (return ()) -page :: Page a => a -> HtmlGenerator () -page aPage = +htmlDocument :: HasContent a => a -> HtmlGenerator () +htmlDocument someContent = doctypehtml_ (do head_ (do meta_ [charset_ "utf-8"] @@ -91,7 +92,7 @@ page aPage = script_ [src_ "/js/remarkable.min.js"] empty script_ [src_ "/js/hablo.js"] empty optional faviconLink =<< (asks $skin.$favicon) - optional (Card.make aPage) =<< (asks $urls.$cards) + optional (Card.make someContent) =<< (asks $urls.$cards) optional toHtmlRaw =<< (asks $skin.$head) ) body_ (do @@ -100,6 +101,6 @@ page aPage = h2_ . toHtml =<< template "tagsList" [] ul_ . mapM_ tag . Map.keys =<< asks tags ) - div_ [id_ "contents"] $ content aPage + div_ [id_ "contents"] $ content someContent ) ) diff --git a/src/HTML.hs b/src/HTML.hs index 9818d13..294e85c 100644 --- a/src/HTML.hs +++ b/src/HTML.hs @@ -13,8 +13,9 @@ 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 (page) +import DOM (htmlDocument) import Lucid (renderTextT) +import Markdown (Markdown(..)) import Pretty ((.$)) import System.FilePath.Posix ((), (<.>)) @@ -29,14 +30,15 @@ articlesLists collection@(Collection {basePath}) = [ generateArticles :: [Article] -> ReaderT Blog IO () generateArticles = mapM_ $ \article -> do baseDir <- () <$> (asks $path.$root) <*> (asks $path.$articlesPath) - (renderTextT $ page article) - >>= liftIO . TextIO.writeFile (baseDir key article <.> "html") + let filePath = baseDir key (Article.getMarkdown article) <.> "html" + (renderTextT $ htmlDocument article) >>= liftIO . TextIO.writeFile filePath generateCollection :: Collection -> ReaderT Blog IO () generateCollection (Collection {featured = []}) = return () generateCollection collection = 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 = do diff --git a/src/RSS.hs b/src/RSS.hs index 73f8b79..0413f60 100644 --- a/src/RSS.hs +++ b/src/RSS.hs @@ -20,6 +20,7 @@ import Data.Time (defaultTimeLocale, formatTime, rfc822DateFormat) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Lucid (Attribute, HtmlT, Term, ToHtml(..), term, renderTextT) import Lucid.Base (makeAttribute) +import Markdown (Markdown(..)) import Pretty ((.$)) import System.FilePath.Posix ((), (<.>)) @@ -57,7 +58,7 @@ pubDate_ :: Term arg result => arg -> result pubDate_ = term "pubDate" articleItem :: MonadReader Blog m => String -> Article -> HtmlT m () -articleItem siteURL (Article {key, metadata, title}) = +articleItem siteURL (Article (Markdown {key, metadata, title})) = item_ $ do title_ $ toHtml title link_ . toHtml =<< link <$> (asks $path.$articlesPath)