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

add nsfw tags & put tags on singlepage

Browse source
This commit is contained in:
Rhiannon Morris 2020-07-12 05:42:31 +02:00
parent bf6308de32
commit f61e9916fb
2 changed files with 16 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
make-pages/Info.hs
View file

@ -20,6 +20,7 @@ data Info =
date :: !Day, date :: !Day,
title :: !(Maybe Text), title :: !(Maybe Text),
tags :: ![Text], tags :: ![Text],
nsfwTags :: ![Text],
description :: !(Maybe Text), description :: !(Maybe Text),
images :: ![Image], images :: ![Image],
thumb :: !Text, thumb :: !Text,
@ -49,6 +50,7 @@ instance FromYAML Info where
Info <$> m .: "date" Info <$> m .: "date"
<*> m .:? "title" <*> m .:? "title"
<*> m .:? "tags" .!= [] <*> m .:? "tags" .!= []
<*> m .:? "nsfwTags" .!= []
<*> m .:? "description" <*> m .:? "description"
<*> m .: "images" <*> m .: "images"
<*> m .: "thumb" <*> m .: "thumb"

15
make-pages/SinglePage.hs
View file

@ -25,7 +25,8 @@ make :: Bool -> Info -> Lazy.Text
make includeNsfw = toLazyText . make' includeNsfw make includeNsfw = toLazyText . make' includeNsfw
make' :: Bool -> Info -> Builder make' :: Bool -> Info -> Builder
make' includeNsfw (Info {date, title, tags, description, images, links}) = make' includeNsfw (Info {date, title, tags, nsfwTags,
description, images, links}) =
"<!DOCTYPE html>\n" <> "<!DOCTYPE html>\n" <>
"<html lang=en>\n" <> "<html lang=en>\n" <>
"<meta charset=utf-8>\n" <> "<meta charset=utf-8>\n" <>
@ -43,6 +44,7 @@ make' includeNsfw (Info {date, title, tags, description, images, links}) =
" <h2>description</h2>\n" <> " <h2>description</h2>\n" <>
indent 4 d <> indent 4 d <>
" </div>\n") <> " </div>\n") <>
makeTags includeNsfw tags nsfwTags <>
extLinks includeNsfw links <> extLinks includeNsfw links <>
"</main>\n\n" <> "</main>\n\n" <>
"<nav class=back>\n" <> "<nav class=back>\n" <>
@ -113,6 +115,17 @@ indent n txt = spaces <> go (Strict.unpack txt) where
go (c:cs) = singleton c <> go cs go (c:cs) = singleton c <> go cs
spaces = fromString $ replicate n ' ' spaces = fromString $ replicate n ' '
makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder
makeTags includeNsfw sfwTags nsfwTags =
if null tags then mempty else
" <div class=tags>\n" <>
" <h2>tags</h2>\n" <>
" <ul>\n" <> foldMap makeTag tags <> " </ul>\n" <>
" </div>\n\n"
where
tags = List.nub $ if includeNsfw then sfwTags else sfwTags <> nsfwTags
makeTag t = " <li>" <> fromText t <> "\n"
extLinks :: Bool -> [Link] -> Builder extLinks :: Bool -> [Link] -> Builder
extLinks includeNsfw links = extLinks includeNsfw links =
let links' = let links' =