add more details (and the image‼) to rss

This commit is contained in:
rhiannon morris 2024-08-18 06:22:55 +02:00
parent 969cdc938d
commit fa0b826c26
5 changed files with 69 additions and 45 deletions

View file

@ -34,7 +34,7 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0
<meta property=og:title content="$title"> <meta property=og:title content="$title">
<meta property=og:site_name content="$title"> <meta property=og:site_name content="$title">
<meta property=og:description content="$desc"> <meta property=og:description content="$desc">
<meta property=og:image content="$url/$imagepath0"> <meta property=og:image content="$url/style/card.png">
<meta property=og:url content="$url"> <meta property=og:url content="$url">
<meta name=twitter:site content=@2_gecs> <meta name=twitter:site content=@2_gecs>
<meta name=twitter:card content=summary> <meta name=twitter:card content=summary>
@ -108,9 +108,6 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0
nsfw = filters.nsfw /= NoNsfw nsfw = filters.nsfw /= NoNsfw
url = [b|$root/$prefix|] url = [b|$root/$prefix|]
imagepath0
| (_, (p, i) : _) : _ <- infosByYear = getThumb (takeDirectory p) i
| otherwise = "/style/card.png"
nsfw' = NsfwWarning.Gallery <$ guard nsfw nsfw' = NsfwWarning.Gallery <$ guard nsfw
nsfwScript = NsfwWarning.script nsfw' nsfwScript = NsfwWarning.script nsfw'

View file

@ -13,6 +13,7 @@ module Info
CompareKey (..), compareKeyFor, compareFor, sortFor, CompareKey (..), compareKeyFor, compareFor, sortFor,
Artist (..), Images' (..), Images, Image (..), Desc (..), DescField (..), Artist (..), Images' (..), Images, Image (..), Desc (..), DescField (..),
PreviewImage (..), previewImage,
Link (..), Update (..), Bg (..), Link (..), Update (..), Bg (..),
@ -117,6 +118,13 @@ data Images' a =
type Images = Images' Image type Images = Images' Image
data PreviewImage = PFull Image | PThumb FilePath
previewImage :: Info -> Maybe PreviewImage
previewImage info
| Just img <- find (.sfw) $ allImages info.images = Just $ PFull img
| otherwise = PThumb <$> info.thumb'
data Link = data Link =
Link { Link {
@ -261,8 +269,7 @@ newtype NoThumb = NoThumb FilePath
instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir
getThumb :: FilePath -> Info -> FilePath getThumb :: FilePath -> Info -> FilePath
getThumb dir = getThumb dir = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) . thumb
maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) . thumb
thumbFile :: FilePath -> FilePath thumbFile :: FilePath -> FilePath
thumbFile = addSuffix "_small" thumbFile = addSuffix "_small"

View file

