gallery/make-pages/GalleryPage.hs

174 lines
5.3 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|@0
<!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/$imagepath0">
<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>
$0.nsfwScript
<title>$title</title>
$0.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>
$10.requireFilters
</ul>
<h3>exclude</h3>
<ul id=exclude class=filterlist>
$10.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>
$6.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) -> #latestYear i nsfw)
undir = joinPath (replicate (length (splitPath prefix)) "..")
allTags = infos
& concatMap (map (,1) . tagsFor nsfw . #second)
& HashMap.fromListWith (+) & HashMap.toList
& sort
requireFilters = map (uncurry $ makeFilter "require" mempty) allTags
excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags
nsfw = #nsfw filters /= 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'
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|@0
<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|@0
<li class="item year-marker" id="marker-$year">
<span class=year-text>$year'</span>
$0.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|@0
<li class="item post$nsfw'" data-year=$year' data-updated="$updated'"
data-tags="$tags'">
<a href="$dir">
<img src="$thumb" loading=lazy$bgStyle
width=200 height=200
title="$tooltip">
</a>
|]
where
title = fromMaybe (#title info) $ #galleryTitle info
dir = takeDirectory file
thumb = getThumb dir info
nsfw' = if nsfw && #anyNsfw info then [b| nsfw|] else ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
date = #latestDate info nsfw
date' = formatTooltip date
year' = #year date
updated' = if #updated info nsfw then [b|true|] else [b|false|]
bgStyle = case bg of Other col -> [b| style="background: $col"|]; _ -> ""
tooltip =
let upd = if #updated info nsfw then "updated " else "" :: Builder in
[b|$title ($upd$date')|]