Skip to content
Snippets Groups Projects
Commit 05e8fc39 authored by Ryan Scott's avatar Ryan Scott
Browse files

Patch deriving-compat-0.5.10 and text-show-3.9

parent d4e46f0c
No related branches found
No related tags found
1 merge request!149Patch deriving-compat-0.5.10 and text-show-3.9
Pipeline #33333 failed
Stage: test
Hide whitespace changes
Inline Side-by-side
patches/deriving-compat-0.5.10.patch
+ 160
− 0
View file @ 05e8fc39
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 diff --git a/src/Data/Functor/Deriving/Internal.hs b/src/Data/Functor/Deriving/Internal.hs
index 57d8f9c..e79ba2d 100644 index 57d8f9c..e79ba2d 100644
--- a/src/Data/Functor/Deriving/Internal.hs --- a/src/Data/Functor/Deriving/Internal.hs
...@@ -40,3 +126,77 @@ index 57d8f9c..e79ba2d 100644 ...@@ -40,3 +126,77 @@ index 57d8f9c..e79ba2d 100644
+ [] + []
+#endif +#endif
+ pats + 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
patches/text-show-3.9.patch 0 → 100644
+ 243
− 0
View file @ 05e8fc39
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
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment