gallery/make-pages/GalleryPage.hs

{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where

import BuilderQQ
import Date
import Info

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)

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>

    <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=singles>toggle single-use tags</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 = #latestYear 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'" data-count=$count>$tag</label>
  |]
 where
  id' = [b|$prefix$&_$tag'|]
  tag' = escId tag
  checked = if HashSet.member tag initial then [b| checked|] else ""

makeYearItems :: Bool -- ^ nsfw
              -> Int -- ^ 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}) = [b|@4
    <li class="item post$nsfw'" data-date="$date'" data-updated="$updated'"
        data-tags="$tags'">
      <figure>
        <a href="$dir">
          <img src="$thumb"$bgStyle>
        </a>
        <figcaption>
          <span class=date>$date'</span>
          <span class=title>$title</span>
        </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'    = formatShort $ #latestDate info
  updated' = if #updated info then [b|true|] else [b|false|]
  bgStyle  = ifJust bg \col -> [b| style="background: $col"|]
improve sorting 2020-07-19 11:55:54 -04:00			`{-# LANGUAGE TransformListComp #-}`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`module GalleryPage (make) where`

add support for approx dates 2020-09-25 17:08:44 -04:00			`import BuilderQQ`
			`import Date`
			`import Info`

add tags to gallery items 2020-08-03 17:07:59 -04:00			`import Data.Foldable`
new style 2020-07-20 16:40:34 -04:00			`import Data.Function (on, (&))`
add tags to gallery items 2020-08-03 17:07:59 -04:00			`import qualified Data.HashMap.Strict as HashMap`
support initially-hidden tags 2020-08-03 20:27:19 -04:00			`import Data.HashSet (HashSet)`
			`import qualified Data.HashSet as HashSet`
add tags to gallery items 2020-08-03 17:07:59 -04:00			`import Data.List (intersperse, groupBy, sortOn)`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`import qualified Data.Text.Lazy as Lazy`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`import System.FilePath (takeDirectory, joinPath, splitPath)`
improve sorting 2020-07-19 11:55:54 -04:00			`import GHC.Exts (Down (..), the)`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`make :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text`
			`make root ginfo infos = toLazyText $ make' root ginfo infos`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00
pass index file to gallery/rss (instead of trying to escape the strings inside in make & on the command line) 2020-08-03 20:25:59 -04:00
add twitter [etc] card previews 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`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`<!DOCTYPE html>`
			`<html lang=en>`
			`<meta charset=utf-8>`
remove old title attr on stylesheets 2020-08-04 17:12:58 -04:00			`<link rel=stylesheet href=/style/shiny/gallery.css>`
add [temporary] favicon 2020-08-04 18:52:56 -04:00			`<link rel=icon href=/style/niss.svg>`
add rss [fixes #1] 2020-07-19 12:04:40 -04:00			`<link rel=alternate href=rss.xml type=application/rss+xml>`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`<meta property=og:type content=og:website>`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<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">`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`<meta property=og:url content="$url">`
changed twitter username 2020-09-19 02:13:13 -04:00			`<meta name=twitter:site content=@2_gecs>`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`<meta name=twitter:card content=summary>`

use DOMContentLoaded 2020-08-04 13:14:12 -04:00			`<script src=/script/gallery.js></script>`
add scripting for filters 2020-08-03 17:11:15 -04:00
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<title>$title</title>`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00
			`<header>`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<h1>$title</h1>`
add rss [fixes #1] 2020-07-19 12:04:40 -04:00			`<h2 class="right corner">`
			`<a href=rss.xml>rss</a>`
			`</h2>`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`</header>`

make filters into a <nav> 2020-08-04 12:22:16 -04:00			`<nav id=filters>`
open filters on load if not empty or 'all' 2020-08-04 12:46:17 -04:00			`<details id=filters-details>`
add filter elements to page 2020-08-03 17:10:52 -04:00			`<summary><h2>filters</h2></summary>`
			`<div>`
			`<h3>show only</h3>`
simplify some css selectors (by adding more classes & ids :( ) 2020-08-04 12:58:40 -04:00			`<ul id=require class="buttonbar bb-choice">`
add filter elements to page 2020-08-03 17:10:52 -04:00			`$8.requireFilters`
			`</ul>`

			`<h3>exclude</h3>`
simplify some css selectors (by adding more classes & ids :( ) 2020-08-04 12:58:40 -04:00			`<ul id=exclude class="buttonbar bb-choice">`
add filter elements to page 2020-08-03 17:10:52 -04:00			`$8.excludeFilters`
			`</ul>`

			`<a href=# id=clear>clear</a>`
replace reset link with hide single-use tags 2020-09-17 13:13:32 -04:00			`<a href=# id=singles>toggle single-use tags</a>`
add filter elements to page 2020-08-03 17:10:52 -04:00			`</div>`
			`</details>`
make filters into a <nav> 2020-08-04 12:22:16 -04:00			`</nav>`
add filter elements to page 2020-08-03 17:10:52 -04:00
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`<main>`
			`<ul class=grid>`
			`$4.items`
			`</ul>`
			`</main>`
put link to index in footer of gallery pages 2020-07-23 13:51:53 -04:00
			`<footer>`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<a href=$undir>all galleries</a>`
put link to index in footer of gallery pages 2020-07-23 13:51:53 -04:00			`</footer>`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`\|]`
			`where`
group gallery items by year 2020-07-18 05:43:35 -04:00			`items = map (uncurry $ makeYearItems nsfw) infosByYear`
pass index file to gallery/rss (instead of trying to escape the strings inside in make & on the command line) 2020-08-03 20:25:59 -04:00
group gallery items by year 2020-07-18 05:43:35 -04:00			`infosByYear =`
improve sorting 2020-07-19 11:55:54 -04:00			`[(the year, infopath) \|`
			`infopath@(_, info) <- infos,`
			`then sortOn by Down info,`
use year of latest update on gallery page 2020-09-21 15:44:54 -04:00			`let year = #latestYear info,`
improve sorting 2020-07-19 11:55:54 -04:00			`then group by Down year using groupBy']`
			groupBy' f = groupBy ((==) `on` f)
pass index file to gallery/rss (instead of trying to escape the strings inside in make & on the command line) 2020-08-03 20:25:59 -04:00
put link to index in footer of gallery pages 2020-07-23 13:51:53 -04:00			`undir = joinPath (replicate (length (splitPath prefix)) "..")`
pass index file to gallery/rss (instead of trying to escape the strings inside in make & on the command line) 2020-08-03 20:25:59 -04:00
add tags to gallery items 2020-08-03 17:07:59 -04:00			`allTags = infos`
			`& concatMap (map (,1) . tagsFor nsfw . #second)`
			`& HashMap.fromListWith (+) & HashMap.toList`
			`& sortOn (\(tag, count) -> (Down count, tag))`
support initially-hidden tags 2020-08-03 20:27:19 -04:00
			`requireFilters = map (uncurry $ makeFilter "require" mempty) allTags`
			`excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags`
group gallery items by year 2020-07-18 05:43:35 -04:00
pass index file to gallery/rss (instead of trying to escape the strings inside in make & on the command line) 2020-08-03 20:25:59 -04:00			`nsfw = #nsfw filters /= NoNsfw`

use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`url = [b\|$root/$prefix\|]`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`imagepath0`
			`\| (_, (p0, i0) : _) : _ <- infosByYear = getThumb (takeDirectory p0) i0`
			`\| otherwise = "/style/card.png"`

support initially-hidden tags 2020-08-03 20:27:19 -04:00			`makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder`
(re-)add tag counts to filter list 2020-09-17 13:12:48 -04:00			`makeFilter prefix initial tag count = [b\|@8`
add filter elements to page 2020-08-03 17:10:52 -04:00			`<li>`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<input type=checkbox id="$id'" value="$tag"$checked>`
(re-)add tag counts to filter list 2020-09-17 13:12:48 -04:00			`<label for="$id'" data-count=$count>$tag</label>`
add filter elements to page 2020-08-03 17:10:52 -04:00			`\|]`
support initially-hidden tags 2020-08-03 20:27:19 -04:00			`where`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`id' = [b\|$prefix$&_$tag'\|]`
support initially-hidden tags 2020-08-03 20:27:19 -04:00			`tag' = escId tag`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`checked = if HashSet.member tag initial then [b\| checked\|] else ""`
add filter elements to page 2020-08-03 17:10:52 -04:00
group gallery items by year 2020-07-18 05:43:35 -04:00			`makeYearItems :: Bool -- ^ nsfw`
add support for approx dates 2020-09-25 17:08:44 -04:00			`-> Int -- ^ year`
group gallery items by year 2020-07-18 05:43:35 -04:00			`-> [(FilePath, Info)]`
			`-> Builder`
			`makeYearItems nsfw year infos = [b\|@4`
			`<li class="item year-marker">`
new style 2020-07-20 16:40:34 -04:00			`<span class=year-text>$year'</span>`
group gallery items by year 2020-07-18 05:43:35 -04:00			`$4.items`
			`\|]`
new style 2020-07-20 16:40:34 -04:00			`where`
			`items = map (uncurry $ makeItem nsfw) infos`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`year' = show year & foldMap \c -> [b\|<span class=y>$c</span>\|]`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00
add nsfw class to relevant gallery items but only on galleries showing nsfw at all 2020-07-18 05:40:56 -04:00			`makeItem :: Bool -> FilePath -> Info -> Builder`
support updates 2020-09-19 01:51:52 -04:00			`makeItem nsfw file info@(Info {title, bg}) = [b\|@4`
			`<li class="item post$nsfw'" data-date="$date'" data-updated="$updated'"`
			`data-tags="$tags'">`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`<figure>`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<a href="$dir">`
			`<img src="$thumb"$bgStyle>`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`</a>`
support updates 2020-09-19 01:51:52 -04:00			`<figcaption>`
			`<span class=date>$date'</span>`
			`<span class=title>$title</span>`
			`</figcaption>`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`</figure>`
			`\|]`
			`where`
support updates 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`
add support for approx dates 2020-09-25 17:08:44 -04:00			`date' = formatShort $ #latestDate info`
support updates 2020-09-19 01:51:52 -04:00			`updated' = if #updated info then [b\|true\|] else [b\|false\|]`
			`bgStyle = ifJust bg \col -> [b\| style="background: $col"\|]`