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:site_name content="$title">
<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 name=twitter:site content=@2_gecs>
<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
url = [b|$root/$prefix|]
imagepath0
| (_, (p, i) : _) : _ <- infosByYear = getThumb (takeDirectory p) i
| otherwise = "/style/card.png"
nsfw' = NsfwWarning.Gallery <$ guard nsfw
nsfwScript = NsfwWarning.script nsfw'

View file

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

View file

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

View file

@ -4,8 +4,8 @@ import Date
import Info
import BuilderQQ
import Data.List (sortBy)
import Data.Maybe (isJust)
import Data.List (sortBy, intersperse)
import Data.Maybe (catMaybes)
import Data.Function (on)
import qualified Data.Text as Strict
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@
-> Strict.Text -- ^ website name e.g. @nissart@
-> GalleryInfo
-> Maybe FilePath -- ^ output filename for self link
-> [(FilePath, Info)]
-> Lazy.Text
make root ginfo output infos =
toLazyText $ make' root ginfo output infos
make root name 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
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"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
<rss version="2.0">
<channel>
<title>$title</title>
<title>$name$title</title>
<link>$link</link>
<description>$desc</description>
$selflink
@ -43,37 +44,54 @@ make' root ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0
filter (not . (.unlisted) . snd) infos
selflink = case output of
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 root prefix nsfw path i@(Info {title, artist}) = [b|@4
<item>
<title>$title$up</title>
<title>$title$suf</title>
<link>$link</link>
<guid>$link</guid>
$descArtist'
$body
<pubDate>$date</pubDate>
</item>
|]
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
link = [b|$root/$prefix/$dir|]
date = formatRSS $ latestDateFor nsfw i
artist' = ifJust artist \case
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' = makeDesc desc
descArtist' = if desc.exists || isJust artist then [b|@6
<description>
<![CDATA[
$10.artist'
$10.desc'
]]>
</description>
body = [b|@6
<description> <![CDATA[
$8.image
$8.artist'
$8.desc'
]]> </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 NoDesc = ""

View file

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