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

allow updates to be marked nsfw-only

Browse source
This commit is contained in:
Rhiannon Morris 2020-11-16 23:30:56 +01:00
parent 6567bdf059
commit 9a54cc0d53
4 changed files with 85 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

26
make-pages/SinglePage.hs
View file

@ -7,7 +7,7 @@ import Records ()
import qualified NsfwWarning
import Control.Exception
import qualified Data.Map.Strict as Map
import Data.List (sort)
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
@ -36,8 +36,7 @@ make root prefix nsfw dataDir dir info =
toLazyText <$> make' root prefix nsfw dataDir dir info
make' :: Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder
make' root prefix nsfw dataDir dir
info@(Info {date, title, artist, bg, updates}) = do
make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
images <- withSizes (dataDir </> dir) $ imagesFor nsfw info
let undir = joinPath (replicate (length (splitPath dir)) "..")
@ -56,7 +55,8 @@ make' root prefix nsfw dataDir dir
let descSection = makeDesc $ descFor nsfw info
let tagsList = makeTags undir $ tagsFor nsfw info
let linksList = extLinks $ linksFor nsfw info
let updatesList = makeUpdates $ Map.toList updates
let updates = sort $ updatesFor nsfw info
let updatesList = makeUpdates updates
let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$path>|]
let prefetches = map (makePrefetch . #first) $ tail images
@ -80,8 +80,9 @@ make' root prefix nsfw dataDir dir
Nothing -> "by niss"
let thumb = getThumb "" info
let updateDate = ifJust (Map.lookupMax updates) \(formatLong -> u, _) ->
[b|<br> <span class=updated>updated $u</span>|]
let updateDate = ifJust (last' updates) \(Update {date = d}) ->
let updated = formatLong d in
[b|<br> <span class=updated>updated $updated</span>|]
let nsfwScript = NsfwWarning.script nsfw
let nsfwDialog = NsfwWarning.dialog nsfw
@ -153,6 +154,9 @@ make' root prefix nsfw dataDir dir
</template>
|]
last' :: [a] -> Maybe a
last' xs = if null xs then Nothing else Just $ last xs
makeArtist :: Artist -> Builder
makeArtist (Artist {name, url}) =
[b|<h2 id=artist class="left corner">by $artistLink</h2>|]
@ -236,7 +240,7 @@ extLink (Link {title, url}) = [b|@8
</a>
|]
makeUpdates :: [(Date, Text)] -> Builder
makeUpdates :: [Update] -> Builder
makeUpdates ups =
if null ups then "" else [b|@4
<section id=updates class=info-section>
@ -246,12 +250,12 @@ makeUpdates ups =
</dl>
</section>
|]
where updateList = map (uncurry makeUpdate) ups
where updateList = map makeUpdate ups
makeUpdate :: Date -> Text -> Builder
makeUpdate date txt = [b|@8
makeUpdate :: Update -> Builder
makeUpdate (Update {date, desc}) = [b|@8
<dt>$date'
<dd>$txt
<dd>$desc
|]
where date' = formatSlash date