@ -8,6 +8,7 @@ import Data.List (intersperse)
import qualified Data.List as List import qualified Data.List as List
import Data.Text.Lazy (Text) import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder (toLazyText)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy.IO as Text import qualified Data.Text.Lazy.IO as Text
import qualified Data.YAML as YAML import qualified Data.YAML as YAML
import System.FilePath (makeRelative, takeDirectory, takeFileName) import System.FilePath (makeRelative, takeDirectory, takeFileName)
@ -56,7 +57,7 @@ main2 (SinglePage {root, file, prefix, index, dataDir, nsfw, output}) = do
writeOutput output page writeOutput output page
main2 (GalleryPage {root, files, prefix, index, output, dataDir}) = do main2 (GalleryPage {root, files, prefix, index, output, dataDir}) = do
ginfo <- galleryFromIndex index prefix (_, ginfo) <- galleryFromIndex index prefix
printV $ "gallery_info" := ginfo printV $ "gallery_info" := ginfo
infos <- mapM (infoYAML dataDir) files infos <- mapM (infoYAML dataDir) files
printV $ "infos" := infos printV $ "infos" := infos
@ -70,12 +71,12 @@ main2 (IndexPage {root, file, output}) = do
writeOutput output page writeOutput output page
main2 (RSS {files, root, index, prefix, output, dataDir}) = do main2 (RSS {files, root, index, prefix, output, dataDir}) = do
ginfo <- galleryFromIndex index prefix (name, ginfo) <- galleryFromIndex index prefix
printV $ "gallery_info" := ginfo printV $ "gallery_info" := ginfo
infos <- mapM (infoYAML dataDir) files infos <- mapM (infoYAML dataDir) files
printV $ "infos" := infos printV $ "infos" := infos
let output' = takeFileName <$> output let output' = takeFileName <$> output
let rss = RSS.make root ginfo output' infos let rss = RSS.make root name ginfo output' infos
writeOutput output rss writeOutput output rss
main2 (DependSingle {index, file, nsfw, output, prefix, buildDir, dataDir}) = do main2 (DependSingle {index, file, nsfw, output, prefix, buildDir, dataDir}) = do
@ -117,10 +118,10 @@ findInfos dataDir infoName =
readYAML :: YAML.FromYAML a => FilePath -> IO a readYAML :: YAML.FromYAML a => FilePath -> IO a
readYAML file = ByteString.readFile file >>= decode1Must file readYAML file = ByteString.readFile file >>= decode1Must file
galleryFromIndex :: FilePath -> FilePath -> IO GalleryInfo galleryFromIndex :: FilePath -> FilePath -> IO (Strict.Text, GalleryInfo)
galleryFromIndex file prefix = do galleryFromIndex file prefix = do
IndexInfo {galleries} <- readYAML file IndexInfo {title, galleries} <- readYAML file
maybe (fail $ "no gallery with prefix " ++ prefix) pure $ maybe (fail $ "no gallery with prefix " ++ prefix) (pure . (title,)) $
List.find (\g -> g.prefix == prefix) galleries List.find (\g -> g.prefix == prefix) galleries
decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a

View file

@ -4,8 +4,8 @@ import Date
import Info import Info
import BuilderQQ import BuilderQQ
import Data.List (sortBy) import Data.List (sortBy, intersperse)
import Data.Maybe (isJust) import Data.Maybe (catMaybes)
import Data.Function (on) import Data.Function (on)
import qualified Data.Text as Strict import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
@ -13,20 +13,21 @@ import System.FilePath (takeDirectory)
make :: Strict.Text -- ^ website root e.g. @https://gallery.niss.website@ make :: Strict.Text -- ^ website root e.g. @https://gallery.niss.website@
-> Strict.Text -- ^ website name e.g. @nissart@
-> GalleryInfo -> GalleryInfo
-> Maybe FilePath -- ^ output filename for self link -> Maybe FilePath -- ^ output filename for self link
-> [(FilePath, Info)] -> [(FilePath, Info)]
-> Lazy.Text -> Lazy.Text
make root ginfo output infos = make root name ginfo output infos =
toLazyText $ make' root ginfo output infos toLazyText $ make' root name ginfo output infos
make' :: Strict.Text -> GalleryInfo make' :: Strict.Text -> Strict.Text -> GalleryInfo
-> Maybe FilePath -> [(FilePath, Info)] -> Builder -> Maybe FilePath -> [(FilePath, Info)] -> Builder
make' root ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0 make' root name ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom"> <rss version="2.0">
<channel> <channel>
<title>$title</title> <title>$name$title</title>
<link>$link</link> <link>$link</link>
<description>$desc</description> <description>$desc</description>
$selflink $selflink
@ -43,37 +44,54 @@ make' root ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0
filter (not . (.unlisted) . snd) infos filter (not . (.unlisted) . snd) infos
selflink = case output of selflink = case output of
Nothing -> "" Nothing -> ""
Just o -> [b|<atom:link href="$link/$o" rel="self" />|] Just o -> [b|<link href="$link/$o" rel="self" />|]
makeItem :: Strict.Text -> FilePath -> Bool -> FilePath -> Info -> Builder makeItem :: Strict.Text -> FilePath -> Bool -> FilePath -> Info -> Builder
makeItem root prefix nsfw path i@(Info {title, artist}) = [b|@4 makeItem root prefix nsfw path i@(Info {title, artist}) = [b|@4
<item> <item>
<title>$title$up</title> <title>$title$suf</title>
<link>$link</link> <link>$link</link>
<guid>$link</guid> <guid>$link</guid>
$descArtist' $body
<pubDate>$date</pubDate> <pubDate>$date</pubDate>
</item> </item>
|] |]
where where
up = if hasUpdatesFor nsfw i then [b| (updated)|] else "" suf = let parts = catMaybes [o18, cnt, up] in
if null parts then ""
else " (" <> mconcat (intersperse ", " parts) <> ")"
up = if hasUpdatesFor nsfw i then Just "updated" else Nothing
o18 = if nsfw && anyNsfw i then Just "🔞" else Nothing
cnt = let len = maybe 0 length $ allImages <$> imagesFor nsfw i in
if len == 1 then Nothing else Just [b|$len images|]
dir = takeDirectory path dir = takeDirectory path
link = [b|$root/$prefix/$dir|] link = [b|$root/$prefix/$dir|]
date = formatRSS $ latestDateFor nsfw i
artist' = ifJust artist \case artist' = ifJust artist \case
Artist {name, url = Nothing} -> [b|<p>by $name|] Artist {name, url = Nothing} -> [b|<p>by $name|]
Artist {name, url = Just url} -> [b|<p>by <a href=$url>$name</a>|] Artist {name, url = Just url} -> [b|<p>by <a href="$url">$name</a>|]
desc = descFor nsfw i desc = descFor nsfw i
desc' = makeDesc desc desc' = makeDesc desc
descArtist' = if desc.exists || isJust artist then [b|@6
<description> body = [b|@6
<![CDATA[ <description> <![CDATA[
$10.artist' $8.image
$10.desc' $8.artist'
]]> $8.desc'
</description> ]]> </description>
|] |]
else ""
date = formatRSS $ latestDateFor nsfw i image = case previewImage i of
Just (PFull img) -> go $ pageFile img
Just (PThumb th) -> go $ thumbFile th
Nothing -> ""
where go p = [b|@0
<figure>
<a href="$link"><img src="$link/$p"></a>
</figure>
|]
makeDesc :: Desc -> Builder makeDesc :: Desc -> Builder
makeDesc NoDesc = "" makeDesc NoDesc = ""

