diff --git a/patches/HTTP-4000.3.15.patch b/patches/HTTP-4000.3.15.patch deleted file mode 100644 index d7601f91cf9a6d462aab0f8d529ef872a2dca569..0000000000000000000000000000000000000000 --- a/patches/HTTP-4000.3.15.patch +++ /dev/null @@ -1,13 +0,0 @@ -diff --git a/Network/TCP.hs b/Network/TCP.hs -index 6f20319..ce01117 100644 ---- a/Network/TCP.hs -+++ b/Network/TCP.hs -@@ -89,7 +89,7 @@ instance Eq EndPoint where - map toLower host1 == map toLower host2 && port1 == port2 - - data Conn a -- = MkConn { connSock :: ! Socket -+ = MkConn { connSock :: !Socket - , connHandle :: Handle - , connBuffer :: BufferOp a - , connInput :: Maybe a diff --git a/patches/bifunctors-5.5.10.patch b/patches/bifunctors-5.5.10.patch index b90913c61a1ab906dacf3b3c1c9e70544c55d22a..f520ba47c38a9228a3764374c2d5b8278302dcef 100644 --- a/patches/bifunctors-5.5.10.patch +++ b/patches/bifunctors-5.5.10.patch @@ -1,29 +1,27 @@ diff --git a/src/Data/Bifunctor/TH.hs b/src/Data/Bifunctor/TH.hs -index 6545db1..f817ec7 100644 +index 6545db1..41f77ea 100644 --- a/src/Data/Bifunctor/TH.hs +++ b/src/Data/Bifunctor/TH.hs -@@ -1252,7 +1252,12 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp) +@@ -1252,7 +1252,11 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp) -> Q Match mkSimpleConMatch fold conName insides = do varsNeeded <- newNameList "_arg" $ length insides - let pat = ConP conName (map VarP varsNeeded) + let pat = ConP conName -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (map VarP varsNeeded) rhs <- fold conName (zipWith (\i v -> i $ VarE v) insides varsNeeded) return $ Match pat (NormalB rhs) [] -@@ -1276,7 +1281,12 @@ mkSimpleConMatch2 :: (Exp -> [Exp] -> Q Exp) +@@ -1276,7 +1280,11 @@ mkSimpleConMatch2 :: (Exp -> [Exp] -> Q Exp) -> Q Match mkSimpleConMatch2 fold conName insides = do varsNeeded <- newNameList "_arg" lengthInsides - let pat = ConP conName (map VarP varsNeeded) + let pat = ConP conName -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (map VarP varsNeeded) diff --git a/patches/boomerang-1.4.6.patch b/patches/boomerang-1.4.6.patch deleted file mode 100644 index bbee64e28b330ac839c861893c93242d45e6c42a..0000000000000000000000000000000000000000 --- a/patches/boomerang-1.4.6.patch +++ /dev/null @@ -1,57 +0,0 @@ -diff --git a/Text/Boomerang/TH.hs b/Text/Boomerang/TH.hs -index 8a635da..d9020fb 100644 ---- a/Text/Boomerang/TH.hs -+++ b/Text/Boomerang/TH.hs -@@ -41,7 +41,7 @@ derivePrinterParsers = makeBoomerangs - {-# DEPRECATED derivePrinterParsers "Use makeBoomerangs instead" #-} - - -- Derive a router for a single constructor. --deriveBoomerang :: (Name, [TyVarBndr]) -> Con -> Q [Dec] -+deriveBoomerang :: (Name, [TyVarBndrUnit]) -> Con -> Q [Dec] - deriveBoomerang (tName, tParams) con = - case con of - NormalC name tys -> go name (map snd tys) -@@ -50,8 +50,8 @@ deriveBoomerang (tName, tParams) con = - runIO $ putStrLn $ "Skipping unsupported constructor " ++ show (conName con) - return [] - where -- takeName (PlainTV n) = n -- takeName (KindedTV n _) = n -+ takeName (PlainTV n _) = n -+ takeName (KindedTV n _ _) = n - go name tys = do - let name' = mkBoomerangName name - let tok' = mkName "tok" -@@ -66,7 +66,7 @@ deriveBoomerang (tName, tParams) con = - expr <- [| xpure $(deriveConstructor name (length tys)) - $(deriveDestructor name tys) |] - return [ SigD name' -- (ForallT (map PlainTV ([tok', e', r'] ++ (map takeName tParams))) -+ (ForallT (map (`PlainTV` SpecifiedSpec) ([tok', e', r'] ++ (map takeName tParams))) - [] - (AppT (AppT ppType inT) outT)) - , FunD name' [Clause [] (NormalB expr) []] -@@ -98,13 +98,21 @@ deriveDestructor name tys = do - ConE cons <- [| (:-) |] - - -- let conPat = ConP name (map VarP fieldNames) -+ let conPat = ConP name -+#if __GLASGOW_HASKELL__ >= 901 -+ [] -+#endif -+ (map VarP fieldNames) - let okBody = ConE just `AppE` - foldr - (\h t -> ConE cons `AppE` VarE h `AppE` t) - (VarE r) - fieldNames -- let okCase = Match (ConP cons [conPat, VarP r]) (NormalB okBody) [] -+ let okCase = Match (ConP cons -+#if __GLASGOW_HASKELL__ >= 901 -+ [] -+#endif -+ [conPat, VarP r]) (NormalB okBody) [] - let nStr = show name - let failCase = Match WildP (NormalB nothing) [] - diff --git a/patches/boomerang-1.4.7.patch b/patches/boomerang-1.4.7.patch new file mode 100644 index 0000000000000000000000000000000000000000..a116230cc91e6ba0b8350ed17c99da992fbd8ea4 --- /dev/null +++ b/patches/boomerang-1.4.7.patch @@ -0,0 +1,28 @@ +diff --git a/Text/Boomerang/TH.hs b/Text/Boomerang/TH.hs +index 629d1f2..f7dadd6 100644 +--- a/Text/Boomerang/TH.hs ++++ b/Text/Boomerang/TH.hs +@@ -97,13 +97,21 @@ deriveDestructor name tys = do + ConE cons <- [| (:-) |] + + +- let conPat = ConP name (map VarP fieldNames) ++ let conPat = ConP name ++#if __GLASGOW_HASKELL__ >= 901 ++ [] ++#endif ++ (map VarP fieldNames) + let okBody = ConE just `AppE` + foldr + (\h t -> ConE cons `AppE` VarE h `AppE` t) + (VarE r) + fieldNames +- let okCase = Match (ConP cons [conPat, VarP r]) (NormalB okBody) [] ++ let okCase = Match (ConP cons ++#if __GLASGOW_HASKELL__ >= 901 ++ [] ++#endif ++ [conPat, VarP r]) (NormalB okBody) [] + let nStr = show name + let failCase = Match WildP (NormalB nothing) [] + diff --git a/patches/bound-2.0.3.patch b/patches/bound-2.0.3.patch index 98e7311bd72b2c557c663a023a2b4e6b81153e1f..da8b858e82e05dd951ae1d7005690a48f3d705c0 100644 --- a/patches/bound-2.0.3.patch +++ b/patches/bound-2.0.3.patch @@ -1,15 +1,14 @@ diff --git a/src/Bound/TH.hs b/src/Bound/TH.hs -index c4a9255..83253cf 100644 +index c4a9255..faced54 100644 --- a/src/Bound/TH.hs +++ b/src/Bound/TH.hs -@@ -318,7 +318,12 @@ interpret bnds = do +@@ -318,7 +318,11 @@ interpret bnds = do exprs <- foldM bindOne (ConE name) bounds pure $ Match - (ConP name [ VarP arg | (arg, _) <- bounds ]) + (ConP name -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + [ VarP arg | (arg, _) <- bounds ]) diff --git a/patches/constraints-extras-0.3.0.2.patch b/patches/constraints-extras-0.3.0.2.patch index e97fe13dd43baf1315001cc7a872ec20567890a3..5d61b2f63e26491924a618ef099eec3e2af668a8 100644 --- a/patches/constraints-extras-0.3.0.2.patch +++ b/patches/constraints-extras-0.3.0.2.patch @@ -34,7 +34,7 @@ index 029e5a8..0e8c49c 100644 main-is: README.lhs ghc-options: -Wall -optL -q diff --git a/src/Data/Constraint/Extras/TH.hs b/src/Data/Constraint/Extras/TH.hs -index 148ff3e..45179d4 100644 +index 148ff3e..52b2ec3 100644 --- a/src/Data/Constraint/Extras/TH.hs +++ b/src/Data/Constraint/Extras/TH.hs @@ -1,3 +1,4 @@ @@ -42,14 +42,13 @@ index 148ff3e..45179d4 100644 {-# LANGUAGE LambdaCase #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} -@@ -55,7 +56,12 @@ matches c n argDictName = do +@@ -55,7 +56,11 @@ matches c n argDictName = do Nothing -> WildP : rest done Just _ -> VarP v : rest True pat = foldr patf (const []) ps False - in [Match (ConP name pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []] + in [Match (ConP name -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []] diff --git a/patches/cql-4.0.3.patch b/patches/cql-4.0.3.patch index a6413a9feb8061e6c85089c6d2df423249bebc54..87c2f1883d3c0556daeceed499b7a51c312f35ae 100644 --- a/patches/cql-4.0.3.patch +++ b/patches/cql-4.0.3.patch @@ -1,16 +1,15 @@ diff --git a/src/Database/CQL/Protocol/Record.hs b/src/Database/CQL/Protocol/Record.hs -index 266501a..8c84f54 100644 +index 266501a..1ea7db3 100644 --- a/src/Database/CQL/Protocol/Record.hs +++ b/src/Database/CQL/Protocol/Record.hs -@@ -91,8 +91,17 @@ asTupleDecl c = +@@ -91,8 +91,16 @@ asTupleDecl c = where go n t = do vars <- replicateM (length t) (newName "a") - return $ Clause [ConP n (map VarP vars)] (body vars) [] - body = NormalB . mkTup . map VarE + return $ Clause [ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (map VarP vars)] (body vars) [] @@ -23,7 +22,7 @@ index 266501a..8c84f54 100644 asRecrdDecl ::Con -> Q Clause asRecrdDecl c = diff --git a/src/Database/CQL/Protocol/Tuple/TH.hs b/src/Database/CQL/Protocol/Tuple/TH.hs -index 26a179f..c381b8e 100644 +index 26a179f..ab43ff2 100644 --- a/src/Database/CQL/Protocol/Tuple/TH.hs +++ b/src/Database/CQL/Protocol/Tuple/TH.hs @@ -72,7 +72,11 @@ storeDecl n = do @@ -39,14 +38,13 @@ index 26a179f..c381b8e 100644 size = var "put" $$ SigE (litInt n) (tcon "Word16") value x v = var "putValue" $$ VarE x $$ (var "toCql" $$ VarE v) -@@ -117,7 +121,12 @@ cqlInstances n = do +@@ -117,7 +121,11 @@ cqlInstances n = do Clause [VarP (mkName "t")] (NormalB $ CaseE (var "t") - [ Match (ParensP (ConP (mkName "CqlTuple") [ListP (map VarP names)])) + [ Match (ParensP (ConP (mkName "CqlTuple") -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + [ListP (map VarP names)])) diff --git a/patches/cryptonite-0.27.patch b/patches/cryptonite-0.27.patch deleted file mode 100644 index 0c376a918d87e4a7643e1955038b5b818d70a6b3..0000000000000000000000000000000000000000 --- a/patches/cryptonite-0.27.patch +++ /dev/null @@ -1,165 +0,0 @@ -diff --git a/Crypto/Internal/WordArray.hs b/Crypto/Internal/WordArray.hs -index 0f3c0f6..349be6c 100644 ---- a/Crypto/Internal/WordArray.hs -+++ b/Crypto/Internal/WordArray.hs -@@ -10,6 +10,7 @@ - -- - -- The array produced should never be exposed to the user directly. - -- -+{-# LANGUAGE CPP #-} - {-# LANGUAGE BangPatterns #-} - {-# LANGUAGE MagicHash #-} - {-# LANGUAGE UnboxedTuples #-} -@@ -114,7 +115,7 @@ mutableArray32FromAddrBE (I# n) a = IO $ \s -> - loop i st mb - | booleanPrim (i ==# n) = (# st, MutableArray32 mb #) - | otherwise = -- let !st' = writeWord32Array# mb i (be32Prim (indexWord32OffAddr# a i)) st -+ let !st' = writeWord32Array# mb i (wordToWord32Compat# (be32Prim (word32ToWordCompat# (indexWord32OffAddr# a i)))) st - in loop (i +# 1#) st' mb - - -- | freeze a Mutable Array of Word32 into a immutable Array of Word32 -@@ -155,3 +156,17 @@ mutableArrayWriteXor32 :: MutableArray32 -> Int -> Word32 -> IO () - mutableArrayWriteXor32 m o w = - mutableArrayRead32 m o >>= \wOld -> mutableArrayWrite32 m o (wOld `xor` w) - {-# INLINE mutableArrayWriteXor32 #-} -+ -+#if MIN_VERSION_base(4,16,0) -+word32ToWordCompat# :: Word32# -> Word# -+word32ToWordCompat# = word32ToWord# -+ -+wordToWord32Compat# :: Word# -> Word32# -+wordToWord32Compat# = wordToWord32# -+#else -+word32ToWordCompat# :: Word# -> Word# -+word32ToWordCompat# x = x -+ -+wordToWord32Compat# :: Word# -> Word# -+wordToWord32Compat# x = x -+#endif -diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs -index e624b42..253b222 100644 ---- a/Crypto/Number/Basic.hs -+++ b/Crypto/Number/Basic.hs -@@ -100,6 +100,7 @@ numBits n = gmpSizeInBits n `onGmpUnsupported` (if n == 0 then 1 else computeBit - - -- | Compute the number of bytes for an integer - numBytes :: Integer -> Int -+numBytes 0 = 1 - numBytes n = gmpSizeInBytes n `onGmpUnsupported` ((numBits n + 7) `div` 8) - - -- | Express an integer as an odd number and a power of 2 -diff --git a/Crypto/Number/Compat.hs b/Crypto/Number/Compat.hs -index 01e0455..4ebb9cb 100644 ---- a/Crypto/Number/Compat.hs -+++ b/Crypto/Number/Compat.hs -@@ -51,7 +51,9 @@ onGmpUnsupported GmpUnsupported f = f - - -- | Compute the GCDE of a two integer through GMP - gmpGcde :: Integer -> Integer -> GmpSupported (Integer, Integer, Integer) --#if MIN_VERSION_integer_gmp(0,5,1) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpGcde _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(0,5,1) - gmpGcde a b = - GmpSupported (s, t, g) - where (# g, s #) = gcdExtInteger a b -@@ -72,7 +74,9 @@ gmpLog2 _ = GmpUnsupported - -- | Compute the power modulus using extra security to remain constant - -- time wise through GMP - gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer --#if MIN_VERSION_integer_gmp(1,0,2) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpPowModSecInteger _ _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(1,0,2) - gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m) - #elif MIN_VERSION_integer_gmp(1,0,0) - gmpPowModSecInteger _ _ _ = GmpUnsupported -@@ -84,7 +88,9 @@ gmpPowModSecInteger _ _ _ = GmpUnsupported - - -- | Compute the power modulus through GMP - gmpPowModInteger :: Integer -> Integer -> Integer -> GmpSupported Integer --#if MIN_VERSION_integer_gmp(0,5,1) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpPowModInteger _ _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(0,5,1) - gmpPowModInteger b e m = GmpSupported (powModInteger b e m) - #else - gmpPowModInteger _ _ _ = GmpUnsupported -@@ -92,7 +98,9 @@ gmpPowModInteger _ _ _ = GmpUnsupported - - -- | Inverse modulus of a number through GMP - gmpInverse :: Integer -> Integer -> GmpSupported (Maybe Integer) --#if MIN_VERSION_integer_gmp(0,5,1) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpInverse _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(0,5,1) - gmpInverse g m - | r == 0 = GmpSupported Nothing - | otherwise = GmpSupported (Just r) -@@ -103,7 +111,9 @@ gmpInverse _ _ = GmpUnsupported - - -- | Get the next prime from a specific value through GMP - gmpNextPrime :: Integer -> GmpSupported Integer --#if MIN_VERSION_integer_gmp(0,5,1) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpNextPrime _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(0,5,1) - gmpNextPrime n = GmpSupported (nextPrimeInteger n) - #else - gmpNextPrime _ = GmpUnsupported -@@ -111,7 +121,9 @@ gmpNextPrime _ = GmpUnsupported - - -- | Test if a number is prime using Miller Rabin - gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool --#if MIN_VERSION_integer_gmp(0,5,1) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpTestPrimeMillerRabin _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(0,5,1) - gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $ - case testPrimeInteger n tries of - 0# -> False -@@ -138,7 +150,9 @@ gmpSizeInBits _ = GmpUnsupported - - -- | Export an integer to a memory (big-endian) - gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ()) --#if MIN_VERSION_integer_gmp(1,0,0) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpExportInteger _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(1,0,0) - gmpExportInteger n (Ptr addr) = GmpSupported $ do - _ <- exportIntegerToAddr n addr 1# - return () -@@ -152,7 +166,9 @@ gmpExportInteger _ _ = GmpUnsupported - - -- | Export an integer to a memory (little-endian) - gmpExportIntegerLE :: Integer -> Ptr Word8 -> GmpSupported (IO ()) --#if MIN_VERSION_integer_gmp(1,0,0) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpExportIntegerLE _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(1,0,0) - gmpExportIntegerLE n (Ptr addr) = GmpSupported $ do - _ <- exportIntegerToAddr n addr 0# - return () -@@ -166,7 +182,9 @@ gmpExportIntegerLE _ _ = GmpUnsupported - - -- | Import an integer from a memory (big-endian) - gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer) --#if MIN_VERSION_integer_gmp(1,0,0) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpImportInteger _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(1,0,0) - gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ - importIntegerFromAddr addr (int2Word# n) 1# - #elif MIN_VERSION_integer_gmp(0,5,1) -@@ -178,7 +196,9 @@ gmpImportInteger _ _ = GmpUnsupported - - -- | Import an integer from a memory (little-endian) - gmpImportIntegerLE :: Int -> Ptr Word8 -> GmpSupported (IO Integer) --#if MIN_VERSION_integer_gmp(1,0,0) -+#if MIN_VERSION_integer_gmp(1,1,0) -+gmpImportIntegerLE _ _ = GmpUnsupported -+#elif MIN_VERSION_integer_gmp(1,0,0) - gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $ - importIntegerFromAddr addr (int2Word# n) 0# - #elif MIN_VERSION_integer_gmp(0,5,1) diff --git a/patches/data-dword-0.3.2.patch b/patches/data-dword-0.3.2.patch index 970d74340b4bcbb103cf58dde71fc8f0831179f5..e3e00f3823a91fb1c49f217b1aad2ffb858b5fba 100644 --- a/patches/data-dword-0.3.2.patch +++ b/patches/data-dword-0.3.2.patch @@ -1,5 +1,5 @@ diff --git a/src/Data/DoubleWord/TH.hs b/src/Data/DoubleWord/TH.hs -index 78bbfa9..99beec4 100644 +index 78bbfa9..24f93e1 100644 --- a/src/Data/DoubleWord/TH.hs +++ b/src/Data/DoubleWord/TH.hs @@ -157,7 +157,7 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $ @@ -176,14 +176,13 @@ index 78bbfa9..99beec4 100644 (NormalB e) []] match' p e ds = Match p (NormalB e) ds match p e = match' p e [] -@@ -1565,3 +1565,10 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $ +@@ -1565,3 +1565,9 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $ | ConT ut == t = Just ts | otherwise = smallerStdTypes' t ts +conPCompat :: Name -> [Pat] -> Pat +conPCompat n pats = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats diff --git a/patches/deriving-compat-0.5.10.patch b/patches/deriving-compat-0.5.10.patch index 47e304caa9c5873c2ef07157a28a2b189ad6a1fb..553c576179f37a15d46a280935db30b5bd3846d0 100644 --- a/patches/deriving-compat-0.5.10.patch +++ b/patches/deriving-compat-0.5.10.patch @@ -1,5 +1,91 @@ +diff --git a/src/Data/Deriving/Internal.hs b/src/Data/Deriving/Internal.hs +index 3c1e37b..2a89bbc 100644 +--- a/src/Data/Deriving/Internal.hs ++++ b/src/Data/Deriving/Internal.hs +@@ -2146,16 +2146,36 @@ eqWord16HashValName :: Name + eqWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "eqWord16#" + + extendInt8HashValName :: Name +-extendInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendInt8#" ++extendInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" ++# if MIN_VERSION_base(4,16,0) ++ "int8ToInt#" ++# else ++ "extendInt8#" ++# endif + + extendInt16HashValName :: Name +-extendInt16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendInt16#" ++extendInt16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" ++# if MIN_VERSION_base(4,16,0) ++ "int16ToInt#" ++# else ++ "extendInt16#" ++# endif + + extendWord8HashValName :: Name +-extendWord8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendWord8#" ++extendWord8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" ++# if MIN_VERSION_base(4,16,0) ++ "word8ToWord#" ++# else ++ "extendWord8#" ++# endif + + extendWord16HashValName :: Name +-extendWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendWord16#" ++extendWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" ++# if MIN_VERSION_base(4,16,0) ++ "word16ToWord#" ++# else ++ "extendWord16#" ++# endif + + geInt8HashValName :: Name + geInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "geInt8#" +diff --git a/src/Data/Deriving/Via/Internal.hs b/src/Data/Deriving/Via/Internal.hs +index 49aec0c..259407a 100644 +--- a/src/Data/Deriving/Via/Internal.hs ++++ b/src/Data/Deriving/Via/Internal.hs +@@ -46,12 +46,11 @@ $('deriveGND' [t| forall a. 'Eq' a => 'Eq' (Foo a) |]) + deriveGND :: Q Type -> Q [Dec] + deriveGND qty = do + ty <- qty +- let (instanceTvbs, instanceCxt, instanceTy) = decomposeType ty ++ let (_instanceTvbs, instanceCxt, instanceTy) = decomposeType ty + instanceTy' <- (resolveTypeSynonyms <=< resolveInfixT) instanceTy + decs <- deriveViaDecs instanceTy' Nothing +- let instanceHeader = ForallT instanceTvbs instanceCxt instanceTy +- (:[]) `fmap` instanceD (return []) +- (return instanceHeader) ++ (:[]) `fmap` instanceD (return instanceCxt) ++ (return instanceTy) + (map return decs) + + {- | Generates an instance for a type class by emulating the behavior of the +@@ -71,7 +70,7 @@ correctly across all the types being used (e.g., to make sure that the same + deriveVia :: Q Type -> Q [Dec] + deriveVia qty = do + ty <- qty +- let (instanceTvbs, instanceCxt, viaApp) = decomposeType ty ++ let (_instanceTvbs, instanceCxt, viaApp) = decomposeType ty + viaApp' <- (resolveTypeSynonyms <=< resolveInfixT) viaApp + (instanceTy, viaTy) + <- case unapplyTy viaApp' of +@@ -84,9 +83,8 @@ deriveVia qty = do + , "\t[t| forall a. C (T a) `Via` V a |]" + ] + decs <- deriveViaDecs instanceTy (Just viaTy) +- let instanceHeader = ForallT instanceTvbs instanceCxt instanceTy +- (:[]) `fmap` instanceD (return []) +- (return instanceHeader) ++ (:[]) `fmap` instanceD (return instanceCxt) ++ (return instanceTy) + (map return decs) + + deriveViaDecs :: Type -- ^ The instance head (e.g., @Eq (Foo a)@) diff --git a/src/Data/Functor/Deriving/Internal.hs b/src/Data/Functor/Deriving/Internal.hs -index 57d8f9c..8adb4c5 100644 +index 57d8f9c..e79ba2d 100644 --- a/src/Data/Functor/Deriving/Internal.hs +++ b/src/Data/Functor/Deriving/Internal.hs @@ -703,7 +703,7 @@ functorFunTrivial fmapE traverseE ff z = go ff @@ -29,15 +115,88 @@ index 57d8f9c..8adb4c5 100644 -- Make sure to zip BEFORE invoking catMaybes. We want the variable -- indicies in each expression to match up with the argument indices -- in conExpr (defined below). -@@ -933,3 +933,11 @@ mkSimpleTupleCase matchForCon tupSort insides x = do +@@ -933,3 +933,10 @@ mkSimpleTupleCase matchForCon tupSort insides x = do #endif m <- matchForCon tupDataName insides return $ CaseE x [m] + +conPCompat :: Name -> [Pat] -> Pat +conPCompat n pats = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats +diff --git a/src/Text/Show/Deriving/Internal.hs b/src/Text/Show/Deriving/Internal.hs +index 75e10c2..4a2a092 100644 +--- a/src/Text/Show/Deriving/Internal.hs ++++ b/src/Text/Show/Deriving/Internal.hs +@@ -694,22 +694,42 @@ primShowTbl = Map.fromList + , (int8HashTypeName, PrimShow + { primShowBoxer = appE (conE iHashDataName) . appE (varE extendInt8HashValName) + , primShowPostfixMod = oneHashE +- , primShowConv = mkNarrowE "narrowInt8#" ++ , primShowConv = mkNarrowE ++# if MIN_VERSION_base(4,16,0) ++ "intToInt8#" ++# else ++ "narrowInt8#" ++# endif + }) + , (int16HashTypeName, PrimShow + { primShowBoxer = appE (conE iHashDataName) . appE (varE extendInt16HashValName) + , primShowPostfixMod = oneHashE +- , primShowConv = mkNarrowE "narrowInt16#" ++ , primShowConv = mkNarrowE ++# if MIN_VERSION_base(4,16,0) ++ "intToInt16#" ++# else ++ "narrowInt16#" ++# endif + }) + , (word8HashTypeName, PrimShow + { primShowBoxer = appE (conE wHashDataName) . appE (varE extendWord8HashValName) + , primShowPostfixMod = twoHashE +- , primShowConv = mkNarrowE "narrowWord8#" ++ , primShowConv = mkNarrowE ++# if MIN_VERSION_base(4,16,0) ++ "wordToWord8#" ++# else ++ "narrowWord8#" ++# endif + }) + , (word16HashTypeName, PrimShow + { primShowBoxer = appE (conE wHashDataName) . appE (varE extendWord16HashValName) + , primShowPostfixMod = twoHashE +- , primShowConv = mkNarrowE "narrowWord16#" ++ , primShowConv = mkNarrowE ++# if MIN_VERSION_base(4,16,0) ++ "wordToWord16#" ++# else ++ "narrowWord16#" ++# endif + }) + #endif + ] +diff --git a/tests/GH27Spec.hs b/tests/GH27Spec.hs +index 3e5d372..5eb152a 100644 +--- a/tests/GH27Spec.hs ++++ b/tests/GH27Spec.hs +@@ -30,6 +30,10 @@ import Prelude.Compat + + import Test.Hspec + ++{- ++Unfortunately, this cannot be made to work on GHC 9.2. ++See https://github.com/haskell-compat/deriving-compat/issues/34. ++ + #if MIN_VERSION_template_haskell(2,12,0) + import Data.Deriving.Via + import Data.Functor.Const +@@ -37,6 +41,7 @@ import Data.Functor.Const + newtype Age = MkAge Int + $(deriveVia [t| forall a. Show Age `Via` Const Int a |]) + #endif ++-} + + main :: IO () + main = hspec spec diff --git a/patches/doctest-0.16.3.patch b/patches/doctest-0.16.3.patch index 568a2739574cb4501531010a4ac15219fd386911..02cd32869bb890e69ae68a508067ad3f451facaf 100644 --- a/patches/doctest-0.16.3.patch +++ b/patches/doctest-0.16.3.patch @@ -13,7 +13,7 @@ index 1b55e76..c890767 100644 executable doctest diff --git a/src/Extract.hs b/src/Extract.hs -index 81ed5a9..1606e89 100644 +index 81ed5a9..4f4f6b6 100644 --- a/src/Extract.hs +++ b/src/Extract.hs @@ -21,10 +21,20 @@ import GHC hiding (flags, Module, Located) @@ -117,6 +117,60 @@ index 81ed5a9..1606e89 100644 #else loadModPlugins = return #endif +@@ -219,13 +249,15 @@ docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs + -- traversing the whole source in a generic way, to ensure that we get + -- everything in source order. + header = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]] ++ exports = [ (Nothing, L (locA loc) doc) + #if __GLASGOW_HASKELL__ < 710 +- exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- concat (hsmodExports source)] ++ | L loc (IEDoc doc) <- concat (hsmodExports source) + #elif __GLASGOW_HASKELL__ < 805 +- exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)] ++ | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source) + #else +- exports = [(Nothing, L loc doc) | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)] ++ | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source) + #endif ++ ] + decls = extractDocStrings (hsmodDecls source) + + type Selector a = a -> ([(Maybe String, LHsDocString)], Bool) +@@ -279,15 +311,21 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl + -- no location information attached. The location information is + -- attached to HsDecl instead. + #if __GLASGOW_HASKELL__ < 805 +- DocD x -> select (fromDocDecl loc x) ++ DocD x + #else +- DocD _ x -> select (fromDocDecl loc x) ++ DocD _ x + #endif ++ -> select (fromDocDecl (locA loc) x) + + _ -> (extractDocStrings decl, True) + +- fromLDocDecl :: Selector LDocDecl +- fromLDocDecl (L loc x) = select (fromDocDecl loc x) ++ fromLDocDecl :: Selector ++#if __GLASGOW_HASKELL__ >= 901 ++ (LDocDecl GhcPs) ++#else ++ LDocDecl ++#endif ++ fromLDocDecl (L loc x) = select (fromDocDecl (locA loc) x) + + fromLHsDocString :: Selector LHsDocString + fromLHsDocString x = select (Nothing, x) +@@ -302,3 +340,8 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl + unpackHDS :: HsDocString -> String + unpackHDS (HsDocString s) = unpackFS s + #endif ++ ++#if __GLASGOW_HASKELL__ < 901 ++locA :: SrcSpan -> SrcSpan ++locA = id ++#endif diff --git a/src/GhcUtil.hs b/src/GhcUtil.hs index 52e965e..f1eb842 100644 --- a/src/GhcUtil.hs diff --git a/patches/doctest-0.18.1.patch b/patches/doctest-0.18.1.patch index 7bbb4074b84b4cf515a89c004b641994a93b9a56..0cb9341f86a27ddf17538b75c841bbe71f69b6d0 100644 --- a/patches/doctest-0.18.1.patch +++ b/patches/doctest-0.18.1.patch @@ -1,5 +1,5 @@ diff --git a/src/Extract.hs b/src/Extract.hs -index e419fdc..9785bef 100644 +index e419fdc..cdad6ae 100644 --- a/src/Extract.hs +++ b/src/Extract.hs @@ -66,6 +66,12 @@ import GHC.Runtime.Loader (initializePlugins) @@ -54,6 +54,60 @@ index e419fdc..9785bef 100644 #else loadModPlugins = return #endif +@@ -238,13 +255,15 @@ docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs + -- traversing the whole source in a generic way, to ensure that we get + -- everything in source order. + header = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]] ++ exports = [ (Nothing, L (locA loc) doc) + #if __GLASGOW_HASKELL__ < 710 +- exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- concat (hsmodExports source)] ++ | L loc (IEDoc doc) <- concat (hsmodExports source) + #elif __GLASGOW_HASKELL__ < 805 +- exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)] ++ | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source) + #else +- exports = [(Nothing, L loc doc) | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)] ++ | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source) + #endif ++ ] + decls = extractDocStrings (hsmodDecls source) + + type Selector a = a -> ([(Maybe String, LHsDocString)], Bool) +@@ -298,15 +317,21 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl + -- no location information attached. The location information is + -- attached to HsDecl instead. + #if __GLASGOW_HASKELL__ < 805 +- DocD x -> select (fromDocDecl loc x) ++ DocD x + #else +- DocD _ x -> select (fromDocDecl loc x) ++ DocD _ x + #endif ++ -> select (fromDocDecl (locA loc) x) + + _ -> (extractDocStrings decl, True) + +- fromLDocDecl :: Selector LDocDecl +- fromLDocDecl (L loc x) = select (fromDocDecl loc x) ++ fromLDocDecl :: Selector ++#if __GLASGOW_HASKELL__ >= 901 ++ (LDocDecl GhcPs) ++#else ++ LDocDecl ++#endif ++ fromLDocDecl (L loc x) = select (fromDocDecl (locA loc) x) + + fromLHsDocString :: Selector LHsDocString + fromLHsDocString x = select (Nothing, x) +@@ -321,3 +346,8 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl + unpackHDS :: HsDocString -> String + unpackHDS (HsDocString s) = unpackFS s + #endif ++ ++#if __GLASGOW_HASKELL__ < 901 ++locA :: SrcSpan -> SrcSpan ++locA = id ++#endif diff --git a/src/GhcUtil.hs b/src/GhcUtil.hs index c928496..810d58a 100644 --- a/src/GhcUtil.hs diff --git a/patches/free-functors-1.2.1.patch b/patches/free-functors-1.2.1.patch index a8ba393f4fc228fd67129860032fed1e7e9464b4..3949d26aecb7d40923563bb5d27b33378af5327d 100644 --- a/patches/free-functors-1.2.1.patch +++ b/patches/free-functors-1.2.1.patch @@ -1,15 +1,14 @@ diff --git a/src/Data/Functor/Cofree/Internal.hs b/src/Data/Functor/Cofree/Internal.hs -index 59cbd36..af7c7bc 100644 +index 59cbd36..6ece256 100644 --- a/src/Data/Functor/Cofree/Internal.hs +++ b/src/Data/Functor/Cofree/Internal.hs -@@ -40,7 +40,12 @@ cofreeDeriv cofree = idDeriv { +@@ -40,7 +40,11 @@ cofreeDeriv cofree = idDeriv { cst = \e -> [| const $e $kExp |], -- Suppress "Defined but not used: ‘k’" warning res = \e -> [| $(pure (ConE cofree)) $kExp $e |], eff = \e -> [| $(pure (ConE cofree)) $kExp <$> $e |], - inp = fmap (\vp -> ConP cofree [kPat, vp]) + inp = fmap (\vp -> ConP cofree -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + [kPat, vp]) diff --git a/patches/haskell-src-meta-0.8.7.patch b/patches/haskell-src-meta-0.8.7.patch index 9cb62a4c90bc2f8e4205dff76f40ccf4c66b9a38..5098191791d3b936ae33de38fa3cfeeadfc4b485 100644 --- a/patches/haskell-src-meta-0.8.7.patch +++ b/patches/haskell-src-meta-0.8.7.patch @@ -1,15 +1,14 @@ diff --git a/src/Language/Haskell/Meta/Syntax/Translate.hs b/src/Language/Haskell/Meta/Syntax/Translate.hs -index 6b795bf..4a3a571 100644 +index 6b795bf..6658fa8 100644 --- a/src/Language/Haskell/Meta/Syntax/Translate.hs +++ b/src/Language/Haskell/Meta/Syntax/Translate.hs -@@ -222,7 +222,12 @@ instance ToPat (Exts.Pat l) where +@@ -222,7 +222,11 @@ instance ToPat (Exts.Pat l) where TH.DoublePrimL r'' -> TH.DoublePrimL (negate r'') _ -> nonsense "toPat" "negating wrong kind of literal" l toPat (Exts.PInfixApp _ p n q) = TH.UInfixP (toPat p) (toName n) (toPat q) - toPat (Exts.PApp _ n ps) = TH.ConP (toName n) (fmap toPat ps) + toPat (Exts.PApp _ n ps) = TH.ConP (toName n) -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (fmap toPat ps) @@ -17,17 +16,16 @@ index 6b795bf..4a3a571 100644 toPat (Exts.PTuple _ Exts.Unboxed ps) = TH.UnboxedTupP (fmap toPat ps) toPat (Exts.PList _ ps) = TH.ListP (fmap toPat ps) diff --git a/src/Language/Haskell/Meta/Utils.hs b/src/Language/Haskell/Meta/Utils.hs -index 6cdadcb..5378ff3 100644 +index 6cdadcb..baea476 100644 --- a/src/Language/Haskell/Meta/Utils.hs +++ b/src/Language/Haskell/Meta/Utils.hs -@@ -333,7 +333,12 @@ fromDataConI (DataConI dConN ty _tyConN) = +@@ -333,7 +333,11 @@ fromDataConI (DataConI dConN ty _tyConN) = let n = arityT ty in replicateM n (newName "a") >>= \ns -> return (Just (LamE - [ConP dConN (fmap VarP ns)] + [ConP dConN -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (fmap VarP ns)] diff --git a/patches/hxt-9.3.1.21.patch b/patches/hxt-9.3.1.21.patch deleted file mode 100644 index ec5c6e3a38192bc106805d70864097ce58b05874..0000000000000000000000000000000000000000 --- a/patches/hxt-9.3.1.21.patch +++ /dev/null @@ -1,257 +0,0 @@ -diff --git a/src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs b/src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs -index 9a81bbd..8095180 100644 ---- a/src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs -+++ b/src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs -@@ -59,8 +59,8 @@ import Text.XML.HXT.DOM.Interface - -- state datatype consists of a system state and a user state - -- the user state is not fixed - --data XIOState us = XIOState { xioSysState :: ! XIOSysState -- , xioUserState :: ! us -+data XIOState us = XIOState { xioSysState :: !XIOSysState -+ , xioUserState :: !us - } - - instance (NFData us) => NFData (XIOState us) where -@@ -152,42 +152,42 @@ withoutUserState = withOtherUserState () - -- predefined system state data type with all components for the - -- system functions, like trace, error handling, ... - --data XIOSysState = XIOSys { xioSysWriter :: ! XIOSysWriter -- , xioSysEnv :: ! XIOSysEnv -+data XIOSysState = XIOSys { xioSysWriter :: !XIOSysWriter -+ , xioSysEnv :: !XIOSysEnv - } - - instance NFData XIOSysState where - rnf x = seq x () -- all fields of interest are strict - --data XIOSysWriter = XIOwrt { xioErrorStatus :: ! Int -- , xioErrorMsgList :: ! XmlTrees -+data XIOSysWriter = XIOwrt { xioErrorStatus :: !Int -+ , xioErrorMsgList :: !XmlTrees - , xioExpatErrors :: IOSArrow XmlTree XmlTree -- , xioRelaxNoOfErrors :: ! Int -- , xioRelaxDefineId :: ! Int -+ , xioRelaxNoOfErrors :: !Int -+ , xioRelaxDefineId :: !Int - , xioRelaxAttrList :: AssocList String XmlTrees - } - --data XIOSysEnv = XIOEnv { xioTraceLevel :: ! Int -+data XIOSysEnv = XIOEnv { xioTraceLevel :: !Int - , xioTraceCmd :: Int -> String -> IO () - , xioErrorMsgHandler :: String -> IO () -- , xioErrorMsgCollect :: ! Bool -- , xioBaseURI :: ! String -- , xioDefaultBaseURI :: ! String -- , xioAttrList :: ! Attributes -- , xioInputConfig :: ! XIOInputConfig -- , xioParseConfig :: ! XIOParseConfig -- , xioOutputConfig :: ! XIOOutputConfig -- , xioRelaxConfig :: ! XIORelaxConfig -- , xioXmlSchemaConfig :: ! XIOXmlSchemaConfig -- , xioCacheConfig :: ! XIOCacheConfig -+ , xioErrorMsgCollect :: !Bool -+ , xioBaseURI :: !String -+ , xioDefaultBaseURI :: !String -+ , xioAttrList :: !Attributes -+ , xioInputConfig :: !XIOInputConfig -+ , xioParseConfig :: !XIOParseConfig -+ , xioOutputConfig :: !XIOOutputConfig -+ , xioRelaxConfig :: !XIORelaxConfig -+ , xioXmlSchemaConfig :: !XIOXmlSchemaConfig -+ , xioCacheConfig :: !XIOCacheConfig - } - --data XIOInputConfig = XIOIcgf { xioStrictInput :: ! Bool -- , xioEncodingErrors :: ! Bool -+data XIOInputConfig = XIOIcgf { xioStrictInput :: !Bool -+ , xioEncodingErrors :: !Bool - , xioInputEncoding :: String - , xioHttpHandler :: IOSArrow XmlTree XmlTree -- , xioInputOptions :: ! Attributes -- , xioRedirect :: ! Bool -+ , xioInputOptions :: !Attributes -+ , xioRedirect :: !Bool - , xioProxy :: String - } - -@@ -196,59 +196,59 @@ data XIOParseConfig = XIOPcfg { xioMimeTypes :: MimeTypeTable - , xioMimeTypeFile :: String - , xioAcceptedMimeTypes :: [String] - , xioFileMimeType :: String -- , xioWarnings :: ! Bool -- , xioRemoveWS :: ! Bool -- , xioParseByMimeType :: ! Bool -- , xioParseHTML :: ! Bool -- , xioLowerCaseNames :: ! Bool -- , xioPreserveComment :: ! Bool -- , xioValidate :: ! Bool -- , xioSubstDTDEntities :: ! Bool -- , xioSubstHTMLEntities :: ! Bool -- , xioCheckNamespaces :: ! Bool -- , xioCanonicalize :: ! Bool -- , xioIgnoreNoneXmlContents :: ! Bool -- , xioTagSoup :: ! Bool -+ , xioWarnings :: !Bool -+ , xioRemoveWS :: !Bool -+ , xioParseByMimeType :: !Bool -+ , xioParseHTML :: !Bool -+ , xioLowerCaseNames :: !Bool -+ , xioPreserveComment :: !Bool -+ , xioValidate :: !Bool -+ , xioSubstDTDEntities :: !Bool -+ , xioSubstHTMLEntities :: !Bool -+ , xioCheckNamespaces :: !Bool -+ , xioCanonicalize :: !Bool -+ , xioIgnoreNoneXmlContents :: !Bool -+ , xioTagSoup :: !Bool - , xioTagSoupParser :: IOSArrow XmlTree XmlTree -- , xioExpat :: ! Bool -+ , xioExpat :: !Bool - , xioExpatParser :: IOSArrow XmlTree XmlTree - } - --data XIOOutputConfig = XIOOcfg { xioIndent :: ! Bool -- , xioOutputEncoding :: ! String -- , xioOutputFmt :: ! XIOXoutConfig -- , xioXmlPi :: ! Bool -- , xioNoEmptyElemFor :: ! [String] -- , xioAddDefaultDTD :: ! Bool -- , xioTextMode :: ! Bool -- , xioShowTree :: ! Bool -- , xioShowHaskell :: ! Bool -+data XIOOutputConfig = XIOOcfg { xioIndent :: !Bool -+ , xioOutputEncoding :: !String -+ , xioOutputFmt :: !XIOXoutConfig -+ , xioXmlPi :: !Bool -+ , xioNoEmptyElemFor :: ![String] -+ , xioAddDefaultDTD :: !Bool -+ , xioTextMode :: !Bool -+ , xioShowTree :: !Bool -+ , xioShowHaskell :: !Bool - } - data XIOXoutConfig = XMLoutput | XHTMLoutput | HTMLoutput | PLAINoutput - deriving (Eq) - --data XIORelaxConfig = XIORxc { xioRelaxValidate :: ! Bool -+data XIORelaxConfig = XIORxc { xioRelaxValidate :: !Bool - , xioRelaxSchema :: String -- , xioRelaxCheckRestr :: ! Bool -- , xioRelaxValidateExtRef :: ! Bool -- , xioRelaxValidateInclude :: ! Bool -- , xioRelaxCollectErrors :: ! Bool -+ , xioRelaxCheckRestr :: !Bool -+ , xioRelaxValidateExtRef :: !Bool -+ , xioRelaxValidateInclude :: !Bool -+ , xioRelaxCollectErrors :: !Bool - , xioRelaxValidator :: IOSArrow XmlTree XmlTree - } - --data XIOXmlSchemaConfig = XIOScc { xioXmlSchemaValidate :: ! Bool -+data XIOXmlSchemaConfig = XIOScc { xioXmlSchemaValidate :: !Bool - , xioXmlSchemaSchema :: String - , xioXmlSchemaValidator :: IOSArrow XmlTree XmlTree - } - - data XIOCacheConfig = XIOCch { xioBinaryCompression :: CompressionFct - , xioBinaryDeCompression :: DeCompressionFct -- , xioWithCache :: ! Bool -- , xioCacheDir :: ! String -- , xioDocumentAge :: ! Int -- , xioCache404Err :: ! Bool -+ , xioWithCache :: !Bool -+ , xioCacheDir :: !String -+ , xioDocumentAge :: !Int -+ , xioCache404Err :: !Bool - , xioCacheRead :: String -> IOSArrow XmlTree XmlTree -- , xioStrictDeserialize :: ! Bool -+ , xioStrictDeserialize :: !Bool - } - - type MimeTypeHandlers = M.Map String (IOSArrow XmlTree XmlTree) -diff --git a/src/Text/XML/HXT/DOM/QualifiedName.hs b/src/Text/XML/HXT/DOM/QualifiedName.hs -index 18ef9e6..7cf2b6b 100644 ---- a/src/Text/XML/HXT/DOM/QualifiedName.hs -+++ b/src/Text/XML/HXT/DOM/QualifiedName.hs -@@ -110,7 +110,7 @@ import Data.Char.Properties.XMLCharProps (isXmlNCNameChar, - -- Names are always reduced to normal form, and they are stored internally in a name cache - -- for sharing equal names by the same data structure - --data XName = XN { _idXN :: ! Int -- for optimization of equality test, see Eq instance -+data XName = XN { _idXN :: !Int -- for optimization of equality test, see Eq instance - , unXN :: String - } - deriving (Typeable) -@@ -158,9 +158,9 @@ type NsEnv = AssocList XName XName - -- When dealing with namespaces, the document tree must be processed by 'Text.XML.HXT.Arrow.Namespace.propagateNamespaces' - -- to split names of structure \"prefix:localPart\" and label the name with the apropriate namespace uri - --data QName = QN { localPart' :: ! XName -- , namePrefix' :: ! XName -- , namespaceUri' :: ! XName -+data QName = QN { localPart' :: !XName -+ , namePrefix' :: !XName -+ , namespaceUri' :: !XName - } - deriving (Typeable) - -@@ -507,9 +507,9 @@ toNsEnv = map (newXName *** newXName) - - -- the name and string cache - --data NameCache = NC { _newXN :: ! Int -- next free name id -- , _xnCache :: ! (M.Map String XName) -- , _qnCache :: ! (M.Map (XName, XName, XName) QName) -- we need another type than QName -+data NameCache = NC { _newXN :: !Int -- next free name id -+ , _xnCache :: !(M.Map String XName) -+ , _qnCache :: !(M.Map (XName, XName, XName) QName) -- we need another type than QName - } -- for the key because of the unusable - -- Eq instance of QName - type ChangeNameCache r = NameCache -> (NameCache, r) -@@ -530,13 +530,13 @@ nullXName - , xmlNamespaceXName - , xmlXName :: XName - --initialXNames@ -- [ nullXName -- , xmlnsNamespaceXName -- , xmlnsXName -- , xmlNamespaceXName -- , xmlXName -- ] = zipWith XN [0..] $ -+initialXNames@[ nullXName -+ , xmlnsNamespaceXName -+ , xmlnsXName -+ , xmlNamespaceXName -+ , xmlXName -+ ] -+ = zipWith XN [0..] $ - [ "" - , xmlnsNamespace - , a_xmlns -@@ -548,8 +548,8 @@ initialQNames :: [QName] - - xmlnsQN :: QName - --initialQNames@ -- [xmlnsQN] = [QN xmlnsXName nullXName xmlnsNamespaceXName] -+initialQNames@[xmlnsQN] -+ = [QN xmlnsXName nullXName xmlnsNamespaceXName] - - initialCache :: NameCache - initialCache = NC -diff --git a/src/Text/XML/HXT/Parser/XmlCharParser.hs b/src/Text/XML/HXT/Parser/XmlCharParser.hs -index 702f847..4bc13b1 100644 ---- a/src/Text/XML/HXT/Parser/XmlCharParser.hs -+++ b/src/Text/XML/HXT/Parser/XmlCharParser.hs -@@ -49,7 +49,7 @@ type XParser s a = GenParser Char (XPState s) a - type SimpleXParser a = XParser () a - - data XPState s = XPState -- { xps_normalizeNewline :: ! Bool -+ { xps_normalizeNewline :: !Bool - , xps_userState :: s - } - diff --git a/patches/inspection-testing-0.4.3.0.patch b/patches/inspection-testing-0.4.3.0.patch index 25c2d6311d34a7ba72a8c6a0480dbe018cc1292a..fb3d21b3055e1eb618f86dd71dd551a9ddb49b6a 100644 --- a/patches/inspection-testing-0.4.3.0.patch +++ b/patches/inspection-testing-0.4.3.0.patch @@ -1,8 +1,19 @@ diff --git a/src/Test/Inspection/Core.hs b/src/Test/Inspection/Core.hs -index 7816010..265d3ba 100644 +index 7816010..45ec4b6 100644 --- a/src/Test/Inspection/Core.hs +++ b/src/Test/Inspection/Core.hs -@@ -83,7 +83,12 @@ slice binds v +@@ -44,6 +44,10 @@ import DataCon + import TyCon (TyCon, isClassTyCon) + #endif + ++#if MIN_VERSION_ghc(9,1,0) ++import GHC.Types.Tickish (CoreTickish, GenTickish(..)) ++#endif ++ + import qualified Data.Set as S + import Control.Monad.State.Strict + import Control.Monad.Trans.Maybe +@@ -83,7 +87,12 @@ slice binds v go (Type _) = pure () go (Coercion _) = pure () @@ -16,7 +27,7 @@ index 7816010..265d3ba 100644 -- | Pretty-print a slice pprSlice :: Slice -> SDoc -@@ -211,7 +216,11 @@ eqSlice it slice1 slice2 +@@ -211,14 +220,22 @@ eqSlice it slice1 slice2 go _ _ _ = guard False ----------- @@ -27,8 +38,21 @@ index 7816010..265d3ba 100644 +#endif = guard (c1 == c2) >> go (rnBndrs2 env bs1 bs2) e1 e2 - go_tick :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool -@@ -250,7 +259,12 @@ allTyCons ignore slice = +- go_tick :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool +- go_tick env (Breakpoint lid lids) (Breakpoint rid rids) ++ go_tick :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool ++ go_tick env (Breakpoint{breakpointId = lid, breakpointFVs = lids}) ++ (Breakpoint{breakpointId = rid, breakpointFVs = rids}) + = lid == rid && map (rnOccL env) lids == map (rnOccR env) rids + go_tick _ l r = l == r + ++#if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) ++type CoreTickish = Tickish Id ++#endif + + + -- | Returns @True@ if the given core expression mentions no type constructor +@@ -250,7 +267,12 @@ allTyCons ignore slice = goB (b, e) = goV b ++ go e @@ -42,7 +66,7 @@ index 7816010..265d3ba 100644 goT (TyVarTy _) = [] goT (AppTy t1 t2) = goT t1 ++ goT t2 -@@ -296,7 +310,12 @@ freeOfTerm slice needles = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ] +@@ -296,7 +318,12 @@ freeOfTerm slice needles = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ] goB (_, e) = go e @@ -56,7 +80,7 @@ index 7816010..265d3ba 100644 goAltCon (DataAlt dc) | isNeedle (dataConName dc) = False goAltCon _ = True -@@ -343,7 +362,12 @@ doesNotAllocate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go (idArity v +@@ -343,7 +370,12 @@ doesNotAllocate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go (idArity v -- A let binding allocates if any variable is not a join point and not -- unlifted diff --git a/patches/invariant-0.5.4.patch b/patches/invariant-0.5.4.patch index e35aaeb24dda6b9ead7306fec4114193ca8a581a..ec4d7cd9fccfe680b39b90c94afa6d6c59a33485 100644 --- a/patches/invariant-0.5.4.patch +++ b/patches/invariant-0.5.4.patch @@ -28,17 +28,16 @@ index e68ec01..ce0ded0 100644 instance Invariant (Arg a) where invmap = invmapFunctor diff --git a/src/Data/Functor/Invariant/TH.hs b/src/Data/Functor/Invariant/TH.hs -index a94dd5d..a629b00 100644 +index a94dd5d..b50c748 100644 --- a/src/Data/Functor/Invariant/TH.hs +++ b/src/Data/Functor/Invariant/TH.hs -@@ -866,7 +866,12 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp) +@@ -866,7 +866,11 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp) -> Q Match mkSimpleConMatch fold conName insides = do varsNeeded <- newNameList "_arg" $ length insides - let pat = ConP conName (map VarP varsNeeded) + let pat = ConP conName -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (map VarP varsNeeded) diff --git a/patches/kind-generics-th-0.2.2.1.patch b/patches/kind-generics-th-0.2.2.1.patch deleted file mode 100644 index abe0ebf508ff8ad484f9c4350a1c4f30c1a53be4..0000000000000000000000000000000000000000 --- a/patches/kind-generics-th-0.2.2.1.patch +++ /dev/null @@ -1,31 +0,0 @@ -diff --git a/src/Generics/Kind/TH.hs b/src/Generics/Kind/TH.hs -index 74c24b2..f3732b6 100644 ---- a/src/Generics/Kind/TH.hs -+++ b/src/Generics/Kind/TH.hs -@@ -485,7 +485,12 @@ nTimes n f = f . nTimes (n-1) f - newNameList :: String -> Int -> Q [Name] - newNameList prefix n = traverse (newName . (prefix ++) . show) [1..n] - --gatherExistentials :: [ConstructorInfo] -> [TyVarBndr] -+gatherExistentials :: [ConstructorInfo] -+#if MIN_VERSION_template_haskell(2,17,0) -+ -> [TyVarBndrUnit] -+#else -+ -> [TyVarBndr] -+#endif - gatherExistentials = concatMap constructorVars - - gatherConstraints :: [ConstructorInfo] -> [Pred] -@@ -545,7 +550,11 @@ resolveConSynonyms con@(ConstructorInfo{ constructorVars = vars - vars' <- traverse (\tvb -> - case tvb of - PlainTV{} -> pure tvb -- KindedTV n k -> KindedTV n <$> resolveTypeSynonyms k) vars -+ KindedTV n -+#if MIN_VERSION_template_haskell(2,17,0) -+ _ -+#endif -+ k -> kindedTV n <$> resolveTypeSynonyms k) vars - context' <- traverse resolveTypeSynonyms context - fields' <- traverse resolveTypeSynonyms fields - pure $ con{ constructorVars = vars' diff --git a/patches/lens-4.19.2.patch b/patches/lens-4.19.2.patch index 5a484455f19a9a4bbfa1eabf93d5c2a02fafe3f1..898d619131b10b1fdbbf148543961e13112dddfb 100644 --- a/patches/lens-4.19.2.patch +++ b/patches/lens-4.19.2.patch @@ -427,7 +427,7 @@ index 2276d7e..7aadf53 100644 +ixmapped i = setting $ ixmap i {-# INLINE ixmapped #-} diff --git a/src/Language/Haskell/TH/Lens.hs b/src/Language/Haskell/TH/Lens.hs -index 652b880..50429ed 100644 +index 652b880..5bb6f45 100644 --- a/src/Language/Haskell/TH/Lens.hs +++ b/src/Language/Haskell/TH/Lens.hs @@ -425,6 +425,7 @@ import Control.Lens.At @@ -665,12 +665,11 @@ index 652b880..50429ed 100644 remitter _ = Nothing _ImplicitParamVarE :: Prism' Exp String -@@ -2550,8 +2581,14 @@ _ConP :: Prism' Pat (Name, [Pat]) +@@ -2550,8 +2581,13 @@ _ConP :: Prism' Pat (Name, [Pat]) _ConP = prism' reviewer remitter where -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + reviewer (x, y) = ConP x [] y + remitter (ConP x _ y) = Just (x, y) +#else @@ -680,7 +679,7 @@ index 652b880..50429ed 100644 remitter _ = Nothing _InfixP :: Prism' Pat (Pat, Name, Pat) -@@ -2642,7 +2679,7 @@ _ViewP +@@ -2642,7 +2678,7 @@ _ViewP remitter (ViewP x y) = Just (x, y) remitter _ = Nothing @@ -689,7 +688,7 @@ index 652b880..50429ed 100644 _ForallT = prism' reviewer remitter where -@@ -2847,7 +2884,7 @@ _ImplicitParamT +@@ -2847,7 +2883,7 @@ _ImplicitParamT #endif #if MIN_VERSION_template_haskell(2,16,0) @@ -698,7 +697,7 @@ index 652b880..50429ed 100644 _ForallVisT = prism' reviewer remitter where -@@ -2856,20 +2893,28 @@ _ForallVisT +@@ -2856,20 +2892,28 @@ _ForallVisT remitter _ = Nothing #endif @@ -733,7 +732,7 @@ index 652b880..50429ed 100644 remitter _ = Nothing #if MIN_VERSION_template_haskell(2,11,0) -@@ -2889,7 +2934,7 @@ _KindSig +@@ -2889,7 +2933,7 @@ _KindSig remitter (KindSig x) = Just x remitter _ = Nothing diff --git a/patches/lens-5.0.1.patch b/patches/lens-5.0.1.patch index dd964e334fde6e831bfb5a9b1c928cd07f6df53c..769e0719d3a01c038f45dd12614d27c495794c39 100644 --- a/patches/lens-5.0.1.patch +++ b/patches/lens-5.0.1.patch @@ -17,15 +17,14 @@ index a8a76f0..55516c3 100644 -- * contravariant diff --git a/src/Language/Haskell/TH/Lens.hs b/src/Language/Haskell/TH/Lens.hs -index 6202d37..91fae75 100644 +index 6202d37..8b5d9a2 100644 --- a/src/Language/Haskell/TH/Lens.hs +++ b/src/Language/Haskell/TH/Lens.hs -@@ -2476,8 +2476,14 @@ _ConP :: Prism' Pat (Name, [Pat]) +@@ -2476,8 +2476,13 @@ _ConP :: Prism' Pat (Name, [Pat]) _ConP = prism' reviewer remitter where -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + reviewer (x, y) = ConP x [] y + remitter (ConP x _ y) = Just (x, y) +#else diff --git a/patches/lens-family-th-0.5.2.0.patch b/patches/lens-family-th-0.5.2.0.patch index b600fdbd2d22ae791d457156366fcf54cb02630b..400c629fab0bd26513b7c634bc45b9412b306045 100644 --- a/patches/lens-family-th-0.5.2.0.patch +++ b/patches/lens-family-th-0.5.2.0.patch @@ -1,15 +1,14 @@ diff --git a/src/Lens/Family/THCore.hs b/src/Lens/Family/THCore.hs -index 9139718..90d14f8 100644 +index 9139718..272da90 100644 --- a/src/Lens/Family/THCore.hs +++ b/src/Lens/Family/THCore.hs -@@ -158,7 +158,12 @@ deriveTraversal nameTransform ty cs con = do +@@ -158,7 +158,11 @@ deriveTraversal nameTransform ty cs con = do deconstructReconstruct :: Con -> String -> (Pat, Exp) deconstructReconstruct c nameBase = (pat, expr) where - pat = ConP conN (map VarP argNames) + pat = ConP conN -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (map VarP argNames) diff --git a/patches/pandoc-2.12.patch b/patches/pandoc-2.13.patch similarity index 89% rename from patches/pandoc-2.12.patch rename to patches/pandoc-2.13.patch index 77892da348dbdc1bf2d4846e23888d52f9eed144..faca437fb8159ba94a48188db4f68c6ed4f488a2 100644 --- a/patches/pandoc-2.12.patch +++ b/patches/pandoc-2.13.patch @@ -37,7 +37,7 @@ index 92bda36..496991f 100644 camelCaseStrToHyphenated } ''WrapOption) diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs -index bcf26c4..ea5bd8b 100644 +index 7c6d017..ea62fea 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -57,7 +57,7 @@ module Text.Pandoc.Readers.Docx.Combine ( smushInlines @@ -62,6 +62,16 @@ index bcf26c4..ea5bd8b 100644 x_rem_attr = filter isAttrModifier x_remaining y_rem_attr = filter isAttrModifier y_remaining in +@@ -182,7 +182,7 @@ isAttrModifier _ = False + + smushInlines :: [Inlines] -> Inlines + smushInlines xs = combineInlines xs' mempty +- where xs' = foldl' combineInlines mempty xs ++ where xs' = L.foldl' combineInlines mempty xs + + smushBlocks :: [Blocks] -> Blocks +-smushBlocks xs = foldl' combineBlocks mempty xs ++smushBlocks xs = L.foldl' combineBlocks mempty xs diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index df90880..e4cf1f8 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs diff --git a/patches/parameterized-utils-2.1.2.0.patch b/patches/parameterized-utils-2.1.2.0.patch index 78f464ca844fcbb264d5dde6e8e109f9141d5630..92043608ce41bffd751674df7bc684cd8112c42a 100644 --- a/patches/parameterized-utils-2.1.2.0.patch +++ b/patches/parameterized-utils-2.1.2.0.patch @@ -121,7 +121,7 @@ index bde0080..4e95448 100644 -- | Recursor for natural numbeers. natRec :: forall p f diff --git a/src/Data/Parameterized/TH/GADT.hs b/src/Data/Parameterized/TH/GADT.hs -index fc6563c..ef98c93 100644 +index fc6563c..73b4069 100644 --- a/src/Data/Parameterized/TH/GADT.hs +++ b/src/Data/Parameterized/TH/GADT.hs @@ -8,6 +8,7 @@ @@ -150,15 +150,14 @@ index fc6563c..ef98c93 100644 let go s e = [| $(s) . showChar ' ' . showsPrec 11 $(varE e) |] let ctor = [| showString $(return (LitE (StringL (nameBase nm)))) |] let rhs | null vars = ctor -@@ -532,3 +533,11 @@ matchShowCtor p con = showCon p (constructorName con) (length (constructorFields +@@ -532,3 +533,10 @@ matchShowCtor p con = showCon p (constructorName con) (length (constructorFields -- -- The use of 'DataArg' says that the type parameter of the 'NatRepr' must -- be the same as the second type parameter of @T@. + +conPCompat :: Name -> [Pat] -> Pat +conPCompat n pats = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats diff --git a/patches/shakespeare-2.0.25.patch b/patches/shakespeare-2.0.25.patch index 086b2125d96f3c76ac18b6b80e6efbd6647d31bf..f1f55362ee3305bc1980d447eb3f17c9a9e79fcc 100644 --- a/patches/shakespeare-2.0.25.patch +++ b/patches/shakespeare-2.0.25.patch @@ -1,15 +1,14 @@ diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs -index e60fdfc..14ca5cb 100644 +index e60fdfc..63c5157 100644 --- a/Text/Hamlet.hs +++ b/Text/Hamlet.hs -@@ -139,7 +139,12 @@ bindingPattern (BindList is) = do +@@ -139,7 +139,11 @@ bindingPattern (BindList is) = do return (ListP patterns, concat scopes) bindingPattern (BindConstr con is) = do (patterns, scopes) <- fmap unzip $ mapM bindingPattern is - return (ConP (mkConName con) patterns, concat scopes) + return (ConP (mkConName con) -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + patterns, concat scopes) @@ -17,7 +16,7 @@ index e60fdfc..14ca5cb 100644 let f (Ident field,b) = do (p,s) <- bindingPattern b diff --git a/Text/MkSizeType.hs b/Text/MkSizeType.hs -index ee54e7a..3121e53 100644 +index ee54e7a..94e559c 100644 --- a/Text/MkSizeType.hs +++ b/Text/MkSizeType.hs @@ -38,7 +38,7 @@ showInstanceDec name unit' = instanceD [] (instanceType "Show" name) [showDec] @@ -49,20 +48,19 @@ index ee54e7a..3121e53 100644 body = NormalB $ AppE (ConE name) (AppE (VarE fun) (VarE v)) fun = mkName fun' v = mkName "v" -@@ -92,3 +92,11 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness +@@ -92,3 +92,10 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness instanceD :: Cxt -> Type -> [Dec] -> Dec instanceD = InstanceD Nothing + +conPCompat :: Name -> [Pat] -> Pat +conPCompat n pats = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs -index 836bcb6..1e927c2 100644 +index 836bcb6..7d56294 100644 --- a/Text/Shakespeare/I18N.hs +++ b/Text/Shakespeare/I18N.hs @@ -1,3 +1,4 @@ @@ -97,15 +95,14 @@ index 836bcb6..1e927c2 100644 (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d) [] -@@ -405,3 +406,11 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness +@@ -405,3 +406,10 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness instanceD :: Cxt -> Type -> [Dec] -> Dec instanceD = InstanceD Nothing + +conPCompat :: Name -> [Pat] -> Pat +conPCompat n pats = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats diff --git a/patches/text-show-3.9.patch b/patches/text-show-3.9.patch new file mode 100644 index 0000000000000000000000000000000000000000..e37d83a1abfbb68c48faedc8f85fa37680028845 --- /dev/null +++ b/patches/text-show-3.9.patch @@ -0,0 +1,243 @@ +diff --git a/src/TextShow/TH/Internal.hs b/src/TextShow/TH/Internal.hs +index c83c70e..c5c61d2 100644 +--- a/src/TextShow/TH/Internal.hs ++++ b/src/TextShow/TH/Internal.hs +@@ -78,7 +78,11 @@ import GHC.Exts ( Char(..), Double(..), Float(..), Int(..), Word(..) + , Char#, Double#, Float#, Int#, Word# + #if MIN_VERSION_base(4,13,0) + , Int8#, Int16#, Word8#, Word16# ++# if MIN_VERSION_base(4,16,0) ++ , int8ToInt#, int16ToInt#, word8ToWord#, word16ToWord# ++# else + , extendInt8#, extendInt16#, extendWord8#, extendWord16# ++# endif + #endif + ) + import GHC.Show (appPrec, appPrec1) +@@ -1258,24 +1262,68 @@ primShowTbl = Map.fromList + }) + #if MIN_VERSION_base(4,13,0) + , (''Int8#, PrimShow +- { primShowBoxer = appE (conE 'I#) . appE (varE 'extendInt8#) ++ { primShowBoxer = appE (conE 'I#) . appE (varE ++# if MIN_VERSION_base(4,16,0) ++ 'int8ToInt# ++# else ++ 'extendInt8# ++# endif ++ ) + , primShowPostfixMod = oneHashE +- , primShowConv = mkNarrowE "narrowInt8#" ++ , primShowConv = mkNarrowE ++# if MIN_VERSION_base(4,16,0) ++ "intToInt8#" ++# else ++ "narrowInt8#" ++# endif + }) + , (''Int16#, PrimShow +- { primShowBoxer = appE (conE 'I#) . appE (varE 'extendInt16#) ++ { primShowBoxer = appE (conE 'I#) . appE (varE ++# if MIN_VERSION_base(4,16,0) ++ 'int16ToInt# ++# else ++ 'extendInt16# ++# endif ++ ) + , primShowPostfixMod = oneHashE +- , primShowConv = mkNarrowE "narrowInt16#" ++ , primShowConv = mkNarrowE ++# if MIN_VERSION_base(4,16,0) ++ "intToInt16#" ++# else ++ "narrowInt16#" ++# endif + }) + , (''Word8#, PrimShow +- { primShowBoxer = appE (conE 'W#) . appE (varE 'extendWord8#) ++ { primShowBoxer = appE (conE 'W#) . appE (varE ++# if MIN_VERSION_base(4,16,0) ++ 'word8ToWord# ++# else ++ 'extendWord8# ++# endif ++ ) + , primShowPostfixMod = twoHashE +- , primShowConv = mkNarrowE "narrowWord8#" ++ , primShowConv = mkNarrowE ++# if MIN_VERSION_base(4,16,0) ++ "wordToWord8#" ++# else ++ "narrowWord8#" ++# endif + }) + , (''Word16#, PrimShow +- { primShowBoxer = appE (conE 'W#) . appE (varE 'extendWord16#) ++ { primShowBoxer = appE (conE 'W#) . appE (varE ++# if MIN_VERSION_base(4,16,0) ++ 'word16ToWord# ++# else ++ 'extendWord16# ++# endif ++ ) + , primShowPostfixMod = twoHashE +- , primShowConv = mkNarrowE "narrowWord16#" ++ , primShowConv = mkNarrowE ++# if MIN_VERSION_base(4,16,0) ++ "wordToWord16#" ++# else ++ "narrowWord16#" ++# endif + }) + #endif + ] +diff --git a/tests/Derived/MagicHash.hs b/tests/Derived/MagicHash.hs +index 7421618..3b938f1 100644 +--- a/tests/Derived/MagicHash.hs ++++ b/tests/Derived/MagicHash.hs +@@ -124,8 +124,8 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon'# a b) where + I# i2 <- arbitrary + W# w1 <- arbitrary + W# w2 <- arbitrary +- pure $ TyCon'# a b (narrowInt8# i1) (narrowInt16# i2) +- (narrowWord8# w1) (narrowWord16# w2) ++ pure $ TyCon'# a b (intToInt8Compat# i1) (intToInt16Compat# i2) ++ (wordToWord8Compat# w1) (wordToWord16Compat# w2) + + instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily'# a b) where + arbitrary = do +@@ -135,8 +135,35 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily'# a b) where + I# i2 <- arbitrary + W# w1 <- arbitrary + W# w2 <- arbitrary +- pure $ TyFamily'# a b (narrowInt8# i1) (narrowInt16# i2) +- (narrowWord8# w1) (narrowWord16# w2) ++ pure $ TyFamily'# a b (intToInt8Compat# i1) (intToInt16Compat# i2) ++ (wordToWord8Compat# w1) (wordToWord16Compat# w2) ++ ++ ++# if MIN_VERSION_base(4,16,0) ++intToInt8Compat# :: Int# -> Int8# ++intToInt8Compat# = intToInt8# ++ ++intToInt16Compat# :: Int# -> Int16# ++intToInt16Compat# = intToInt16# ++ ++wordToWord8Compat# :: Word# -> Word8# ++wordToWord8Compat# = wordToWord8# ++ ++wordToWord16Compat# :: Word# -> Word16# ++wordToWord16Compat# = wordToWord16# ++# else ++intToInt8Compat# :: Int# -> Int8# ++intToInt8Compat# = narrowInt8# ++ ++intToInt16Compat# :: Int# -> Int16# ++intToInt16Compat# = narrowInt16# ++ ++wordToWord8Compat# :: Word# -> Word8# ++wordToWord8Compat# = narrowWord8# ++ ++wordToWord16Compat# :: Word# -> Word16# ++wordToWord16Compat# = narrowWord16# ++# endif + #endif + + ------------------------------------------------------------------------------- +diff --git a/tests/Derived/TypeSynonyms.hs b/tests/Derived/TypeSynonyms.hs +index 3882bd9..12deec2 100644 +--- a/tests/Derived/TypeSynonyms.hs ++++ b/tests/Derived/TypeSynonyms.hs +@@ -78,10 +78,12 @@ newtype instance TyFamily a b = TyFamily + ------------------------------------------------------------------------------- + + -- TODO: Replace these with non-orphan instances ++#if !(MIN_VERSION_base(4,16,0)) + $(deriveShow1 ''(,,,)) + #if defined(NEW_FUNCTOR_CLASSES) + $(deriveShow2 ''(,,,)) + #endif ++#endif + + $(deriveShow1 ''TyCon) + #if defined(NEW_FUNCTOR_CLASSES) +diff --git a/tests/Instances/Data/Tuple.hs b/tests/Instances/Data/Tuple.hs +index e96b6ad..019bb83 100644 +--- a/tests/Instances/Data/Tuple.hs ++++ b/tests/Instances/Data/Tuple.hs +@@ -1,3 +1,4 @@ ++{-# LANGUAGE CPP #-} + {-# LANGUAGE DeriveGeneric #-} + {-# LANGUAGE StandaloneDeriving #-} + {-# OPTIONS_GHC -fno-warn-orphans #-} +@@ -99,8 +100,10 @@ instance ( Arbitrary a + ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where + arbitrary = genericArbitrary + ++#if !(MIN_VERSION_base(4,16,0)) + deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k) + deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l) + deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m) + deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n) + deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) ++#endif +diff --git a/tests/Instances/Data/Typeable.hs b/tests/Instances/Data/Typeable.hs +index 2812c05..890c2fd 100644 +--- a/tests/Instances/Data/Typeable.hs ++++ b/tests/Instances/Data/Typeable.hs +@@ -37,7 +37,11 @@ import Data.Typeable.Internal (TyCon(..)) + #if MIN_VERSION_base(4,10,0) + import GHC.Exts (Int(..), Ptr(..)) + import GHC.Types (KindRep(..), RuntimeRep(..), TypeLitSort(..), +- VecCount(..), VecElem(..)) ++ VecCount(..), VecElem(..) ++# if MIN_VERSION_base(4,16,0) ++ , Levity(..) ++# endif ++ ) + import Type.Reflection (SomeTypeRep(..), Typeable, TypeRep, typeRep) + #else + import Data.Typeable.Internal (TypeRep(..)) +@@ -80,8 +84,13 @@ instance Arbitrary RuntimeRep where + arbitrary = oneof [ VecRep <$> arbitrary <*> arbitrary + , pure $ TupleRep [] + , pure $ SumRep [] ++#if MIN_VERSION_base(4,16,0) ++ , pure $ BoxedRep Lifted ++ , pure $ BoxedRep Unlifted ++#else + , pure LiftedRep + , pure UnliftedRep ++#endif + , pure IntRep + , pure WordRep + , pure Int64Rep +diff --git a/text-show.cabal b/text-show.cabal +index b328593..c69a876 100644 +--- a/text-show.cabal ++++ b/text-show.cabal +@@ -1,5 +1,6 @@ + name: text-show + version: 3.9 ++x-revision: 1 + synopsis: Efficient conversion of values into Text + description: @text-show@ offers a replacement for the @Show@ typeclass intended + for use with @Text@ instead of @String@s. This package was created +@@ -157,7 +158,7 @@ library + build-depends: array >= 0.3 && < 0.6 + , base-compat-batteries >= 0.11 && < 0.12 + , bifunctors >= 5.1 && < 6 +- , bytestring >= 0.9 && < 0.11 ++ , bytestring >= 0.9 && < 0.12 + , bytestring-builder + , containers >= 0.1 && < 0.7 + , generic-deriving >= 1.11 && < 2 +@@ -341,7 +342,7 @@ test-suite spec + build-depends: array >= 0.3 && < 0.6 + , base-compat-batteries >= 0.11 && < 0.12 + , base-orphans >= 0.8.2 && < 0.9 +- , bytestring >= 0.9 && < 0.11 ++ , bytestring >= 0.9 && < 0.12 + , bytestring-builder + , deriving-compat >= 0.5.6 && < 1 + , generic-deriving >= 1.11 && < 2 diff --git a/patches/th-desugar-1.11.patch b/patches/th-desugar-1.11.patch index e853dd3da62a0939e7d65f9f27b41021b1027692..3969210ea480b3284fad4e80364be468c771f27c 100644 --- a/patches/th-desugar-1.11.patch +++ b/patches/th-desugar-1.11.patch @@ -15,31 +15,29 @@ index 626a689..adc1bb4 100644 instance Desugar [Dec] [DDec] where desugar = dsDecs diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs -index 21b1fbe..c48e50d 100644 +index 21b1fbe..a5f06ad 100644 --- a/Language/Haskell/TH/Desugar/Core.hs +++ b/Language/Haskell/TH/Desugar/Core.hs -@@ -85,8 +85,18 @@ dsExp (LamCaseE matches) = do +@@ -85,8 +85,16 @@ dsExp (LamCaseE matches) = do dsExp (TupE exps) = dsTup tupleDataName exps dsExp (UnboxedTupE exps) = dsTup unboxedTupleDataName exps dsExp (CondE e1 e2 e3) = - dsExp (CaseE e1 [ Match (ConP 'True []) (NormalB e2) [] - , Match (ConP 'False []) (NormalB e3) [] ]) + dsExp (CaseE e1 [ Match (ConP 'True -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + []) (NormalB e2) [] + , Match (ConP 'False -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + []) (NormalB e3) [] ]) dsExp (MultiIfE guarded_exps) = let failure = DAppE (DVarE 'error) (DLitE (StringL "Non-exhaustive guards in multi-way if")) in dsGuards guarded_exps failure -@@ -105,7 +115,11 @@ dsExp (CaseE exp matches) = do +@@ -105,7 +113,11 @@ dsExp (CaseE exp matches) = do matches' <- dsMatches scrutinee matches return $ DLetE [DValD (DVarP scrutinee) exp'] $ DCaseE (DVarE scrutinee) matches' @@ -52,35 +50,33 @@ index 21b1fbe..c48e50d 100644 dsExp (CompE stmts) = dsComp stmts dsExp (ArithSeqE (FromR exp)) = DAppE (DVarE 'enumFrom) <$> dsExp exp dsExp (ArithSeqE (FromThenR exp1 exp2)) = -@@ -509,7 +523,12 @@ dsParComp (q : rest) = do +@@ -509,7 +521,11 @@ dsParComp (q : rest) = do (rest_pat, rest_exp) <- dsParComp rest dsQ <- dsComp (q ++ [mk_tuple_stmt qv]) let zipped = DAppE (DAppE (DVarE 'mzip) dsQ) rest_exp - return (ConP (tupleDataName 2) [mk_tuple_pat qv, rest_pat], zipped) + return (ConP (tupleDataName 2) -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + [mk_tuple_pat qv, rest_pat], zipped) -- helper function for dsParComp mk_tuple_stmt :: OSet Name -> Stmt -@@ -553,7 +572,12 @@ dsPat (VarP n) = return $ DVarP n +@@ -553,7 +569,11 @@ dsPat (VarP n) = return $ DVarP n dsPat (TupP pats) = DConP (tupleDataName (length pats)) <$> mapM dsPat pats dsPat (UnboxedTupP pats) = DConP (unboxedTupleDataName (length pats)) <$> mapM dsPat pats -dsPat (ConP name pats) = DConP name <$> mapM dsPat pats +dsPat (ConP name -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + _ +#endif + pats) = DConP name <$> mapM dsPat pats dsPat (InfixP p1 name p2) = DConP name <$> mapM dsPat [p1, p2] dsPat (UInfixP _ _ _) = fail "Cannot desugar unresolved infix operators." -@@ -779,7 +803,7 @@ dsDec (KiSigD n ki) = (:[]) <$> (DKiSigD n <$> dsType ki) +@@ -779,7 +799,7 @@ dsDec (KiSigD n ki) = (:[]) <$> (DKiSigD n <$> dsType ki) -- | Desugar a 'DataD' or 'NewtypeD'. dsDataDec :: DsMonad q @@ -89,7 +85,7 @@ index 21b1fbe..c48e50d 100644 -> Maybe Kind -> [Con] -> [DerivingClause] -> q [DDec] dsDataDec nd cxt n tvbs mk cons derivings = do tvbs' <- mapM dsTvb tvbs -@@ -796,7 +820,7 @@ dsDataDec nd cxt n tvbs mk cons derivings = do +@@ -796,7 +816,7 @@ dsDataDec nd cxt n tvbs mk cons derivings = do -- | Desugar a 'DataInstD' or a 'NewtypeInstD'. dsDataInstDec :: DsMonad q @@ -98,7 +94,7 @@ index 21b1fbe..c48e50d 100644 -> Maybe Kind -> [Con] -> [DerivingClause] -> q [DDec] dsDataInstDec nd cxt n mtvbs tys mk cons derivings = do mtvbs' <- mapM (mapM dsTvb) mtvbs -@@ -1134,6 +1158,10 @@ dsClauses n clauses@(Clause outer_pats _ _ : _) = do +@@ -1134,6 +1154,10 @@ dsClauses n clauses@(Clause outer_pats _ _ : _) = do -- | Desugar a type dsType :: DsMonad q => Type -> q DType @@ -109,7 +105,7 @@ index 21b1fbe..c48e50d 100644 dsType (ForallT tvbs preds ty) = mkDForallConstrainedT ForallInvis <$> mapM dsTvb tvbs <*> dsCxt preds <*> dsType ty dsType (AppT t1 t2) = DAppT <$> dsType t1 <*> dsType t2 -@@ -1178,9 +1206,8 @@ dsType (ForallVisT tvbs ty) = DForallT ForallVis <$> mapM dsTvb tvbs <*> dsType +@@ -1178,9 +1202,8 @@ dsType (ForallVisT tvbs ty) = DForallT ForallVis <$> mapM dsTvb tvbs <*> dsType #endif -- | Desugar a @TyVarBndr@ @@ -121,7 +117,7 @@ index 21b1fbe..c48e50d 100644 -- | Desugar a @Cxt@ dsCxt :: DsMonad q => Cxt -> q DCxt -@@ -1294,7 +1321,7 @@ dsPred t@(ForallVisT {}) = +@@ -1294,7 +1317,7 @@ dsPred t@(ForallVisT {}) = #endif -- | Desugar a quantified constraint. @@ -130,14 +126,13 @@ index 21b1fbe..c48e50d 100644 dsForallPred tvbs cxt p = do ps' <- dsPred p case ps' of -@@ -1375,7 +1402,12 @@ mkTupleDPat pats = DConP (tupleDataName (length pats)) pats +@@ -1375,7 +1398,11 @@ mkTupleDPat pats = DConP (tupleDataName (length pats)) pats -- | Make a tuple 'Pat' from a list of 'Pat's. Avoids using a 1-tuple. mkTuplePat :: [Pat] -> Pat mkTuplePat [pat] = pat -mkTuplePat pats = ConP (tupleDataName (length pats)) pats +mkTuplePat pats = ConP (tupleDataName (length pats)) -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats @@ -409,7 +404,7 @@ index 7b35177..989ce4e 100644 default_res_ki :: Maybe Kind -> Kind default_res_ki = fromMaybe StarT diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs -index 4a18d57..914dbe2 100644 +index 4a18d57..a1f6f7c 100644 --- a/Language/Haskell/TH/Desugar/Sweeten.hs +++ b/Language/Haskell/TH/Desugar/Sweeten.hs @@ -28,7 +28,7 @@ module Language.Haskell.TH.Desugar.Sweeten ( @@ -421,21 +416,20 @@ index 4a18d57..914dbe2 100644 #if __GLASGOW_HASKELL__ >= 801 patSynDirToTH, #endif -@@ -75,7 +75,12 @@ matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) [] +@@ -75,7 +75,11 @@ matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) [] patToTH :: DPat -> Pat patToTH (DLitP lit) = LitP lit patToTH (DVarP n) = VarP n -patToTH (DConP n pats) = ConP n (map patToTH pats) +patToTH (DConP n pats) = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (map patToTH pats) patToTH (DTildeP pat) = TildeP (patToTH pat) patToTH (DBangP pat) = BangP (patToTH pat) patToTH (DSigP pat ty) = SigP (patToTH pat) (typeToTH ty) -@@ -90,15 +95,15 @@ decToTH :: DDec -> [Dec] +@@ -90,15 +94,15 @@ decToTH :: DDec -> [Dec] decToTH (DLetDec d) = maybeToList (letDecToTH d) decToTH (DDataD Data cxt n tvbs _mk cons derivings) = #if __GLASGOW_HASKELL__ > 710 @@ -454,7 +448,7 @@ index 4a18d57..914dbe2 100644 (concatMap derivClauseToTH derivings)] #else [NewtypeD (cxtToTH cxt) n (map tvbToTH tvbs) (conToTH con) -@@ -106,9 +111,9 @@ decToTH (DDataD Newtype cxt n tvbs _mk [con] derivings) = +@@ -106,9 +110,9 @@ decToTH (DDataD Newtype cxt n tvbs _mk [con] derivings) = #endif decToTH (DDataD Newtype _cxt _n _tvbs _mk _cons _derivings) = error "Newtype declaration without exactly 1 constructor." @@ -466,7 +460,7 @@ index 4a18d57..914dbe2 100644 decToTH (DInstanceD over mtvbs _cxt _ty decs) = [instanceDToTH over cxt' ty' decs] where -@@ -125,16 +130,16 @@ decToTH (DInstanceD over mtvbs _cxt _ty decs) = +@@ -125,16 +129,16 @@ decToTH (DInstanceD over mtvbs _cxt _ty decs) = decToTH (DForeignD f) = [ForeignD (foreignToTH f)] #if __GLASGOW_HASKELL__ > 710 decToTH (DOpenTypeFamilyD (DTypeFamilyHead n tvbs frs ann)) = @@ -487,7 +481,7 @@ index 4a18d57..914dbe2 100644 #endif decToTH (DDataInstD nd cxt mtvbs lhs mk cons derivings) = let ndc = case (nd, cons) of -@@ -151,12 +156,12 @@ decToTH (DTySynInstD eqn) = +@@ -151,12 +155,12 @@ decToTH (DTySynInstD eqn) = #endif #if __GLASGOW_HASKELL__ > 710 decToTH (DClosedTypeFamilyD (DTypeFamilyHead n tvbs frs ann) eqns) = @@ -502,7 +496,7 @@ index 4a18d57..914dbe2 100644 #endif decToTH (DRoleAnnotD n roles) = [RoleAnnotD n roles] decToTH (DStandaloneDerivD mds mtvbs _cxt _ty) = -@@ -210,11 +215,11 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings = +@@ -210,11 +214,11 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings = case ndc of DNewtypeCon con -> #if __GLASGOW_HASKELL__ >= 807 @@ -516,7 +510,7 @@ index 4a18d57..914dbe2 100644 (concatMap derivClauseToTH derivings)] #else [NewtypeInstD (cxtToTH cxt) _n _lhs_args (conToTH con) -@@ -223,11 +228,11 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings = +@@ -223,11 +227,11 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings = DDataCons cons -> #if __GLASGOW_HASKELL__ >= 807 @@ -530,7 +524,7 @@ index 4a18d57..914dbe2 100644 (concatMap derivClauseToTH derivings)] #else [DataInstD (cxtToTH cxt) _n _lhs_args (map conToTH cons) -@@ -244,7 +249,7 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings = +@@ -244,7 +248,7 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings = frsToTH :: DFamilyResultSig -> FamilyResultSig frsToTH DNoSig = NoSig frsToTH (DKindSig k) = KindSig (typeToTH k) @@ -539,7 +533,7 @@ index 4a18d57..914dbe2 100644 #else frsToTH :: DFamilyResultSig -> Maybe Kind frsToTH DNoSig = Nothing -@@ -291,7 +296,7 @@ conToTH (DCon [] [] n (DRecC vstys) _) = +@@ -291,7 +295,7 @@ conToTH (DCon [] [] n (DRecC vstys) _) = -- perfectly OK to put all of the quantified type variables -- (both universal and existential) in a ForallC. conToTH (DCon tvbs cxt n fields rty) = @@ -548,7 +542,7 @@ index 4a18d57..914dbe2 100644 #else -- On GHCs earlier than 8.0, we must be careful, since the only time ForallC is -- used is when there are either: -@@ -370,7 +375,7 @@ pragmaToTH (DSpecialiseP n ty m_inl phases) = +@@ -370,7 +374,7 @@ pragmaToTH (DSpecialiseP n ty m_inl phases) = pragmaToTH (DSpecialiseInstP ty) = Just $ SpecialiseInstP (typeToTH ty) #if __GLASGOW_HASKELL__ >= 807 pragmaToTH (DRuleP str mtvbs rbs lhs rhs phases) = @@ -557,7 +551,7 @@ index 4a18d57..914dbe2 100644 (expToTH lhs) (expToTH rhs) phases #else pragmaToTH (DRuleP str _ rbs lhs rhs phases) = -@@ -399,7 +404,7 @@ tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn) +@@ -399,7 +403,7 @@ tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn) tySynEqnToTH (DTySynEqn tvbs lhs rhs) = let lhs' = typeToTH lhs in case unfoldType lhs' of @@ -566,7 +560,7 @@ index 4a18d57..914dbe2 100644 (_, _) -> error $ "Illegal type instance LHS: " ++ pprint lhs' #else tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn) -@@ -418,18 +423,17 @@ typeToTH :: DType -> Type +@@ -418,18 +422,17 @@ typeToTH :: DType -> Type -- so that we may collapse them into a single ForallT when sweetening. -- See Note [Desugaring and sweetening ForallT] in L.H.T.Desugar.Core. typeToTH (DForallT ForallInvis tvbs (DConstrainedT ctxt ty)) = @@ -588,7 +582,7 @@ index 4a18d57..914dbe2 100644 ty' = typeToTH ty typeToTH (DConstrainedT cxt ty) = ForallT [] (map predToTH cxt) (typeToTH ty) typeToTH (DAppT t1 t2) = AppT (typeToTH t1) (typeToTH t2) -@@ -451,9 +455,20 @@ typeToTH (DAppKindT t k) = AppKindT (typeToTH t) (typeToTH k) +@@ -451,9 +454,20 @@ typeToTH (DAppKindT t k) = AppKindT (typeToTH t) (typeToTH k) typeToTH (DAppKindT t _) = typeToTH t #endif @@ -612,7 +606,7 @@ index 4a18d57..914dbe2 100644 cxtToTH :: DCxt -> Cxt cxtToTH = map predToTH -@@ -530,13 +545,13 @@ predToTH DWildCardT = error "Wildcards supported only in GHC 8.0+" +@@ -530,13 +544,13 @@ predToTH DWildCardT = error "Wildcards supported only in GHC 8.0+" -- so that we may collapse them into a single ForallT when sweetening. -- See Note [Desugaring and sweetening ForallT] in L.H.T.Desugar.Core. predToTH (DForallT ForallInvis tvbs (DConstrainedT ctxt p)) = @@ -629,7 +623,7 @@ index 4a18d57..914dbe2 100644 predToTH (DConstrainedT cxt p) = ForallT [] (map predToTH cxt) (predToTH p) #else diff --git a/Language/Haskell/TH/Desugar/Util.hs b/Language/Haskell/TH/Desugar/Util.hs -index dd2f621..87ce301 100644 +index dd2f621..d63ad9d 100644 --- a/Language/Haskell/TH/Desugar/Util.hs +++ b/Language/Haskell/TH/Desugar/Util.hs @@ -36,6 +36,7 @@ module Language.Haskell.TH.Desugar.Util ( @@ -720,21 +714,20 @@ index dd2f621..87ce301 100644 #endif unravelType t = (FANil, t) -@@ -414,7 +413,12 @@ extractBoundNamesPat (LitP _) = OS.empty +@@ -414,7 +413,11 @@ extractBoundNamesPat (LitP _) = OS.empty extractBoundNamesPat (VarP name) = OS.singleton name extractBoundNamesPat (TupP pats) = foldMap extractBoundNamesPat pats extractBoundNamesPat (UnboxedTupP pats) = foldMap extractBoundNamesPat pats -extractBoundNamesPat (ConP _ pats) = foldMap extractBoundNamesPat pats +extractBoundNamesPat (ConP _ -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + _ +#endif + pats) = foldMap extractBoundNamesPat pats extractBoundNamesPat (InfixP p1 _ p2) = extractBoundNamesPat p1 `OS.union` extractBoundNamesPat p2 extractBoundNamesPat (UInfixP p1 _ p2) = extractBoundNamesPat p1 `OS.union` -@@ -566,3 +570,31 @@ uniStarKindName = ''(Kind.★) +@@ -566,3 +569,31 @@ uniStarKindName = ''(Kind.★) uniStarKindName = starKindName #endif #endif diff --git a/patches/th-desugar-1.12.patch b/patches/th-desugar-1.12.patch index e0a86dc79926b305e4a2143fb2514797119f9fa7..8da2efebc19da7643dac63572802d5ce03be5f12 100644 --- a/patches/th-desugar-1.12.patch +++ b/patches/th-desugar-1.12.patch @@ -1,36 +1,33 @@ diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs -index 0a6fe1d..ea00a8b 100644 +index 0a6fe1d..ba9e12d 100644 --- a/Language/Haskell/TH/Desugar/Core.hs +++ b/Language/Haskell/TH/Desugar/Core.hs -@@ -89,8 +89,18 @@ dsExp (LamCaseE matches) = do +@@ -89,8 +89,16 @@ dsExp (LamCaseE matches) = do dsExp (TupE exps) = dsTup tupleDataName exps dsExp (UnboxedTupE exps) = dsTup unboxedTupleDataName exps dsExp (CondE e1 e2 e3) = - dsExp (CaseE e1 [ Match (ConP 'True []) (NormalB e2) [] - , Match (ConP 'False []) (NormalB e3) [] ]) + dsExp (CaseE e1 [ Match (ConP 'True -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + []) (NormalB e2) [] + , Match (ConP 'False -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + []) (NormalB e3) [] ]) dsExp (MultiIfE guarded_exps) = let failure = DAppE (DVarE 'error) (DLitE (StringL "Non-exhaustive guards in multi-way if")) in dsGuards guarded_exps failure -@@ -558,7 +568,12 @@ dsPat (VarP n) = return $ DVarP n +@@ -558,7 +566,11 @@ dsPat (VarP n) = return $ DVarP n dsPat (TupP pats) = DConP (tupleDataName (length pats)) <$> mapM dsPat pats dsPat (UnboxedTupP pats) = DConP (unboxedTupleDataName (length pats)) <$> mapM dsPat pats -dsPat (ConP name pats) = DConP name <$> mapM dsPat pats +dsPat (ConP name -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + _ +#endif + pats) = DConP name <$> mapM dsPat pats @@ -38,17 +35,16 @@ index 0a6fe1d..ea00a8b 100644 dsPat (UInfixP _ _ _) = fail "Cannot desugar unresolved infix operators." diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs -index 1512ddb..f7475c2 100644 +index 1512ddb..efa9ace 100644 --- a/Language/Haskell/TH/Desugar/Sweeten.hs +++ b/Language/Haskell/TH/Desugar/Sweeten.hs -@@ -74,7 +74,12 @@ matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) [] +@@ -74,7 +74,11 @@ matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) [] patToTH :: DPat -> Pat patToTH (DLitP lit) = LitP lit patToTH (DVarP n) = VarP n -patToTH (DConP n pats) = ConP n (map patToTH pats) +patToTH (DConP n pats) = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (map patToTH pats) @@ -56,17 +52,16 @@ index 1512ddb..f7475c2 100644 patToTH (DBangP pat) = BangP (patToTH pat) patToTH (DSigP pat ty) = SigP (patToTH pat) (typeToTH ty) diff --git a/Language/Haskell/TH/Desugar/Util.hs b/Language/Haskell/TH/Desugar/Util.hs -index 6ad206c..73da83a 100644 +index 6ad206c..f5227dd 100644 --- a/Language/Haskell/TH/Desugar/Util.hs +++ b/Language/Haskell/TH/Desugar/Util.hs -@@ -417,7 +417,12 @@ extractBoundNamesPat (LitP _) = OS.empty +@@ -417,7 +417,11 @@ extractBoundNamesPat (LitP _) = OS.empty extractBoundNamesPat (VarP name) = OS.singleton name extractBoundNamesPat (TupP pats) = foldMap extractBoundNamesPat pats extractBoundNamesPat (UnboxedTupP pats) = foldMap extractBoundNamesPat pats -extractBoundNamesPat (ConP _ pats) = foldMap extractBoundNamesPat pats +extractBoundNamesPat (ConP _ -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + _ +#endif + pats) = foldMap extractBoundNamesPat pats diff --git a/patches/true-name-0.1.0.3.patch b/patches/true-name-0.1.0.3.patch index 5803a48c1b2d338077f2164a6a401931c0cd06a9..eb67b87318c4c656c5b48180daa5a9e4af9cb966 100644 --- a/patches/true-name-0.1.0.3.patch +++ b/patches/true-name-0.1.0.3.patch @@ -1,5 +1,5 @@ diff --git a/Unsafe/TrueName.hs b/Unsafe/TrueName.hs -index cab1bc1..a53edae 100644 +index cab1bc1..40423aa 100644 --- a/Unsafe/TrueName.hs +++ b/Unsafe/TrueName.hs @@ -65,6 +65,11 @@ decNames dec = case dec of @@ -47,14 +47,13 @@ index cab1bc1..a53edae 100644 #endif predNames :: Pred -> [Name]{- {{{ -} -@@ -321,7 +342,12 @@ truename = QuasiQuoter +@@ -321,7 +342,11 @@ truename = QuasiQuoter _ -> err $ occString occ ++ " has a strange flavour" makeP (name, vars) = if vars == [".."] then RecP name . capture VarP <$> recFields name - else return $ ConP name (map pat vars) where + else return $ ConP name -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + (map pat vars) where diff --git a/patches/typenums-0.1.2.1.patch b/patches/typenums-0.1.2.1.patch deleted file mode 100644 index 18fcce45958d22a73063bbaccb5d91568ea9c1e3..0000000000000000000000000000000000000000 --- a/patches/typenums-0.1.2.1.patch +++ /dev/null @@ -1,53 +0,0 @@ -diff --git a/src/Data/TypeNums/Ints.hs b/src/Data/TypeNums/Ints.hs -index 300bd5b..b0f6cbc 100644 ---- a/src/Data/TypeNums/Ints.hs -+++ b/src/Data/TypeNums/Ints.hs -@@ -53,14 +53,17 @@ data TInt - class KnownInt (n :: k) where - intSing :: SInt n - -+proxy'# :: () -> Proxy# (a :: k) -+proxy'# _ = proxy# -+ - instance forall n. KnownNat n => KnownInt n where -- intSing = SInt $! natVal' (proxy# @Nat @n) -+ intSing = SInt $! natVal' (proxy'# @Nat @n ()) - - instance forall n. KnownNat n => KnownInt ('Pos n) where -- intSing = SInt $! natVal' (proxy# @Nat @n) -+ intSing = SInt $! natVal' (proxy'# @Nat @n ()) - - instance forall n. KnownNat n => KnownInt ('Neg n) where -- intSing = SInt $! negate (natVal' (proxy# @Nat @n)) -+ intSing = SInt $! negate (natVal' (proxy'# @Nat @n ())) - - -- | Get the value associated with a type-level integer - intVal :: -diff --git a/src/Data/TypeNums/Rats.hs b/src/Data/TypeNums/Rats.hs -index 74a7bb6..390bca5 100644 ---- a/src/Data/TypeNums/Rats.hs -+++ b/src/Data/TypeNums/Rats.hs -@@ -58,16 +58,19 @@ newtype SRat r = - class KnownRat r where - ratSing :: SRat r - -+proxy'# :: () -> Proxy# (a :: k) -+proxy'# _ = proxy# -+ - instance {-# OVERLAPPING #-} (TypeError ('Text "Denominator must not equal 0")) => - KnownRat (n ':% 0) where - ratSing = error "Unreachable" - --instance {-# OVERLAPS #-} forall (n :: k) d. (KnownInt n, KnownNat d, d /= 0) => -+instance {-# OVERLAPS #-} forall k (n :: k) d. (KnownInt n, KnownNat d, d /= 0) => - KnownRat (n ':% d) where -- ratSing = SRat $! intVal' (proxy# @k @n) % natVal' (proxy# @Nat @d) -+ ratSing = SRat $! intVal' (proxy'# @k @n ()) % natVal' (proxy'# @Nat @d ()) - --instance {-# OVERLAPPABLE #-} forall (n :: k). (KnownInt n) => KnownRat n where -- ratSing = SRat $! intVal' (proxy# @k @n) % 1 -+instance {-# OVERLAPPABLE #-} forall k (n :: k). (KnownInt n) => KnownRat n where -+ ratSing = SRat $! intVal' (proxy'# @k @n ()) % 1 - - -- | Get the value associated with a type-level rational - ratVal :: diff --git a/patches/vector-th-unbox-0.2.1.9.patch b/patches/vector-th-unbox-0.2.1.9.patch index bee24190c728d8af01141b276a98e8ca7a66407e..5b7c006c6a3d575deb9ed610ef39d7056a564982 100644 --- a/patches/vector-th-unbox-0.2.1.9.patch +++ b/patches/vector-th-unbox-0.2.1.9.patch @@ -1,8 +1,8 @@ diff --git a/Data/Vector/Unboxed/Deriving.hs b/Data/Vector/Unboxed/Deriving.hs -index 3752249..f7e811c 100644 +index 3752249..50fcd49 100644 --- a/Data/Vector/Unboxed/Deriving.hs +++ b/Data/Vector/Unboxed/Deriving.hs -@@ -56,10 +56,17 @@ common name = do +@@ -56,10 +56,16 @@ common name = do let vName = mkName ("V_" ++ name) i <- newPatExp "idx" n <- newPatExp "len" @@ -15,11 +15,19 @@ index 3752249..f7e811c 100644 return Common {..} + where + conPCompat n pats = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats -- Turn any 'Name' into a capturable one. capture :: Name -> Name +@@ -164,7 +170,7 @@ derivingUnbox name argsQ toRepQ fromRepQ = do + , newtypeVector, instanceVector ] + + newtypeInstD' :: Name -> [Type] -> Con -> Dec +-newtypeInstD' name args con = ++newtypeInstD' name args con = + #if MIN_VERSION_template_haskell(2,15,0) + NewtypeInstD [] Nothing (foldl AppT (ConT name) args) Nothing con [] + #elif MIN_VERSION_template_haskell(2,11,0) diff --git a/patches/xml-hamlet-0.5.0.1.patch b/patches/xml-hamlet-0.5.0.1.patch index c331d12c78d28c105042f97d9b89d3b55f1727f4..2d83a797f337755431879c890d48d091c6d23ffe 100644 --- a/patches/xml-hamlet-0.5.0.1.patch +++ b/patches/xml-hamlet-0.5.0.1.patch @@ -1,15 +1,14 @@ diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs -index e0dec6d..cb218dd 100644 +index e0dec6d..5dc0235 100644 --- a/Text/Hamlet/XML.hs +++ b/Text/Hamlet/XML.hs -@@ -77,7 +77,12 @@ bindingPattern (BindList is) = do +@@ -77,7 +77,11 @@ bindingPattern (BindList is) = do return (ListP patterns, concat scopes) bindingPattern (BindConstr con is) = do (patterns, scopes) <- fmap unzip $ mapM bindingPattern is - return (ConP (mkConName con) patterns, concat scopes) + return (ConP (mkConName con) -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + patterns, concat scopes) diff --git a/patches/yesod-core-1.6.18.8.patch b/patches/yesod-core-1.6.18.8.patch index 7b5338f2a8beb22617fbe64f1801a4eea00b64da..254cdd21d710f9364399d84b21d872df17ad4ced 100644 --- a/patches/yesod-core-1.6.18.8.patch +++ b/patches/yesod-core-1.6.18.8.patch @@ -53,7 +53,7 @@ index f3505b9..7fe9159 100644 ) appCxt' mname <- lookupTypeName namestr diff --git a/src/Yesod/Routes/TH/Dispatch.hs b/src/Yesod/Routes/TH/Dispatch.hs -index c061a1c..d496dfd 100644 +index c061a1c..1d12c9d 100644 --- a/src/Yesod/Routes/TH/Dispatch.hs +++ b/src/Yesod/Routes/TH/Dispatch.hs @@ -1,3 +1,4 @@ @@ -93,20 +93,19 @@ index c061a1c..d496dfd 100644 return (pat, Just $ VarE multiName) let dynsMulti = -@@ -200,3 +201,11 @@ mkDispatchClause MkDispatchSettings {..} resources = do +@@ -200,3 +201,10 @@ mkDispatchClause MkDispatchSettings {..} resources = do defaultGetHandler :: Maybe String -> String -> Q Exp defaultGetHandler Nothing s = return $ VarE $ mkName $ "handle" ++ s defaultGetHandler (Just method) s = return $ VarE $ mkName $ map toLower method ++ s + +conPCompat :: Name -> [Pat] -> Pat +conPCompat n pats = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats diff --git a/src/Yesod/Routes/TH/RenderRoute.hs b/src/Yesod/Routes/TH/RenderRoute.hs -index 09654c8..c7ed292 100644 +index 09654c8..6d9e4de 100644 --- a/src/Yesod/Routes/TH/RenderRoute.hs +++ b/src/Yesod/Routes/TH/RenderRoute.hs @@ -67,7 +67,7 @@ mkRenderRouteClauses = @@ -127,20 +126,19 @@ index 09654c8..c7ed292 100644 pack' <- [|pack|] tsp <- [|toPathPiece|] -@@ -182,3 +182,11 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness +@@ -182,3 +182,10 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness instanceD :: Cxt -> Type -> [Dec] -> Dec instanceD = InstanceD Nothing + +conPCompat :: Name -> [Pat] -> Pat +conPCompat n pats = ConP n -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + pats diff --git a/src/Yesod/Routes/TH/RouteAttrs.hs b/src/Yesod/Routes/TH/RouteAttrs.hs -index 0f1aeec..8d52ff5 100644 +index 0f1aeec..72b24b4 100644 --- a/src/Yesod/Routes/TH/RouteAttrs.hs +++ b/src/Yesod/Routes/TH/RouteAttrs.hs @@ -1,3 +1,4 @@ @@ -148,14 +146,13 @@ index 0f1aeec..8d52ff5 100644 {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} module Yesod.Routes.TH.RouteAttrs -@@ -26,7 +27,12 @@ goTree front (ResourceParent name _check pieces trees) = +@@ -26,7 +27,11 @@ goTree front (ResourceParent name _check pieces trees) = toIgnore = length $ filter isDynamic pieces isDynamic Dynamic{} = True isDynamic Static{} = False - front' = front . ConP (mkName name) . ignored + front' = front . ConP (mkName name) -+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083) -+#if __GLASGOW_HASKELL__ >= 901 ++#if MIN_VERSION_template_haskell(2,18,0) + [] +#endif + . ignored