summaryrefslogtreecommitdiff
path: root/testsuite/tests/polykinds/T7332.hs
blob: 79623e9803f45a7214021d2fffb3a8a0f2d38ea8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}

module T7332 where

import GHC.Exts( IsString(..) )
import Data.Monoid

newtype DC d = DC d
    deriving (Show, Monoid)

instance IsString (DC String) where
    fromString = DC


class Monoid acc => Build acc r where
    type BuildR r :: *          -- Result type
    build :: (acc -> BuildR r) -> acc -> r

instance Monoid dc => Build dc (DC dx) where
    type BuildR (DC dx) = DC dx
    build tr acc = tr acc

instance (Build dc r, a ~ dc) => Build dc (a->r) where
    type BuildR (a->r) = BuildR r
    build tr acc s = build tr (acc `mappend` s)


-- The type is inferred
-- tspan :: (Monoid d, Build (DC d) r, BuildR r ~ DC d) => r
tspan :: (Build (DC d) r, BuildR r ~ DC d) => r
tspan = build (id :: DC d -> DC d) mempty

{- Wanted:
       Build acc0 r0
       Monid acc0
       acc0 ~ DC d0
       DC d0 ~ BuildR r0
==>
       Build (DC d0) r0
       Monoid (DC d0)  -->  Monoid d0
       DC d- ~ BuildR r0

In fact Monoid (DC d0) is a superclass of (Build (DC do) r0)
But during inference we do not take upserclasses of wanteds
-}


foo = tspan "aa"

foo1 = tspan (tspan "aa")

bar = tspan "aa" :: DC String