skip nsfw stuff in non-nsfw singlepages
This commit is contained in:
parent
80cf5cfacc
commit
a18786e70c
2 changed files with 38 additions and 17 deletions
|
@ -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"
|
||||||
|
|
|
@ -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" <>
|
||||||
|
|
Loading…
Reference in a new issue