remove TransformListComp which panics in ghc ≥ 9.6

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
     <li$hidden>

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

make-pages/make-pages.cabal

@@ -58,7 +58,6 @@ executable make-pages
     MultiParamTypeClasses,
     ScopedTypeVariables,
     TemplateHaskell,
-    TransformListComp,
     TypeApplications
   build-depends:
     base                 ^>= 4.16.4,