add twitter [etc] card previews

This commit is contained in:
Rhiannon Morris 2020-08-11 20:29:54 +02:00
parent 8865b951fa
commit 5ad4e3dc30
9 changed files with 115 additions and 57 deletions

View file

@ -1,7 +1,6 @@
{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where
import Control.Exception
import Data.Foldable
import Data.Function (on, (&))
import qualified Data.HashMap.Strict as HashMap
@ -9,23 +8,18 @@ import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List (intersperse, groupBy, sortOn)
import qualified Data.Text.Lazy as Lazy
import System.FilePath ((</>), takeDirectory, joinPath, splitPath)
import System.FilePath (takeDirectory, joinPath, splitPath)
import GHC.Exts (Down (..), the)
import BuilderQQ
import Depend (thumbFile)
import Info
newtype NoThumb = NoThumb FilePath
deriving stock Eq deriving anyclass Exception
instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir
make :: GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make ginfo infos = toLazyText $ make' ginfo infos
make :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make root ginfo infos = toLazyText $ make' root ginfo infos
make' :: GalleryInfo -> [(FilePath, Info)] -> Builder
make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
make' :: Text -> GalleryInfo -> [(FilePath, Info)] -> Builder
make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
@ -33,6 +27,15 @@ make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
<link rel=icon href=/style/niss.svg>
<link rel=alternate href=rss.xml type=application/rss+xml>
<meta property=og:type content=og:website>
<meta property=og:title content="$*title">
<meta property=og:site_name content="$*title">
<meta property=og:description content="$*desc">
<meta property=og:image content="$url/$@imagepath0">
<meta property=og:url content="$url">
<meta name=twitter:site content=@gec_ko_>
<meta name=twitter:card content=summary>
<script src=/script/gallery.js></script>
<title>$*title</title>
@ -97,6 +100,11 @@ make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
nsfw = #nsfw filters /= NoNsfw
url = [b|$*root/$@prefix|]
imagepath0
| (_, (p0, i0) : _) : _ <- infosByYear = getThumb (takeDirectory p0) i0
| otherwise = "/style/card.png"
makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder
makeFilter prefix initial tag _count = [b|@8
<li>
@ -133,7 +141,7 @@ makeItem nsfw file info@(Info {title, bg}) = [b|@4
|]
where
dir = takeDirectory file
thumb = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) $ #thumb info
thumb = getThumb dir info
nsfw' = if nsfw && #anyNsfw info then " nsfw" else ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
bgStyle = ifJust bg \col -> [b| style="background: $*col"|]