103 lines
2.9 KiB
Haskell
103 lines
2.9 KiB
Haskell
module RSS (make, make') where
|
|
|
|
import Date
|
|
import Info
|
|
import BuilderQQ
|
|
|
|
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
|
|
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 name ginfo output infos =
|
|
toLazyText $ make' root name ginfo output infos
|
|
|
|
make' :: Strict.Text -> Strict.Text -> GalleryInfo
|
|
-> Maybe FilePath -> [(FilePath, Info)] -> Builder
|
|
make' root name ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0
|
|
<?xml version="1.0" encoding="UTF-8"?>
|
|
<rss version="2.0">
|
|
<channel>
|
|
<title>$name—$title</title>
|
|
<link>$link</link>
|
|
<description>$desc</description>
|
|
$selflink
|
|
|
|
$4.items
|
|
</channel>
|
|
</rss>
|
|
|]
|
|
where
|
|
link = [b|$root/$prefix|]
|
|
nsfw = ginfo.nsfw
|
|
items = map (uncurry $ makeItem root prefix nsfw) $
|
|
sortBy (flip (compareFor nsfw `on` snd)) $
|
|
filter (not . (.unlisted) . snd) infos
|
|
selflink = case output of
|
|
Nothing -> ""
|
|
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$suf</title>
|
|
<link>$link</link>
|
|
<guid>$link</guid>
|
|
$body
|
|
<pubDate>$date</pubDate>
|
|
</item>
|
|
|]
|
|
where
|
|
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>|]
|
|
desc = descFor nsfw i
|
|
desc' = makeDesc desc
|
|
|
|
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>
|
|
|]
|
|
|
|
makeDesc :: Desc -> Builder
|
|
makeDesc NoDesc = ""
|
|
makeDesc (TextDesc txt) = [b|$txt|]
|
|
makeDesc (LongDesc fs) = [b|<dl>$fields</dl>|]
|
|
where
|
|
fields = map makeField fs
|
|
makeField (DescField {name, text}) = [b|<dt>$name <dd>$text|]
|