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

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

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

20
make-pages/Info.hs
View file

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

15
make-pages/SinglePage.hs
View file

@ -6,6 +6,7 @@ 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
@ -30,7 +31,7 @@ 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 {date, title, artist, tags, nsfwTags,
description, images, links}) = [b|@0 description, nsfwDescription, images, links}) = [b|@0
<!DOCTYPE html> <!DOCTYPE html>
<html lang=en> <html lang=en>
<meta charset=utf-8> <meta charset=utf-8>
@ -83,7 +84,7 @@ 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 = ifJust description makeDesc descSection = makeDesc nsfw description nsfwDescription
tagsList = makeTags nsfw tags nsfwTags tagsList = makeTags nsfw tags nsfwTags
linksList = extLinks nsfw links linksList = extLinks nsfw links
@ -102,15 +103,19 @@ 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 :: Strict.Text -> Builder makeDesc :: Bool -> Maybe Strict.Text -> Maybe Strict.Text -> Builder
makeDesc desc = [b|@4 makeDesc nsfw desc nsfwDesc = [b|@4
<section class=desc> <section class=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
ifJust :: Monoid b => Maybe a -> (a -> b) -> b ifJust :: Monoid b => Maybe a -> (a -> b) -> b
ifJust x f = maybe mempty f x ifJust x f = maybe mempty f x