Finish adapting everything to the new Markdown data type
This commit is contained in:
parent
1df95d5091
commit
1a2ece9dd9
4 changed files with 23 additions and 19 deletions
|
@ -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}
|
||||||
|
|
25
src/DOM.hs
25
src/DOM.hs
|
@ -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
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
10
src/HTML.hs
10
src/HTML.hs
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue