gallery/make-pages/RSS.hs

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, desc, date}) = [b|@4
    <item>
      <title>$*title</title>
      <link>$link</link>
      <guid>$link</guid>
      $desc'
      <pubDate>$date'</pubDate>
    </item>
  |]
 where
  dir  = takeDirectory path
  link = [b|$*root/$@prefix/$@dir|]
  desc' =
    case desc 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"