gallery/make-pages/SinglePage.hs

197 lines
5.2 KiB
Haskell

module SinglePage (make) where
import Depend (pageFile)
import Info hiding (Text)
import BuilderQQ
import Records ()
import Control.Exception
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import qualified Data.Time.Calendar as Time
import System.FilePath (joinPath, splitPath)
-- | 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 :: Bool -> FilePath -> Info -> Lazy.Text
make nsfw dir = toLazyText . make' nsfw dir
make' :: Bool -> FilePath -> Info -> Builder
make' nsfw dir info@(Info {date, title, artist}) = [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 title=shiny>
<script src=/script/single.js></script>
$0.prefetches
<title>$*title</title>
<header>
<h1>$*title</h1>
$artistTag
<h2 id=date class="right corner">$formattedDate</h2>
</header>
$buttonBar
<main>
<figure id=mainfig>
$warning'
<a id=mainlink href="$@download0" title="download full version">
<img id=mainimg src="$@path0'" alt="">
</a>
</figure>
<div id=info>
$descSection
$tagsList
$linksList
</div>
</main>
<footer>
<a href=$@undir>back to gallery</a>
</footer>
|]
where
artistTag = ifJust artist makeArtist
formattedDate = formatDate date
buttonBar = makeButtonBar title images
image0 = head images
path0 = #path image0
download0 = fromMaybe path0 (#download image0)
path0' = pageFile path0
images = imagesFor nsfw info
descSection = makeDesc $ descFor nsfw info
tagsList = makeTags undir $ tagsFor nsfw info
linksList = extLinks $ linksFor nsfw info
prefetches = map makePrefetch $ tail images
makePrefetch (Image {path}) = [b|<link rel=prefetch href=$@path>|]
warning' = ifJust (#warning image0) \w -> [b|@4
<figcaption id=cw aria-role=button tabindex=0>
<span id=cw-text>cw: <b>$*w</b></span>
</figcaption>
|]
undir = joinPath (replicate (length (splitPath dir)) "..")
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 :: Strict.Text -> Builder
makeDesc desc = [b|@4
<section id=desc class=info-section>
<h2>about</h2>
<div>
$8*desc
</div>
</section>
|]
makeButtonBar :: Strict.Text -> [Image] -> 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 (uncurry altButton) $ zip [0..] images
altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw, warning}) = [b|@4
<li$nsfwClass>
<input type=radio$checked id="$idLabel" name=variant
autocomplete=off value="$@path'"
data-link="$@path"$warning'>
<label for="$idLabel"$nsfwLabelClass>$*label</label>
|]
where
nsfwClass = if nsfw then " class=nsfw" else ""
nsfwLabelClass = if nsfw then " class=nsfw-label" else ""
checked = if i == 0 then " checked" else ""
idLabel = escId label
path' = pageFile path
warning' = ifJust warning \w -> [b| data-warning="$*w"|]
makeTags :: FilePath -> [Strict.Text] -> Builder
makeTags undir tags =
if null tags then "" else [b|@4
<nav id=tags class=info-section>
<h2>tags</h2>
<ul class="buttonbar bb-links">
$8.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|@4
<nav id=links class=info-section>
<h2>links</h2>
<ul class="buttonbar bb-links">
$8.linkList
</ul>
</nav>
|]
where linkList = map extLink links
extLink :: Link -> Builder
extLink (Link {title, url}) = [b|@8
<li>
<a href="$*url">
$*title
</a>
|]
formatDate :: Day -> Builder
formatDate date = [b|$*week $day $*month $^year|] where
(year, month', day') = Time.toGregorian date
week' = Time.dayOfWeek date
day = nth day'
month = Strict.words "january february march april may june july \
\august september october november december"
!! (month' - 1)
week = Strict.words "mon tue wed thu fri sat sun" !! (fromEnum week' - 1)
nth :: Int -> Builder
nth n = [b|$^n$suf|] where
suf | n >= 10, n <= 19 = "th"
| n `mod` 10 == 1 = "st"
| n `mod` 10 == 2 = "nd"
| n `mod` 10 == 3 = "rd"
| otherwise = "th"