gallery/make-pages/RSS.hs
Rhiannon Morris a8e5adb50d Add 'unlisted' key
unlisted posts will still be put in the normal place but
not added to the gallery or rss feed
2021-10-02 23:00:33 +02:00

84 lines
2.3 KiB
Haskell

module RSS (make, make') where
import Date
import Info
import BuilderQQ
import Records ()
import Data.List (sortBy)
import Data.Maybe (isJust)
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@
-> GalleryInfo
-> Maybe FilePath -- ^ output filename for self link
-> [(FilePath, Info)]
-> Lazy.Text
make root ginfo output infos =
toLazyText $ make' root ginfo output infos
make' :: Strict.Text -> GalleryInfo
-> Maybe FilePath -> [(FilePath, Info)] -> Builder
make' root 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">
<channel>
<title>$title</title>
<link>$link</link>
<description>$desc</description>
$selflink
$4.items
</channel>
</rss>
|]
where
link = [b|$root/$prefix|]
nsfw = #nsfw ginfo
items = map (uncurry $ makeItem root prefix nsfw) $
sortBy (flip (compareFor nsfw `on` #second)) $
filter (not . #unlisted . snd) infos
selflink = case output of
Nothing -> ""
Just o -> [b|<atom:link href="$link/$o" rel="self" />|]
makeItem :: Strict.Text -> FilePath -> Bool -> FilePath -> Info -> Builder
makeItem root prefix nsfw path i@(Info {title, date, artist}) = [b|@4
<item>
<title>$title</title>
<link>$link</link>
<guid>$link</guid>
$descArtist'
<pubDate>$date'</pubDate>
</item>
|]
where
dir = takeDirectory path
link = [b|$root/$prefix/$dir|]
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
descArtist' = if #exists desc || isJust artist then [b|@6
<description>
<![CDATA[
$10.desc'
$10.artist'
]]>
</description>
|]
else ""
date' = formatRSS date
makeDesc :: Desc -> Builder
makeDesc NoDesc = ""
makeDesc (TextDesc txt) = [b|$txt|]
makeDesc (LongDesc fs) = [b|$fields|]
where
fields = map makeField fs
makeField (DescField {name, text}) = [b|<b>$name</b>: $text|]