gallery/make-pages/SinglePage.hs

199 lines
5.3 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
2020-07-16 10:07:28 -04:00
import Depend (pageFile)
2020-07-07 23:28:09 -04:00
import Info hiding (Text)
2020-07-15 15:31:46 -04:00
import BuilderQQ
2020-07-16 10:07:28 -04:00
import Records ()
2020-07-12 22:01:31 -04:00
import Control.Exception
2020-07-21 19:48:29 -04:00
import Data.Maybe (fromMaybe)
2020-07-07 23:28:09 -04:00
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
2020-07-31 20:27:24 -04:00
import qualified Data.Time.Calendar as Time
2020-07-21 18:13:02 -04:00
import System.FilePath (joinPath, splitPath)
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
2020-07-21 18:13:02 -04:00
make :: Bool -> FilePath -> Info -> Lazy.Text
make nsfw dir = toLazyText . make' nsfw dir
2020-07-07 23:28:09 -04:00
2020-07-21 18:13:02 -04:00
make' :: Bool -> FilePath -> Info -> Builder
2020-08-03 13:36:48 -04:00
make' nsfw dir info@(Info {date, title, artist}) = [b|@0
2020-07-12 22:01:31 -04:00
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
2020-08-04 12:59:09 -04:00
<meta name=viewport content="width=1200,viewport-fit=cover">
2020-08-04 17:12:58 -04:00
<link rel=stylesheet href=/style/shiny/single.css>
2020-08-04 18:52:56 -04:00
<link rel=icon href=/style/niss.svg>
2020-07-17 06:29:13 -04:00
2020-08-04 13:14:12 -04:00
<script src=/script/single.js></script>
2020-08-03 13:32:40 -04:00
2020-07-25 07:59:04 -04:00
$0.prefetches
2020-07-19 11:58:19 -04:00
<title>$*title</title>
2020-07-12 22:01:31 -04:00
<header>
2020-07-19 11:58:19 -04:00
<h1>$*title</h1>
2020-07-14 00:51:46 -04:00
$artistTag
2020-07-19 12:03:24 -04:00
<h2 id=date class="right corner">$formattedDate</h2>
2020-07-12 22:01:31 -04:00
</header>
2020-08-03 13:32:40 -04:00
$buttonBar
2020-07-17 06:29:13 -04:00
2020-07-12 22:01:31 -04:00
<main>
<figure id=mainfig>
2020-07-17 06:29:13 -04:00
$warning'
2020-08-04 12:56:44 -04:00
<a id=mainlink href="$@download0" title="download full version">
<img id=mainimg src="$@path0'" alt="">
2020-07-17 06:29:13 -04:00
</a>
</figure>
2020-07-12 22:01:31 -04:00
2020-08-04 12:26:36 -04:00
<div id=info>
2020-07-17 06:29:13 -04:00
$descSection
2020-07-12 22:01:31 -04:00
2020-07-17 06:29:13 -04:00
$tagsList
2020-07-12 22:01:31 -04:00
2020-07-17 06:29:13 -04:00
$linksList
2020-08-04 12:26:36 -04:00
</div>
2020-07-12 22:01:31 -04:00
</main>
<footer>
2020-08-04 12:26:36 -04:00
<a href=$@undir>back to gallery</a>
2020-07-12 22:01:31 -04:00
</footer>
|]
where
2020-07-14 00:51:46 -04:00
artistTag = ifJust artist makeArtist
2020-07-12 22:01:31 -04:00
formattedDate = formatDate date
2020-07-13 02:33:27 -04:00
2020-07-25 07:58:53 -04:00
buttonBar = makeButtonBar title images
2020-07-17 06:29:13 -04:00
image0 = head images
path0 = #path image0
2020-07-21 19:48:29 -04:00
download0 = fromMaybe path0 (#download image0)
2020-07-16 10:07:28 -04:00
path0' = pageFile path0
2020-07-12 22:01:31 -04:00
2020-08-03 13:36:48 -04:00
images = imagesFor nsfw info
descSection = makeDesc $ descFor nsfw info
2020-08-04 13:05:20 -04:00
tagsList = makeTags undir $ tagsFor nsfw info
2020-08-03 13:36:48 -04:00
linksList = extLinks $ linksFor nsfw info
2020-07-12 22:01:31 -04:00
2020-07-25 07:59:04 -04:00
prefetches = map makePrefetch $ tail images
makePrefetch (Image {path}) = [b|<link rel=prefetch href=$@path>|]
2020-07-17 06:29:13 -04:00
warning' = ifJust (#warning image0) \w -> [b|@4
2020-08-03 17:06:19 -04:00
<figcaption id=cw aria-role=button tabindex=0>
2020-07-18 05:45:59 -04:00
<span id=cw-text>cw: <b>$*w</b></span>
2020-07-17 06:29:13 -04:00
</figcaption>
|]
2020-07-21 18:13:02 -04:00
undir = joinPath (replicate (length (splitPath dir)) "..")
2020-07-17 06:29:13 -04:00
2020-07-14 00:51:46 -04:00
makeArtist :: Artist -> Builder
makeArtist (Artist {name, url}) =
2020-07-19 12:03:24 -04:00
[b|<h2 id=artist class="left corner">by $artistLink</h2>|]
2020-07-14 00:51:46 -04:00
where
artistLink = case url of
Just u -> [b|<a href="$*u">$*name</a>|]
Nothing -> [b|$*name|]
2020-08-03 13:36:48 -04:00
makeDesc :: Strict.Text -> Builder
makeDesc desc = [b|@4
<section id=desc class=info-section>
2020-08-03 13:36:48 -04:00
<h2>about</h2>
<div>
$8*desc
</div>
</section>
2020-07-12 22:01:31 -04:00
|]
2020-07-07 23:28:09 -04:00
2020-07-25 07:58:53 -04:00
makeButtonBar :: Strict.Text -> [Image] -> Builder
makeButtonBar title images =
2020-07-12 22:01:31 -04:00
case length images of
0 -> throw $ NoEligibleImages title
1 -> ""
2020-08-03 13:32:40 -04:00
_ -> [b|@0
2020-08-04 12:26:36 -04:00
<nav id=alts aria-label="alternate versions">
<ul class="buttonbar bb-choice">
2020-08-03 13:32:40 -04:00
$4.alts
2020-07-12 22:01:31 -04:00
</ul>
</nav>
|]
2020-07-25 07:58:53 -04:00
where alts = map (uncurry altButton) $ zip [0..] images
2020-07-07 23:28:09 -04:00
altButton :: Int -> Image -> Builder
2020-08-03 13:32:40 -04:00
altButton i (Image {label, path, nsfw, warning}) = [b|@4
2020-07-12 22:01:31 -04:00
<li$nsfwClass>
<input type=radio$checked id="$idLabel" name=variant
2020-07-17 06:29:13 -04:00
autocomplete=off value="$@path'"
data-link="$@path"$warning'>
<label for="$idLabel"$nsfwLabelClass>$*label</label>
2020-07-12 22:01:31 -04:00
|]
2020-07-07 23:28:09 -04:00
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"|]
2020-07-07 23:28:09 -04:00
2020-08-04 13:05:20 -04:00
makeTags :: FilePath -> [Strict.Text] -> Builder
makeTags undir tags =
2020-07-17 06:29:13 -04:00
if null tags then "" else [b|@4
2020-08-04 12:26:36 -04:00
<nav id=tags class=info-section>
2020-07-12 22:01:31 -04:00
<h2>tags</h2>
<ul class="buttonbar bb-links">
2020-07-17 06:29:13 -04:00
$8.tagList
2020-07-12 22:01:31 -04:00
</ul>
2020-08-04 12:26:36 -04:00
</nav>
2020-07-12 22:01:31 -04:00
|]
2020-07-11 23:42:31 -04:00
where
2020-07-12 22:01:31 -04:00
tagList = map makeTag tags
2020-08-04 13:05:20 -04:00
makeTag tag = [b|<li><a href="$@undir#require_$tag'">$*tag</a>|]
where tag' = escId tag
2020-07-11 23:42:31 -04:00
2020-08-03 13:36:48 -04:00
extLinks :: [Link] -> Builder
extLinks links =
2020-07-17 06:29:13 -04:00
if null links then "" else [b|@4
2020-08-04 12:26:36 -04:00
<nav id=links class=info-section>
2020-07-12 22:01:31 -04:00
<h2>links</h2>
2020-08-04 12:26:36 -04:00
<ul class="buttonbar bb-links">
2020-07-17 06:29:13 -04:00
$8.linkList
2020-07-12 22:01:31 -04:00
</ul>
2020-08-04 12:26:36 -04:00
</nav>
2020-07-12 22:01:31 -04:00
|]
2020-08-03 13:36:48 -04:00
where linkList = map extLink links
2020-07-07 23:28:09 -04:00
extLink :: Link -> Builder
2020-08-04 12:26:36 -04:00
extLink (Link {title, url}) = [b|@8
2020-07-12 22:01:31 -04:00
<li>
<a href="$*url">
$*title
</a>
|]
2020-07-31 20:27:24 -04:00
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"