gallery/make-pages/SinglePage.hs

159 lines
3.8 KiB
Haskell

module SinglePage (make) where
import Records ()
import Info hiding (Text)
import BuildVar
import Control.Exception
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder
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, tags, nsfwTags,
description, images, links}) = [b|@0
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
$titleTag
<header>
$titleHeader
<h2 class=date>$formattedDate</date>
$buttonBar
</header>
<main>
<img id=it src="$*path0">
$descSection
$tagsList
$linksList
</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>|]
formattedDate = formatDate date
buttonBar = makeButtonBar (fromMaybe path0 title) nsfw images
path0 = #path $ head images
descSection = ifJust description makeDesc
tagsList = makeTags nsfw tags nsfwTags
linksList = extLinks nsfw links
makeDesc :: Strict.Text -> Builder
makeDesc desc = [b|@2
<div class=desc>
<h2>description</h2>
$4*desc
</div>
|]
ifJust :: Monoid b => Maybe a -> (a -> b) -> b
ifJust x f = maybe mempty f x
formatDate :: Day -> Builder
formatDate = fromString . formatTime defaultTimeLocale "%e %#B %Y"
makeButtonBar :: Strict.Text -> Bool -> [Image] -> Builder
makeButtonBar title nsfw allImages =
case length images of
0 -> throw $ NoEligibleImages title
1 -> ""
_ -> [b|@2
<nav id=variants class=buttonbar>
<h2>alts</h2>
<ul id=variantlist>
$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}) = [b|@6
<li$nsfwClass>
<input type=radio$checked id="$idLabel" name=variant
autocomplete=off value="$*path">
<label for="$idLabel">$*label</label>
|]
where
nsfwClass = if nsfw then " class=nsfw" else ""
checked = if i == 0 then " checked" else ""
idLabel = escId label
escId :: Strict.Text -> Builder
escId = foldMap esc1 . Strict.unpack where
esc1 c
| Char.isSpace c = ""
| c < 'ÿ' && not (Char.isAlphaNum c || c == '-') = "_"
| otherwise = singleton c
makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder
makeTags nsfw sfwTags nsfwTags =
if null tags then "" else [b|@2
<div class=tags>
<h2>tags</h2>
<ul>
$6.tagList
</ul>
</div>
|]
where
tagList = map makeTag tags
makeTag t = [b|<li>$*t|]
tags = List.nub $ if nsfw then sfwTags else sfwTags <> nsfwTags
extLinks :: Bool -> [Link] -> Builder
extLinks nsfw allLinks =
if null links then "" else [b|@2
<div class=links>
<h2>links</h2>
<ul>
$6.linkList
</ul>
</div>
|]
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>
|]