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

handle nsfw flag better

Browse source
This commit is contained in:
Rhiannon Morris 2020-08-03 19:36:48 +02:00
parent 9c23e13628
commit 981319483a
2 changed files with 39 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

49
make-pages/SinglePage.hs
View file

@ -6,13 +6,10 @@ import BuilderQQ
import Records ()
import Control.Exception
import Control.Monad
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import qualified Data.Time.Calendar as Time
import qualified Data.Char as Char
import qualified Data.List as List
import System.FilePath (joinPath, splitPath)
@ -30,8 +27,7 @@ make :: Bool -> FilePath -> Info -> Lazy.Text
make nsfw dir = toLazyText . make' nsfw dir
make' :: Bool -> FilePath -> Info -> Builder
make' nsfw dir (Info {date, title, artist, tags, nsfwTags,
desc, nsfwDesc, images = allImages, links}) = [b|@0
make' nsfw dir info@(Info {date, title, artist}) = [b|@0
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
@ -79,9 +75,6 @@ make' nsfw dir (Info {date, title, artist, tags, nsfwTags,
where
artistTag = ifJust artist makeArtist
images | nsfw = allImages
| otherwise = filter #sfw allImages
formattedDate = formatDate date
buttonBar = makeButtonBar title images
@ -90,9 +83,10 @@ make' nsfw dir (Info {date, title, artist, tags, nsfwTags,
download0 = fromMaybe path0 (#download image0)
path0' = pageFile path0
descSection = makeDesc nsfw desc nsfwDesc
tagsList = makeTags nsfw tags nsfwTags
linksList = extLinks nsfw links
images = imagesFor nsfw info
descSection = makeDesc $ descFor nsfw info
tagsList = makeTags $ tagsFor nsfw info
linksList = extLinks $ linksFor nsfw info
prefetches = map makePrefetch $ tail images
makePrefetch (Image {path}) = [b|<link rel=prefetch href=$@path>|]
@ -112,19 +106,15 @@ makeArtist (Artist {name, url}) =
Just u -> [b|<a href="$*u">$*name</a>|]
Nothing -> [b|$*name|]
makeDesc :: Bool -> Maybe Strict.Text -> Maybe Strict.Text -> Builder
makeDesc nsfw desc nsfwDesc = [b|@4
<section id=desc>
<h2>about</h2>
<div>
$8*desc'
$8*nsfwDesc'
</div>
</section>
makeDesc :: Strict.Text -> Builder
makeDesc desc = [b|@4
<section id=desc>
<h2>about</h2>
<div>
$8*desc
</div>
</section>
|]
where
desc' = fromMaybe "" desc
nsfwDesc' = fromMaybe "" $ guard nsfw *> nsfwDesc
makeButtonBar :: Strict.Text -> [Image] -> Builder
makeButtonBar title images =
@ -162,8 +152,8 @@ escId = foldMap esc1 . Strict.unpack where
| c < 'ÿ' && not (Char.isAlphaNum c || c == '-') = "_"
| otherwise = [b|$'c|]
makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder
makeTags nsfw sfwTags nsfwTags =
makeTags :: [Strict.Text] -> Builder
makeTags tags =
if null tags then "" else [b|@4
<section id=tags>
<h2>tags</h2>
@ -175,10 +165,9 @@ makeTags nsfw sfwTags nsfwTags =
where
tagList = map makeTag tags
makeTag t = [b|<li>$*t|]
tags = List.nub $ if nsfw then sfwTags <> nsfwTags else sfwTags
extLinks :: Bool -> [Link] -> Builder
extLinks nsfw allLinks =
extLinks :: [Link] -> Builder
extLinks links =
if null links then "" else [b|@4
<section id=links>
<h2>links</h2>
@ -187,9 +176,7 @@ extLinks nsfw allLinks =
</ul>
</section>
|]
where
links = if nsfw then allLinks else filter #sfw allLinks
linkList = map extLink links
where linkList = map extLink links
extLink :: Link -> Builder
extLink (Link {title, url}) = [b|@6