From 61fd58413fea4bdde8c4ae8bc1e42fdb76df8d52 Mon Sep 17 00:00:00 2001 From: rhiannon morris Date: Sun, 7 Jul 2024 16:22:14 +0200 Subject: [PATCH] =?UTF-8?q?remove=20TransformListComp=20which=20panics=20i?= =?UTF-8?q?n=20ghc=20=E2=89=A5=209.6?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- make-pages/GalleryPage.hs | 30 ++++++++++++++++-------------- make-pages/Info.hs | 10 ++++++++-- make-pages/make-pages.cabal | 1 - 3 files changed, 24 insertions(+), 17 deletions(-) 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 diff --git a/make-pages/Info.hs b/make-pages/Info.hs index 0677ca0..4003137 100644 --- a/make-pages/Info.hs +++ b/make-pages/Info.hs @@ -4,7 +4,7 @@ module Info (Info (..), tagsFor, descFor, imagesFor, linksFor, updatesFor, lastUpdate, - compareFor, sortFor, + CompareKey (..), compareKeyFor, compareFor, sortFor, Artist (..), Images' (..), Images, Image (..), Desc (..), DescField (..), Link (..), Update (..), Bg (..), GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..), @@ -225,8 +225,14 @@ lastUpdate :: Bool -> Info -> Maybe Date lastUpdate nsfw info = case updatesFor nsfw info of [] -> Nothing; us -> Just $ fst $ last us +data CompareKey = MkCompareKey !Date !Text !Text + deriving (Eq, Ord) + +compareKeyFor :: Bool -> Info -> CompareKey +compareKeyFor nsfw i = MkCompareKey (#latestDate i nsfw) (#sortEx i) (#title i) + compareFor :: Bool -> Info -> Info -> Ordering -compareFor nsfw = comparing \i -> (#latestDate i nsfw, #sortEx i, #title i) +compareFor nsfw = comparing $ compareKeyFor nsfw sortFor :: Bool -> [Info] -> [Info] sortFor = sortBy . compareFor diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal index 20799ab..0f50ecf 100644 --- a/make-pages/make-pages.cabal +++ b/make-pages/make-pages.cabal @@ -58,7 +58,6 @@ executable make-pages MultiParamTypeClasses, ScopedTypeVariables, TemplateHaskell, - TransformListComp, TypeApplications build-depends: base ^>= 4.16.4,