Test Trac #7729

testsuite/tests/indexed-types/should_fail/T7729.hs

+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+module T7729 where
+
+class Monad m => PrimMonad m where
+  type PrimState m
+
+class MonadTrans t where
+  lift :: Monad m => m a -> t m a
+
+class (PrimMonad (BasePrimMonad m), Monad m) => MonadPrim m where
+  type BasePrimMonad m :: * -> *
+  liftPrim :: BasePrimMonad m a -> m a
+
+
+newtype Rand m a = Rand {
+  runRand :: Maybe (m ()) -> m a
+  }
+
+instance (Monad m) => Monad (Rand m) where
+  return           = Rand . const . return
+  (Rand rnd) >>= f = Rand $ \g -> (\x -> runRand (f x) g) =<< rnd g
+
+instance MonadTrans Rand where
+  lift = Rand . const
+
+instance MonadPrim m => MonadPrim (Rand m) where
+  type BasePrimMonad (Rand m) = BasePrimMonad m
+  liftPrim = liftPrim . lift
\ No newline at end of file

testsuite/tests/indexed-types/should_fail/T7729.stderr

+
+T7729.hs:28:14:
+    Could not deduce (BasePrimMonad (Rand m)
+                      ~ t0 (BasePrimMonad (Rand m)))
+    from the context (PrimMonad (BasePrimMonad (Rand m)),
+                      Monad (Rand m),
+                      MonadPrim m)
+      bound by the instance declaration at T7729.hs:26:10-42
+    The type variable ‛t0’ is ambiguous
+    Expected type: t0 (BasePrimMonad (Rand m)) a -> Rand m a
+      Actual type: BasePrimMonad (Rand m) a -> Rand m a
+    Relevant bindings include
+      liftPrim :: BasePrimMonad (Rand m) a -> Rand m a
+        (bound at T7729.hs:28:3)
+    In the first argument of ‛(.)’, namely ‛liftPrim’
+    In the expression: liftPrim . lift
+    In an equation for ‛liftPrim’: liftPrim = liftPrim . lift

testsuite/tests/indexed-types/should_fail/T7729a.hs

+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+module T7729a where
+
+class Monad m => PrimMonad m where
+  type PrimState m
+
+class MonadTrans t where
+  lift :: Monad m => m a -> t m a
+
+class (PrimMonad (BasePrimMonad m), Monad m) => MonadPrim m where
+  type BasePrimMonad m :: * -> *
+  liftPrim :: BasePrimMonad m a -> m a
+
+
+newtype Rand m a = Rand {
+  runRand :: Maybe (m ()) -> m a
+  }
+
+instance (Monad m) => Monad (Rand m) where
+  return           = Rand . const . return
+  (Rand rnd) >>= f = Rand $ \g -> (\x -> runRand (f x) g) =<< rnd g
+
+instance MonadTrans Rand where
+  lift = Rand . const
+
+instance MonadPrim m => MonadPrim (Rand m) where
+  type BasePrimMonad (Rand m) = BasePrimMonad m
+  liftPrim x = liftPrim (lift x)   -- This line changed from T7729
\ No newline at end of file

testsuite/tests/indexed-types/should_fail/T7729a.stderr

+
+T7729a.hs:28:31:
+    Occurs check: cannot construct the infinite type: m0 ~ t0 m0
+    Expected type: m0 a
+      Actual type: BasePrimMonad (Rand m) a
+    In the first argument of ‛lift’, namely ‛x’
+    In the first argument of ‛liftPrim’, namely ‛(lift x)’
+    In the expression: liftPrim (lift x)

testsuite/tests/indexed-types/should_fail/all.T

@@ -94,4 +94,6 @@ test('T7354a',
      ['$MAKE -s --no-print-directory T7354a'])
 test('T7536', normal, compile_fail, [''])
 
-test('T7560', normal, compile_fail, [''])
\ No newline at end of file
+test('T7560', normal, compile_fail, [''])
+test('T7729', normal, compile_fail, [''])
+test('T7729a', normal, compile_fail, [''])