{-# LANGUAGE RecordWildCards #-}
module GalleryPage (make) where
import BuilderQQ
import Date
import Info
import qualified NsfwWarning
import TagTransforms
import Control.Monad
import Data.Foldable
import Data.Function ((&))
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import Data.List (intersperse, sort, sortOn)
import Data.Maybe
import Data.Ord (Down (..))
import qualified Data.Text.Lazy as Lazy
import System.FilePath (takeDirectory, joinPath, splitPath)
make :: Text -> IndexInfo -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make root iinfo ginfo infos =
toLazyText $ make' root ginfo $
map (fmap $ transformInfoTags iinfo.tags) infos
make' :: Text -> GalleryInfo -> [(FilePath, Info)] -> Builder
make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos =
[b|
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
<link rel=stylesheet href=/style/shiny/gallery.css>
<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/style/card.png">
<meta property=og:url content="$url">
<meta name=twitter:site content=@2_gecs>
<meta name=twitter:card content=summary>
<meta name=robots content='noai,noimageai'>
<script src=/script/gallery.js type=module></script>
$nsfwScript
<title>$title</title>
$nsfwDialog
<div class=page>
<header>
<h1>$title</h1>
<a class="right corner" href=rss.xml>rss</a>
<a class="left corner" href=$undir>back</a>
</header>
<nav id=filters>
<details id=filters-details>
<summary><h2>filters</h2></summary>
<div>
<h3>show only</h3>
<ul id=require class=filterlist>
$requireFilters
</ul>
<h3>exclude</h3>
<ul id=exclude class=filterlist>
$excludeFilters
</ul>
<ul id=filterstuff>
<li><a href=# id=clear>clear</a>
<li><a href=# id=sortalpha>sort by name</a>
<li><a href=# id=sortuses>sort by uses</a>
<li><a href=# id=singles>toggle single-use tags</a>
</ul>
</div>
</details>
</nav>
<main>
$items
</main>
</div>
|]
where
items = map (uncurry $ makeYearItems nsfw) infosByYear
infosByYear :: [(Int, [(FilePath, Info)])]
infosByYear = infos &
filter (not . (.unlisted) . snd) &
sortOn (Down . compareKeyFor nsfw . snd) &
groupOnKey (\(_, i) -> latestYearFor nsfw i)
undir = joinPath (replicate (length (splitPath prefix)) "..")
allTags = infos
& concatMap (map (,1) . HashSet.toList . tagsFor nsfw . snd)
& HashMap.fromListWith (+) & HashMap.toList
& sort
requireFilters = map (uncurry $ makeFilter "require" mempty) allTags
excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags
nsfw = filters.nsfw /= NoNsfw
url = [b|$root/$prefix|]
nsfw' = NsfwWarning.Gallery <$ guard nsfw
nsfwScript = NsfwWarning.script nsfw'
nsfwDialog = NsfwWarning.dialog nsfw'
-- from @extra@
groupOnKey :: Eq k => (a -> k) -> [a] -> [(k, [a])]
groupOnKey _ [] = []
groupOnKey f (x:xs) = (fx, x:yes) : groupOnKey f no where
fx = f x
(yes, no) = span (\y -> fx == f y) xs
makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder
makeFilter prefix initial tag count = [b|
<li$hidden>
<input type=checkbox id="$id'" value="$tag"$checked>
<label for="$id'" data-count=$count>$tag</label>
|]
where
id' = [b|$prefix$&_$tag'|]
tag' = escId tag
checked = if HashSet.member tag initial then [b|$& checked|] else ""
hidden = if count <= 1 then [b|$& hidden|] else ""
makeYearItems :: Bool -- ^ nsfw
-> Int -- ^ year
-> [(FilePath, Info)]
-> Builder
makeYearItems nsfw year infos = [b|
<h2 class="item year-marker" id="marker-$year" aria-label=$year>
$year'
</h2>
$items
|]
where
items = map (uncurry $ makeItem nsfw) infos
year' = show year & foldMap \c -> [b|<span class=y>$c</span>|]
makeItem :: Bool -> FilePath -> Info -> Builder
makeItem nsfw file info@(Info {bg}) = [b|
<figure class="item post$nsfw'" data-year=$year' data-updated="$updated'"
data-tags="$tags'">
<a href="$dir">
<img src="$thumbnail" loading=lazy$bgStyle
width=200 height=200
alt="$title" title="$tooltip">
</a>
</figure>
|]
where
title = escAttr $ fromMaybe info.title info.galleryTitle
dir = takeDirectory file
thumbnail = getThumb dir info
nsfw' = if nsfw && anyNsfw info then [b|$& nsfw|] else ""
tags' = fold $ intersperse ";" $ map fromText $
sort $ HashSet.toList $ tagsFor nsfw info
date = latestDateFor nsfw info
date' = formatTooltip date
year' = date.year
updated' = if hasUpdatesFor nsfw info then [b|true|] else [b|false|]
bgStyle = case bg of Other col -> [b|$& style="background: $col"|]; _ -> ""
tooltip = [b|$title ($upd$date')|]
where upd = if hasUpdatesFor nsfw info then "updated " else "" :: Builder