rhi/gallery
1
0
Fork 0
Code Issues 5 Pull requests 1 Releases Wiki Activity

make lots of fields optional & get rid of vector

Browse source
This commit is contained in:
Rhiannon Morris 2020-07-12 05:40:14 +02:00
parent cc485f798d
commit de160967e8
3 changed files with 62 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

66
make-pages/SinglePage.hs
View file

@ -1,12 +1,24 @@
module SinglePage (make) where
import Info hiding (Text)
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.Vector as Vector
import qualified Data.List as List
-- | 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
@ -18,25 +30,31 @@ make' includeNsfw (Info {date, title, tags, description, images, links}) =
"<html lang=en>\n" <>
"<meta charset=utf-8>\n" <>
"<link href=single.css rel=stylesheet>\n\n" <>
"<title>" <> esc title <> "</title>\n\n" <>
ifJust title (\t -> "<title>" <> esc t <> "</title>\n\n") <>
"<header>\n" <>
" <h1>" <> esc title <> "</h1>\n" <>
ifJust title (\t -> " <h1>" <> esc t <> "</h1>\n") <>
" <h2 class=date>" <> formatDate date <> "</h2>\n" <>
buttonBar includeNsfw images <>
buttonBar title' includeNsfw images <>
"</header>\n\n" <>
"<main>\n" <>
" <img id=it src=\"" <> path0 <> "\">\n" <>
" <section id=description>\n" <>
indent 4 description <>
" </section>\n\n" <>
ifJust description (\d ->
" <div class=desc>\n" <>
" <h2>description</h2>\n" <>
indent 4 d <>
" </div>\n") <>
extLinks includeNsfw links <>
"</main>\n\n" <>
"<nav class=back>\n" <>
" <a href=../>back to gallery</a>\n" <>
"</nav>\n"
where
path0 = let Image {path} = Vector.head images in fromText path
path0' = let Image {path} = head images in path
path0 = fromText path0'
title' = fromMaybe path0' title
ifJust :: Monoid b => Maybe a -> (a -> b) -> b
ifJust x f = maybe mempty f x
esc :: Strict.Text -> Builder
esc = foldMap esc1 . Strict.unpack where
@ -50,21 +68,23 @@ esc = foldMap esc1 . Strict.unpack where
formatDate :: Day -> Builder
formatDate = fromString . formatTime defaultTimeLocale "%e %#B %Y"
buttonBar :: Bool -> Vector Image -> Builder
buttonBar includeNsfw images =
let images' = if includeNsfw then images
else Vector.filter (\Image {nsfw} -> not nsfw) images in
if null images' then
error "not including nsfw but there are no sfw images!"
else if length images' == 1 then
buttonBar :: Strict.Text -> Bool -> [Image] -> Builder
buttonBar title includeNsfw allImages =
if null images then
throw $ NoEligibleImages title
else if length images == 1 then
mempty
else
" <nav id=variants class=buttonbar>\n" <>
" <h2>alts</h2>\n" <>
" <ul id=variantlist>\n" <>
Vector.ifoldl' (\b i im -> b <> altButton i im) mempty images' <>
List.foldl' (\b (i, im) -> b <> altButton i im) mempty iimages <>
" </ul>\n" <>
" </nav>\n"
where
images | includeNsfw = allImages
| otherwise = filter (\Image {nsfw} -> not nsfw) allImages
iimages = zip [0..] images
altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw}) =
@ -93,16 +113,18 @@ indent n txt = spaces <> go (Strict.unpack txt) where
go (c:cs) = singleton c <> go cs
spaces = fromString $ replicate n ' '
extLinks :: Bool -> Vector Link -> Builder
extLinks :: Bool -> [Link] -> Builder
extLinks includeNsfw links =
let links' =
if includeNsfw then links
else Vector.filter (\Link {nsfw} -> not nsfw) links in
else filter (\Link {nsfw} -> not nsfw) links in
if null links' then mempty else
" <h2>links</h2>\n" <>
" <ul>\n" <>
foldMap extLink links' <>
" </ul>\n"
" <div class=links>\n" <>
" <h2>links</h2>\n" <>
" <ul>\n" <>
foldMap extLink links' <>
" </ul>\n" <>
" </div>\n"
extLink :: Link -> Builder
extLink (Link {title, url}) =