handle nsfw flag better

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

View file

@ -1,6 +1,7 @@
{-# OPTIONS_GHC -Wno-orphans #-}
module Info
(Info (..), Artist (..), Image (..), Link (..),
(Info (..), tagsFor, descFor, imagesFor, linksFor,
Artist (..), Image (..), Link (..),
GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..),
IndexInfo (..),
readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters,
@ -14,7 +15,7 @@ import Control.Applicative
import Data.Foldable (find)
import qualified Data.HashSet as HashSet
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, isNothing)
import Data.Maybe (isJust, isNothing, fromMaybe)
import Data.Ord (comparing)
import Data.String (IsString)
import Data.Text (Text)
@ -78,6 +79,11 @@ instance HasField "allSfw" Info Bool where getField = null . #nsfwImages
instance HasField "anySfw" Info Bool where getField = not . #allNsfw
instance HasField "anyNsfw" Info Bool where getField = not . #allSfw
instance HasField "sfwLinks" Info [Link] where
getField = filter #sfw . #links
instance HasField "nsfwLinks" Info [Link] where
getField = filter #nsfw . #links
instance HasField "thumb" Info (Maybe FilePath) where
getField (Info {thumb', images}) = thumb' <|> #path <$> find #sfw images
@ -90,6 +96,19 @@ instance HasField "year" Info Integer where getField = #first . #dmy
instance HasField "month" Info Int where getField = #second . #dmy
instance HasField "day" Info Int where getField = #third . #dmy
descFor :: Bool -> Info -> Text
descFor nsfw i = if nsfw then desc <> "\n" <> nsfwDesc else desc
where desc = fromMaybe "" $ #desc i; nsfwDesc = fromMaybe "" $ #nsfwDesc i
tagsFor :: Bool -> Info -> [Text]
tagsFor nsfw i = if nsfw then #tags i <> #nsfwTags i else #tags i
imagesFor :: Bool -> Info -> [Image]
imagesFor nsfw = if nsfw then #images else #sfwImages
linksFor :: Bool -> Info -> [Link]
linksFor nsfw = if nsfw then #links else #sfwLinks
instance Ord Info where
compare = comparing \Info {date, title} -> (date, title)

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
makeDesc :: Strict.Text -> Builder
makeDesc desc = [b|@4
<section id=desc>
<h2>about</h2>
<div>
$8*desc'
$8*nsfwDesc'
$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