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 main = main2 =<< Opt.execParser optionsParser
main2 :: Options -> IO () main2 :: Options -> IO ()
main2 (SinglePage {file, includeNsfw, output}) = do main2 s@(SinglePage {file, includeNsfw, output}) = do
print s
txt <- ByteString.readFile file txt <- ByteString.readFile file
let Right info = YAML.decode1 txt let Right info = YAML.decode1 txt
let page = make info let page = make includeNsfw info
case output of case output of
Nothing -> Text.putStr page Nothing -> Text.putStr page
Just out -> Text.writeFile out page Just out -> Text.writeFile out page
main2 (GalleryPage {}) = do main2 g@(GalleryPage {}) = do
print g
error "surprise! this doesn't exist yet" 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 import qualified Data.Vector as Vector
make :: Info -> Lazy.Text make :: Bool -> Info -> Lazy.Text
make = toLazyText . make' make includeNsfw = toLazyText . make' includeNsfw
make' :: Info -> Builder make' :: Bool -> Info -> Builder
make' (Info {date, title, tags, description, images, links}) = make' includeNsfw (Info {date, title, tags, description, images, links}) =
"<!DOCTYPE html>\n" <> "<!DOCTYPE html>\n" <>
"<html lang=en>\n" <> "<html lang=en>\n" <>
"<meta charset=utf-8>\n" <> "<meta charset=utf-8>\n" <>
@ -22,22 +22,14 @@ make' (Info {date, title, tags, description, images, links}) =
"<header>\n" <> "<header>\n" <>
" <h1>" <> esc title <> "</h1>\n" <> " <h1>" <> esc title <> "</h1>\n" <>
" <h2 class=date>" <> formatDate date <> "</h2>\n" <> " <h2 class=date>" <> formatDate date <> "</h2>\n" <>
" <nav id=variants class=buttonbar>\n" <> buttonBar includeNsfw images <>
" <h2>alts</h2>\n" <>
" <ul id=variantlist>\n" <>
Vector.ifoldl (\b i im -> b <> altButton i im) mempty images <>
" </ul>\n" <>
" </nav>\n" <>
"</header>\n\n" <> "</header>\n\n" <>
"<main>\n" <> "<main>\n" <>
" <img id=it src=\"" <> path0 <> "\">\n" <> " <img id=it src=\"" <> path0 <> "\">\n" <>
" <section id=description>\n" <> " <section id=description>\n" <>
indent 4 description <> indent 4 description <>
" </section>\n\n" <> " </section>\n\n" <>
" <h2>links</h2>\n" <> extLinks includeNsfw links <>
" <ul>\n" <>
foldMap extLink links <>
" </ul>\n" <>
"</main>\n\n" <> "</main>\n\n" <>
"<nav class=back>\n" <> "<nav class=back>\n" <>
" <a href=../>back to gallery</a>\n" <> " <a href=../>back to gallery</a>\n" <>
@ -58,6 +50,22 @@ esc = foldMap esc1 . Strict.unpack where
formatDate :: Day -> Builder formatDate :: Day -> Builder
formatDate = fromString . formatTime defaultTimeLocale "%e %#B %Y" 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 :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw}) = altButton i (Image {label, path, nsfw}) =
" <li" <> nsfwClass <> ">\n" <> " <li" <> nsfwClass <> ">\n" <>
@ -85,6 +93,17 @@ indent n txt = spaces <> go (Strict.unpack txt) where
go (c:cs) = singleton c <> go cs go (c:cs) = singleton c <> go cs
spaces = fromString $ replicate n ' ' 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 -> Builder
extLink (Link {title, url}) = extLink (Link {title, url}) =
" <li>\n" <> " <li>\n" <>