summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/deriving/should_compile/drv020.hs
blob: 8794b745e53899ea43458e73344fed5992f2d51e (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
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
             FlexibleInstances, GeneralizedNewtypeDeriving #-}

-- Test deriving of a multi-parameter class for 
-- one-argument newtype defined in the same module
module ShouldSucceed where

-- library stuff

class Monad m => MonadState s m | m -> s where
    get :: m s
    put :: s -> m ()

newtype State s a = State {
                           runState :: (s -> (a, s))
                          }

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

-- test code

newtype Foo a = MkFoo (State Int a)
 deriving (Monad, MonadState Int)

f :: Foo Int
f = get