gallery/make-pages/SinglePage.hs

module SinglePage (make) where

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

import Control.Exception
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)


-- | 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 images
  let (image0@(Image {path = path0, download = download0'}),
       Size {width = width0, height = height0})
        = head 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) $ tail images

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

  let warning' = ifJust (#warning image0) makeWarning
  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 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 :: Maybe Strict.Text -> Builder
makeDesc mdesc = ifJust mdesc \desc -> [b|@0
    <section id=desc class=info-section>
      <h2>about</h2>
      <div>
        $4.desc
      </div>
    </section>
  |]

makeButtonBar :: Strict.Text -> [(Image, Size)] -> Builder
makeButtonBar title images =
  case length images of
    0 -> throw $ NoEligibleImages title
    1 -> ""
    _ -> [b|@0
      <nav id=alts aria-label="alternate versions">
        <ul class="buttonbar bb-choice">
          $4.alts
        </ul>
      </nav>
      |]
 where alts = map (\(i, (im, sz)) -> altButton i im sz) $ zip [0..] images

altButton :: Int -> Image -> Size -> Builder
altButton i img size = [b|@0
  <li$nsfwClass>
    <input type=radio$checked name=variant id="$idLabel" value="$path'"
           data-link="$link"$warning'
           data-width=$width data-height=$height>
    <label for="$idLabel"$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 ""
  checked        = if i == 0 then [b| checked|] else ""
  idLabel        = escId label
  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 :: FilePath -> [Image] -> IO [(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`
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)`
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
			`let buttonBar = makeButtonBar title images`
			`let (image0@(Image {path = path0, download = download0'}),`
			`Size {width = width0, height = height0})`
			`= head images`
			`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>\|]`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`let prefetches = map (makePrefetch . #first) $ tail images`

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			`\|]`

use <template> element for cws 2020-09-13 20:34:21 -04:00			`let warning' = ifJust (#warning image0) makeWarning`
			`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
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`let nsfwScript = NsfwWarning.script nsfw`
			`let nsfwDialog = NsfwWarning.dialog nsfw`

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
fix desc field showing up without desc 2020-08-08 19:20:34 -04:00			`makeDesc :: Maybe Strict.Text -> Builder`
add nsfw warning dialog 2020-10-06 16:07:39 -04:00			`makeDesc mdesc = ifJust mdesc \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 image page 2020-07-07 23:28:09 -04:00
put full dimensions on image 2020-08-08 19:22:00 -04:00			`makeButtonBar :: Strict.Text -> [(Image, Size)] -> Builder`
refactor makeButtonBar 2020-07-25 07:58:53 -04:00			`makeButtonBar title images =`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`case length images of`
			`0 -> throw $ NoEligibleImages title`
			`1 -> ""`
make buttonbar class 2020-08-03 13:32:40 -04:00			`_ -> [b\|@0`
fix some markup bits 2020-08-04 12:26:36 -04:00			`<nav id=alts aria-label="alternate versions">`
simplify some css selectors (by adding more classes & ids :( ) 2020-08-04 12:58:40 -04:00			`<ul class="buttonbar bb-choice">`
make buttonbar class 2020-08-03 13:32:40 -04:00			`$4.alts`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`</ul>`
			`</nav>`
			`\|]`
put full dimensions on image 2020-08-08 19:22:00 -04:00			`where alts = map (\(i, (im, sz)) -> altButton i im sz) $ zip [0..] images`
skip nsfw stuff in non-nsfw singlepages 2020-07-09 15:48:29 -04:00
put full dimensions on image 2020-08-08 19:22:00 -04:00			`altButton :: Int -> Image -> Size -> Builder`
fix download links for multipart pics 2021-02-09 06:50:22 -05:00			`altButton i img size = [b\|@0`
make quasiquoter for text building 2020-07-12 22:01:31 -04:00			`<li$nsfwClass>`
use class instead of twigils for builder 2020-08-30 13:13:40 -04:00			`<input type=radio$checked name=variant id="$idLabel" 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>`
			`<label for="$idLabel"$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 ""`
			`checked = if i == 0 then [b\| checked\|] else ""`
simplify some css selectors (by adding more classes & ids :( ) 2020-08-04 12:58:40 -04:00			`idLabel = escId label`
			`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`

			`withSizes :: FilePath -> [Image] -> IO [(Image, Size)]`
			`withSizes dir = traverse \img -> do`
			`size <- imageSize dir $ #path img`
			`pure (img, size)`