53c163992b412c32591c25d9e820dcaa6961e41b
[ghc.git] / testsuite / tests / indexed-types / should_fail / T7729a.hs
1 {-# LANGUAGE FlexibleContexts, TypeFamilies #-}
2 module T7729a where
3
4 class Monad m => PrimMonad m where
5 type PrimState m
6
7 class MonadTrans t where
8 lift :: Monad m => m a -> t m a
9
10 class (PrimMonad (BasePrimMonad m), Monad m) => MonadPrim m where
11 type BasePrimMonad m :: * -> *
12 liftPrim :: BasePrimMonad m a -> m a
13
14
15 newtype Rand m a = Rand {
16 runRand :: Maybe (m ()) -> m a
17 }
18
19 instance (Monad m) => Monad (Rand m) where
20 return = Rand . const . return
21 (Rand rnd) >>= f = Rand $ \g -> (\x -> runRand (f x) g) =<< rnd g
22
23 instance MonadTrans Rand where
24 lift = Rand . const
25
26 instance MonadPrim m => MonadPrim (Rand m) where
27 type BasePrimMonad (Rand m) = BasePrimMonad m
28 liftPrim x = liftPrim (lift x) -- This line changed from T7729