gallery/make-pages/GalleryPage.hs

173 lines
5.1 KiB
Haskell

{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where
import BuilderQQ
import Date
import Info
import qualified NsfwWarning
import Control.Monad
import Data.Foldable
import Data.Function (on, (&))
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List (intersperse, groupBy, sortBy, sortOn)
import Data.Maybe
import qualified Data.Text.Lazy as Lazy
import System.FilePath (takeDirectory, joinPath, splitPath)
import GHC.Exts (Down (..), the)
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>
<script src=/script/gallery.js></script>
$0.nsfwScript
<title>$title</title>
$0.nsfwDialog
<div class=page>
<header>
<h1>$title</h1>
<h2 class="right corner">
<a href=rss.xml>rss</a>
</h2>
</header>
<nav id=filters>
<details id=filters-details>
<summary><h2>filters</h2></summary>
<div>
<h3>show only</h3>
<ul id=require class="buttonbar bb-choice">
$10.requireFilters
</ul>
<h3>exclude</h3>
<ul id=exclude class="buttonbar bb-choice">
$10.excludeFilters
</ul>
<a href=# id=clear>clear</a>
<a href=# id=singles>toggle single-use tags</a>
</div>
</details>
</nav>
<main>
<ul class=grid>
$6.items
</ul>
</main>
<footer>
<a href=$undir>all galleries</a>
</footer>
</div>
|]
where
items = map (uncurry $ makeYearItems nsfw) infosByYear
infosByYear =
[(the year, infopath) |
infopath@(_, info) <- infos,
not $ #unlisted info,
then sortInfo by info,
let year = #latestYear info nsfw,
then group by Down year using groupBy']
sortInfo f = sortBy $ flip (compareFor nsfw `on` f)
groupBy' f = groupBy ((==) `on` f)
undir = joinPath (replicate (length (splitPath prefix)) "..")
allTags = infos
& concatMap (map (,1) . tagsFor nsfw . #second)
& HashMap.fromListWith (+) & HashMap.toList
& sortOn (\(tag, count) -> (Down count, tag))
requireFilters = map (uncurry $ makeFilter "require" mempty) allTags
excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags
nsfw = #nsfw filters /= NoNsfw
url = [b|$root/$prefix|]
imagepath0
| (_, (p0, i0) : _) : _ <- infosByYear = getThumb (takeDirectory p0) i0
| otherwise = "/style/card.png"
nsfw' = NsfwWarning.Gallery <$ guard nsfw
nsfwScript = NsfwWarning.script nsfw'
nsfwDialog = NsfwWarning.dialog nsfw'
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-date="$date'" data-year=$year'
data-updated="$updated'"
data-tags="$tags'">
<figure>
<a href="$dir">
<img src="$thumb" loading=lazy$bgStyle>
</a>
<figcaption>
<span class=date>$date'</span>
<span class=title>$title</span>
</figcaption>
</figure>
|]
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' = formatShort date
year' = #year date
updated' = if #updated info nsfw then [b|true|] else [b|false|]
bgStyle = ifJust bg \col -> [b| style="background: $col"|]