add more details (and the image‼) to rss

make-pages/GalleryPage.hs

@@ -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'

make-pages/Info.hs

@@ -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 =
+getThumb dir = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) . thumb
-  maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) . thumb
 
 thumbFile :: FilePath -> FilePath
 thumbFile = addSuffix "_small"

make-pages/Main.hs

@@ -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
+  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
 
 decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a

make-pages/RSS.hs

@@ -4,8 +4,8 @@ import Date
 import Info
 import BuilderQQ
 
-import Data.List (sortBy)
+import Data.List (sortBy, intersperse)
-import Data.Maybe (isJust)
+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 =
+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
-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>
+  body = [b|@6
-        <![CDATA[
+      <description> <![CDATA[
-          $10.artist'
+        $8.image
-          $10.desc'
+        $8.artist'
-        ]]>
+        $8.desc'
-      </description>
+      ]]> </description>
+    |]
+
+  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>
       |]
-    else ""
-  date = formatRSS $ latestDateFor nsfw i
 
 makeDesc :: Desc -> Builder
 makeDesc NoDesc = ""

make-pages/SinglePage.hs

@@ -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 =
+  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: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 property=og:image content="$url/$path">
             <meta name=twitter:card content=summary>
           |]
+        Nothing -> throw $ NoThumb dir
 
   pure [b|@0
     <!DOCTYPE html>