From 49eff9c009018510237db6bcbf23b51b41c96c8e Mon Sep 17 00:00:00 2001 From: Rhiannon Morris Date: Sat, 25 Jul 2020 01:10:52 +0200 Subject: [PATCH] add tag filters and refactor others --- make-pages/Depend.hs | 2 +- make-pages/IndexPage.hs | 2 +- make-pages/Info.hs | 69 ++++++++++++++++++++++++------------- make-pages/make-pages.cabal | 3 +- 4 files changed, 49 insertions(+), 27 deletions(-) diff --git a/make-pages/Depend.hs b/make-pages/Depend.hs index 01e1c43..a607c76 100644 --- a/make-pages/Depend.hs +++ b/make-pages/Depend.hs @@ -104,7 +104,7 @@ makeRules prefix filters build data_ tmp = [b|@0 filtersToFlags :: GalleryFilters -> Builder filtersToFlags (GalleryFilters {nsfw}) = - case nsfw of Just False -> ""; _ -> "-n" + case nsfw of NoNsfw -> ""; _ -> "-n" thumbnail :: Info -> FilePath thumbnail = fromMaybe (error "no thumbnail or sfw images") . #thumb diff --git a/make-pages/IndexPage.hs b/make-pages/IndexPage.hs index a7681e9..e37dcf7 100644 --- a/make-pages/IndexPage.hs +++ b/make-pages/IndexPage.hs @@ -63,4 +63,4 @@ makeLink (Link {title, url, nsfw}) = [b|@4 where nsfw' = if nsfw then " class=nsfw" else "" hasNsfw :: GalleryFilters -> Bool -hasNsfw (GalleryFilters {nsfw}) = nsfw /= Just False +hasNsfw (GalleryFilters {nsfw}) = nsfw /= NoNsfw diff --git a/make-pages/Info.hs b/make-pages/Info.hs index 4ab64aa..50fe344 100644 --- a/make-pages/Info.hs +++ b/make-pages/Info.hs @@ -1,10 +1,9 @@ -{-# OPTIONS_GHC -fdefer-typed-holes #-} {-# OPTIONS_GHC -Wno-orphans #-} module Info (Info (..), Artist (..), Image (..), Link (..), - GalleryInfo (..), GalleryFilters (..), Whose (..), + GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..), IndexInfo (..), - readWhose, matchWhose, matchNsfw, matchFilters, + readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters, -- ** Reexports Day (..), Text) where @@ -13,6 +12,7 @@ import Records import Control.Applicative import Data.Foldable (find) +import qualified Data.HashSet as HashSet import qualified Data.Map.Strict as Map import Data.Maybe (isJust, isNothing) import Data.Ord (comparing) @@ -159,35 +159,53 @@ data GalleryInfo = data GalleryFilters = GalleryFilters { - nsfw :: Maybe Bool, - whose :: Whose + nsfw :: !NsfwFilter, + artist :: !ArtistFilter, + require, exclude :: ![Text] } deriving (Eq, Show) -data Whose = Mine | NotMine | All deriving (Eq, Show) +data NsfwFilter = NoNsfw | OnlyNsfw | AllN deriving (Eq, Show) + +readNsfwFilter :: (IsString str, Eq str, Alternative f) => str -> f NsfwFilter +readNsfwFilter "no" = pure NoNsfw +readNsfwFilter "only" = pure OnlyNsfw +readNsfwFilter "all" = pure AllN +readNsfwFilter _ = empty + +matchNsfw :: NsfwFilter -> Info -> Bool +matchNsfw NoNsfw i = #allSfw i +matchNsfw OnlyNsfw i = #allNsfw i +matchNsfw AllN _ = True + +instance FromYAML NsfwFilter where + parseYAML = YAML.withStr "nsfw filter" readNsfwFilter -matchNsfw :: Maybe Bool -> Info -> Bool -matchNsfw Nothing _ = True -matchNsfw (Just nsfw) i = #allNsfw i == nsfw +data ArtistFilter = Me | NotMe | AllW deriving (Eq, Show) -readWhose :: (IsString str, Eq str, Alternative f) => str -> f Whose -readWhose "mine" = pure Mine -readWhose "not-mine" = pure NotMine -readWhose "all" = pure All -readWhose _ = empty +readArtistFilter :: (IsString str, Eq str, Alternative f) + => str -> f ArtistFilter +readArtistFilter "me" = pure Me +readArtistFilter "not-me" = pure NotMe +readArtistFilter "all" = pure AllW +readArtistFilter _ = empty -matchWhose :: Whose -> Info -> Bool -matchWhose Mine = #mine -matchWhose NotMine = #notMine -matchWhose All = const True +matchArtist :: ArtistFilter -> Info -> Bool +matchArtist Me = #mine +matchArtist NotMe = #notMine +matchArtist AllW = const True noFilters :: GalleryFilters -noFilters = GalleryFilters {nsfw = Nothing, whose = All} +noFilters = + GalleryFilters {nsfw = AllN, artist = AllW, require = [], exclude = []} matchFilters :: GalleryFilters -> Info -> Bool -matchFilters (GalleryFilters {nsfw, whose}) i = - matchNsfw nsfw i && matchWhose whose i +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 $ #tags i instance FromYAML GalleryInfo where @@ -199,10 +217,13 @@ instance FromYAML GalleryInfo where instance FromYAML GalleryFilters where parseYAML = YAML.withMap "gallery filters" \m -> - GalleryFilters <$> m .:? "nsfw" - <*> m .:? "whose" .!= All + GalleryFilters <$> m .:? "nsfw" .!= AllN + <*> m .:? "artist" .!= AllW + <*> m .:? "require" .!= [] + <*> m .:? "exclude" .!= [] -instance FromYAML Whose where parseYAML = YAML.withStr "whose" readWhose +instance FromYAML ArtistFilter where + parseYAML = YAML.withStr "artist filter" readArtistFilter data IndexInfo = diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal index 2d915df..ad93ad7 100644 --- a/make-pages/make-pages.cabal +++ b/make-pages/make-pages.cabal @@ -52,7 +52,8 @@ executable make-pages optparse-applicative ^>= 0.15.1.0, template-haskell ^>= 2.16.0.0, text ^>= 1.2.3.1, - time >= 1.8.0.2 && < 1.10 + time >= 1.8.0.2 && < 1.10, + unordered-containers ^>= 0.2.11.0 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N if flag(pretty-verbose)