Major patch to add -fwarn-redundant-constraints
[ghc.git] / testsuite / tests / polykinds / T7332.hs
1 {-# LANGUAGE NoMonomorphismRestriction #-}
2 {-# LANGUAGE MultiParamTypeClasses #-}
3 {-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
5 {-# LANGUAGE TypeFamilies #-}
6 {-# LANGUAGE OverloadedStrings #-}
7
8 module T7332 where
9
10 import GHC.Exts( IsString(..) )
11 import Data.Monoid
12
13 newtype DC d = DC d
14 deriving (Show, Monoid)
15
16 instance IsString (DC String) where
17 fromString = DC
18
19
20 class Monoid acc => Build acc r where
21 type BuildR r :: * -- Result type
22 build :: (acc -> BuildR r) -> acc -> r
23
24 instance Monoid dc => Build dc (DC dx) where
25 type BuildR (DC dx) = DC dx
26 build tr acc = tr acc
27
28 instance (Build dc r, a ~ dc) => Build dc (a->r) where
29 type BuildR (a->r) = BuildR r
30 build tr acc s = build tr (acc `mappend` s)
31
32
33 -- The type is inferred
34 -- tspan :: (Monoid d, Build (DC d) r, BuildR r ~ DC d) => r
35 tspan :: (Build (DC d) r, BuildR r ~ DC d) => r
36 tspan = build (id :: DC d -> DC d) mempty
37
38 {- Wanted:
39 Build acc0 r0
40 Monid acc0
41 acc0 ~ DC d0
42 DC d0 ~ BuildR r0
43 ==>
44 Build (DC d0) r0
45 Monoid (DC d0) --> Monoid d0
46 DC d- ~ BuildR r0
47
48 In fact Monoid (DC d0) is a superclass of (Build (DC do) r0)
49 But during inference we do not take upserclasses of wanteds
50 -}
51
52
53 foo = tspan "aa"
54
55 foo1 = tspan (tspan "aa")
56
57 bar = tspan "aa" :: DC String