handle nsfw flag better
This commit is contained in:
parent
9c23e13628
commit
981319483a
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue