Pattern match phantom type

Question

I'm trying to implement a CurrencyQty type that acts like a number tagged at compile time:

data Currency = Usd | Eur | Gbp

data CurrencyQty (a :: Currency) = CurrencyQty Double deriving (Num)

And now I want to implement a generic conversion function that looks up exchange rates dynamically. Suppose I have some function

currentExchangeRate :: Currency -> Currency -> IO Double

I want to write

inUsd :: CurrencyQty a -> IO (CurrencyQty Usd)
inUsd (CurrencyQty Usd x) = return x
inUsd (CurrencyQty Eur x) = fmap (*x) $ currentExchangeRate Usd Eur
inUsd (CurrencyQty Gbp x) = fmap (*x) $ currentExchangeRate Usd Gbp

Or maybe somehow

inUsd :: CurrencyQty a -> IO (CurrencyQty Usd)
inUsd (CurrencyQty a x) = fmap (*x) $ currentExchangeRate Usd a

The syntax I'm using obviously isn't valid haskell... is there a way to accomplish this?

Answer 1

You can't use a phantom for this. Phantom types disappear at runtime, and you need some runtime information for your inUsd function.

The usual approach is to use GADTs and singleton types.

-- the "index" type
data Currency = Usd | Eur | Gbp

-- the "singleton" type
-- If you want to autogenerate this, check out the singletons
-- package on Hackage
data SCurrency (a :: Currency) where
   SUsd :: Scurrency Usd
   SEur :: Scurrency Eur
   SGbp :: Scurrency Gbp

-- the "indexed" type
data CurrencyQty (a :: Currency) where
  CurrencyQty :: SCurrency a -> Double -> CurrencyQty a

instance Num (CurrencyQty a) where
   ... -- you have to manually write this, I guess?

inUsd :: CurrencyQty a -> IO (CurrencyQty Usd)
inUsd (CurrencyQty SUsd x) = return x
inUsd (CurrencyQty SEur x) = fmap (*x) $ currentExchangeRate Usd Eur
inUsd (CurrencyQty SGbp x) = fmap (*x) $ currentExchangeRate Usd Gbp

Let me add that your code is OK. If Haskell had full dependent types, it would be possible to use your code with minor adjustments, and avoiding the additional singleton type. At the present time, however, Haskell can not avoid that, and some more effort is needed.