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

skip nsfw stuff in non-nsfw singlepages

This commit is contained in:
Rhiannon Morris 2020-07-09 21:48:29 +02:00
parent 80cf5cfacc
commit a18786e70c
2 changed files with 38 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
make-pages/Main.hs
View File

@ -49,12 +49,14 @@ main :: IO ()
main = main2 =<< Opt.execParser optionsParser
main2 :: Options -> IO ()
main2 (SinglePage {file, includeNsfw, output}) = do
main2 s@(SinglePage {file, includeNsfw, output}) = do
print s
txt <- ByteString.readFile file
let Right info = YAML.decode1 txt
let page = make info
let page = make includeNsfw info
case output of
Nothing -> Text.putStr page
Just out -> Text.writeFile out page
main2 (GalleryPage {}) = do
main2 g@(GalleryPage {}) = do
print g
error "surprise! this doesn't exist yet"

47
make-pages/SinglePage.hs
View File

@ -9,11 +9,11 @@ import qualified Data.Char as Char
import qualified Data.Vector as Vector
make :: Info -> Lazy.Text
make = toLazyText . make'
make :: Bool -> Info -> Lazy.Text
make includeNsfw = toLazyText . make' includeNsfw
make' :: Info -> Builder
make' (Info {date, title, tags, description, images, links}) =
make' :: Bool -> Info -> Builder
make' includeNsfw (Info {date, title, tags, description, images, links}) =
"<!DOCTYPE html>\n" <>
"<html lang=en>\n" <>
"<meta charset=utf-8>\n" <>
@ -22,22 +22,14 @@ make' (Info {date, title, tags, description, images, links}) =
"<header>\n" <>
" <h1>" <> esc title <> "</h1>\n" <>
" <h2 class=date>" <> formatDate date <> "</h2>\n" <>
" <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 <>
" </ul>\n" <>
" </nav>\n" <>
buttonBar includeNsfw images <>
"</header>\n\n" <>
"<main>\n" <>
" <img id=it src=\"" <> path0 <> "\">\n" <>
" <section id=description>\n" <>
indent 4 description <>
" </section>\n\n" <>
" <h2>links</h2>\n" <>
" <ul>\n" <>
foldMap extLink links <>
" </ul>\n" <>
extLinks includeNsfw links <>
"</main>\n\n" <>
"<nav class=back>\n" <>
" <a href=../>back to gallery</a>\n" <>
@ -58,6 +50,22 @@ 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
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' <>
" </ul>\n" <>
" </nav>\n"
altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw}) =
" <li" <> nsfwClass <> ">\n" <>
@ -85,6 +93,17 @@ 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 includeNsfw links =
let links' =
if includeNsfw then links
else Vector.filter (\Link {nsfw} -> not nsfw) links in
if null links' then mempty else
" <h2>links</h2>\n" <>
" <ul>\n" <>
foldMap extLink links' <>
" </ul>\n"
extLink :: Link -> Builder
extLink (Link {title, url}) =
" <li>\n" <>