add rss [fixes #1]

2020-07-19 18:04:40 +02:00 · 2020-07-19 18:04:40 +02:00 · ecaba4e33d
commit ecaba4e33d
parent 0f908581df
7 changed files with 132 additions and 7 deletions
--- a/1
+++ b/1
@ -2,6 +2,7 @@ DATADIR  = data
 TMPDIR   = _tmp
 BUILDDIR = _build
 INFONAME = info.yaml
+ROOT     = https://gallery.niss.website

 # SMALL = thumbnails, MED = single pages (link to full size)
 SMALL := 200
--- a/make-pages/Depend.hs
+++ b/make-pages/Depend.hs
@ -43,14 +43,16 @@ dependGallery ginfo infos build data_ tmp =

 dependGallery' :: GalleryInfo -> [(FilePath, Info)]
               -> FilePath -> FilePath -> FilePath -> Builder
-dependGallery' (GalleryInfo {title, prefix, filters}) infos' build data_ tmp =
-  let infos  = filter (matchFilters filters . snd) infos'
-      files  = map fst infos
+dependGallery' (GalleryInfo {title, description, prefix, filters})
+               infos' build data_ tmp =
+  let infos  = filter (matchFilters filters . #second) infos'
+      files  = map #first infos
      files' = unwords $ map (data_ </>) files
      page d = build </> prefix </> takeDirectory d </> "index.html"
-      pages  = map (page . fst) infos
+      pages  = map page files
      pages' = unwords pages
      path   = build </> prefix </> "index.html"
+      rss    = build </> prefix </> "rss.xml"
      rules  = makeRules prefix filters build data_ tmp
      inc d  = tmp </> prefix </> takeDirectory d <.> "mk"
      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 "$$@" \
    	  $$(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

    $incs
--- a/make-pages/GalleryPage.hs
+++ b/make-pages/GalleryPage.hs
@ -28,11 +28,15 @@ make' title nsfw infos = [b|@0
    <html lang=en>
    <meta charset=utf-8>
    <link rel=stylesheet href=/style/gallery.css>
+    <link rel=alternate href=rss.xml type=application/rss+xml>

    <title>$*title</title>

    <header>
      <h1>$*title</h1>
+      <h2 class="right corner">
+        <a href=rss.xml>rss</a>
+      </h2>
    </header>

    <main>
--- a/make-pages/Main.hs
+++ b/make-pages/Main.hs
@ -9,7 +9,7 @@ import Data.Text.Lazy (Text)
 import Data.Text.Lazy.Builder (toLazyText)
 import qualified Data.Text.Lazy.IO as Text
 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.IO (hPrint, stderr)

@ -19,6 +19,7 @@ import Options
 import qualified SinglePage
 import qualified GalleryPage
 import qualified IndexPage
+import qualified RSS

 #ifdef PRETTY_VERBOSE
 import qualified Text.PrettyPrint as PP
@ -61,6 +62,13 @@ main2 (IndexPage {file, output}) = do
  let page = IndexPage.make info
  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
  info <- readYAML file
  printV $ "contents" := info
--- a/make-pages/Options.hs
+++ b/make-pages/Options.hs
@ -27,6 +27,15 @@ data ModeOptions =
      file   :: FilePath,
      output :: Maybe FilePath
    }
+  | RSS {
+      files       :: [FilePath],
+      title       :: Text,
+      description :: Text,
+      root        :: Text,
+      prefix      :: FilePath,
+      output      :: Maybe FilePath,
+      dataDir     :: FilePath
+    }
  | DependSingle {
      file     :: FilePath,
      nsfw     :: Bool,
@ -53,7 +62,7 @@ optionsParser = globalOpts `info` mainInfo where
    short 'v' <> long "verbose" <>
    help "print extra stuff to stderr"
  subcommands = hsubparser $
-    single <> gallery <> index <> dependSingle <> dependGallery
+    single <> gallery <> index <> rss <> dependSingle <> dependGallery

  single = command "single" $ singleOpts `info` singleInfo
  singleOpts = SinglePage <$> file <*> nsfwS <*> output
@ -85,6 +94,17 @@ optionsParser = globalOpts `info` mainInfo where
    help "page title"
  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
  dsOpts =
    DependSingle <$> file <*> nsfwS <*> output <*> prefix
--- a/make-pages/RSS.hs
+++ b/make-pages/RSS.hs
@ -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"
--- a/make-pages/make-pages.cabal
+++ b/make-pages/make-pages.cabal
@ -21,7 +21,8 @@ executable make-pages
    IndexPage,
    Options
    Records,
-    SinglePage
+    SinglePage,
+    RSS
  default-language: Haskell2010
  default-extensions:
    BlockArguments,