add rss [fixes #1]
This commit is contained in:
parent
0f908581df
commit
ecaba4e33d
7 changed files with 132 additions and 7 deletions
1
Makefile
1
Makefile
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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>
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
80
make-pages/RSS.hs
Normal 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"
|
|
@ -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,
|
||||||
|
|
Loading…
Reference in a new issue