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)) "..") undir = joinPath (replicate (length (splitPath prefix)) "..")
allTags = infos allTags = infos
& concatMap (map (,1) . tagsFor nsfw . snd) & concatMap (map (,1) . HashSet.toList . tagsFor nsfw . snd)
& HashMap.fromListWith (+) & HashMap.toList & HashMap.fromListWith (+) & HashMap.toList
& sort & sort
@ -160,7 +160,8 @@ makeItem nsfw file info@(Info {bg}) = [b|
dir = takeDirectory file dir = takeDirectory file
thumbnail = getThumb dir info thumbnail = getThumb dir info
nsfw' = if nsfw && anyNsfw info then [b|$& nsfw|] else "" 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 = latestDateFor nsfw info
date' = formatTooltip date date' = formatTooltip date
year' = date.year year' = date.year

View file

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

View file

@ -38,7 +38,8 @@ stats1 nsfw path (Info {tags, nsfwTags}) =
if null tags' then if null tags' then
Stats {tags = [], untagged = [path]} Stats {tags = [], untagged = [path]}
else 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 :: Bool -> [(FilePath, Info)] -> Stats
stats nsfw = foldMap $ uncurry $ stats1 nsfw 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 as Strict
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import System.FilePath (joinPath, splitPath) 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.Traversable
import Data.Semigroup import Data.Semigroup
import Data.List.NonEmpty (toList) 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 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 :: Traversable t => t Image -> t (Image, Text)
addIds = snd . mapAccumL makeId Set.empty where addIds = snd . mapAccumL makeId HashSet.empty where
makeId used img = (Set.insert newId used, (img, newId)) where makeId used img = (HashSet.insert newId used, (img, newId)) where
newId = headI $ filterI (\i -> not $ i `Set.member` used) ids newId = headI $ filterI (\i -> not $ i `HashSet.member` used) ids
ids = fmap (\i -> toStrictText [b|$label$i|]) suffixes ids = fmap (\i -> toStrictText [b|$label$i|]) suffixes
label = escId $ img.label label = escId $ img.label
@ -314,7 +315,7 @@ altButton img i = [b|
warning' = ifJust warning \(escAttr -> w) -> [b|$& data-warning="$w"|] warning' = ifJust warning \(escAttr -> w) -> [b|$& data-warning="$w"|]
alt = img.desc alt = img.desc
makeTags :: FilePath -> [Strict.Text] -> Builder makeTags :: FilePath -> HashSet Strict.Text -> Builder
makeTags undir tags = makeTags undir tags =
if null tags then "" else [b| if null tags then "" else [b|
<nav id=tags class=info-section> <nav id=tags class=info-section>
@ -325,7 +326,7 @@ makeTags undir tags =
</nav> </nav>
|] |]
where where
tagList = map makeTag tags tagList = map makeTag $ sort $ HashSet.toList tags
makeTag tag = [b|<li><a href="$undir#require_$tag'">$tag</a>|] makeTag tag = [b|<li><a href="$undir#require_$tag'">$tag</a>|]
where tag' = escId tag where tag' = escId tag