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 qualified Blog (get)
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.Text (Text, pack, empty)
import Lucid
import Lucid.Base (makeAttribute)
import Prelude hiding (head)
import Prelude hiding (head, lookup)
import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>))
@ -26,15 +26,21 @@ class Page a where
content :: a -> HtmlGenerator ()
instance Page Article where
card (Article {title}) =
makeCard title =<< (Blog.get $name.$("A new article on " <>).$pack)
card (Article {title, metadata}) = do
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
instance Page ArticlesList where
card al = do
blogName <- Blog.get name
makeCard (maybe blogName ((blogName ++ " - ") ++) $ tagged al) =<< pageTitle al
cardTitle <- getTitle <$> Blog.get name
description <- pageTitle al
makeCard cardTitle description Nothing
where
getTitle name = maybe name ((name ++ " - ") ++) $ tagged al
content al@(ArticlesList {featured, full}) = do
preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
@ -58,11 +64,11 @@ article raw (Article {key, body, title}) = do
where
(aElem, extension) = if raw then (a_, "md") else (navigationA, "html")
makeCard :: String -> Text -> HtmlGenerator ()
makeCard title description = do
makeCard :: String -> Text -> Maybe String -> HtmlGenerator ()
makeCard title description image = do
og "title" $ pack title
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)
where
og attribute value = meta_ [makeAttribute "property" $ "og:" <> attribute , content_ value]