Using phantom types to represent amounts and exchange rates of currencies I posted the following snippet to StackOverflow, and someone said there was much to be improved.

{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

class (Show a) =&gt; Currency a where unphantom :: a

data USD = USD deriving Show
data EUR = EUR deriving Show

instance Currency USD where unphantom = USD
instance Currency EUR where unphantom = EUR

data Amount a where
  Amount :: Currency a =&gt; Float -&gt; Amount a
instance Show (Amount a) where 
  show (Amount x) = show x ++ show (unphantom :: a)

data Rate a b where
  Rate :: (Currency a, Currency b) =&gt; Float -&gt; Rate a b
-- ...


Having to define an unphantom function for each currency is a bit annoying but I don't really see a way around it. Also, note that my use of Float to represent monetary values is just a placeholder.

How can I improve this code?
You could rely on the fact the types describing your currencies are Enumerable and you can therefore always generate the appropriate token based on the type of an expression. You would write something like this:

{-# LANGUAGE ScopedTypeVariables #-}

module Currency where

data USD = USD deriving (Show, Enum)
data EUR = EUR deriving (Show, Enum)

currencyRep :: Enum a =&gt; a
currencyRep = toEnum 0

newtype Amount a = Amount { value :: Float }

instance (Enum a, Show a) =&gt; Show (Amount a) where
  show v = show (value v) ++ " " ++ show (currencyRep :: a)

newtype Rate a b = Rate { rate :: Float }

convert :: Rate a b -&gt; Amount a -&gt; Amount b
convert k v = Amount (rate k * value v)

-- example:
main :: IO ()
main = putStrLn $ show (Amount 3 :: Amount EUR)


Now you can really talk about phantom types: Amount does not carry around a representation of the currency being used and both Amount and Rate are newtypes meaning that they will be optimized away.

Question: Is there a typeclass of singletons out there? It'd be cleaner than using Enum (though relying on deriving is pretty useful) if we had something like this:

class Singleton a where
  unique :: a