81 lines
2.1 KiB
Haskell
81 lines
2.1 KiB
Haskell
|
module RSS (make, make') where
|
||
|
|
|
||
|
|
import Info
|
||
|
|
import BuilderQQ
|
||
|
|
import Records ()
|
||
|
|
|
||
|
|
import Data.List (sortOn)
|
||
|
|
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@
|
||
|
|
-> Strict.Text -- ^ title
|
||
|
|
-> Strict.Text -- ^ description
|
||
|
|
-> FilePath -- ^ gallery prefix e.g. @main@
|
||
|
|
-> Maybe FilePath -- ^ output filename for self link
|
||
|
|
-> [(FilePath, Info)]
|
||
|
|
-> Lazy.Text
|
||
|
|
make root title desc prefix output infos =
|
||
|
|
toLazyText $ make' root title desc prefix output infos
|
||
|
|
|
||
|
|
make' :: Strict.Text -> Strict.Text -> Strict.Text
|
||
|
|
-> FilePath -> Maybe FilePath -> [(FilePath, Info)] -> Builder
|
||
|
|
make' root 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|@4
|
||
|
|
<atom:link href="$link/$@o" rel="self" />
|
||
|
|
|]
|
||
|
|
|
||
|
|
makeItem :: Strict.Text -> FilePath -> FilePath -> Info -> Builder
|
||
|
|
makeItem root prefix path (Info {title, description, date}) = [b|@4
|
||
|
|
<item>
|
||
|
|
<title>$*title</title>
|
||
|
|
<link>$link</link>
|
||
|
|
<guid>$link</guid>
|
||
|
|
$description'
|
||
|
|
<pubDate>$date'</pubDate>
|
||
|
|
</item>
|
||
|
|
|]
|
||
|
|
where
|
||
|
|
dir = takeDirectory path
|
||
|
|
link = [b|$*root/$@prefix/$@dir|]
|
||
|
|
description' =
|
||
|
|
case description of
|
||
|
|
Nothing -> ""
|
||
|
|
Just d -> [b|@6
|
||
|
|
<description>
|
||
|
|
<![CDATA[
|
||
|
|
$10*d
|
||
|
|
]]>
|
||
|
|
</description>
|
||
|
|
|]
|
||
|
|
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"
|