add more details (and the image‼) to rss
This commit is contained in:
parent
969cdc938d
commit
fa0b826c26
5 changed files with 69 additions and 45 deletions
|
|
@ -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'
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|]
|
||||
|
||||
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 = ""
|
||||
|
|
|
|||
|
|
@ -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'">
|
||||
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/$path0'">
|
||||
|] else [b|@0
|
||||
<meta property=og:image content="$url/$thumbnail">
|
||||
<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>
|
||||
|
|
|
|||
Loading…
Reference in a new issue