gallery/make-pages/SinglePage.hs

197 lines
4.8 KiB
Haskell

module SinglePage (make) where
import Depend (pageFile)
import Info hiding (Text)
import BuilderQQ
import Records ()
import Control.Exception
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder (Builder, toLazyText)
import Data.Time (formatTime, defaultTimeLocale)
import Data.Maybe (fromMaybe)
import qualified Data.Char as Char
import qualified Data.List as List
-- | 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 -> Info -> Lazy.Text
make nsfw = toLazyText . make' nsfw
make' :: Bool -> Info -> Builder
make' nsfw (Info {date, title, artist, tags, nsfwTags,
description, images, background, links}) = [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/single.css>
$titleTag
<header>
$titleHeader
$artistTag
<h2 class=date>$formattedDate</h2>
$buttonBar
</header>
<script async src=/script/single.js></script>
<main>
<figure id=mainfig$dataBg>
$warning'
<a id=mainlink href="$@path0">
<img id=mainimg src="$@path0'">
</a>
</figure>
<section class=info>
$descSection
$tagsList
$linksList
</section>
</main>
<footer>
<nav class=back>
<a href=../>back to gallery</a>
</nav>
</footer>
|]
where
titleTag = ifJust title \t -> [b|<title>$*t</title>|]
titleHeader = ifJust title \t -> [b|<h1>$*t</h1>|]
artistTag = ifJust artist makeArtist
formattedDate = formatDate date
buttonBar = makeButtonBar (fromMaybe (Strict.pack path0) title) nsfw images
image0 = head images
path0 = #path image0
path0' = pageFile path0
descSection = ifJust description makeDesc
tagsList = makeTags nsfw tags nsfwTags
linksList = extLinks nsfw links
dataBg = ifJust background \bg -> [b| data-bg="$*bg"|]
warning' = ifJust (#warning image0) \w -> [b|@4
<figcaption id=cw>
$*w
</figcaption>
|]
makeArtist :: Artist -> Builder
makeArtist (Artist {name, url}) =
[b|<h2 class=artist>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 class=desc>
<h2>about</h2>
<div>
$8*desc
</div>
</section>
|]
ifJust :: Monoid b => Maybe a -> (a -> b) -> b
ifJust x f = maybe mempty f x
formatDate :: Day -> Builder
formatDate d =
let str = formatTime defaultTimeLocale "%e %#B %Y" d in [b|$@str|]
makeButtonBar :: Strict.Text -> Bool -> [Image] -> Builder
makeButtonBar title nsfw allImages =
case length images of
0 -> throw $ NoEligibleImages title
1 -> ""
_ -> [b|@2
<nav class=alts>
<ul id=altlist>
$6.alts
</ul>
</nav>
|]
where
images | nsfw = allImages
| otherwise = filter #sfw allImages
alts = map (uncurry altButton) $ zip [0..] images
altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw, warning}) = [b|@6
<li$nsfwClass>
<input type=radio$checked id="$idLabel" name=variant
autocomplete=off value="$@path'"
data-link="$@path"$warning'>
<label for="$idLabel">$*label</label>
|]
where
nsfwClass = if nsfw then " class=nsfw" else ""
checked = if i == 0 then " checked" else ""
idLabel = escId label
path' = pageFile path
warning' = ifJust warning \w -> [b| data-warning="$*w"|]
escId :: Strict.Text -> Builder
escId = foldMap esc1 . Strict.unpack where
esc1 c
| Char.isSpace c = ""
| c < 'ÿ' && not (Char.isAlphaNum c || c == '-') = "_"
| otherwise = [b|$'c|]
makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder
makeTags nsfw sfwTags nsfwTags =
if null tags then "" else [b|@4
<section class=tags>
<h2>tags</h2>
<ul>
$8.tagList
</ul>
</section>
|]
where
tagList = map makeTag tags
makeTag t = [b|<li>$*t|]
tags = List.nub $ if nsfw then sfwTags <> nsfwTags else sfwTags
extLinks :: Bool -> [Link] -> Builder
extLinks nsfw allLinks =
if null links then "" else [b|@4
<section class=links>
<h2>links</h2>
<ul>
$8.linkList
</ul>
</section>
|]
where
links = if nsfw then allLinks else filter #sfw allLinks
linkList = map extLink links
extLink :: Link -> Builder
extLink (Link {title, url}) = [b|@6
<li>
<a href="$*url">
$*title
</a>
|]