171 lines
5.2 KiB
Haskell
171 lines
5.2 KiB
Haskell
module GalleryPage (make) where
|
|
|
|
import BuilderQQ
|
|
import Date
|
|
import Info
|
|
import qualified NsfwWarning
|
|
|
|
import Control.Monad
|
|
import Data.Foldable
|
|
import Data.Function ((&))
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
import Data.HashSet (HashSet)
|
|
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 -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
|
|
make root ginfo infos = toLazyText $ make' root ginfo 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>
|
|
<ul class=grid>
|
|
$items
|
|
</ul>
|
|
</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) . 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|
|
|
<li class="item year-marker" id="marker-$year">
|
|
<span class=year-text>$year'</span>
|
|
$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|
|
|
<li 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
|
|
title="$tooltip">
|
|
</a>
|
|
|]
|
|
where
|
|
title = 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 $ 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
|