
8 Apr
2009
8 Apr
'09
5:09 a.m.
Stephan Friedrichs wrote:
Oh I see - my bad. I was somehow thinking I could prevent modification of the input list but that's obviously impossible when the ConsumerT constructor is... exported? public? how do you say that?
You can export ConsumerT as an abstract type constructor.
{-# LANGUAGE GeneralizedNewtypeDeriving #-} module ConsumerT(ConsumerT, runConsumerT, next) where
import Control.Monad.State import Control.Monad.Trans
newtype ConsumerT c m a = ConsumerT { runConsumerT' :: StateT [c] m a } deriving (Functor, Monad, MonadTrans)
runConsumerT = runStateT . runConsumerT'
next :: Monad m => ConsumerT a m a next = ConsumerT $ StateT $ \(x:xs) -> return (x, xs)