rhi/gallery
1
0
Fork 0
Code Issues 5 Pull requests 1 Releases Wiki Activity

add twitter [etc] card previews

Browse source
This commit is contained in:
Rhiannon Morris 2020-08-11 20:29:54 +02:00
parent 8865b951fa
commit 5ad4e3dc30
9 changed files with 115 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
Makefile
View file

@ -33,7 +33,7 @@ build: $(BUILDDIR)/index.html $(BSTATIC)
$(BUILDDIR)/index.html: $(DATADIR)/index.yaml $(MAKEPAGES) $(BUILDDIR)/index.html: $(DATADIR)/index.yaml $(MAKEPAGES)
echo "[index] "$@ echo "[index] "$@
mkdir -p $(dir $@) mkdir -p $(dir $@)
$(MAKEPAGES) $(MPFLAGS) index $< -o $@ $(MAKEPAGES) $(MPFLAGS) index -R $(ROOT) $< -o $@
$(BUILDDIR)/%: % $(BUILDDIR)/%: %
@ -145,17 +145,18 @@ endef
define gallery define gallery
echo "[gallery] "$@ echo "[gallery] "$@
mkdir -p "$(dir $@)" mkdir -p "$(dir $@)"
$(MAKEPAGES) $(MPFLAGS) gallery -i "$(1)" -p "$(2)" $(3) -o "$@" \ $(MAKEPAGES) $(MPFLAGS) gallery -i "$(1)" -R $(ROOT) -p "$(2)" $(3) -o "$@" \
$(filter $(DATADIR)/%/$(INFONAME),$^) $(filter $(DATADIR)/%/$(INFONAME),$^)
endef endef
# args: # args:
# 1. data dir # 1. data dir
# 2. other flags # 2. gallery prefix
# 3. other flags
define single define single
echo "[single] "$@ echo "[single] "$@
mkdir -p "$(dir $@)" mkdir -p "$(dir $@)"
$(MAKEPAGES) $(MPFLAGS) single -D "$(1)" $< -o "$@" $(2) $(MAKEPAGES) $(MPFLAGS) single -R $(ROOT) -D "$(1)" -p "$(2)" $< -o "$@" $(3)
endef endef
# args: # args:

15
make-pages/Depend.hs
View file

