rhi/gallery
1
0
Fork 0
Code Issues 5 Pull requests 1 Releases Wiki Activity

support initially-hidden tags

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

20
make-pages/GalleryPage.hs
View file

@ -5,6 +5,8 @@ import Control.Exception
import Data.Foldable import Data.Foldable
import Data.Function (on, (&)) import Data.Function (on, (&))
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List (intersperse, groupBy, sortOn) import Data.List (intersperse, groupBy, sortOn)
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import System.FilePath ((</>), takeDirectory, joinPath, splitPath) import System.FilePath ((</>), takeDirectory, joinPath, splitPath)
@ -23,7 +25,7 @@ make ginfo infos = toLazyText $ make' ginfo infos
make' :: GalleryInfo -> [(FilePath, Info)] -> Builder make' :: GalleryInfo -> [(FilePath, Info)] -> Builder
make' (GalleryInfo {title, prefix, filters}) infos = [b|@0 make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
<!DOCTYPE html> <!DOCTYPE html>
<html lang=en> <html lang=en>
<meta charset=utf-8> <meta charset=utf-8>
@ -89,18 +91,22 @@ make' (GalleryInfo {title, prefix, filters}) infos = [b|@0
& concatMap (map (,1) . tagsFor nsfw . #second) & concatMap (map (,1) . tagsFor nsfw . #second)
& HashMap.fromListWith (+) & HashMap.toList & HashMap.fromListWith (+) & HashMap.toList
& sortOn (\(tag, count) -> (Down count, tag)) & 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 nsfw = #nsfw filters /= NoNsfw
makeFilter :: Text -> Text -> Int -> Builder makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder
makeFilter prefix tag count = [b|@8 makeFilter prefix initial tag _count = [b|@8
<li> <li>
<input type=checkbox id="$id'" value="$*tag"> <input type=checkbox id="$id'" value="$*tag"$checked>
<label for="$id'">$*tag</label> <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 makeYearItems :: Bool -- ^ nsfw
-> Integer -- ^ year -> Integer -- ^ year

18
make-pages/Info.hs
View file

@ -13,6 +13,8 @@ import Records
import Control.Applicative import Control.Applicative
import Data.Foldable (find) import Data.Foldable (find)
import Data.Hashable (Hashable)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet import qualified Data.HashSet as HashSet
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, isNothing, fromMaybe) import Data.Maybe (isJust, isNothing, fromMaybe)
@ -175,7 +177,8 @@ data GalleryInfo =
title :: !Text, title :: !Text,
desc :: !Text, desc :: !Text,
prefix :: !FilePath, prefix :: !FilePath,
filters :: !GalleryFilters filters :: !GalleryFilters,
hidden :: !(HashSet Text) -- ^ tags to initially hide
} }
deriving (Eq, Show) deriving (Eq, Show)
@ -183,7 +186,7 @@ data GalleryFilters =
GalleryFilters { GalleryFilters {
nsfw :: !NsfwFilter, nsfw :: !NsfwFilter,
artist :: !ArtistFilter, artist :: !ArtistFilter,
require, exclude :: ![Text] require, exclude :: !(HashSet Text)
} }
deriving (Eq, Show) deriving (Eq, Show)
@ -225,10 +228,9 @@ noFilters =
matchFilters :: GalleryFilters -> Info -> Bool matchFilters :: GalleryFilters -> Info -> Bool
matchFilters (GalleryFilters {nsfw, artist, require, exclude}) i = matchFilters (GalleryFilters {nsfw, artist, require, exclude}) i =
matchNsfw nsfw i && matchArtist artist i && matchNsfw nsfw i && matchArtist artist i &&
all (∊ tags) require && all (∉ tags) exclude all (\t -> HashSet.member t tags) require &&
where all (\t -> not $ HashSet.member t tags) exclude
tags = HashSet.fromList $ #tags i where tags = HashSet.fromList $ #tags i
(∊) = HashSet.member; x ∉ xs = not $ x ∊ xs
instance FromYAML GalleryInfo where instance FromYAML GalleryInfo where
@ -237,6 +239,7 @@ instance FromYAML GalleryInfo where
<*> m .: "desc" <*> m .: "desc"
<*> m .: "prefix" <*> m .: "prefix"
<*> m .:? "filters" .!= noFilters <*> m .:? "filters" .!= noFilters
<*> m .:? "hidden" .!= mempty
instance FromYAML GalleryFilters where instance FromYAML GalleryFilters where
parseYAML = YAML.withMap "gallery filters" \m -> parseYAML = YAML.withMap "gallery filters" \m ->
@ -283,3 +286,6 @@ instance FromYAML Day where
instance {-# OVERLAPPING #-} FromYAML String where instance {-# OVERLAPPING #-} FromYAML String where
parseYAML y = Text.unpack <$> parseYAML y parseYAML y = Text.unpack <$> parseYAML y
instance (FromYAML a, Eq a, Hashable a) => FromYAML (HashSet a) where
parseYAML y = HashSet.fromList <$> parseYAML y

1
make-pages/make-pages.cabal
View file

@ -58,6 +58,7 @@ executable make-pages
containers ^>= 0.6.0.1, containers ^>= 0.6.0.1,
filemanip ^>= 0.3.6.3, filemanip ^>= 0.3.6.3,
filepath ^>= 1.4.2.1, filepath ^>= 1.4.2.1,
hashable ^>= 1.3.0.0,
HsYAML ^>= 0.2.1.0, HsYAML ^>= 0.2.1.0,
optparse-applicative ^>= 0.15.1.0, optparse-applicative ^>= 0.15.1.0,
template-haskell ^>= 2.16.0.0, template-haskell ^>= 2.16.0.0,