View file

@ -9,7 +9,7 @@ import qualified NsfwWarning
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import Data.List (sort, intersperse) import Data.List (sort, intersperse)
import Data.Maybe (fromMaybe, isNothing, isJust) import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as Strict import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import System.FilePath (joinPath, splitPath) import System.FilePath (joinPath, splitPath)
@ -94,7 +94,6 @@ make' root siteName prefix nsfw _dataDir dir
let desc = case artist of let desc = case artist of
Just (Artist {name}) -> [b|by $name|] Just (Artist {name}) -> [b|by $name|]
Nothing -> "by niss" Nothing -> "by niss"
let thumbnail = getThumb "" info
let updateDate = ifJust (last' updates) \(d, _) -> let updateDate = ifJust (last' updates) \(d, _) ->
let updated = formatLong d in let updated = formatLong d in
@ -104,15 +103,17 @@ make' root siteName prefix nsfw _dataDir dir
let nsfwScript = NsfwWarning.script nsfw' let nsfwScript = NsfwWarning.script nsfw'
let nsfwDialog = NsfwWarning.dialog nsfw' let nsfwDialog = NsfwWarning.dialog nsfw'
let imageMeta = let imageMeta = case previewImage info of
if image0.sfw && isNothing image0.warning then [b|@0 Just (PFull (Image {path})) -> [b|@0
<meta property=og:image content="$url/$path0'"> <meta property=og:image content="$url/$path">
<meta name=twitter:card content=summary_large_image> <meta name=twitter:card content=summary_large_image>
<meta name=twitter:image content="$url/$path0'"> <meta name=twitter:image content="$url/$path">
|] else [b|@0 |]
<meta property=og:image content="$url/$thumbnail"> Just (PThumb path) -> [b|@0
<meta name=twitter:card content=summary> <meta property=og:image content="$url/$path">
|] <meta name=twitter:card content=summary>
|]
Nothing -> throw $ NoThumb dir
pure [b|@0 pure [b|@0
<!DOCTYPE html> <!DOCTYPE html>