diff options
| -rw-r--r-- | testsuite/tests/indexed-types/should_compile/T7332.hs | 49 | ||||
| -rw-r--r-- | testsuite/tests/indexed-types/should_compile/all.T | 1 |
2 files changed, 50 insertions, 0 deletions
diff --git a/testsuite/tests/indexed-types/should_compile/T7332.hs b/testsuite/tests/indexed-types/should_compile/T7332.hs new file mode 100644 index 0000000000..0649741f9d --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T7332.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MagicHash #-}
+
+module Oleg where
+
+import GHC.Exts hiding( build )
+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 (id :: DC d -> DC d) mempty
+
+foo = tspan "aa"
+
+{- Need (Monoid d, Build (DC d) (a -> t), BuildR (a -> t) ~ DC d, IsString a)
+
+BuildR (a -> t) = BuildR t
+Build (DC d) (a -> t) ===> (Build (DC d) t, a ~ DC d)
+
+ -}
+
+foo1 = tspan (tspan "aa")
+
+bar = tspan "aa" :: DC String
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 067415dcc0..bdb3bff47c 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -200,5 +200,6 @@ test('T7156', normal, compile, ['']) test('T5591a', normal, compile, ['']) test('T5591b', normal, compile, ['']) test('T7280', normal, compile, ['']) +test('T7332', normal, compile, ['']) |