Allow recursive (undecidable) superclasses
[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 {- Solving 'tspan'
39
40 Given: Build (DC d) r, BuildR r ~ DC d
41 (by sc) Monoid (DC d)
42
43 Wanted:
44 Build acc0 r0
45 Monid acc0
46 acc0 ~ DC d0
47 DC d0 ~ BuildR r0
48 r ~ r0
49 ==>
50 Build (DC d0) r
51 Monoid (DC d0) --> Monoid d0
52 DC d0 ~ BuildR r
53
54 From Given: BuildR r = DC d, hence
55 DC d0 ~ DC d
56 hence
57 d0 ~ d
58
59 ===>
60 Build (DC d) r
61 Monoid (DC d)
62
63 Now things are delicate. Either the instance Monoid (DC d) will fire or,
64 if we are lucky, we might spot that (Monoid (DC d)) is a superclass of
65 a given. But now (Decl 15) we add superclasses lazily, so that is less
66 likely to happen, and was always fragile. So include (MOnoid d) in the
67 signature, as was the case in the orignal ticket.
68 -}
69
70
71 foo = tspan "aa"
72
73 foo1 = tspan (tspan "aa")
74
75 bar = tspan "aa" :: DC String