summaryrefslogtreecommitdiff
path: root/testsuite/tests/rebindable/rebindable9.hs
blob: 120a93a3a4dde5689135957e1993a716899c2f45 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
{-# LANGUAGE RebindableSyntax, FlexibleInstances,
             MultiParamTypeClasses, FunctionalDependencies #-}

-- Trac #1537

module Foo where
import qualified Prelude
import Prelude hiding (Monad(..))

import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)

newtype Identity a = Identity { runIdentity :: a }

instance Prelude.Functor Identity where
    fmap = liftM

instance Applicative Identity where
    pure = Prelude.return
    (<*>) = ap

instance Prelude.Monad Identity where
    return a = Identity a
    m >>= k  = k (runIdentity m)

class Bind m1 m2 m3 | m1 m2 -> m3 where 
  (>>=) :: m1 a -> (a -> m2 b) -> m3 b

class Return m where
  returnM :: a -> m a
  fail   :: String -> m a 

instance Bind Maybe [] [] where
  Just x  >>= f = f x
  Nothing >>= f = []

instance Functor a => Bind Identity a a 	where m >>= f = f (runIdentity m)
instance Functor a => Bind a Identity a 	where m >>= f = fmap (runIdentity . f) m

instance Prelude.Monad m => Bind m m m where (>>=) = (Prelude.>>=)

instance Return [] where 
  returnM x = [x]
  fail _   = [] 

return :: a -> Identity a
return = Prelude.return

should_compile :: [Int]
should_compile = do 
  a <- Just 1
  b <- [a*1,a*2]
  return (b+1)