add tag filters and refactor others

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

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

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,
+    nsfw  :: !NsfwFilter,
-    whose :: Whose
+    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
+data ArtistFilter = Me | NotMe | AllW deriving (Eq, Show)
-matchNsfw Nothing     _ = True
-matchNsfw (Just nsfw) i = #allNsfw i == nsfw
 
-readWhose :: (IsString str, Eq str, Alternative f) => str -> f Whose
+readArtistFilter :: (IsString str, Eq str, Alternative f)
-readWhose "mine"     = pure Mine
+                 => str -> f ArtistFilter
-readWhose "not-mine" = pure NotMine
+readArtistFilter "me"     = pure Me
-readWhose "all"      = pure All
+readArtistFilter "not-me" = pure NotMe
-readWhose _          = empty
+readArtistFilter "all"    = pure AllW
+readArtistFilter _        = empty
 
-matchWhose :: Whose -> Info -> Bool
+matchArtist :: ArtistFilter -> Info -> Bool
-matchWhose Mine    = #mine
+matchArtist Me    = #mine
-matchWhose NotMine = #notMine
+matchArtist NotMe = #notMine
-matchWhose All     = const True
+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 =
+matchFilters (GalleryFilters {nsfw, artist, require, exclude}) i =
-  matchNsfw nsfw i && matchWhose whose 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"
+    GalleryFilters <$> m .:? "nsfw"    .!= AllN
-                   <*> m .:? "whose" .!= All
+                   <*> 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 =

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)