diff --git a/make-pages/GalleryPage.hs b/make-pages/GalleryPage.hs index 5331e21..fd7b370 100644 --- a/make-pages/GalleryPage.hs +++ b/make-pages/GalleryPage.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TransformListComp #-} module GalleryPage (make) where import BuilderQQ @@ -8,15 +7,15 @@ import qualified NsfwWarning import Control.Monad import Data.Foldable -import Data.Function (on, (&)) +import Data.Function ((&)) import qualified Data.HashMap.Strict as HashMap import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet -import Data.List (intersperse, groupBy, sortBy, sort) +import Data.List (intersperse, sort, sortOn) import Data.Maybe +import Data.Ord (Down (..)) import qualified Data.Text.Lazy as Lazy import System.FilePath (takeDirectory, joinPath, splitPath) -import GHC.Exts (Down (..), the) make :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text make root ginfo infos = toLazyText $ make' root ginfo infos @@ -90,15 +89,11 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0 where items = map (uncurry $ makeYearItems nsfw) infosByYear - infosByYear = - [(the year, infopath) | - infopath@(_, info) <- infos, - not $ #unlisted info, - then sortInfo by info, - let year = #latestYear info nsfw, - then group by Down year using groupBy'] - sortInfo f = sortBy $ flip (compareFor nsfw `on` f) - groupBy' f = groupBy ((==) `on` f) + infosByYear :: [(Int, [(FilePath, Info)])] + infosByYear = infos & + filter (not . #unlisted . snd) & + sortOn (Down . compareKeyFor nsfw . snd) & + groupOnKey (\(_, i) -> #latestYear i nsfw) undir = joinPath (replicate (length (splitPath prefix)) "..") @@ -114,13 +109,20 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0 url = [b|$root/$prefix|] imagepath0 - | (_, (p0, i0) : _) : _ <- infosByYear = getThumb (takeDirectory p0) i0 + | (_, (p₀, i₀) : _) : _ <- infosByYear = getThumb (takeDirectory p₀) i₀ | otherwise = "/style/card.png" nsfw' = NsfwWarning.Gallery <$ guard nsfw nsfwScript = NsfwWarning.script nsfw' nsfwDialog = NsfwWarning.dialog nsfw' +-- from @extra@ +groupOnKey :: Eq k => (a -> k) -> [a] -> [(k, [a])] +groupOnKey _ [] = [] +groupOnKey f (x:xs) = (fx, x:yes) : groupOnKey f no where + fx = f x + (yes, no) = span (\y -> fx == f y) xs + makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder makeFilter prefix initial tag count = [b|@0