use sets for tags

This commit is contained in:
rhiannon morris 2024-11-04 00:55:07 +01:00
parent b9b0edc173
commit 34bd2214f5
4 changed files with 19 additions and 17 deletions

View file

@ -96,7 +96,7 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|
undir = joinPath (replicate (length (splitPath prefix)) "..")
allTags = infos
& concatMap (map (,1) . tagsFor nsfw . snd)
& concatMap (map (,1) . HashSet.toList . tagsFor nsfw . snd)
& HashMap.fromListWith (+) & HashMap.toList
& sort
@ -160,7 +160,8 @@ makeItem nsfw file info@(Info {bg}) = [b|
dir = takeDirectory file
thumbnail = getThumb dir info
nsfw' = if nsfw && anyNsfw info then [b|$& nsfw|] else ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
tags' = fold $ intersperse ";" $ map fromText $
sort $ HashSet.toList $ tagsFor nsfw info
date = latestDateFor nsfw info
date' = formatTooltip date
year' = date.year

View file

@ -41,7 +41,7 @@ import qualified Data.Map.Strict as Map
import Data.Set (Set, (\\))
import qualified Data.Set as Set
import Data.Maybe (isJust, isNothing, fromMaybe, mapMaybe, catMaybes)
import Data.List (nub, sortBy)
import Data.List (sortBy)
import Data.List.NonEmpty (NonEmpty (..), toList, nonEmpty)
import Data.Ord (comparing)
import Data.String (IsString)
@ -69,8 +69,8 @@ data Info =
galleryTitle :: !(Maybe Text),
artist :: !(Maybe Artist), -- nothing = me, obv
nsfwOnly :: !Bool,
tags :: ![Text],
nsfwTags :: ![Text],
tags :: !(HashSet Text),
nsfwTags :: !(HashSet Text),
desc :: !Desc,
nsfwDesc :: !Desc,
bg :: !Bg,
@ -246,8 +246,8 @@ instance HasField "exists" Desc Bool where
descFor :: Bool -> Info -> Desc
descFor nsfw (Info {desc, nsfwDesc}) = if nsfw then desc <> nsfwDesc else desc
tagsFor :: Bool -> Info -> [Text]
tagsFor nsfw i = if nsfw then nub $ i.tags <> i.nsfwTags else i.tags
tagsFor :: Bool -> Info -> HashSet Text
tagsFor nsfw i = if nsfw then i.tags <> i.nsfwTags else i.tags
imagesFor :: Bool -> Info -> Maybe Images
imagesFor nsfw i = if nsfw then Just i.images else sfwImages i
@ -488,9 +488,8 @@ noFilters =
matchFilters :: GalleryFilters -> Info -> Bool
matchFilters (GalleryFilters {nsfw, artist, require, exclude}) i =
matchNsfw nsfw i && matchArtist artist i &&
all (\t -> HashSet.member t tags) require &&
all (\t -> not $ HashSet.member t tags) exclude
where tags = HashSet.fromList i.tags
all (\t -> HashSet.member t i.tags) require &&
all (\t -> not $ HashSet.member t i.tags) exclude
instance FromYAML GalleryInfo where

View file

@ -38,7 +38,8 @@ stats1 nsfw path (Info {tags, nsfwTags}) =
if null tags' then
Stats {tags = [], untagged = [path]}
else
Stats {tags = HashMap.fromList $ map (, 1) tags', untagged = []}
let tagMap = HashMap.fromList $ map (, 1) $ HashSet.toList tags' in
Stats {tags = tagMap, untagged = []}
stats :: Bool -> [(FilePath, Info)] -> Stats
stats nsfw = foldMap $ uncurry $ stats1 nsfw

View file

@ -13,7 +13,8 @@ import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import System.FilePath (joinPath, splitPath)
import qualified Data.HashSet as Set
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Traversable
import Data.Semigroup
import Data.List.NonEmpty (toList)
@ -242,9 +243,9 @@ filterI :: (a -> Bool) -> Inf a -> Inf a
filterI p (x :> xs) = if p x then x :> filterI p xs else filterI p xs
addIds :: Traversable t => t Image -> t (Image, Text)
addIds = snd . mapAccumL makeId Set.empty where
makeId used img = (Set.insert newId used, (img, newId)) where
newId = headI $ filterI (\i -> not $ i `Set.member` used) ids
addIds = snd . mapAccumL makeId HashSet.empty where
makeId used img = (HashSet.insert newId used, (img, newId)) where
newId = headI $ filterI (\i -> not $ i `HashSet.member` used) ids
ids = fmap (\i -> toStrictText [b|$label$i|]) suffixes
label = escId $ img.label
@ -314,7 +315,7 @@ altButton img i = [b|
warning' = ifJust warning \(escAttr -> w) -> [b|$& data-warning="$w"|]
alt = img.desc
makeTags :: FilePath -> [Strict.Text] -> Builder
makeTags :: FilePath -> HashSet Strict.Text -> Builder
makeTags undir tags =
if null tags then "" else [b|
<nav id=tags class=info-section>
@ -325,7 +326,7 @@ makeTags undir tags =
</nav>
|]
where
tagList = map makeTag tags
tagList = map makeTag $ sort $ HashSet.toList tags
makeTag tag = [b|<li><a href="$undir#require_$tag'">$tag</a>|]
where tag' = escId tag