ensure ids are unique

This commit is contained in:
Rhiannon Morris 2021-08-23 16:35:55 +02:00
parent 8e5e066699
commit 004e43f52f
2 changed files with 17 additions and 9 deletions

View File

@ -1,7 +1,7 @@
{-# LANGUAGE TemplateHaskell #-}
module BuilderQQ
(b,
Builder, toLazyText, fromText, fromString, fromChar,
Builder, toStrictText, toLazyText, fromText, fromString, fromChar,
textMap, ifJust, escId, escAttr)
where

View File

@ -14,6 +14,8 @@ import qualified Data.Text.Lazy as Lazy
import System.FilePath (joinPath, splitPath, (</>))
import qualified System.Process as Proc
import Text.Read (readMaybe)
import qualified Data.HashSet as Set
import Data.Traversable
-- | e.g. only nsfw images are present for a non-nsfw page
@ -45,7 +47,7 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
let formattedDate = formatLong date
let buttonBar = makeButtonBar title images
let buttonBar = makeButtonBar title $ addIds images
let (image0@(Image {path = path0, download = download0'}),
Size {width = width0, height = height0}) : otherImages
= #all images
@ -195,7 +197,14 @@ makeDesc (LongDesc fs) = [b|@0
</div>
|]
makeButtonBar :: Strict.Text -> Images' (Image, Size) -> Builder
addIds :: Images' (Image, a) -> Images' (Image, a, Text)
addIds = snd . mapAccumL makeId Set.empty where
makeId used (img, x) = (Set.insert newId used, (img, x, newId)) where
newId = head $ filter (\i -> not $ i `Set.member` used) ids
ids = [toStrictText [b|$label$i|] | i <- "" : map show [0::Int ..]]
label = escId $ #label img
makeButtonBar :: Strict.Text -> Images' (Image, Size, Text) -> Builder
makeButtonBar title images =
case images of
Uncat [] -> throw $ NoEligibleImages title
@ -218,22 +227,21 @@ makeButtonBar title images =
<ul class="buttonbar bb-choice">
$2.elems
</ul> |]
where elems = map (uncurry altButton) imgs
where elems = map (\(img,sz,i) -> altButton img sz i) imgs
altButton :: Image -> Size -> Builder
altButton img size = [b|@0
altButton :: Image -> Size -> Text -> Builder
altButton img size i = [b|@0
<li$nsfwClass>
<input type=radio name=variant id="$idLabel" value="$path'"
<input type=radio name=variant id="$i" value="$path'"
data-link="$link"$warning'
data-width=$width data-height=$height>
<label for="$idLabel"$nsfwLabelClass>$label</label>
<label for="$i"$nsfwLabelClass>$label</label>
|]
where
Image {label, path, nsfw, warning, download} = img
Size {width, height} = size
nsfwClass = if nsfw then [b| class=nsfw|] else ""
nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else ""
idLabel = escId label
path' = pageFile path
link = fromMaybe path download
warning' = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|]