add extra nsfw-description field (nsfw pages show both)

This commit is contained in:
Rhiannon Morris 2020-07-24 14:17:54 +02:00
parent a533d096eb
commit c9dc887931
2 changed files with 21 additions and 14 deletions

View file

@ -27,15 +27,16 @@ import Text.Read (readMaybe)
data Info =
Info {
date :: !Day,
title :: !Text,
artist :: !(Maybe Artist), -- nothing = me, obv
tags :: ![Text],
nsfwTags :: ![Text],
description :: !(Maybe Text),
images :: ![Image],
thumb' :: !(Maybe FilePath),
links :: ![Link]
date :: !Day,
title :: !Text,
artist :: !(Maybe Artist), -- nothing = me, obv
tags :: ![Text],
nsfwTags :: ![Text],
description :: !(Maybe Text),
nsfwDescription :: !(Maybe Text),
images :: ![Image],
thumb' :: !(Maybe FilePath),
links :: ![Link]
}
deriving (Eq, Show)
@ -100,6 +101,7 @@ instance FromYAML Info where
<*> m .:? "tags" .!= []
<*> m .:? "nsfw-tags" .!= []
<*> m .:? "description"
<*> m .:? "nsfw-description"
<*> (m .: "images" >>= imageList)
<*> m .:? "thumb"
<*> m .:? "links" .!= []

View file

@ -6,6 +6,7 @@ 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
@ -30,7 +31,7 @@ make nsfw dir = toLazyText . make' nsfw dir
make' :: Bool -> FilePath -> Info -> Builder
make' nsfw dir (Info {date, title, artist, tags, nsfwTags,
description, images, links}) = [b|@0
description, nsfwDescription, images, links}) = [b|@0
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
@ -83,7 +84,7 @@ make' nsfw dir (Info {date, title, artist, tags, nsfwTags,
download0 = fromMaybe path0 (#download image0)
path0' = pageFile path0
descSection = ifJust description makeDesc
descSection = makeDesc nsfw description nsfwDescription
tagsList = makeTags nsfw tags nsfwTags
linksList = extLinks nsfw links
@ -102,15 +103,19 @@ makeArtist (Artist {name, url}) =
Just u -> [b|<a href="$*u">$*name</a>|]
Nothing -> [b|$*name|]
makeDesc :: Strict.Text -> Builder
makeDesc desc = [b|@4
makeDesc :: Bool -> Maybe Strict.Text -> Maybe Strict.Text -> Builder
makeDesc nsfw desc nsfwDesc = [b|@4
<section class=desc>
<h2>about</h2>
<div>
$8*desc
$8*desc'
$8*nsfwDesc'
</div>
</section>
|]
where
desc' = fromMaybe "" desc
nsfwDesc' = fromMaybe "" $ guard nsfw *> nsfwDesc
ifJust :: Monoid b => Maybe a -> (a -> b) -> b
ifJust x f = maybe mempty f x