gallery/make-pages/GalleryPage.hs

154 lines
4.5 KiB
Haskell

{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where
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, sortOn)
import qualified Data.Text.Lazy as Lazy
import qualified Data.Time as Time
import System.FilePath (takeDirectory, joinPath, splitPath)
import GHC.Exts (Down (..), the)
import BuilderQQ
import Info
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=@gec_ko_>
<meta name=twitter:card content=summary>
<script src=/script/gallery.js></script>
<title>$title</title>
<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">
$8.requireFilters
</ul>
<h3>exclude</h3>
<ul id=exclude class="buttonbar bb-choice">
$8.excludeFilters
</ul>
<a href=# id=clear>clear</a>
<a href=# id=reset>default</a>
</div>
</details>
</nav>
<main>
<ul class=grid>
$4.items
</ul>
</main>
<footer>
<a href=$undir>all galleries</a>
</footer>
|]
where
items = map (uncurry $ makeYearItems nsfw) infosByYear
infosByYear =
[(the year, infopath) |
infopath@(_, info) <- infos,
then sortOn by Down info,
let year = #year info,
then group by Down year using groupBy']
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"
makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder
makeFilter prefix initial tag _count = [b|@8
<li>
<input type=checkbox id="$id'" value="$tag"$checked>
<label for="$id'">$tag</label>
|]
where
id' = [b|$prefix$&_$tag'|]
tag' = escId tag
checked = if HashSet.member tag initial then [b| checked|] else ""
makeYearItems :: Bool -- ^ nsfw
-> Integer -- ^ year
-> [(FilePath, Info)]
-> Builder
makeYearItems nsfw year infos = [b|@4
<li class="item year-marker">
<span class=year-text>$year'</span>
$4.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 {title, bg, date}) = [b|@4
<li class="item post$nsfw'" data-tags="$tags'" data-date="$date'">
<figure>
<a href="$dir">
<img src="$thumb"$bgStyle>
</a>
<figcaption>$title</figcaption>
</figure>
|]
where
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' = formatDateShort date
bgStyle = ifJust bg \col -> [b| style="background: $col"|]
formatDateShort :: Time.Day -> Builder
formatDateShort date = [b|$day $month|] where
(_, m, day) = Time.toGregorian date
month = words "jan feb mar apr may jun jul aug sep oct nov dec" !! (m - 1)