Update Trac ticket URLs to point to GitLab
[ghc.git] / testsuite / tests / rebindable / rebindable9.hs
1 {-# LANGUAGE RebindableSyntax, FlexibleInstances,
2 MultiParamTypeClasses, FunctionalDependencies #-}
3
4 -- #1537
5
6 module Foo where
7 import qualified Prelude
8 import Prelude hiding (Monad(..))
9
10 import Control.Applicative (Applicative(..))
11 import Control.Monad (liftM, ap)
12
13 newtype Identity a = Identity { runIdentity :: a }
14
15 instance Prelude.Functor Identity where
16 fmap = liftM
17
18 instance Applicative Identity where
19 pure = Prelude.return
20 (<*>) = ap
21
22 instance Prelude.Monad Identity where
23 return a = Identity a
24 m >>= k = k (runIdentity m)
25
26 class Bind m1 m2 m3 | m1 m2 -> m3 where
27 (>>=) :: m1 a -> (a -> m2 b) -> m3 b
28
29 class Return m where
30 returnM :: a -> m a
31 fail :: String -> m a
32
33 instance Bind Maybe [] [] where
34 Just x >>= f = f x
35 Nothing >>= f = []
36
37 instance Bind Identity a a where m >>= f = f (runIdentity m)
38 instance Functor a => Bind a Identity a where m >>= f = fmap (runIdentity . f) m
39
40 instance Prelude.Monad m => Bind m m m where (>>=) = (Prelude.>>=)
41
42 instance Return [] where
43 returnM x = [x]
44 fail _ = []
45
46 return :: a -> Identity a
47 return = Prelude.return
48
49 should_compile :: [Int]
50 should_compile = do
51 a <- Just 1
52 b <- [a*1,a*2]
53 return (b+1)