Tissevert/hablo
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Detect and use custom summary and featured image for articles

Browse source
This commit is contained in:
Tissevert 2019-02-19 17:36:16 +01:00
parent 968b221efa
commit dd1dc6b3b1
1 changed files with 15 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
src/Dom.hs
View file

@ -10,12 +10,12 @@ import ArticlesList (ArticlesList(..), otherUrl, pageTitle)
import Blog (Blog(..), Path(..), Skin(..), Wording(..)) import Blog (Blog(..), Path(..), Skin(..), Wording(..))
import qualified Blog (get) import qualified Blog (get)
import Control.Monad.Reader (ReaderT) import Control.Monad.Reader (ReaderT)
import qualified Data.Map as Map (keys) import qualified Data.Map as Map (keys, lookup)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Text (Text, pack, empty) import Data.Text (Text, pack, empty)
import Lucid import Lucid
import Lucid.Base (makeAttribute) import Lucid.Base (makeAttribute)
import Prelude hiding (head) import Prelude hiding (head, lookup)
import Pretty ((.$)) import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>)) import System.FilePath.Posix ((</>), (<.>))
@ -26,15 +26,21 @@ class Page a where
content :: a -> HtmlGenerator () content :: a -> HtmlGenerator ()
instance Page Article where instance Page Article where
card (Article {title}) = card (Article {title, metadata}) = do
makeCard title =<< (Blog.get $name.$("A new article on " <>).$pack) description <- getDescription (Map.lookup "summary" metadata)
makeCard title (pack description) (Map.lookup "featuredImage" metadata)
where
getDescription = maybe (Blog.get $name.$("A new article on " <>)) return
content = article True content = article True
instance Page ArticlesList where instance Page ArticlesList where
card al = do card al = do
blogName <- Blog.get name cardTitle <- getTitle <$> Blog.get name
makeCard (maybe blogName ((blogName ++ " - ") ++) $ tagged al) =<< pageTitle al description <- pageTitle al
makeCard cardTitle description Nothing
where
getTitle name = maybe name ((name ++ " - ") ++) $ tagged al
content al@(ArticlesList {featured, full}) = do content al@(ArticlesList {featured, full}) = do
preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount) preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
@ -58,11 +64,11 @@ article raw (Article {key, body, title}) = do
where where
(aElem, extension) = if raw then (a_, "md") else (navigationA, "html") (aElem, extension) = if raw then (a_, "md") else (navigationA, "html")
makeCard :: String -> Text -> HtmlGenerator () makeCard :: String -> Text -> Maybe String -> HtmlGenerator ()
makeCard title description = do makeCard title description image = do
og "title" $ pack title og "title" $ pack title
og "description" description og "description" description
og "image" =<< (Blog.get $skin.$cardImage.$pack) og "image" =<< pack <$> maybe (Blog.get $skin.$cardImage) return image
og "site_name" =<< (Blog.get $name.$pack) og "site_name" =<< (Blog.get $name.$pack)
where where
og attribute value = meta_ [makeAttribute "property" $ "og:" <> attribute , content_ value] og attribute value = meta_ [makeAttribute "property" $ "og:" <> attribute , content_ value]