diff --git a/base-compat/CHANGES.markdown b/base-compat/CHANGES.markdown index b94df68..c7f8b48 100644 --- a/base-compat/CHANGES.markdown +++ b/base-compat/CHANGES.markdown @@ -5,6 +5,8 @@ - Backport `getSolo` to `Data.Tuple.Compat` when building against `ghc-prim-0.8.0` (GHC 9.2) or later. To backport `getSolo` to older versions of GHC, import `Data.Tuple.Compat` from `base-compat-batteries` instead. + - Backport `decT` and `hdecT` to `Data.Typeable.Compat` + - Backport `decTypeRep` to `Type.Reflection.Compat` ## Changes in 0.13.0 [2023.03.10] - Sync with `base-4.18`/GHC 9.6 diff --git a/base-compat/README.markdown b/base-compat/README.markdown index b7cc290..ef52284 100644 --- a/base-compat/README.markdown +++ b/base-compat/README.markdown @@ -166,6 +166,8 @@ So far the following is covered. * `unzip` to `Data.Functor.Compat` * `(!?)` and `unsnoc` to `Data.List.Compat` * `getSolo` to `Data.Tuple.Compat` + * `decT` and `hdecT` to `Data.Typeable.Compat` + * `decTypeRep` to `Type.Reflection.Compat` ## What is not covered diff --git a/base-compat/src/Data/Typeable/Compat.hs b/base-compat/src/Data/Typeable/Compat.hs index 81595fc..3362b4f 100644 --- a/base-compat/src/Data/Typeable/Compat.hs +++ b/base-compat/src/Data/Typeable/Compat.hs @@ -3,22 +3,27 @@ {-# LANGUAGE Trustworthy #-} #endif #if MIN_VERSION_base(4,10,0) && !(MIN_VERSION_base(4,18,0)) +{-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} #endif module Data.Typeable.Compat ( module Base #if MIN_VERSION_base(4,10,0) , heqT +, decT +, hdecT #endif ) where import Data.Typeable as Base -#if MIN_VERSION_base(4,10,0) && !(MIN_VERSION_base(4,18,0)) +#if MIN_VERSION_base(4,10,0) && !(MIN_VERSION_base(4,19,0)) import Prelude.Compat +import Data.Void (Void) import qualified Type.Reflection.Compat as TR #endif @@ -32,3 +37,22 @@ heqT = ta `TR.eqTypeRep` tb ta = TR.typeRep :: TR.TypeRep a tb = TR.typeRep :: TR.TypeRep b #endif + +#if !(MIN_VERSION_base(4,19,0)) +-- | Decide an equality of two types +-- +-- /Since: 4.19.0.0/ +decT :: forall a b. (Typeable a, Typeable b) => Either (a :~: b -> Void) (a :~: b) +decT = case hdecT @a @b of + Right HRefl -> Right Refl + Left p -> Left (\Refl -> p HRefl) + +-- | Decide heterogeneous equality of two types. +-- +-- /Since: 4.19.0.0/ +hdecT :: forall a b. (Typeable a, Typeable b) => Either (a :~~: b -> Void) (a :~~: b) +hdecT = ta `TR.decTypeRep` tb + where + ta = TR.typeRep :: TR.TypeRep a + tb = TR.typeRep :: TR.TypeRep b +#endif diff --git a/base-compat/src/Type/Reflection/Compat.hs b/base-compat/src/Type/Reflection/Compat.hs index 5f0c01b..b1503b4 100644 --- a/base-compat/src/Type/Reflection/Compat.hs +++ b/base-compat/src/Type/Reflection/Compat.hs @@ -8,6 +8,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} # if !(MIN_VERSION_base(4,11,0)) {-# LANGUAGE TypeInType #-} @@ -18,6 +19,7 @@ module Type.Reflection.Compat ( module Base , withTypeable , pattern TypeRep +, decTypeRep #endif ) where @@ -31,8 +33,16 @@ import Type.Reflection as Base hiding (withTypeable) # if !(MIN_VERSION_base(4,11,0)) import GHC.Exts (TYPE) import Type.Reflection (Typeable, TypeRep) +# endif + +# if !(MIN_VERSION_base(4,19,0)) +import Data.Void (Void) +import Prelude.Compat +import Type.Reflection.Unsafe (typeRepFingerprint) import Unsafe.Coerce (unsafeCoerce) +# endif +# if !(MIN_VERSION_base(4,11,0)) -- | Use a 'TypeRep' as 'Typeable' evidence. withTypeable :: forall (a :: k) (r :: TYPE rep). () => TypeRep a -> (Typeable a => r) -> r @@ -79,4 +89,20 @@ pattern TypeRep :: forall a. () => Typeable a => TypeRep a pattern TypeRep <- (typeableInstance -> TypeableInstance) where TypeRep = typeRep # endif + +# if !(MIN_VERSION_base(4,19,0)) +-- | Type equality decision +-- +-- /Since: 4.19.0.0/ +decTypeRep :: forall k1 k2 (a :: k1) (b :: k2). + TypeRep a -> TypeRep b -> Either (a :~~: b -> Void) (a :~~: b) +decTypeRep a b + | sameTypeRep a b = Right (unsafeCoerce HRefl) + | otherwise = Left (\HRefl -> errorWithoutStackTrace ("decTypeRep: Impossible equality proof " ++ show a ++ " :~: " ++ show b)) +{-# INLINEABLE decTypeRep #-} + +sameTypeRep :: forall k1 k2 (a :: k1) (b :: k2). + TypeRep a -> TypeRep b -> Bool +sameTypeRep a b = typeRepFingerprint a == typeRepFingerprint b +# endif #endif