support initially-hidden tags
This commit is contained in:
parent
28fc9db3e0
commit
e8bd20c896
3 changed files with 26 additions and 13 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
Loading…
Reference in a new issue