support initially-hidden tags

This commit is contained in:
Rhiannon Morris 2020-08-04 02:27:19 +02:00
parent 28fc9db3e0
commit e8bd20c896
3 changed files with 26 additions and 13 deletions

View File

@ -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
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
@ -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
<li>
<input type=checkbox id="$id'" value="$*tag">
<input type=checkbox id="$id'" value="$*tag"$checked>
<label for="$id'">$*tag</label>
|]
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

View File

@ -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

View File

@ -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,