From e8bd20c89642d9d386c2b9d0c44bffacd2197501 Mon Sep 17 00:00:00 2001 From: Rhiannon Morris Date: Tue, 4 Aug 2020 02:27:19 +0200 Subject: [PATCH] support initially-hidden tags --- make-pages/GalleryPage.hs | 20 +++++++++++++------- make-pages/Info.hs | 18 ++++++++++++------ make-pages/make-pages.cabal | 1 + 3 files changed, 26 insertions(+), 13 deletions(-) diff --git a/make-pages/GalleryPage.hs b/make-pages/GalleryPage.hs index 5080d60..d68c9d5 100644 --- a/make-pages/GalleryPage.hs +++ b/make-pages/GalleryPage.hs @@ -5,6 +5,8 @@ import Control.Exception import Data.Foldable import Data.Function (on, (&)) import qualified Data.HashMap.Strict as HashMap +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet import Data.List (intersperse, groupBy, sortOn) import qualified Data.Text.Lazy as Lazy import System.FilePath ((), takeDirectory, joinPath, splitPath) @@ -23,7 +25,7 @@ make ginfo infos = toLazyText $ make' ginfo infos make' :: GalleryInfo -> [(FilePath, Info)] -> Builder -make' (GalleryInfo {title, prefix, filters}) infos = [b|@0 +make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0 @@ -89,18 +91,22 @@ make' (GalleryInfo {title, prefix, filters}) infos = [b|@0 & concatMap (map (,1) . tagsFor nsfw . #second) & HashMap.fromListWith (+) & HashMap.toList & sortOn (\(tag, count) -> (Down count, tag)) - requireFilters = map (uncurry $ makeFilter "require") allTags - excludeFilters = map (uncurry $ makeFilter "exclude") allTags + + requireFilters = map (uncurry $ makeFilter "require" mempty) allTags + excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags nsfw = #nsfw filters /= NoNsfw -makeFilter :: Text -> Text -> Int -> Builder -makeFilter prefix tag count = [b|@8 +makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder +makeFilter prefix initial tag _count = [b|@8
  • - + |] - where id' = [b|$*prefix$&_$tag'|]; tag' = escId tag + where + id' = [b|$*prefix$&_$tag'|] + tag' = escId tag + checked = if HashSet.member tag initial then " checked" else "" makeYearItems :: Bool -- ^ nsfw -> Integer -- ^ year diff --git a/make-pages/Info.hs b/make-pages/Info.hs index 6d07873..73bfd47 100644 --- a/make-pages/Info.hs +++ b/make-pages/Info.hs @@ -13,6 +13,8 @@ import Records import Control.Applicative import Data.Foldable (find) +import Data.Hashable (Hashable) +import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import qualified Data.Map.Strict as Map import Data.Maybe (isJust, isNothing, fromMaybe) @@ -175,7 +177,8 @@ data GalleryInfo = title :: !Text, desc :: !Text, prefix :: !FilePath, - filters :: !GalleryFilters + filters :: !GalleryFilters, + hidden :: !(HashSet Text) -- ^ tags to initially hide } deriving (Eq, Show) @@ -183,7 +186,7 @@ data GalleryFilters = GalleryFilters { nsfw :: !NsfwFilter, artist :: !ArtistFilter, - require, exclude :: ![Text] + require, exclude :: !(HashSet Text) } deriving (Eq, Show) @@ -225,10 +228,9 @@ noFilters = matchFilters :: GalleryFilters -> Info -> Bool matchFilters (GalleryFilters {nsfw, artist, require, exclude}) i = matchNsfw nsfw i && matchArtist artist i && - all (∊ tags) require && all (∉ tags) exclude - where - tags = HashSet.fromList $ #tags i - (∊) = HashSet.member; x ∉ xs = not $ x ∊ xs + all (\t -> HashSet.member t tags) require && + all (\t -> not $ HashSet.member t tags) exclude + where tags = HashSet.fromList $ #tags i instance FromYAML GalleryInfo where @@ -237,6 +239,7 @@ instance FromYAML GalleryInfo where <*> m .: "desc" <*> m .: "prefix" <*> m .:? "filters" .!= noFilters + <*> m .:? "hidden" .!= mempty instance FromYAML GalleryFilters where parseYAML = YAML.withMap "gallery filters" \m -> @@ -283,3 +286,6 @@ instance FromYAML Day where instance {-# OVERLAPPING #-} FromYAML String where parseYAML y = Text.unpack <$> parseYAML y + +instance (FromYAML a, Eq a, Hashable a) => FromYAML (HashSet a) where + parseYAML y = HashSet.fromList <$> parseYAML y diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal index 40312b9..b3e8f39 100644 --- a/make-pages/make-pages.cabal +++ b/make-pages/make-pages.cabal @@ -58,6 +58,7 @@ executable make-pages containers ^>= 0.6.0.1, filemanip ^>= 0.3.6.3, filepath ^>= 1.4.2.1, + hashable ^>= 1.3.0.0, HsYAML ^>= 0.2.1.0, optparse-applicative ^>= 0.15.1.0, template-haskell ^>= 2.16.0.0,