[Haskell-cafe] Typeable convenience class
David Feuer
david.feuer at gmail.com
Wed Sep 15 04:33:23 UTC 2021
Occasionally it's useful to get a little information about a type's
constructor (especially its name, module, or source package), without
needing a Typeable instance for the type itself. I came up with this
rather simple way, but I'm wondering if something like this already
exists on Hackage.
#if __GLASGOW_HASKELL__ < 710
{-# language OverlappingInstances #-}
#endif
...
import Data.Typeable
class OuterTypeable a where
-- | Get the 'TypeRep' corresponding to the outermost constructor
-- of a type.
getConTR :: proxy a -> TypeRep
#if __GLASGOW_HASKELL__ >= 708
instance
# if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPING #-}
# endif
OuterTypeable f => OuterTypeable (f a) where
getConTR _ = getConTR (Proxy :: Proxy f)
instance Typeable a => OuterTypeable a where
getConTR = typeRep
#else
-- Before GHC 7.8, we didn't have polykinded Typeable, so things were
-- rather less nice.
instance Typeable a => OuterTypeable a where
getConTR _ = typeOf (undefined :: a)
instance Typeable1 p => OuterTypeable (p a) where
getConTR _ = typeOf1 (undefined :: p a)
[...]
instance Typeable7 p => OuterTypeable (p a b c d e f g) where
getConTR _ = typeOf7 (undefined :: p a b c d e f g)
#endif
More information about the Haskell-Cafe
mailing list