remove TransformListComp which panics in ghc ≥ 9.6
This commit is contained in:
parent
6554dfd54c
commit
61fd58413f
3 changed files with 24 additions and 17 deletions
|
@ -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>
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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,
|
||||||
|
|
Loading…
Reference in a new issue