From 5ad4e3dc303260d8d2e91ed7746db25abd799e4c Mon Sep 17 00:00:00 2001 From: Rhiannon Morris Date: Tue, 11 Aug 2020 20:29:54 +0200 Subject: [PATCH] add twitter [etc] card previews --- Makefile | 9 +++++---- make-pages/Depend.hs | 15 +-------------- make-pages/GalleryPage.hs | 32 ++++++++++++++++++++------------ make-pages/IndexPage.hs | 18 ++++++++++++++---- make-pages/Info.hs | 28 +++++++++++++++++++++++++++- make-pages/Main.hs | 12 ++++++------ make-pages/Options.hs | 26 ++++++++++++++++---------- make-pages/SinglePage.hs | 29 +++++++++++++++++++++++------ style/card.png | 3 +++ 9 files changed, 115 insertions(+), 57 deletions(-) create mode 100644 style/card.png diff --git a/Makefile b/Makefile index 728ef81..9f37463 100644 --- a/Makefile +++ b/Makefile @@ -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: diff --git a/make-pages/Depend.hs b/make-pages/Depend.hs index 0d8c9a2..9b5d035 100644 --- a/make-pages/Depend.hs +++ b/make-pages/Depend.hs @@ -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 diff --git a/make-pages/GalleryPage.hs b/make-pages/GalleryPage.hs index 7da703c..5b16cf0 100644 --- a/make-pages/GalleryPage.hs +++ b/make-pages/GalleryPage.hs @@ -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 @@ -33,6 +27,15 @@ make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0 + + + + + + + + + $*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
  • @@ -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"|] diff --git a/make-pages/IndexPage.hs b/make-pages/IndexPage.hs index f8930ed..e77f3ba 100644 --- a/make-pages/IndexPage.hs +++ b/make-pages/IndexPage.hs @@ -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 + + + + + + + + + $*title
    @@ -53,6 +62,7 @@ make' (IndexInfo {title, galleries, links, footer}) = [b|@0 $2*f |] + url = [b|$*root|] makeItem :: GalleryInfo -> Builder makeItem (GalleryInfo {title, desc, prefix, filters}) = [b|@6 diff --git a/make-pages/Info.hs b/make-pages/Info.hs index 52a9098..7ff0043 100644 --- a/make-pages/Info.hs +++ b/make-pages/Info.hs @@ -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" diff --git a/make-pages/Main.hs b/make-pages/Main.hs index 3680508..1bd81c6 100644 --- a/make-pages/Main.hs +++ b/make-pages/Main.hs @@ -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 diff --git a/make-pages/Options.hs b/make-pages/Options.hs index 65b5c54..7b451e5 100644 --- a/make-pages/Options.hs +++ b/make-pages/Options.hs @@ -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 diff --git a/make-pages/SinglePage.hs b/make-pages/SinglePage.hs index 27aff57..df25e84 100644 --- a/make-pages/SinglePage.hs +++ b/make-pages/SinglePage.hs @@ -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 |] + 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 @@ -73,6 +81,15 @@ make' nsfw dataDir dir info@(Info {date, title, artist, bg}) = do + + + + + + + + + $bgStyle diff --git a/style/card.png b/style/card.png new file mode 100644 index 0000000..8574945 --- /dev/null +++ b/style/card.png @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:90fcb8fb48f30894639be58417298c849c7b8d902fb2c22bc58fcefb02679832 +size 17233