gallery/make-pages/SinglePage.hs

module SinglePage (make) where

import Date
import Info
import BuilderQQ
import Records ()
import qualified NsfwWarning

import Control.Exception
import Control.Monad
import Data.List (sort)
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import System.FilePath (joinPath, splitPath, (</>))
import qualified System.Process as Proc
import Text.Read (readMaybe)
import qualified Data.HashSet as Set
import Data.Traversable


-- | e.g. only nsfw images are present for a non-nsfw page
data NoEligibleImages = NoEligibleImages {title :: !Strict.Text}
  deriving stock Eq deriving anyclass Exception

instance Show NoEligibleImages where
  show (NoEligibleImages {title}) =
    Strict.unpack title <> ": no images selected\n" <>
    "  (probably a nsfw-only work without --nsfw set)"


make :: Text     -- ^ website root
     -> FilePath -- ^ gallery prefix
     -> Bool     -- ^ nsfw?
     -> FilePath -- ^ data dir
     -> FilePath -- ^ subdir of datadir containing this @info.yaml@
     -> Info -> IO Lazy.Text
make root prefix nsfw dataDir dir info =
  toLazyText <$> make' root prefix nsfw dataDir dir info

make' :: Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder
make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
  images <- withSizes (dataDir </> dir) $ imagesFor nsfw info

  let undir = joinPath (replicate (length (splitPath dir)) "..")

  let artistTag = ifJust artist makeArtist

  let formattedDate = formatLong date

  let buttonBar = makeButtonBar title $ addIds images
  let (image0@(Image {path = path0, download = download0'}),
       Size {width = width0, height = height0}) : otherImages
        = #all images
  let download0 = fromMaybe path0 download0'
  let path0'    = pageFile path0
  let tinyCls   = if any (tiny . #second) images then [b| class=tiny|] else ""

  let descSection = makeDesc $ descFor nsfw info
  let tagsList    = makeTags undir $ tagsFor nsfw info
  let linksList   = extLinks $ linksFor nsfw info
  let updates     = sort $ updatesFor nsfw info
  let updatesList = makeUpdates updates

  let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$path>|]
  let prefetches = map (makePrefetch . #first) otherImages

  let makeWarning w = [b|@0
        <figcaption id=cw aria-role=button tabindex=0>
          <span id=cw-text>$w</span>
        </figcaption>
      |]

  let defWarning = "oops i forgot to put one, sorry!<br>\
                   \if you can let me know i'd appreciate it" :: Text
  let warning'
        | Just w <- #warning image0 = makeWarning w
        | #nsfw image0              = makeWarning defWarning
        | otherwise                 = mempty
  let warningT = makeWarning [b|.|]

  let bgStyle = ifJust bg \col -> [b|@0
        <style> #mainfig { background: $col; } </style>
      |]

  let url = [b|$root/$prefix/$dir|]
  let desc = case artist of
        Just (Artist {name}) -> [b|by $name|]
        Nothing -> "by niss"
  let thumb = getThumb "" info

  let updateDate = ifJust (last' updates) \(Update {date = d}) ->
        let updated = formatLong d in
        [b|<br> <span class=updated>updated $updated</span>|]

  let nsfw'      = NsfwWarning.Single <$ guard nsfw
  let nsfwScript = NsfwWarning.script nsfw'
  let nsfwDialog = NsfwWarning.dialog nsfw'

  pure [b|@0
    <!DOCTYPE html>
    <html lang=en>
    <meta charset=utf-8>
    <meta name=viewport content="width=1200,viewport-fit=cover">
    <link rel=stylesheet href=/style/shiny/single.css>
    <link rel=icon href=/style/niss.svg>

    <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/$thumb">
    <meta property=og:url content="$url">
    <meta name=twitter:site content=@2_gecs>
    <meta name=twitter:card content=summary>

    <script src=/script/single.js></script>
    $nsfwScript
    $bgStyle

    $0.prefetches

    <title>$title</title>

    $nsfwDialog

    <div class=page>
      <header>
        <h1>$title</h1>
        $artistTag
        <h2 id=date class="right corner">
          $formattedDate $updateDate
        </h2>
      </header>

      $2.buttonBar

      <main>
        <figure id=mainfig data-width=$width0 data-height=$height0$tinyCls>
          $warning'
          <a id=mainlink href="$download0" title="download full version">
            <img id=mainimg src="$path0'" alt="">
          </a>
        </figure>

        <div id=info>
          $6.descSection

          $6.tagsList

          $6.linksList

          $6.updatesList
        </div>
      </main>

      <footer>
        <a href=$undir>back to gallery</a>
      </footer>
    </div>

    <template id=cw-template>
      $warningT
    </template>
  |]

last' :: [a] -> Maybe a
last' xs = if null xs then Nothing else Just $ last xs

makeArtist :: Artist -> Builder
makeArtist (Artist {name, url}) =
  [b|<h2 id=artist class="left corner">by $artistLink</h2>|]
 where
   artistLink = case url of
    Just u  -> [b|<a href="$u">$name</a>|]
    Nothing -> [b|$name|]

makeDesc :: Desc -> Builder
makeDesc NoDesc = ""
makeDesc (TextDesc desc) = [b|@0
    <section id=desc class=info-section>
      <h2>about</h2>
      <div>
        $4.desc
      </div>
    </section>
  |]
makeDesc (LongDesc fs) = [b|@0
    <section id=desc class=info-section>
      $2.fields
    </section>
  |]
 where
  fields = map makeField fs
  makeField (DescField {name, text}) = [b|@0
      <h2>$name</h2>
      <div>
        $4.text
      </div>
    |]

addIds :: Images' (Image, a) -> Images' (Image, a, Text)
addIds = snd . mapAccumL makeId Set.empty where
  makeId used (img, x) = (Set.insert newId used, (img, x, newId)) where
    newId = head $ filter (\i -> not $ i `Set.member` used) ids
    ids = [toStrictText [b|$label$i|] | i <- "" : map show [0::Int ..]]
    label = escId $ #label img

makeButtonBar :: Strict.Text -> Images' (Image, Size, Text) -> Builder
makeButtonBar title images =
  case images of
    Uncat []        -> throw $ NoEligibleImages title
    Uncat [_]       -> ""
    Cat   [(_,[_])] -> ""
    Uncat imgs      -> makeNav "uncat" $ makeAlts imgs
    Cat   cats      -> makeNav "cat"   $ map (uncurry makeCat) cats
 where
   makeNav (cls :: Text) inner = [b|@0
      <nav id=alts class=$cls aria-label="alternate versions">
        $2.inner
      </nav> |]
   makeCat lbl imgs = [b|@0
       <section>
         <h3 class=alt-cat>$lbl</h3>
         $0.alts
       </section> |]
     where alts = makeAlts imgs
   makeAlts imgs = [b|@0
        <ul class="buttonbar bb-choice">
          $2.elems
        </ul> |]
     where elems = map (\(img,sz,i) -> altButton img sz i) imgs

altButton :: Image -> Size -> Text -> Builder
altButton img size i = [b|@0
  <li$nsfwClass>
    <input type=radio name=variant id="$i" value="$path'"
           data-link="$link"$warning'
           data-width=$width data-height=$height>
    <label for="$i"$nsfwLabelClass>$label</label>
  |]
 where
  Image {label, path, nsfw, warning, download} = img
  Size {width, height} = size
  nsfwClass      = if nsfw then [b| class=nsfw|]       else ""
  nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else ""
  path'          = pageFile path
  link           = fromMaybe path download
  warning'       = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|]

makeTags :: FilePath -> [Strict.Text] -> Builder
makeTags undir tags =
  if null tags then "" else [b|@0
    <nav id=tags class=info-section>
      <h2>tags</h2>
      <ul class="buttonbar bb-links">
        $4.tagList
      </ul>
    </nav>
  |]
 where
  tagList = map makeTag tags
  makeTag tag = [b|<li><a href="$undir#require_$tag'">$tag</a>|]
    where tag' = escId tag

extLinks :: [Link] -> Builder
extLinks links =
  if null links then "" else [b|@0
    <nav id=links class=info-section>
      <h2>links</h2>
      <ul class="buttonbar bb-links">
        $4.linkList
      </ul>
    </nav>
  |]
  where linkList = map extLink links

extLink :: Link -> Builder
extLink (Link {title, url}) = [b|@8
    <li>
      <a href="$url">
        $title
      </a>
  |]

makeUpdates :: [Update] -> Builder
makeUpdates ups =
  if null ups then "" else [b|@4
    <section id=updates class=info-section>
      <h2>updates</h2>
      <dl>
        $8.updateList
      </dl>
    </section>
  |]
 where updateList = map makeUpdate ups

makeUpdate :: Update -> Builder
makeUpdate (Update {date, desc}) = [b|@8
    <dt>$date'
    <dd>$desc
  |]
  where date' = formatSlash date

data Size = Size {width, height :: !Int} deriving (Eq, Show)

tiny :: Size -> Bool
tiny (Size {width, height}) = width < 250 || height < 250

imageSize :: FilePath -> FilePath -> IO Size
imageSize dir img = do
  -- "[0]" to get the first frame of an animation
  -- otherwise it prints a pair for each frame
  let filename = (dir </> img) ++ "[0]"
  output <- Proc.readProcess "identify" ["-format", "(%W,%H)", filename] ""
  case readMaybe output of
    Just (width, height) -> pure $ Size {width, height}
    Nothing -> fail $ "couldn't understand identify output:\n" ++ output

withSizes :: Traversable t => FilePath -> t Image -> IO (t (Image, Size))
withSizes dir = traverse \img -> do
  size <- imageSize dir $ #path img
  pure (img, size)
move ImagePage → SinglePage 2020-07-09 00:20:09 -04:00			`module SinglePage (make) where`
add image page 2020-07-07 23:28:09 -04:00
add support for approx dates 2020-09-25 17:08:44 -04:00			`import Date`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`import Info`
rename BuildVar module to BuilderQQ 2020-07-15 15:31:46 -04:00			`import BuilderQQ`
a lot of stuff sorry 2020-07-16 10:07:28 -04:00			`import Records ()`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`import qualified NsfwWarning`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00
make lots of fields optional & get rid of vector 2020-07-11 23:40:14 -04:00			`import Control.Exception`
messing with the nsfw warning 2022-01-03 14:45:55 -05:00			`import Control.Monad`
allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`import Data.List (sort)`
add download field for svgs etc 2020-07-21 19:48:29 -04:00			`import Data.Maybe (fromMaybe)`
add image page 2020-07-07 23:28:09 -04:00			`import qualified Data.Text as Strict`
			`import qualified Data.Text.Lazy as Lazy`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`import System.FilePath (joinPath, splitPath, (</>))`
			`import qualified System.Process as Proc`
			`import Text.Read (readMaybe)`
ensure ids are unique 2021-08-23 10:35:55 -04:00			`import qualified Data.HashSet as Set`
			`import Data.Traversable`
make lots of fields optional & get rid of vector 2020-07-11 23:40:14 -04:00

change a comment 2020-07-12 23:02:16 -04:00			`-- \| e.g. only nsfw images are present for a non-nsfw page`
make lots of fields optional & get rid of vector 2020-07-11 23:40:14 -04:00			`data NoEligibleImages = NoEligibleImages {title :: !Strict.Text}`
			`deriving stock Eq deriving anyclass Exception`

			`instance Show NoEligibleImages where`
			`show (NoEligibleImages {title}) =`
			`Strict.unpack title <> ": no images selected\n" <>`
			`" (probably a nsfw-only work without --nsfw set)"`
add image page 2020-07-07 23:28:09 -04:00

add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`make :: Text -- ^ website root`
			`-> FilePath -- ^ gallery prefix`
			`-> Bool -- ^ nsfw?`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`-> FilePath -- ^ data dir`
			`-> FilePath -- ^ subdir of datadir containing this @info.yaml@`
			`-> Info -> IO Lazy.Text`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`make root prefix nsfw dataDir dir info =`
			`toLazyText <$> make' root prefix nsfw dataDir dir info`
add image page 2020-07-07 23:28:09 -04:00
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`make' :: Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder`
allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`images <- withSizes (dataDir </> dir) $ imagesFor nsfw info`

			`let undir = joinPath (replicate (length (splitPath dir)) "..")`

			`let artistTag = ifJust artist makeArtist`

add support for approx dates 2020-09-25 17:08:44 -04:00			`let formattedDate = formatLong date`
put full dimensions on image 2020-08-08 19:22:00 -04:00
ensure ids are unique 2021-08-23 10:35:55 -04:00			`let buttonBar = makeButtonBar title $ addIds images`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`let (image0@(Image {path = path0, download = download0'}),`
add support for categorised alts 2021-08-23 10:30:11 -04:00			`Size {width = width0, height = height0}) : otherImages`
			`= #all images`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`let download0 = fromMaybe path0 download0'`
			`let path0' = pageFile path0`
make download link more obvious but hide it for tiny images 2020-11-24 15:18:20 -05:00			`let tinyCls = if any (tiny . #second) images then [b\| class=tiny\|] else ""`
put full dimensions on image 2020-08-08 19:22:00 -04:00
			`let descSection = makeDesc $ descFor nsfw info`
			`let tagsList = makeTags undir $ tagsFor nsfw info`
			`let linksList = extLinks $ linksFor nsfw info`
allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`let updates = sort $ updatesFor nsfw info`
			`let updatesList = makeUpdates updates`
put full dimensions on image 2020-08-08 19:22:00 -04:00
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`let makePrefetch (Image {path}) = [b\|<link rel=prefetch href=$path>\|]`
add support for categorised alts 2021-08-23 10:30:11 -04:00			`let prefetches = map (makePrefetch . #first) otherImages`
put full dimensions on image 2020-08-08 19:22:00 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`let makeWarning w = [b\|@0`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`<figcaption id=cw aria-role=button tabindex=0>`
put "cw: " text in css 2020-09-13 20:35:56 -04:00			`<span id=cw-text>$w</span>`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`</figcaption>`
add bg property for displaying transparent images 2020-08-09 23:42:18 -04:00			`\|]`

add default warning for nsfw stuff 2021-06-03 22:07:05 -04:00			`let defWarning = "oops i forgot to put one, sorry!<br>\`
			`\if you can let me know i'd appreciate it" :: Text`
			`let warning'`
			`\| Just w <- #warning image0 = makeWarning w`
			`\| #nsfw image0 = makeWarning defWarning`
			`\| otherwise = mempty`
use <template> element for cws 2020-09-13 20:34:21 -04:00			`let warningT = makeWarning [b\|.\|]`

add bg property for displaying transparent images 2020-08-09 23:42:18 -04:00			`let bgStyle = ifJust bg \col -> [b\|@0`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<style> #mainfig { background: $col; } </style>`
add bg property for displaying transparent images 2020-08-09 23:42:18 -04:00			`\|]`
put full dimensions on image 2020-08-08 19:22:00 -04:00
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`let url = [b\|$root/$prefix/$dir\|]`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`let desc = case artist of`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`Just (Artist {name}) -> [b\|by $name\|]`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`Nothing -> "by niss"`
			`let thumb = getThumb "" info`

allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`let updateDate = ifJust (last' updates) \(Update {date = d}) ->`
			`let updated = formatLong d in`
			`[b\|<br> <span class=updated>updated $updated</span>\|]`
support updates 2020-09-19 01:51:52 -04:00
messing with the nsfw warning 2022-01-03 14:45:55 -05:00			`let nsfw' = NsfwWarning.Single <$ guard nsfw`
			`let nsfwScript = NsfwWarning.script nsfw'`
			`let nsfwDialog = NsfwWarning.dialog nsfw'`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00
put full dimensions on image 2020-08-08 19:22:00 -04:00			`pure [b\|@0`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`<!DOCTYPE html>`
			`<html lang=en>`
			`<meta charset=utf-8>`
replace a '' with "" 2020-08-04 12:59:09 -04:00			`<meta name=viewport content="width=1200,viewport-fit=cover">`
remove old title attr on stylesheets 2020-08-04 17:12:58 -04:00			`<link rel=stylesheet href=/style/shiny/single.css>`
add [temporary] favicon 2020-08-04 18:52:56 -04:00			`<link rel=icon href=/style/niss.svg>`
a lot of stylin and a little scriptin 2020-07-17 06:29:13 -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">`
add twitter [etc] card previews 2020-08-11 14:29:54 -04:00			`<meta property=og:description content="$desc">`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<meta property=og:image content="$url/$thumb">`
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/single.js></script>`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$nsfwScript`
add bg property for displaying transparent images 2020-08-09 23:42:18 -04:00			`$bgStyle`
make buttonbar class 2020-08-03 13:32:40 -04:00
add image prefetches 2020-07-25 07:59:04 -04:00			`$0.prefetches`

use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<title>$title</title>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$nsfwDialog`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`<div class=page>`
			`<header>`
			`<h1>$title</h1>`
			`$artistTag`
			`<h2 id=date class="right corner">`
			`$formattedDate $updateDate`
			`</h2>`
			`</header>`
a lot of stylin and a little scriptin 2020-07-17 06:29:13 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$2.buttonBar`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`<main>`
make download link more obvious but hide it for tiny images 2020-11-24 15:18:20 -05:00			`<figure id=mainfig data-width=$width0 data-height=$height0$tinyCls>`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$warning'`
			`<a id=mainlink href="$download0" title="download full version">`
			`<img id=mainimg src="$path0'" alt="">`
			`</a>`
			`</figure>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`<div id=info>`
			`$6.descSection`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$6.tagsList`
support updates 2020-09-19 01:51:52 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$6.linksList`

			`$6.updatesList`
			`</div>`
			`</main>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`<footer>`
			`<a href=$undir>back to gallery</a>`
			`</footer>`
			`</div>`
use <template> element for cws 2020-09-13 20:34:21 -04:00
			`<template id=cw-template>`
			`$warningT`
			`</template>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`\|]`
a lot of stylin and a little scriptin 2020-07-17 06:29:13 -04:00
allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`last' :: [a] -> Maybe a`
			`last' xs = if null xs then Nothing else Just $ last xs`

put artist on page 2020-07-14 00:51:46 -04:00			`makeArtist :: Artist -> Builder`
			`makeArtist (Artist {name, url}) =`
add .corner and .left/.right classes 2020-07-19 12:03:24 -04:00			`[b\|<h2 id=artist class="left corner">by $artistLink</h2>\|]`
put artist on page 2020-07-14 00:51:46 -04:00			`where`
			`artistLink = case url of`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`Just u -> [b\|<a href="$u">$name</a>\|]`
			`Nothing -> [b\|$name\|]`
put artist on page 2020-07-14 00:51:46 -04:00
add support for structured descriptions 2021-03-07 16:08:44 -05:00			`makeDesc :: Desc -> Builder`
			`makeDesc NoDesc = ""`
			`makeDesc (TextDesc desc) = [b\|@0`
simplify some css selectors (by adding more classes & ids :( ) 2020-08-04 12:58:40 -04:00			`<section id=desc class=info-section>`
handle nsfw flag better 2020-08-03 13:36:48 -04:00			`<h2>about</h2>`
			`<div>`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$4.desc`
handle nsfw flag better 2020-08-03 13:36:48 -04:00			`</div>`
			`</section>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`\|]`
add support for structured descriptions 2021-03-07 16:08:44 -05:00			`makeDesc (LongDesc fs) = [b\|@0`
			`<section id=desc class=info-section>`
fix text layout for the image description stuff 2021-03-07 18:13:22 -05:00			`$2.fields`
add support for structured descriptions 2021-03-07 16:08:44 -05:00			`</section>`
			`\|]`
			`where`
			`fields = map makeField fs`
			`makeField (DescField {name, text}) = [b\|@0`
			`<h2>$name</h2>`
			`<div>`
			`$4.text`
			`</div>`
			`\|]`
add image page 2020-07-07 23:28:09 -04:00
ensure ids are unique 2021-08-23 10:35:55 -04:00			`addIds :: Images' (Image, a) -> Images' (Image, a, Text)`
			`addIds = snd . mapAccumL makeId Set.empty where`
			`makeId used (img, x) = (Set.insert newId used, (img, x, newId)) where`
			newId = head $ filter (\i -> not $ i `Set.member` used) ids
			`ids = [toStrictText [b\|$label$i\|] \| i <- "" : map show [0::Int ..]]`
			`label = escId $ #label img`

			`makeButtonBar :: Strict.Text -> Images' (Image, Size, Text) -> Builder`
refactor makeButtonBar 2020-07-25 07:58:53 -04:00			`makeButtonBar title images =`
remove unnecessary `length` 2021-03-12 23:30:28 -05:00			`case images of`
add support for categorised alts 2021-08-23 10:30:11 -04:00			`Uncat [] -> throw $ NoEligibleImages title`
			`Uncat [_] -> ""`
			`Cat [(_,[_])] -> ""`
			`Uncat imgs -> makeNav "uncat" $ makeAlts imgs`
			`Cat cats -> makeNav "cat" $ map (uncurry makeCat) cats`
			`where`
			`makeNav (cls :: Text) inner = [b\|@0`
			`<nav id=alts class=$cls aria-label="alternate versions">`
			`$2.inner`
			`</nav> \|]`
			`makeCat lbl imgs = [b\|@0`
			`<section>`
			`<h3 class=alt-cat>$lbl</h3>`
			`$0.alts`
			`</section> \|]`
			`where alts = makeAlts imgs`
			`makeAlts imgs = [b\|@0`
simplify some css selectors (by adding more classes & ids :( ) 2020-08-04 12:58:40 -04:00			`<ul class="buttonbar bb-choice">`
add support for categorised alts 2021-08-23 10:30:11 -04:00			`$2.elems`
			`</ul> \|]`
ensure ids are unique 2021-08-23 10:35:55 -04:00			`where elems = map (\(img,sz,i) -> altButton img sz i) imgs`
skip nsfw stuff in non-nsfw singlepages 2020-07-09 15:48:29 -04:00
ensure ids are unique 2021-08-23 10:35:55 -04:00			`altButton :: Image -> Size -> Text -> Builder`
			`altButton img size i = [b\|@0`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`<li$nsfwClass>`
ensure ids are unique 2021-08-23 10:35:55 -04:00			`<input type=radio name=variant id="$i" value="$path'"`
fix download links for multipart pics 2021-02-09 06:50:22 -05:00			`data-link="$link"$warning'`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`data-width=$width data-height=$height>`
ensure ids are unique 2021-08-23 10:35:55 -04:00			`<label for="$i"$nsfwLabelClass>$label</label>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`\|]`
add image page 2020-07-07 23:28:09 -04:00			`where`
fix download links for multipart pics 2021-02-09 06:50:22 -05:00			`Image {label, path, nsfw, warning, download} = img`
			`Size {width, height} = size`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`nsfwClass = if nsfw then [b\| class=nsfw\|] else ""`
			`nsfwLabelClass = if nsfw then [b\| class=nsfw-label\|] else ""`
simplify some css selectors (by adding more classes & ids :( ) 2020-08-04 12:58:40 -04:00			`path' = pageFile path`
fix download links for multipart pics 2021-02-09 06:50:22 -05:00			`link = fromMaybe path download`
escape data-warning attr 2020-09-13 20:33:27 -04:00			`warning' = ifJust warning \(escAttr -> w) -> [b\| data-warning="$w"\|]`
add image page 2020-07-07 23:28:09 -04:00
make tag buttons into links 2020-08-04 13:05:20 -04:00			`makeTags :: FilePath -> [Strict.Text] -> Builder`
			`makeTags undir tags =`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`if null tags then "" else [b\|@0`
fix some markup bits 2020-08-04 12:26:36 -04:00			`<nav id=tags class=info-section>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`<h2>tags</h2>`
simplify some css selectors (by adding more classes & ids :( ) 2020-08-04 12:58:40 -04:00			`<ul class="buttonbar bb-links">`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$4.tagList`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`</ul>`
fix some markup bits 2020-08-04 12:26:36 -04:00			`</nav>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`\|]`
add nsfw tags & put tags on singlepage 2020-07-11 23:42:31 -04:00			`where`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`tagList = map makeTag tags`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`makeTag tag = [b\|<li><a href="$undir#require_$tag'">$tag</a>\|]`
make tag buttons into links 2020-08-04 13:05:20 -04:00			`where tag' = escId tag`
add nsfw tags & put tags on singlepage 2020-07-11 23:42:31 -04:00
handle nsfw flag better 2020-08-03 13:36:48 -04:00			`extLinks :: [Link] -> Builder`
			`extLinks links =`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`if null links then "" else [b\|@0`
fix some markup bits 2020-08-04 12:26:36 -04:00			`<nav id=links class=info-section>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`<h2>links</h2>`
fix some markup bits 2020-08-04 12:26:36 -04:00			`<ul class="buttonbar bb-links">`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`$4.linkList`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`</ul>`
fix some markup bits 2020-08-04 12:26:36 -04:00			`</nav>`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`\|]`
handle nsfw flag better 2020-08-03 13:36:48 -04:00			`where linkList = map extLink links`
skip nsfw stuff in non-nsfw singlepages 2020-07-09 15:48:29 -04:00
add image page 2020-07-07 23:28:09 -04:00			`extLink :: Link -> Builder`
fix some markup bits 2020-08-04 12:26:36 -04:00			`extLink (Link {title, url}) = [b\|@8`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`<li>`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<a href="$url">`
			`$title`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`</a>`
			`\|]`
redo formatDate so i can have 12th 2020-07-31 20:27:24 -04:00
allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`makeUpdates :: [Update] -> Builder`
support updates 2020-09-19 01:51:52 -04:00			`makeUpdates ups =`
			`if null ups then "" else [b\|@4`
			`<section id=updates class=info-section>`
			`<h2>updates</h2>`
			`<dl>`
			`$8.updateList`
			`</dl>`
			`</section>`
			`\|]`
allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`where updateList = map makeUpdate ups`
support updates 2020-09-19 01:51:52 -04:00
allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`makeUpdate :: Update -> Builder`
			`makeUpdate (Update {date, desc}) = [b\|@8`
support updates 2020-09-19 01:51:52 -04:00			`<dt>$date'`
allow updates to be marked nsfw-only 2020-11-16 17:30:56 -05:00			`<dd>$desc`
support updates 2020-09-19 01:51:52 -04:00			`\|]`
add support for approx dates 2020-09-25 17:08:44 -04:00			`where date' = formatSlash date`
put full dimensions on image 2020-08-08 19:22:00 -04:00
swap fields of Size 2020-08-12 12:05:47 -04:00			`data Size = Size {width, height :: !Int} deriving (Eq, Show)`
put full dimensions on image 2020-08-08 19:22:00 -04:00
make download link more obvious but hide it for tiny images 2020-11-24 15:18:20 -05:00			`tiny :: Size -> Bool`
			`tiny (Size {width, height}) = width < 250 \|\| height < 250`

put full dimensions on image 2020-08-08 19:22:00 -04:00			`imageSize :: FilePath -> FilePath -> IO Size`
			`imageSize dir img = do`
			`-- "[0]" to get the first frame of an animation`
			`-- otherwise it prints a pair for each frame`
			`let filename = (dir </> img) ++ "[0]"`
			`output <- Proc.readProcess "identify" ["-format", "(%W,%H)", filename] ""`
			`case readMaybe output of`
			`Just (width, height) -> pure $ Size {width, height}`
			`Nothing -> fail $ "couldn't understand identify output:\n" ++ output`

add support for categorised alts 2021-08-23 10:30:11 -04:00			`withSizes :: Traversable t => FilePath -> t Image -> IO (t (Image, Size))`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`withSizes dir = traverse \img -> do`
			`size <- imageSize dir $ #path img`
			`pure (img, size)`