add rss [fixes #1]

This commit is contained in:
Rhiannon Morris 2020-07-19 18:04:40 +02:00
parent 0f908581df
commit ecaba4e33d
7 changed files with 132 additions and 7 deletions

View file

@ -2,6 +2,7 @@ DATADIR = data
TMPDIR = _tmp TMPDIR = _tmp
BUILDDIR = _build BUILDDIR = _build
INFONAME = info.yaml INFONAME = info.yaml
ROOT = https://gallery.niss.website
# SMALL = thumbnails, MED = single pages (link to full size) # SMALL = thumbnails, MED = single pages (link to full size)
SMALL := 200 SMALL := 200

View file

@ -43,14 +43,16 @@ dependGallery ginfo infos build data_ tmp =
dependGallery' :: GalleryInfo -> [(FilePath, Info)] dependGallery' :: GalleryInfo -> [(FilePath, Info)]
-> FilePath -> FilePath -> FilePath -> Builder -> FilePath -> FilePath -> FilePath -> Builder
dependGallery' (GalleryInfo {title, prefix, filters}) infos' build data_ tmp = dependGallery' (GalleryInfo {title, description, prefix, filters})
let infos = filter (matchFilters filters . snd) infos' infos' build data_ tmp =
files = map fst infos let infos = filter (matchFilters filters . #second) infos'
files = map #first infos
files' = unwords $ map (data_ </>) files files' = unwords $ map (data_ </>) files
page d = build </> prefix </> takeDirectory d </> "index.html" page d = build </> prefix </> takeDirectory d </> "index.html"
pages = map (page . fst) infos pages = map page files
pages' = unwords pages pages' = unwords pages
path = build </> prefix </> "index.html" path = build </> prefix </> "index.html"
rss = build </> prefix </> "rss.xml"
rules = makeRules prefix filters build data_ tmp rules = makeRules prefix filters build data_ tmp
inc d = tmp </> prefix </> takeDirectory d <.> "mk" inc d = tmp </> prefix </> takeDirectory d <.> "mk"
incs = if null infos then "" else incs = if null infos then "" else
@ -65,6 +67,15 @@ dependGallery' (GalleryInfo {title, prefix, filters}) infos' build data_ tmp =
$$(MAKEPAGES) $$(MPFLAGS) gallery -t "$*title" $flags -o "$$@" \ $$(MAKEPAGES) $$(MPFLAGS) gallery -t "$*title" $flags -o "$$@" \
$$(filter $$(DATADIR)/%/$$(INFONAME),$$^) $$(filter $$(DATADIR)/%/$$(INFONAME),$$^)
$@rss: $@files' $$(MAKEPAGES)
echo "[rss] "$$@
mkdir -p $$(dir $$@)
$$(MAKEPAGES) $$(MPFLAGS) rss -t "$*title" \
-d "$*description" \
-R "$$(ROOT)" -p "$@prefix" \
-o "$$@" -D "$@data_" \
$$(filter $$(DATADIR)/%/$$(INFONAME),$$^)
$rules $rules
$incs $incs

View file

@ -28,11 +28,15 @@ make' title nsfw infos = [b|@0
<html lang=en> <html lang=en>
<meta charset=utf-8> <meta charset=utf-8>
<link rel=stylesheet href=/style/gallery.css> <link rel=stylesheet href=/style/gallery.css>
<link rel=alternate href=rss.xml type=application/rss+xml>
<title>$*title</title> <title>$*title</title>
<header> <header>
<h1>$*title</h1> <h1>$*title</h1>
<h2 class="right corner">
<a href=rss.xml>rss</a>
</h2>
</header> </header>
<main> <main>

View file

@ -9,7 +9,7 @@ import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder (toLazyText)
import qualified Data.Text.Lazy.IO as Text import qualified Data.Text.Lazy.IO as Text
import qualified Data.YAML as YAML import qualified Data.YAML as YAML
import System.FilePath (makeRelative, takeDirectory) import System.FilePath (makeRelative, takeDirectory, takeFileName)
import System.FilePath.Find (find, always, fileName, (==?)) import System.FilePath.Find (find, always, fileName, (==?))
import System.IO (hPrint, stderr) import System.IO (hPrint, stderr)
@ -19,6 +19,7 @@ import Options
import qualified SinglePage import qualified SinglePage
import qualified GalleryPage import qualified GalleryPage
import qualified IndexPage import qualified IndexPage
import qualified RSS
#ifdef PRETTY_VERBOSE #ifdef PRETTY_VERBOSE
import qualified Text.PrettyPrint as PP import qualified Text.PrettyPrint as PP
@ -61,6 +62,13 @@ main2 (IndexPage {file, output}) = do
let page = IndexPage.make info let page = IndexPage.make info
writeOutput output page writeOutput output page
main2 (RSS {files, title, description, root, prefix, output, dataDir}) = do
infos <- mapM (infoYAML dataDir) files
printV $ "infos" := infos
let output' = takeFileName <$> output
let rss = RSS.make root title description prefix output' infos
writeOutput output rss
main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do
info <- readYAML file info <- readYAML file
printV $ "contents" := info printV $ "contents" := info

View file

@ -27,6 +27,15 @@ data ModeOptions =
file :: FilePath, file :: FilePath,
output :: Maybe FilePath output :: Maybe FilePath
} }
| RSS {
files :: [FilePath],
title :: Text,
description :: Text,
root :: Text,
prefix :: FilePath,
output :: Maybe FilePath,
dataDir :: FilePath
}
| DependSingle { | DependSingle {
file :: FilePath, file :: FilePath,
nsfw :: Bool, nsfw :: Bool,
@ -53,7 +62,7 @@ optionsParser = globalOpts `info` mainInfo where
short 'v' <> long "verbose" <> short 'v' <> long "verbose" <>
help "print extra stuff to stderr" help "print extra stuff to stderr"
subcommands = hsubparser $ subcommands = hsubparser $
single <> gallery <> index <> dependSingle <> dependGallery single <> gallery <> index <> rss <> dependSingle <> dependGallery
single = command "single" $ singleOpts `info` singleInfo single = command "single" $ singleOpts `info` singleInfo
singleOpts = SinglePage <$> file <*> nsfwS <*> output singleOpts = SinglePage <$> file <*> nsfwS <*> output
@ -85,6 +94,17 @@ optionsParser = globalOpts `info` mainInfo where
help "page title" help "page title"
galleryInfo = progDesc "generate a gallery page" galleryInfo = progDesc "generate a gallery page"
rss = command "rss" $ rssOpts `info` rssInfo
rssOpts = RSS <$> files <*> title <*> desc <*> root
<*> prefix <*> output <*> dataDir
desc = strOption $
short 'd' <> long "desc" <> metavar "DESC" <>
help "gallery description"
root = strOption $
short 'R' <> long "root" <> metavar "URL" <>
help "website root (no trailing slash)"
rssInfo = progDesc "generate an rss file for a gallery"
dependSingle = command "depend-single" $ dsOpts `info` dsInfo dependSingle = command "depend-single" $ dsOpts `info` dsInfo
dsOpts = dsOpts =
DependSingle <$> file <*> nsfwS <*> output <*> prefix DependSingle <$> file <*> nsfwS <*> output <*> prefix

80
make-pages/RSS.hs Normal file
View file

@ -0,0 +1,80 @@
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"

View file

@ -21,7 +21,8 @@ executable make-pages
IndexPage, IndexPage,
Options Options
Records, Records,
SinglePage SinglePage,
RSS
default-language: Haskell2010 default-language: Haskell2010
default-extensions: default-extensions:
BlockArguments, BlockArguments,