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
Show stats Download patch file Download diff file Expand all files Collapse all files

23
make-pages/Info.hs
View file

@ -1,6 +1,7 @@
{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
module Info module Info
(Info (..), Artist (..), Image (..), Link (..), (Info (..), tagsFor, descFor, imagesFor, linksFor,
Artist (..), Image (..), Link (..),
GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..), GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..),
IndexInfo (..), IndexInfo (..),
readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters, readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters,
@ -14,7 +15,7 @@ import Control.Applicative
import Data.Foldable (find) import Data.Foldable (find)
import qualified Data.HashSet as HashSet import qualified Data.HashSet as HashSet
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, isNothing) import Data.Maybe (isJust, isNothing, fromMaybe)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.String (IsString) import Data.String (IsString)
import Data.Text (Text) 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 "anySfw" Info Bool where getField = not . #allNsfw
instance HasField "anyNsfw" Info Bool where getField = not . #allSfw 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 instance HasField "thumb" Info (Maybe FilePath) where
getField (Info {thumb', images}) = thumb' <|> #path <$> find #sfw images 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 "month" Info Int where getField = #second . #dmy
instance HasField "day" Info Int where getField = #third . #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 instance Ord Info where
compare = comparing \Info {date, title} -> (date, title) compare = comparing \Info {date, title} -> (date, title)

49
make-pages/SinglePage.hs
View file

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