module RSS (make, make') where import Date import Info import BuilderQQ import Data.List (sortBy, intersperse) import Data.Maybe (catMaybes) 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| $name—$title $link $desc $selflink $items |] where link = [b|$root/$prefix|] nsfw = ginfo.nsfw items = map (uncurry $ makeItem root prefix nsfw) $ sortBy (flip (compareFor nsfw `on` snd)) $ filter (not . (.unlisted) . snd) infos selflink = case output of Nothing -> "" Just o -> [b||] makeItem :: Strict.Text -> FilePath -> Bool -> FilePath -> Info -> Builder makeItem root prefix nsfw path info@(Info {title}) = [b| $title$suffix $link $link $body $date |] where body = [b| |] suffix = if null parts then "" else " (" <> mconcat (intersperse ", " parts) <> ")" parts = catMaybes [o18, cnt, up] up = do guard $ hasUpdatesFor nsfw info; Just "updated" 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|] date = formatRSS $ latestDateFor nsfw info artist = ifJust info.artist \case Artist name Nothing -> [b|

by $name|] Artist name (Just url) -> [b|

by $name|] desc = makeDesc $ descFor nsfw info image = case previewImage info of Just (PFull img) -> figure $ pageFile img Just (PThumb th) -> figure $ thumbFile th Nothing -> "" figure p = [b|

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