gallery/make-pages/SinglePage.hs

159 lines
3.9 KiB
Haskell
Raw Normal View History

2020-07-09 00:20:09 -04:00
module SinglePage (make) where
2020-07-07 23:28:09 -04:00
import Info hiding (Text)
2020-07-12 22:01:31 -04:00
import BuildVar
import Control.Exception
2020-07-07 23:28:09 -04:00
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)
2020-07-07 23:28:09 -04:00
import qualified Data.Char as Char
import qualified Data.List as List
2020-07-12 23:02:16 -04:00
-- | 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)"
2020-07-07 23:28:09 -04:00
make :: Bool -> Info -> Lazy.Text
make includeNsfw = toLazyText . make' includeNsfw
2020-07-07 23:28:09 -04:00
make' :: Bool -> Info -> Builder
2020-07-11 23:42:31 -04:00
make' includeNsfw (Info {date, title, tags, nsfwTags,
2020-07-12 22:01:31 -04:00
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) includeNsfw images
path0 = let Image {path} = head images in path
descSection = ifJust description makeDesc
tagsList = makeTags includeNsfw tags nsfwTags
linksList = extLinks includeNsfw links
makeDesc :: Strict.Text -> Builder
makeDesc desc = [b|@2
<div class=desc>
<h2>description</h2>
$4*desc
</div>
|]
2020-07-07 23:28:09 -04:00
ifJust :: Monoid b => Maybe a -> (a -> b) -> b
ifJust x f = maybe mempty f x
2020-07-07 23:28:09 -04:00
formatDate :: Day -> Builder
formatDate = fromString . formatTime defaultTimeLocale "%e %#B %Y"
2020-07-12 22:01:31 -04:00
makeButtonBar :: Strict.Text -> Bool -> [Image] -> Builder
makeButtonBar title includeNsfw 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 | includeNsfw = allImages
| otherwise = filter (\Image {nsfw} -> not nsfw) allImages
iimages = zip [0..] images
2020-07-12 22:01:31 -04:00
alts = map (uncurry altButton) iimages
2020-07-07 23:28:09 -04:00
altButton :: Int -> Image -> Builder
2020-07-12 22:01:31 -04:00
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>
|]
2020-07-07 23:28:09 -04:00
where
2020-07-09 00:19:19 -04:00
nsfwClass = if nsfw then " class=nsfw" else ""
2020-07-12 22:01:31 -04:00
checked = if i == 0 then " checked" else ""
2020-07-07 23:28:09 -04:00
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
2020-07-11 23:42:31 -04:00
makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder
makeTags includeNsfw sfwTags nsfwTags =
2020-07-12 22:01:31 -04:00
if null tags then "" else [b|@2
<div class=tags>
<h2>tags</h2>
<ul>
$6.tagList
</ul>
</div>
|]
2020-07-11 23:42:31 -04:00
where
2020-07-12 22:01:31 -04:00
tagList = map makeTag tags
makeTag t = [b|<li>$*t|]
2020-07-11 23:42:31 -04:00
tags = List.nub $ if includeNsfw then sfwTags else sfwTags <> nsfwTags
extLinks :: Bool -> [Link] -> Builder
2020-07-12 22:01:31 -04:00
extLinks includeNsfw allLinks =
if null links then "" else [b|@2
<div class=links>
<h2>links</h2>
<ul>
$6.linkList
</ul>
</div>
|]
where
links | includeNsfw = allLinks
| otherwise = filter (\Link {nsfw} -> not nsfw) allLinks
linkList = map extLink links
2020-07-07 23:28:09 -04:00
extLink :: Link -> Builder
2020-07-12 22:01:31 -04:00
extLink (Link {title, url}) = [b|@6
<li>
<a href="$*url">
$*title
</a>
|]