add twitter [etc] card previews

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

View File

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

View File

@ -90,7 +90,7 @@ makeRules :: FilePath -- ^ prefix
-> Builder
makeRules prefix filters build data_ tmp = [b|@0
$@buildPrefix/%/index.html: $@data_/%/info.yaml $$(MAKEPAGES)
$$(call single,$@data_,$flags)
$$(call single,$@data_,$@prefix,$flags)
$@tmpPrefix/%.mk: $@data_/%/info.yaml $$(MAKEPAGES)
$$(call depend-single,$@prefix,$@build,$@data_,$flags)
@ -112,16 +112,3 @@ filtersToFlags (GalleryFilters {nsfw}) =
thumbnail :: Info -> FilePath
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

View File

@ -1,7 +1,6 @@
{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where
import Control.Exception
import Data.Foldable
import Data.Function (on, (&))
import qualified Data.HashMap.Strict as HashMap
@ -9,23 +8,18 @@ import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List (intersperse, groupBy, sortOn)
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 BuilderQQ
import Depend (thumbFile)
import Info
newtype NoThumb = NoThumb FilePath
deriving stock Eq deriving anyclass Exception
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 :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make root ginfo infos = toLazyText $ make' root ginfo infos
make' :: GalleryInfo -> [(FilePath, Info)] -> Builder
make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
make' :: Text -> GalleryInfo -> [(FilePath, Info)] -> Builder
make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0
<!DOCTYPE html>
<html lang=en>
<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=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>
<title>$*title</title>
@ -97,6 +100,11 @@ make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
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 prefix initial tag _count = [b|@8
<li>
@ -133,7 +141,7 @@ makeItem nsfw file info@(Info {title, bg}) = [b|@4
|]
where
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 ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
bgStyle = ifJust bg \col -> [b| style="background: $*col"|]

View File

@ -5,17 +5,26 @@ import qualified Data.Text.Lazy as Lazy
import BuilderQQ
import Info
make :: IndexInfo -> Lazy.Text
make info = toLazyText $ make' info
make :: Text -> IndexInfo -> Lazy.Text
make root info = toLazyText $ make' root info
make' :: IndexInfo -> Builder
make' (IndexInfo {title, galleries, links, footer}) = [b|@0
make' :: Text -> IndexInfo -> Builder
make' root (IndexInfo {title, desc, galleries, links, footer}) = [b|@0
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
<link rel=stylesheet href=/style/shiny/index.css>
<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>
<header>
@ -53,6 +62,7 @@ make' (IndexInfo {title, galleries, links, footer}) = [b|@0
$2*f
</footer>
|]
url = [b|$*root|]
makeItem :: GalleryInfo -> Builder
makeItem (GalleryInfo {title, desc, prefix, filters}) = [b|@6

View File

@ -5,6 +5,7 @@ module Info
GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..),
IndexInfo (..),
readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters,
NoThumb (..), getThumb, thumbFile, pageFile,
-- ** Reexports
Day (..), Text)
where
@ -13,6 +14,7 @@ import Records
import Control.Applicative
import Control.Monad
import Control.Exception
import Data.Foldable (find)
import Data.Hashable (Hashable)
import Data.HashSet (HashSet)
@ -26,7 +28,7 @@ import qualified Data.Text as Text
import Data.Time.Calendar (Day (..), toGregorian)
import Data.YAML (FromYAML (..), (.:), (.:?), (.!=))
import qualified Data.YAML as YAML
import System.FilePath (takeBaseName)
import System.FilePath ((</>), takeBaseName, takeExtension, splitExtension)
import Text.Read (readMaybe)
@ -117,6 +119,28 @@ instance Ord Info where
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
parseYAML = YAML.withMap "info" \m ->
Info <$> m .: "date"
@ -259,6 +283,7 @@ instance FromYAML ArtistFilter where
data IndexInfo =
IndexInfo {
title :: !Text,
desc :: !Text,
galleries :: ![GalleryInfo],
links :: ![Link],
footer :: !(Maybe Text)
@ -268,6 +293,7 @@ data IndexInfo =
instance FromYAML IndexInfo where
parseYAML = YAML.withMap "index info" \m ->
IndexInfo <$> m .: "title"
<*> m .: "desc"
<*> m .:? "galleries" .!= []
<*> m .:? "links" .!= []
<*> m .:? "footer"

View File

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

View File

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

View File

@ -1,7 +1,6 @@
module SinglePage (make) where
import Depend (pageFile)
import Info hiding (Text)
import Info
import BuilderQQ
import Records ()
@ -25,14 +24,17 @@ instance Show NoEligibleImages where
" (probably a nsfw-only work without --nsfw set)"
make :: Bool -- ^ nsfw?
make :: Text -- ^ website root
-> FilePath -- ^ gallery prefix
-> Bool -- ^ nsfw?
-> FilePath -- ^ data dir
-> FilePath -- ^ subdir of datadir containing this @info.yaml@
-> 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' nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
make' :: Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder
make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
images <- withSizes (dataDir </> dir) $ imagesFor nsfw info
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>
|]
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
<!DOCTYPE html>
<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=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>
$bgStyle

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

Binary file not shown.