3

I had some types like this:

data Currency = USD | EUR
              deriving (Show, Typeable)

data Money :: Currency -> * where
  Money :: Int -> Money c
  deriving (Show, Typeable)

And I wanted to use typeOf with them in this function:

findRate :: Money a -> Rates -> Maybe Double
findRate a = M.lookup (typeOf a)

That didn't work, because the type a in findRate didn't have a Typeable instance. So I fixed it by doing this:

deriving instance Typeable USD
deriving instance Typeable EUR
findRate :: (Typeable a) => Money a -> Rates -> Maybe Double

However, that becomes a lot of boilerplate when the number of currencies increase. Is there a way to specify that all types of kind Currency should derive a Typeable instance?

EDIT: Also, a way to make it infer that in Money a the a is Typeable would be nice, so then I don't need to add (Typeable a) => everywhere. That's minor though.

Ramith Jayatilleka
  • 2,132
  • 16
  • 25

2 Answers2

4

Yes, you can use the AutoDeriveTypeable extension.

For the other part, the closest thing I could think of was to put Typeable c => inside the GADT definition as follows:

{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}

import Data.Typeable
import qualified Data.Map as M

type Rates = M.Map TypeRep Double

data Currency = USD | EUR
              deriving (Show, Typeable)

data Money :: Currency -> * where
  Money :: Typeable c => Int -> Money c

instance Show (Money c) where
    show (Money n) = "Money " ++ show n

findRate :: Money a -> Rates -> Maybe Double
findRate a@(Money _) = M.lookup (typeOf a)

Note though:

  • By the nature of GADTs, this requires actually evaluating a to get the Typeable context out of it, which typeOf itself doesn't.
  • This seems to ruin the ability to derive Show automatically for the GADT.
Ørjan Johansen
  • 18,119
  • 3
  • 43
  • 53
  • 1
    Thanks. Are there any docs on AutoDeriveTypeable, besides this (http://hauptwerk.blogspot.com/2012/11/coming-soon-in-ghc-head-poly-kinded.html)? It does fix the boilerplate issue (though for some reason I still need the Typeable derivation on `Money`). As for putting the Typeable constraint on `Money`, I tried that myself earlier and now, and it doesn't let findRate infer that. Does it work for you? – Ramith Jayatilleka Feb 08 '15 at 00:03
  • 1
    @RamithJayatilleka The [official GHC docs](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/deriving.html#auto-derive-typeable) are there, but that is just one paragraph. Oh, I *don't* need the `derive Typeable` on `Money`, this with GHC 7.8.3. Note how I changed the code of `findRate` slightly; the pattern match with `Money _` is what brings the `Typeable` instance into scope. – Ørjan Johansen Feb 08 '15 at 00:17
  • Oh I see. That makes more sense. Unfortunately, that end's up worse for me because I can't do `undefined :: Money a` like that. I'd have to do `Money (undefined :: a)` instead (or would that even work?), and I'd rather just put the Typeable constraint on. I think. – Ramith Jayatilleka Feb 08 '15 at 00:35
  • 1
    @RamithJayatilleka I think `Money undefined :: Money a` would work, but you're right it's not any better than putting on `Typeable` at that point. – Ørjan Johansen Feb 08 '15 at 00:38
  • 5
    Adding that `Typeable` context to the GADT will also add a dictionary to each `Money`, which has a performance cost. – dfeuer Feb 08 '15 at 00:46
1

If you're tracking an older document that requires Typeable, you likely do not need it. As of ghc 8.2, the explicit call for Typeable is deprecated and included "par for the course"; so no language pragma etc. is required.

Edmund's Echo
  • 766
  • 8
  • 15