diff --git a/make-pages/GalleryPage.hs b/make-pages/GalleryPage.hs index c69b0da..54b3243 100644 --- a/make-pages/GalleryPage.hs +++ b/make-pages/GalleryPage.hs @@ -34,7 +34,7 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0 - + @@ -108,9 +108,6 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0 nsfw = filters.nsfw /= NoNsfw url = [b|$root/$prefix|] - imagepath0 - | (_, (p₀, i₀) : _) : _ <- infosByYear = getThumb (takeDirectory p₀) i₀ - | otherwise = "/style/card.png" nsfw' = NsfwWarning.Gallery <$ guard nsfw nsfwScript = NsfwWarning.script nsfw' diff --git a/make-pages/Info.hs b/make-pages/Info.hs index dd407ce..e09e294 100644 --- a/make-pages/Info.hs +++ b/make-pages/Info.hs @@ -13,6 +13,7 @@ module Info CompareKey (..), compareKeyFor, compareFor, sortFor, Artist (..), Images' (..), Images, Image (..), Desc (..), DescField (..), + PreviewImage (..), previewImage, Link (..), Update (..), Bg (..), @@ -117,6 +118,13 @@ data Images' a = type Images = Images' Image +data PreviewImage = PFull Image | PThumb FilePath + +previewImage :: Info -> Maybe PreviewImage +previewImage info + | Just img <- find (.sfw) $ allImages info.images = Just $ PFull img + | otherwise = PThumb <$> info.thumb' + data Link = Link { @@ -261,8 +269,7 @@ newtype NoThumb = NoThumb FilePath 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 +getThumb dir = maybe (throw $ NoThumb dir) (\t -> dir thumbFile t) . thumb thumbFile :: FilePath -> FilePath thumbFile = addSuffix "_small" diff --git a/make-pages/Main.hs b/make-pages/Main.hs index 0c4ca25..959148f 100644 --- a/make-pages/Main.hs +++ b/make-pages/Main.hs @@ -8,6 +8,7 @@ import Data.List (intersperse) import qualified Data.List as List import Data.Text.Lazy (Text) import Data.Text.Lazy.Builder (toLazyText) +import qualified Data.Text as Strict import qualified Data.Text.Lazy.IO as Text import qualified Data.YAML as YAML import System.FilePath (makeRelative, takeDirectory, takeFileName) @@ -56,7 +57,7 @@ main2 (SinglePage {root, file, prefix, index, dataDir, nsfw, output}) = do writeOutput output page main2 (GalleryPage {root, files, prefix, index, output, dataDir}) = do - ginfo <- galleryFromIndex index prefix + (_, ginfo) <- galleryFromIndex index prefix printV $ "gallery_info" := ginfo infos <- mapM (infoYAML dataDir) files printV $ "infos" := infos @@ -70,12 +71,12 @@ main2 (IndexPage {root, file, output}) = do writeOutput output page main2 (RSS {files, root, index, prefix, output, dataDir}) = do - ginfo <- galleryFromIndex index prefix + (name, ginfo) <- galleryFromIndex index prefix printV $ "gallery_info" := ginfo infos <- mapM (infoYAML dataDir) files printV $ "infos" := infos let output' = takeFileName <$> output - let rss = RSS.make root ginfo output' infos + let rss = RSS.make root name ginfo output' infos writeOutput output rss main2 (DependSingle {index, file, nsfw, output, prefix, buildDir, dataDir}) = do @@ -117,10 +118,10 @@ findInfos dataDir infoName = readYAML :: YAML.FromYAML a => FilePath -> IO a readYAML file = ByteString.readFile file >>= decode1Must file -galleryFromIndex :: FilePath -> FilePath -> IO GalleryInfo +galleryFromIndex :: FilePath -> FilePath -> IO (Strict.Text, GalleryInfo) galleryFromIndex file prefix = do - IndexInfo {galleries} <- readYAML file - maybe (fail $ "no gallery with prefix " ++ prefix) pure $ + IndexInfo {title, galleries} <- readYAML file + maybe (fail $ "no gallery with prefix " ++ prefix) (pure . (title,)) $ List.find (\g -> g.prefix == prefix) galleries decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a diff --git a/make-pages/RSS.hs b/make-pages/RSS.hs index 8a75604..ba12587 100644 --- a/make-pages/RSS.hs +++ b/make-pages/RSS.hs @@ -4,8 +4,8 @@ import Date import Info import BuilderQQ -import Data.List (sortBy) -import Data.Maybe (isJust) +import Data.List (sortBy, intersperse) +import Data.Maybe (catMaybes) import Data.Function (on) import qualified Data.Text as Strict import qualified Data.Text.Lazy as Lazy @@ -13,20 +13,21 @@ import System.FilePath (takeDirectory) make :: Strict.Text -- ^ website root e.g. @https://gallery.niss.website@ + -> Strict.Text -- ^ website name e.g. @nissart@ -> GalleryInfo -> Maybe FilePath -- ^ output filename for self link -> [(FilePath, Info)] -> Lazy.Text -make root ginfo output infos = - toLazyText $ make' root ginfo output infos +make root name ginfo output infos = + toLazyText $ make' root name ginfo output infos -make' :: Strict.Text -> GalleryInfo +make' :: Strict.Text -> Strict.Text -> GalleryInfo -> Maybe FilePath -> [(FilePath, Info)] -> Builder -make' root ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0 +make' root name ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0 - + - $title + $name—$title $link $desc $selflink @@ -43,37 +44,54 @@ make' root ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0 filter (not . (.unlisted) . snd) infos selflink = case output of Nothing -> "" - Just o -> [b||] + Just o -> [b||] makeItem :: Strict.Text -> FilePath -> Bool -> FilePath -> Info -> Builder makeItem root prefix nsfw path i@(Info {title, artist}) = [b|@4 - $title$up + $title$suf $link $link - $descArtist' + $body $date |] where - up = if hasUpdatesFor nsfw i then [b| (updated)|] else "" + suf = let parts = catMaybes [o18, cnt, up] in + if null parts then "" + else " (" <> mconcat (intersperse ", " parts) <> ")" + up = if hasUpdatesFor nsfw i then Just "updated" else Nothing + o18 = if nsfw && anyNsfw i then Just "🔞" else Nothing + cnt = let len = maybe 0 length $ allImages <$> imagesFor nsfw i in + if len == 1 then Nothing else Just [b|$len images|] + dir = takeDirectory path link = [b|$root/$prefix/$dir|] + + date = formatRSS $ latestDateFor nsfw i artist' = ifJust artist \case Artist {name, url = Nothing} -> [b|

by $name|] - Artist {name, url = Just url} -> [b|

by $name|] + Artist {name, url = Just url} -> [b|

by $name|] desc = descFor nsfw i desc' = makeDesc desc - descArtist' = if desc.exists || isJust artist then [b|@6 - - - + + body = [b|@6 + |] - else "" - date = formatRSS $ latestDateFor nsfw i + + image = case previewImage i of + Just (PFull img) -> go $ pageFile img + Just (PThumb th) -> go $ thumbFile th + Nothing -> "" + where go p = [b|@0 +

+ +
+ |] makeDesc :: Desc -> Builder makeDesc NoDesc = "" diff --git a/make-pages/SinglePage.hs b/make-pages/SinglePage.hs index b2644a3..2852716 100644 --- a/make-pages/SinglePage.hs +++ b/make-pages/SinglePage.hs @@ -9,7 +9,7 @@ import qualified NsfwWarning import Control.Exception import Control.Monad import Data.List (sort, intersperse) -import Data.Maybe (fromMaybe, isNothing, isJust) +import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as Strict import qualified Data.Text.Lazy as Lazy import System.FilePath (joinPath, splitPath) @@ -94,7 +94,6 @@ make' root siteName prefix nsfw _dataDir dir let desc = case artist of Just (Artist {name}) -> [b|by $name|] Nothing -> "by niss" - let thumbnail = getThumb "" info let updateDate = ifJust (last' updates) \(d, _) -> let updated = formatLong d in @@ -104,15 +103,17 @@ make' root siteName prefix nsfw _dataDir dir let nsfwScript = NsfwWarning.script nsfw' let nsfwDialog = NsfwWarning.dialog nsfw' - let imageMeta = - if image0.sfw && isNothing image0.warning then [b|@0 - - - - |] else [b|@0 - - - |] + let imageMeta = case previewImage info of + Just (PFull (Image {path})) -> [b|@0 + + + + |] + Just (PThumb path) -> [b|@0 + + + |] + Nothing -> throw $ NoThumb dir pure [b|@0