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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
make-pages/BuilderQQ.hs
View File

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

24
make-pages/SinglePage.hs
View File

@ -14,6 +14,8 @@ import qualified Data.Text.Lazy as Lazy
import System.FilePath (joinPath, splitPath, (</>)) import System.FilePath (joinPath, splitPath, (</>))
import qualified System.Process as Proc import qualified System.Process as Proc
import Text.Read (readMaybe) 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 -- | 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 formattedDate = formatLong date
let buttonBar = makeButtonBar title images let buttonBar = makeButtonBar title $ addIds images
let (image0@(Image {path = path0, download = download0'}), let (image0@(Image {path = path0, download = download0'}),
Size {width = width0, height = height0}) : otherImages Size {width = width0, height = height0}) : otherImages
= #all images = #all images
@ -195,7 +197,14 @@ makeDesc (LongDesc fs) = [b|@0
</div> </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 = makeButtonBar title images =
case images of case images of
Uncat [] -> throw $ NoEligibleImages title Uncat [] -> throw $ NoEligibleImages title
@ -218,22 +227,21 @@ makeButtonBar title images =
<ul class="buttonbar bb-choice"> <ul class="buttonbar bb-choice">
$2.elems $2.elems
</ul> |] </ul> |]
where elems = map (uncurry altButton) imgs where elems = map (\(img,sz,i) -> altButton img sz i) imgs
altButton :: Image -> Size -> Builder altButton :: Image -> Size -> Text -> Builder
altButton img size = [b|@0 altButton img size i = [b|@0
<li$nsfwClass> <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-link="$link"$warning'
data-width=$width data-height=$height> data-width=$width data-height=$height>
<label for="$idLabel"$nsfwLabelClass>$label</label> <label for="$i"$nsfwLabelClass>$label</label>
|] |]
where where
Image {label, path, nsfw, warning, download} = img Image {label, path, nsfw, warning, download} = img
Size {width, height} = size Size {width, height} = size
nsfwClass = if nsfw then [b| class=nsfw|] else "" nsfwClass = if nsfw then [b| class=nsfw|] else ""
nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else "" nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else ""
idLabel = escId label
path' = pageFile path path' = pageFile path
link = fromMaybe path download link = fromMaybe path download
warning' = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|] warning' = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|]