drv020.hs 1.01 KB
Newer Older
1 2
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
             FlexibleInstances, GeneralizedNewtypeDeriving #-}
3 4 5 6 7

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

thoughtpolice's avatar
thoughtpolice committed
8 9 10
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)

11 12 13 14 15 16 17 18 19 20
-- 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))
                          }

thoughtpolice's avatar
thoughtpolice committed
21 22 23 24 25 26 27
instance Functor (State s) where
    fmap = liftM

instance Applicative (State s) where
    pure = return
    (<*>) = ap

28 29 30 31 32 33 34 35 36 37 38 39 40
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)
thoughtpolice's avatar
thoughtpolice committed
41
 deriving (Functor, Applicative, Monad, MonadState Int)
42 43 44

f :: Foo Int
f = get