summaryrefslogtreecommitdiff
path: root/testsuite/tests/typecheck/should_compile/HasKey.hs
blob: 8da7ee7205f6321649e3d104a3335003ce4a3dbd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}

-- Provided by Christian Maeder; broke
-- a pre-release GHC 7.0

module HasKey where

class Ord key => HasKey x key | x -> key where
   toKey :: x -> key

newtype Keyed x = Keyed { unKey :: x }

lift :: (HasKey x1 key1,HasKey x2 key2)
   => (key1 -> key2 -> a) -> (Keyed x1 -> Keyed x2 -> a)
lift f x1 x2 = f (toKey . unKey $ x1) (toKey . unKey $ x2)

instance HasKey x key => Eq (Keyed x) where
   (==) = lift (==)

instance HasKey x key => Ord (Keyed x)