gallery/make-pages/GalleryPage.hs

137 lines
3.8 KiB
Haskell

{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where
import Control.Exception
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 System.FilePath ((</>), takeDirectory, joinPath, splitPath)
import GHC.Exts (Down (..), the)
import BuilderQQ
import Depend (thumbFile)
import Info
newtype NoThumb = NoThumb FilePath
deriving stock Eq deriving anyclass Exception
instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir
make :: GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make ginfo infos = toLazyText $ make' ginfo infos
make' :: GalleryInfo -> [(FilePath, Info)] -> Builder
make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
<link rel=stylesheet href=/style/shiny/gallery.css title=shiny>
<link rel=alternate href=rss.xml type=application/rss+xml>
<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
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 " 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}) = [b|@4
<li class="item post$nsfw'" data-tags="$tags'">
<figure>
<a href="$@dir">
<img src="$@thumb">
</a>
<figcaption>$*title</figcaption>
</figure>
|]
where
dir = takeDirectory file
thumb = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) $ #thumb info
nsfw' = if nsfw && #anyNsfw info then " nsfw" else ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info