gallery/make-pages/RSS.hs

module RSS (make, make') where

import Date
import Info
import BuilderQQ

import Data.List (sortBy, intersperse)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Function (on)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import System.FilePath (takeDirectory)
import Control.Monad


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|
<?xml version="1.0" encoding="UTF-8"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom"
                   xmlns:dc="http://purl.org/dc/elements/1.1/">
  <channel>
    <title><![CDATA[$name—$title]]></title>
    <link>$link</link>
    <description><![CDATA[$desc]]></description>
    $selflink

    $items
  </channel>
</rss>
|]
 where
  link = [b|$root/$prefix|]
  nsfw = ginfo.nsfw
  items = concatMap (uncurry $ makeItems root prefix nsfw) $
    sortBy (flip (compareFor nsfw `on` snd)) $
    filter (not . (.unlisted) . snd) infos
  selflink = case output of
    Nothing -> ""
    Just o  -> [b|<atom:link href="$link/$o" rel="self" />|]

makeItems :: Strict.Text -> FilePath -> Bool -> FilePath -> Info -> [Builder]
makeItems root prefix nsfw path info =
  makeItem root prefix nsfw path info Nothing :
  map (makeItem root prefix nsfw path info . Just . fst)
      (bigUpdatesFor nsfw info)

makeItem :: Strict.Text -> FilePath -> Bool -> FilePath ->
            Info -> Maybe Date -> Builder
makeItem root prefix nsfw path info@(Info {title}) date = [b|
    <item>
      <title><![CDATA[$title$suffix]]></title>
      <link>$link</link>
      <guid>$link$guidSuffix</guid>
      <dc:creator><![CDATA[$creator]]></dc:creator>
      <pubDate>$dateStr</pubDate>
      $body
    </item>
  |]
 where
  body = [b|
      <description> <![CDATA[
        $image
        $artist
        $desc
      ]]> </description>
    |]

  suffix = if null parts then ""
           else " (" <> mconcat (intersperse ", " parts) <> ")"
  guidSuffix = maybe "" (("?" <>) . show) date
  parts = catMaybes [o18, cnt, up]
  up   = "updated" <$ date
  o18  = do guard $ nsfw && anyNsfw info; Just "🔞"
  cnt  = do let len = maybe 0 length $ allImages <$> imagesFor nsfw info
            guard $ len /= 1; Just [b|$len images|]

  dir  = takeDirectory path
  link = [b|$root/$prefix/$dir|]

  creator = maybe "niss" (.name) info.artist

  dateStr = formatRSS $ fromMaybe info.date date
  artist = ifJust info.artist \case
    Artist name Nothing    -> [b|<p>by $name|]
    Artist name (Just url) -> [b|<p>by <a href="$url">$name</a>|]
  desc = makeDesc $ descFor nsfw info

  preview = previewImage info
  image = case preview of
    Just (PFull img) -> figure (escAttr img.desc) $ pageFile img
    Just (PThumb th) -> figure "full image hidden" $ thumbFile th
    Nothing          -> ""
  msg = case preview of
    Just (PThumb _) -> "<p>(full image hidden; open to see)</p>"
    _               -> "" :: Text
  figure alt p = [b|
      <figure aria-describedby=mainimg>
        <a href="$link">
          <img id=mainimg src="$link/$p" alt="$alt" title="$alt">
        </a>
      </figure>
      $msg
    |]

makeDesc :: Desc -> Builder
makeDesc NoDesc = ""
makeDesc (TextDesc txt) = [b|$txt|]
makeDesc (LongDesc fs) = [b|<ul>$fields</ul>|] where
  fields = map mkField fs
  mkField (DescField {name, text}) = [b|
    <li> <b>$name</b>:
         $text
  |]