remove TransformListComp which panics in ghc ≥ 9.6

This commit is contained in:
rhiannon morris 2024-07-07 16:22:14 +02:00
parent 6554dfd54c
commit 61fd58413f
3 changed files with 24 additions and 17 deletions

View file

@ -1,4 +1,3 @@
{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where module GalleryPage (make) where
import BuilderQQ import BuilderQQ
@ -8,15 +7,15 @@ import qualified NsfwWarning
import Control.Monad import Control.Monad
import Data.Foldable import Data.Foldable
import Data.Function (on, (&)) import Data.Function ((&))
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet) import Data.HashSet (HashSet)
import qualified Data.HashSet as 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.Maybe
import Data.Ord (Down (..))
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)
make :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text make :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make root ginfo infos = toLazyText $ make' root ginfo infos 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 where
items = map (uncurry $ makeYearItems nsfw) infosByYear items = map (uncurry $ makeYearItems nsfw) infosByYear
infosByYear = infosByYear :: [(Int, [(FilePath, Info)])]
[(the year, infopath) | infosByYear = infos &
infopath@(_, info) <- infos, filter (not . #unlisted . snd) &
not $ #unlisted info, sortOn (Down . compareKeyFor nsfw . snd) &
then sortInfo by info, groupOnKey (\(_, i) -> #latestYear i nsfw)
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)
undir = joinPath (replicate (length (splitPath prefix)) "..") 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|] url = [b|$root/$prefix|]
imagepath0 imagepath0
| (_, (p0, i0) : _) : _ <- infosByYear = getThumb (takeDirectory p0) i0 | (_, (p, i) : _) : _ <- infosByYear = getThumb (takeDirectory p) i
| otherwise = "/style/card.png" | otherwise = "/style/card.png"
nsfw' = NsfwWarning.Gallery <$ guard nsfw nsfw' = NsfwWarning.Gallery <$ guard nsfw
nsfwScript = NsfwWarning.script nsfw' nsfwScript = NsfwWarning.script nsfw'
nsfwDialog = NsfwWarning.dialog 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 :: Text -> HashSet Text -> Text -> Int -> Builder
makeFilter prefix initial tag count = [b|@0 makeFilter prefix initial tag count = [b|@0
<li$hidden> <li$hidden>

View file

@ -4,7 +4,7 @@
module Info module Info
(Info (..), (Info (..),
tagsFor, descFor, imagesFor, linksFor, updatesFor, lastUpdate, tagsFor, descFor, imagesFor, linksFor, updatesFor, lastUpdate,
compareFor, sortFor, CompareKey (..), compareKeyFor, compareFor, sortFor,
Artist (..), Images' (..), Images, Image (..), Desc (..), DescField (..), Artist (..), Images' (..), Images, Image (..), Desc (..), DescField (..),
Link (..), Update (..), Bg (..), Link (..), Update (..), Bg (..),
GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..), GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..),
@ -225,8 +225,14 @@ lastUpdate :: Bool -> Info -> Maybe Date
lastUpdate nsfw info = lastUpdate nsfw info =
case updatesFor nsfw info of [] -> Nothing; us -> Just $ fst $ last us 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 :: 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 :: Bool -> [Info] -> [Info]
sortFor = sortBy . compareFor sortFor = sortBy . compareFor

View file

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