add extra nsfw-description field (nsfw pages show both)
This commit is contained in:
parent
a533d096eb
commit
c9dc887931
2 changed files with 21 additions and 14 deletions
|
@ -33,6 +33,7 @@ data Info =
|
|||
tags :: ![Text],
|
||||
nsfwTags :: ![Text],
|
||||
description :: !(Maybe Text),
|
||||
nsfwDescription :: !(Maybe Text),
|
||||
images :: ![Image],
|
||||
thumb' :: !(Maybe FilePath),
|
||||
links :: ![Link]
|
||||
|
@ -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" .!= []
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue