gallery/make-pages/GalleryPage.hs

175 lines
5.3 KiB
Haskell
Raw Normal View History

2020-07-16 10:07:28 -04:00
module GalleryPage (make) where
2020-09-25 17:08:44 -04:00
import BuilderQQ
import Date
import Info
2020-10-06 16:07:39 -04:00
import qualified NsfwWarning
2020-09-25 17:08:44 -04:00
2022-01-03 14:45:55 -05:00
import Control.Monad
2020-08-03 17:07:59 -04:00
import Data.Foldable
import Data.Function ((&))
2020-08-03 17:07:59 -04:00
import qualified Data.HashMap.Strict as HashMap
2020-08-03 20:27:19 -04:00
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List (intersperse, sort, sortOn)
import Data.Maybe
import Data.Ord (Down (..))
2020-07-16 10:07:28 -04:00
import qualified Data.Text.Lazy as Lazy
2020-08-11 14:29:54 -04:00
import System.FilePath (takeDirectory, joinPath, splitPath)
2020-07-16 10:07:28 -04:00
2020-08-11 14:29:54 -04:00
make :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make root ginfo infos = toLazyText $ make' root ginfo infos
2020-07-16 10:07:28 -04:00
2020-08-11 14:29:54 -04:00
make' :: Text -> GalleryInfo -> [(FilePath, Info)] -> Builder
make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0
2020-07-16 10:07:28 -04:00
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
2020-08-04 17:12:58 -04:00
<link rel=stylesheet href=/style/shiny/gallery.css>
2020-08-04 18:52:56 -04:00
<link rel=icon href=/style/niss.svg>
2020-07-19 12:04:40 -04:00
<link rel=alternate href=rss.xml type=application/rss+xml>
2020-07-16 10:07:28 -04:00
2020-08-11 14:29:54 -04:00
<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">
2020-08-11 14:29:54 -04:00
<meta property=og:url content="$url">
2020-09-19 02:13:13 -04:00
<meta name=twitter:site content=@2_gecs>
2020-08-11 14:29:54 -04:00
<meta name=twitter:card content=summary>
2022-11-12 06:14:42 -05:00
<meta name=robots content='noai,noimageai'>
2023-09-06 19:17:21 -04:00
<script src=/script/gallery.js type=module></script>
2020-10-06 16:07:39 -04:00
$0.nsfwScript
2020-08-03 17:11:15 -04:00
<title>$title</title>
2020-07-16 10:07:28 -04:00
2020-10-06 16:07:39 -04:00
$0.nsfwDialog
<div class=page>
<header>
<h1>$title</h1>
2023-06-21 13:58:01 -04:00
<a class="right corner" href=rss.xml>rss</a>
<a class="left corner" href=$undir>back</a>
2020-10-06 16:07:39 -04:00
</header>
<nav id=filters>
<details id=filters-details>
<summary><h2>filters</h2></summary>
<div>
<h3>show only</h3>
2022-12-29 21:19:33 -05:00
<ul id=require class=filterlist>
2020-10-06 16:07:39 -04:00
$10.requireFilters
</ul>
<h3>exclude</h3>
2022-12-29 21:19:33 -05:00
<ul id=exclude class=filterlist>
2020-10-06 16:07:39 -04:00
$10.excludeFilters
</ul>
2022-11-12 06:13:44 -05:00
<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>
2020-10-06 16:07:39 -04:00
</div>
</details>
</nav>
<main>
<ul class=grid>
$6.items
</ul>
</main>
</div>
2020-07-16 10:07:28 -04:00
|]
where
2020-07-18 05:43:35 -04:00
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)) "..")
2020-08-03 17:07:59 -04:00
allTags = infos
& concatMap (map (,1) . tagsFor nsfw . #second)
& HashMap.fromListWith (+) & HashMap.toList
2023-06-21 13:58:01 -04:00
& sort
2020-08-03 20:27:19 -04:00
requireFilters = map (uncurry $ makeFilter "require" mempty) allTags
excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags
2020-07-18 05:43:35 -04:00
nsfw = #nsfw filters /= NoNsfw
url = [b|$root/$prefix|]
2020-08-11 14:29:54 -04:00
imagepath0
| (_, (p, i) : _) : _ <- infosByYear = getThumb (takeDirectory p) i
2020-08-11 14:29:54 -04:00
| otherwise = "/style/card.png"
2022-01-03 14:45:55 -05:00
nsfw' = NsfwWarning.Gallery <$ guard nsfw
nsfwScript = NsfwWarning.script nsfw'
nsfwDialog = NsfwWarning.dialog nsfw'
2020-10-06 16:07:39 -04:00
-- 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
2020-08-03 20:27:19 -04:00
makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder
2020-10-06 16:07:39 -04:00
makeFilter prefix initial tag count = [b|@0
2021-03-12 23:29:57 -05:00
<li$hidden>
<input type=checkbox id="$id'" value="$tag"$checked>
2020-09-17 13:12:48 -04:00
<label for="$id'" data-count=$count>$tag</label>
2020-08-03 17:10:52 -04:00
|]
2020-08-03 20:27:19 -04:00
where
id' = [b|$prefix$&_$tag'|]
2020-08-03 20:27:19 -04:00
tag' = escId tag
checked = if HashSet.member tag initial then [b| checked|] else ""
2021-03-12 23:29:57 -05:00
hidden = if count <= 1 then [b| hidden|] else ""
2020-08-03 17:10:52 -04:00
2020-07-18 05:43:35 -04:00
makeYearItems :: Bool -- ^ nsfw
2020-09-25 17:08:44 -04:00
-> Int -- ^ year
2020-07-18 05:43:35 -04:00
-> [(FilePath, Info)]
-> Builder
2020-10-06 16:07:39 -04:00
makeYearItems nsfw year infos = [b|@0
<li class="item year-marker" id="marker-$year">
2020-07-20 16:40:34 -04:00
<span class=year-text>$year'</span>
2020-10-06 16:07:39 -04:00
$0.items
2020-07-18 05:43:35 -04:00
|]
2020-07-20 16:40:34 -04:00
where
items = map (uncurry $ makeItem nsfw) infos
year' = show year & foldMap \c -> [b|<span class=y>$c</span>|]
2020-07-16 10:07:28 -04:00
makeItem :: Bool -> FilePath -> Info -> Builder
makeItem nsfw file info@(Info {bg}) = [b|@0
2023-06-21 13:58:01 -04:00
<li class="item post$nsfw'" data-year=$year' data-updated="$updated'"
2020-09-19 01:51:52 -04:00
data-tags="$tags'">
2023-06-21 13:58:01 -04:00
<a href="$dir">
<img src="$thumb" loading=lazy$bgStyle
width=200 height=200
2023-06-21 13:58:01 -04:00
title="$tooltip">
</a>
2020-07-16 10:07:28 -04:00
|]
where
title = fromMaybe (#title info) $ #galleryTitle info
2020-09-19 01:51:52 -04:00
dir = takeDirectory file
thumb = getThumb dir info
nsfw' = if nsfw && #anyNsfw info then [b| nsfw|] else ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
2020-11-16 17:30:56 -05:00
date = #latestDate info nsfw
2023-06-21 13:58:01 -04:00
date' = formatTooltip date
year' = #year date
2020-11-16 17:30:56 -05:00
updated' = if #updated info nsfw then [b|true|] else [b|false|]
2023-03-07 10:14:42 -05:00
bgStyle = case bg of Other col -> [b| style="background: $col"|]; _ -> ""
2023-06-21 13:58:01 -04:00
tooltip =
let upd = if #updated info nsfw then "updated " else "" :: Builder in
[b|$title ($upd$date')|]