gallery/make-pages/RSS.hs
Rhiannon Morris 28fc9db3e0 pass index file to gallery/rss
(instead of trying to escape the strings inside in make & on the command
line)
2021-04-16 23:48:55 +02:00

79 lines
2.2 KiB
Haskell

module RSS (make, make') where
import Info
import BuilderQQ
import Records ()
import Data.List (sortOn)
import Data.Maybe (isJust)
import Data.Ord (Down (..))
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import qualified Data.Time as Time
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 (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|]
items = map (uncurry $ makeItem root prefix) $ sortOn (Down . #second) infos
selflink = case output of
Nothing -> ""
Just o -> [b|<atom:link href="$link/$@o" rel="self" />|]
makeItem :: Strict.Text -> FilePath -> FilePath -> Info -> Builder
makeItem root prefix path (Info {title, desc, 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' = ifJust desc \d -> [b|$10*d|]
descArtist' = if isJust desc || isJust artist then [b|@6
<description>
<![CDATA[
$desc'
$artist'
]]>
</description>
|]
else ""
date' = formatDate date
formatDate :: Day -> Builder
formatDate d =
fromString $ Time.formatTime Time.defaultTimeLocale format $
Time.UTCTime d 15669
where
format = "%a, %d %b %_Y %T GMT"