add tags to gallery items

This commit is contained in:
Rhiannon Morris 2020-08-03 23:07:59 +02:00
parent 1b7f8e9af3
commit 3c77492294

View file

@ -2,8 +2,10 @@
module GalleryPage (make) where module GalleryPage (make) where
import Control.Exception import Control.Exception
import Data.Foldable
import Data.Function (on, (&)) import Data.Function (on, (&))
import Data.List (sortOn, groupBy) import qualified Data.HashMap.Strict as HashMap
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)
import GHC.Exts (Down (..), the) import GHC.Exts (Down (..), the)
@ -61,6 +63,12 @@ make' title prefix nsfw infos = [b|@0
then group by Down year using groupBy'] then group by Down year using groupBy']
groupBy' f = groupBy ((==) `on` f) groupBy' f = groupBy ((==) `on` f)
undir = joinPath (replicate (length (splitPath prefix)) "..") undir = joinPath (replicate (length (splitPath prefix)) "..")
allTags = infos
& 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
makeYearItems :: Bool -- ^ nsfw makeYearItems :: Bool -- ^ nsfw
-> Integer -- ^ year -> Integer -- ^ year
@ -77,7 +85,7 @@ makeYearItems nsfw year infos = [b|@4
makeItem :: Bool -> FilePath -> Info -> Builder makeItem :: Bool -> FilePath -> Info -> Builder
makeItem nsfw file info@(Info {title}) = [b|@4 makeItem nsfw file info@(Info {title}) = [b|@4
<li class="item post$nsfw'"> <li class="item post$nsfw'" data-tags="$tags'">
<figure> <figure>
<a href="$@dir"> <a href="$@dir">
<img src="$@thumb"> <img src="$@thumb">
@ -89,3 +97,4 @@ makeItem nsfw file info@(Info {title}) = [b|@4
dir = takeDirectory file dir = takeDirectory file
thumb = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) $ #thumb info thumb = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) $ #thumb info
nsfw' = if nsfw && #anyNsfw info then " nsfw" else "" nsfw' = if nsfw && #anyNsfw info then " nsfw" else ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info