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: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'
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 = ""
|
||||||
|
|
|
@ -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>
|
||||||
|
|
Loading…
Reference in a new issue