@ -90,7 +90,7 @@ makeRules :: FilePath -- ^ prefix
-> Builder -> Builder
makeRules prefix filters build data_ tmp = [b|@0 makeRules prefix filters build data_ tmp = [b|@0
$@buildPrefix/%/index.html: $@data_/%/info.yaml $$(MAKEPAGES) $@buildPrefix/%/index.html: $@data_/%/info.yaml $$(MAKEPAGES)
$$(call single,$@data_,$flags) $$(call single,$@data_,$@prefix,$flags)
$@tmpPrefix/%.mk: $@data_/%/info.yaml $$(MAKEPAGES) $@tmpPrefix/%.mk: $@data_/%/info.yaml $$(MAKEPAGES)
$$(call depend-single,$@prefix,$@build,$@data_,$flags) $$(call depend-single,$@prefix,$@build,$@data_,$flags)
@ -112,16 +112,3 @@ filtersToFlags (GalleryFilters {nsfw}) =
thumbnail :: Info -> FilePath thumbnail :: Info -> FilePath
thumbnail = fromMaybe (error "no thumbnail or sfw images") . #thumb thumbnail = fromMaybe (error "no thumbnail or sfw images") . #thumb
addSuffix :: String -> FilePath -> FilePath
addSuffix suf path =
let (pre, ext) = splitExtension path in
pre ++ suf ++ ext
thumbFile :: FilePath -> FilePath
thumbFile = addSuffix "_small"
pageFile :: FilePath -> FilePath
pageFile f
| takeExtension f == ".gif" = f
| otherwise = addSuffix "_med" f

32
make-pages/GalleryPage.hs
View file

@ -1,7 +1,6 @@
{-# LANGUAGE TransformListComp #-} {-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where module GalleryPage (make) where
import Control.Exception
import Data.Foldable import Data.Foldable
import Data.Function (on, (&)) import Data.Function (on, (&))
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
@ -9,23 +8,18 @@ import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet import qualified Data.HashSet as HashSet
import Data.List (intersperse, groupBy, sortOn) import Data.List (intersperse, groupBy, sortOn)
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import System.FilePath ((</>), takeDirectory, joinPath, splitPath) import System.FilePath (takeDirectory, joinPath, splitPath)
import GHC.Exts (Down (..), the) import GHC.Exts (Down (..), the)
import BuilderQQ import BuilderQQ
import Depend (thumbFile)
import Info import Info
newtype NoThumb = NoThumb FilePath make :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
deriving stock Eq deriving anyclass Exception make root ginfo infos = toLazyText $ make' root ginfo infos
instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir
make :: GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make ginfo infos = toLazyText $ make' ginfo infos
make' :: GalleryInfo -> [(FilePath, Info)] -> Builder make' :: Text -> GalleryInfo -> [(FilePath, Info)] -> Builder
make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0 make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0
<!DOCTYPE html> <!DOCTYPE html>
<html lang=en> <html lang=en>
<meta charset=utf-8> <meta charset=utf-8>
@ -33,6 +27,15 @@ make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
<link rel=icon href=/style/niss.svg> <link rel=icon href=/style/niss.svg>
<link rel=alternate href=rss.xml type=application/rss+xml> <link rel=alternate href=rss.xml type=application/rss+xml>
<meta property=og:type content=og:website>
<meta property=og:title content="$*title">
<meta property=og:site_name content="$*title">
<meta property=og:description content="$*desc">
<meta property=og:image content="$url/$@imagepath0">
<meta property=og:url content="$url">
<meta name=twitter:site content=@gec_ko_>
<meta name=twitter:card content=summary>
<script src=/script/gallery.js></script> <script src=/script/gallery.js></script>
<title>$*title</title> <title>$*title</title>
@ -97,6 +100,11 @@ make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
nsfw = #nsfw filters /= NoNsfw nsfw = #nsfw filters /= NoNsfw
url = [b|$*root/$@prefix|]
imagepath0
| (_, (p0, i0) : _) : _ <- infosByYear = getThumb (takeDirectory p0) i0
| otherwise = "/style/card.png"
makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder
makeFilter prefix initial tag _count = [b|@8 makeFilter prefix initial tag _count = [b|@8
<li> <li>
@ -133,7 +141,7 @@ makeItem nsfw file info@(Info {title, bg}) = [b|@4
|] |]
where where
dir = takeDirectory file dir = takeDirectory file
thumb = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) $ #thumb info thumb = getThumb dir info
nsfw' = if nsfw && #anyNsfw info then " nsfw" else "" nsfw' = if nsfw && #anyNsfw info then " nsfw" else ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
bgStyle = ifJust bg \col -> [b| style="background: $*col"|] bgStyle = ifJust bg \col -> [b| style="background: $*col"|]

18
make-pages/IndexPage.hs
View file

@ -5,17 +5,26 @@ import qualified Data.Text.Lazy as Lazy
import BuilderQQ import BuilderQQ
import Info import Info
make :: IndexInfo -> Lazy.Text make :: Text -> IndexInfo -> Lazy.Text
make info = toLazyText $ make' info make root info = toLazyText $ make' root info
make' :: IndexInfo -> Builder make' :: Text -> IndexInfo -> Builder
make' (IndexInfo {title, galleries, links, footer}) = [b|@0 make' root (IndexInfo {title, desc, galleries, links, footer}) = [b|@0
<!DOCTYPE html> <!DOCTYPE html>
<html lang=en> <html lang=en>
<meta charset=utf-8> <meta charset=utf-8>
<link rel=stylesheet href=/style/shiny/index.css> <link rel=stylesheet href=/style/shiny/index.css>
<link rel=icon href=/style/niss.svg> <link rel=icon href=/style/niss.svg>
<meta property=og:type content=og:website>
<meta property=og:title content="$*title">
<meta property=og:site_name content="$*title">
<meta property=og:description content="$*desc">
<meta property=og:image content="$*root/style/card.png">
<meta property=og:url content="$url">
<meta name=twitter:site content=@gec_ko_>
<meta name=twitter:card content=summary>
<title>$*title</title> <title>$*title</title>
<header> <header>
@ -53,6 +62,7 @@ make' (IndexInfo {title, galleries, links, footer}) = [b|@0
$2*f $2*f
</footer> </footer>
|] |]
url = [b|$*root|]
makeItem :: GalleryInfo -> Builder makeItem :: GalleryInfo -> Builder
makeItem (GalleryInfo {title, desc, prefix, filters}) = [b|@6 makeItem (GalleryInfo {title, desc, prefix, filters}) = [b|@6

28
make-pages/Info.hs
View file

@ -5,6 +5,7 @@ module Info
GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..), GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..),
IndexInfo (..), IndexInfo (..),
readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters, readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters,
NoThumb (..), getThumb, thumbFile, pageFile,
-- ** Reexports -- ** Reexports
Day (..), Text) Day (..), Text)
where where
@ -13,6 +14,7 @@ import Records
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import Control.Exception
import Data.Foldable (find) import Data.Foldable (find)
import Data.Hashable (Hashable) import Data.Hashable (Hashable)
import Data.HashSet (HashSet) import Data.HashSet (HashSet)
@ -26,7 +28,7 @@ import qualified Data.Text as Text
import Data.Time.Calendar (Day (..), toGregorian) import Data.Time.Calendar (Day (..), toGregorian)
import Data.YAML (FromYAML (..), (.:), (.:?), (.!=)) import Data.YAML (FromYAML (..), (.:), (.:?), (.!=))
import qualified Data.YAML as YAML import qualified Data.YAML as YAML
import System.FilePath (takeBaseName) import System.FilePath ((</>), takeBaseName, takeExtension, splitExtension)
import Text.Read (readMaybe) import Text.Read (readMaybe)
@ -117,6 +119,28 @@ instance Ord Info where
compare = comparing \Info {date, title} -> (date, title) compare = comparing \Info {date, title} -> (date, title)
newtype NoThumb = NoThumb FilePath
deriving stock Eq deriving anyclass Exception
instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir
getThumb :: FilePath -> Info -> FilePath
getThumb dir =
maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) . #thumb
thumbFile :: FilePath -> FilePath
thumbFile = addSuffix "_small"
pageFile :: FilePath -> FilePath
pageFile f
| takeExtension f == ".gif" = f
| otherwise = addSuffix "_med" f
addSuffix :: String -> FilePath -> FilePath
addSuffix suf path =
let (pre, ext) = splitExtension path in
pre ++ suf ++ ext
instance FromYAML Info where instance FromYAML Info where
parseYAML = YAML.withMap "info" \m -> parseYAML = YAML.withMap "info" \m ->
Info <$> m .: "date" Info <$> m .: "date"
@ -259,6 +283,7 @@ instance FromYAML ArtistFilter where
data IndexInfo = data IndexInfo =
IndexInfo { IndexInfo {
title :: !Text, title :: !Text,
desc :: !Text,
galleries :: ![GalleryInfo], galleries :: ![GalleryInfo],
links :: ![Link], links :: ![Link],
footer :: !(Maybe Text) footer :: !(Maybe Text)
@ -268,6 +293,7 @@ data IndexInfo =
instance FromYAML IndexInfo where instance FromYAML IndexInfo where
parseYAML = YAML.withMap "index info" \m -> parseYAML = YAML.withMap "index info" \m ->
IndexInfo <$> m .: "title" IndexInfo <$> m .: "title"
<*> m .: "desc"
<*> m .:? "galleries" .!= [] <*> m .:? "galleries" .!= []
<*> m .:? "links" .!= [] <*> m .:? "links" .!= []
<*> m .:? "footer" <*> m .:? "footer"

12
make-pages/Main.hs
View file

@ -47,25 +47,25 @@ main = do
main2 mode main2 mode
main2 :: HasVerbose => ModeOptions -> IO () main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {file, dataDir, nsfw, output}) = do main2 (SinglePage {root, file, prefix, dataDir, nsfw, output}) = do
info <- readYAML file info <- readYAML file
printV $ "contents" := info printV $ "contents" := info
let dir = takeDirectory $ makeRelative dataDir file let dir = takeDirectory $ makeRelative dataDir file
page <- SinglePage.make nsfw dataDir dir info page <- SinglePage.make root prefix nsfw dataDir dir info
writeOutput output page writeOutput output page
main2 (GalleryPage {files, prefix, index, output, dataDir}) = do main2 (GalleryPage {root, files, prefix, index, output, dataDir}) = do
ginfo <- galleryFromIndex index prefix ginfo <- galleryFromIndex index prefix
printV $ "gallery_info" := ginfo printV $ "gallery_info" := ginfo
infos <- mapM (infoYAML dataDir) files infos <- mapM (infoYAML dataDir) files
printV $ "infos" := infos printV $ "infos" := infos
let page = GalleryPage.make ginfo infos let page = GalleryPage.make root ginfo infos
writeOutput output page writeOutput output page
main2 (IndexPage {file, output}) = do main2 (IndexPage {root, file, output}) = do
info <- readYAML file info <- readYAML file
printV $ "info" := info printV $ "info" := info
let page = IndexPage.make info let page = IndexPage.make root info
writeOutput output page writeOutput output page
main2 (RSS {files, root, index, prefix, output, dataDir}) = do main2 (RSS {files, root, index, prefix, output, dataDir}) = do

26
make-pages/Options.hs
View file

@ -12,12 +12,15 @@ data Options =
data ModeOptions = data ModeOptions =
SinglePage { SinglePage {
root :: Text,
file :: FilePath, file :: FilePath,
prefix :: FilePath,
dataDir :: FilePath, dataDir :: FilePath,
nsfw :: Bool, nsfw :: Bool,
output :: Maybe FilePath output :: Maybe FilePath
} }
| GalleryPage { | GalleryPage {
root :: Text,
files :: [FilePath], files :: [FilePath],
prefix :: FilePath, prefix :: FilePath,
index :: FilePath, index :: FilePath,
@ -25,6 +28,7 @@ data ModeOptions =
dataDir :: FilePath dataDir :: FilePath
} }
| IndexPage { | IndexPage {
root :: Text,
file :: FilePath, file :: FilePath,
output :: Maybe FilePath output :: Maybe FilePath
} }
@ -72,9 +76,17 @@ optionsParser = globalOpts `info` mainInfo where
listTags listTags
single = command "single" $ singleOpts `info` singleInfo single = command "single" $ singleOpts `info` singleInfo
singleOpts = SinglePage <$> file <*> dataDir <*> nsfwS <*> output singleOpts =
SinglePage <$> root <*> file <*> prefix <*> dataDir <*> nsfwS <*> output
root = strOption $
short 'R' <> long "root" <> metavar "URL" <>
help "website root (no trailing slash)"
file = strArgument $ file = strArgument $
metavar "FILE" <> help "yaml file to read" metavar "FILE" <> help "yaml file to read"
prefix = strOption $
short 'p' <> long "prefix" <> metavar "DIR" <>
value "" <>
help "gallery directory prefix"
nsfwS = switch $ nsfwS = switch $
short 'n' <> long "nsfw" <> short 'n' <> long "nsfw" <>
help "include nsfw versions" help "include nsfw versions"
@ -85,16 +97,13 @@ optionsParser = globalOpts `info` mainInfo where
singleInfo = progDesc "generate a page for a single work" singleInfo = progDesc "generate a page for a single work"
index = command "index" $ indexOpts `info` indexInfo index = command "index" $ indexOpts `info` indexInfo
indexOpts = IndexPage <$> file <*> output indexOpts = IndexPage <$> root <*> file <*> output
indexInfo = progDesc "generate an index page for all galleries" indexInfo = progDesc "generate an index page for all galleries"
gallery = command "gallery" $ galleryOpts `info` galleryInfo gallery = command "gallery" $ galleryOpts `info` galleryInfo
galleryOpts = galleryOpts =
GalleryPage <$> files <*> prefix <*> indexFile <*> output <*> dataDir GalleryPage <$> root <*> files <*> prefix
prefix = strOption $ <*> indexFile <*> output <*> dataDir
short 'p' <> long "prefix" <> metavar "DIR" <>
value "" <>
help "output directory prefix"
indexFile = strOption $ indexFile = strOption $
short 'i' <> long "index" <> metavar "FILE" <> short 'i' <> long "index" <> metavar "FILE" <>
help "path to index file" help "path to index file"
@ -105,9 +114,6 @@ optionsParser = globalOpts `info` mainInfo where
rss = command "rss" $ rssOpts `info` rssInfo rss = command "rss" $ rssOpts `info` rssInfo
rssOpts = RSS <$> files <*> root <*> indexFile rssOpts = RSS <$> files <*> root <*> indexFile
<*> prefix <*> output <*> dataDir <*> prefix <*> output <*> dataDir
root = strOption $
short 'R' <> long "root" <> metavar "URL" <>
help "website root (no trailing slash)"
rssInfo = progDesc "generate an rss file for a gallery" rssInfo = progDesc "generate an rss file for a gallery"
dependSingle = command "depend-single" $ dsOpts `info` dsInfo dependSingle = command "depend-single" $ dsOpts `info` dsInfo

29
make-pages/SinglePage.hs
View file

@ -1,7 +1,6 @@
module SinglePage (make) where module SinglePage (make) where
import Depend (pageFile) import Info
import Info hiding (Text)
import BuilderQQ import BuilderQQ
import Records () import Records ()
@ -25,14 +24,17 @@ instance Show NoEligibleImages where
" (probably a nsfw-only work without --nsfw set)" " (probably a nsfw-only work without --nsfw set)"
make :: Bool -- ^ nsfw? make :: Text -- ^ website root
-> FilePath -- ^ gallery prefix
-> Bool -- ^ nsfw?
-> FilePath -- ^ data dir -> FilePath -- ^ data dir
-> FilePath -- ^ subdir of datadir containing this @info.yaml@ -> FilePath -- ^ subdir of datadir containing this @info.yaml@
-> Info -> IO Lazy.Text -> Info -> IO Lazy.Text
make nsfw dataDir dir info = toLazyText <$> make' nsfw dataDir dir info make root prefix nsfw dataDir dir info =
toLazyText <$> make' root prefix nsfw dataDir dir info
make' :: Bool -> FilePath -> FilePath -> Info -> IO Builder make' :: Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder
make' nsfw dataDir dir info@(Info {date, title, artist, bg}) = do make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
images <- withSizes (dataDir </> dir) $ imagesFor nsfw info images <- withSizes (dataDir </> dir) $ imagesFor nsfw info
let undir = joinPath (replicate (length (splitPath dir)) "..") let undir = joinPath (replicate (length (splitPath dir)) "..")
@ -65,6 +67,12 @@ make' nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
<style> #mainfig { background: $*col; } </style> <style> #mainfig { background: $*col; } </style>
|] |]
let url = [b|$*root/$@prefix/$@dir|]
let desc = case artist of
Just (Artist {name}) -> [b|by $*name|]
Nothing -> "by niss"
let thumb = getThumb "" info
pure [b|@0 pure [b|@0
<!DOCTYPE html> <!DOCTYPE html>
<html lang=en> <html lang=en>
@ -73,6 +81,15 @@ make' nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
<link rel=stylesheet href=/style/shiny/single.css> <link rel=stylesheet href=/style/shiny/single.css>
<link rel=icon href=/style/niss.svg> <link rel=icon href=/style/niss.svg>
<meta property=og:type content=og:website>
<meta property=og:title content="$*title">
<meta property=og:site_name content="$*title">
<meta property=og:description content="$desc">
<meta property=og:image content="$url/$@thumb">
<meta property=og:url content="$url">
<meta name=twitter:site content=@gec_ko_>
<meta name=twitter:card content=summary>
<script src=/script/single.js></script> <script src=/script/single.js></script>
$bgStyle $bgStyle

BIN
style/card.png (Stored with Git LFS) Normal file
View file

Binary file not shown.