Modified error output and new tests for PolyKinds commit

1 files changed, 29 insertions, 0 deletions

diff --git a/testsuite/tests/polykinds/T5771.hs b/testsuite/tests/polykinds/T5771.hs
new file mode 100644
index 0000000000..00d760439a
--- /dev/null
+++ b/testsuite/tests/polykinds/T5771.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE DataKinds, PolyKinds, GADTs, TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module T5771 where
+
+class IndexedMonad m where
+  unit :: a -> m i i a
+  bind :: m i j a -> (a -> m j k b) -> m i k b
+
+newtype IndexedIO i j a = IndexedIO {runIndexedIO :: IO a}
+
+-- i and j are both *; instance is accepted
+instance IndexedMonad IndexedIO where
+  unit = IndexedIO . return
+  bind m k = IndexedIO $ runIndexedIO m >>= runIndexedIO . k
+infixl 1 `bind`
+
+data HList xs where
+  N    :: HList '[]
+  (:>) :: a -> HList as -> HList (a ': as)
+infixr 5 :>
+
+newtype HLState xs ys a = HLState {runHLState :: HList xs -> (a, HList ys)}
+
+-- i and j are now [*]; rejected with the MPTCs message
+instance IndexedMonad HLState where
+  unit x = HLState $ \s -> (x, s)
+  bind (HLState f) k = HLState $ \xs ->
+    case f xs of (a, ys) -> runHLState (k a) ys