Writing a counter function

Andrew J Bromage andrew@bromage.org
Mon, 1 Jul 2002 14:29:35 +1000


G'day all.

On Sun, Jun 30, 2002 at 01:51:56PM +0100, Peter G. Hancock wrote:

> Why not have a monad m a = Int -> (a,Int) which is a state monad plus
> the operation bump : Int -> m Int
> 
>  bump k n = (n,n+k) 

Oh, ye of insufficient genericity.  We can do better than that...

	import MonadTrans

	class (Monad m, Enum i) => MonadCounter i m | m -> i where
		bump :: Int -> m i
 
	newtype CounterT i m a = CounterT { runCounterT :: i -> m (a,i) }

	instance (Monad m, Enum i) => Monad (CounterT i m) where
		return a = CounterT $ \x -> return (a, x)
		m >>= k  = CounterT $ \x -> do
			(a, x') <- runCounterT m x
			runCounterT (k a) x'
		fail str = CounterT $ \_ -> fail str

	instance (Monad m, Enum i) => MonadCounter i (CounterT i m) where
		bump k = CounterT $ \x ->
			let (next:_) = drop k [x..]
			in return (x, next)   

	instance (Enum i) => MonadTrans (CounterT i) where
		lift m = CounterT $ \x -> do
			a <- m
			return (a, x)

	evalCounterT :: (Monad m, Enum i) => CounterT i m a -> i -> m a
	evalCounterT m x = do
	        (a, _) <- runCounterT m x
	        return a

	-- Example code follows

	main :: IO ()
	main = evalCounterT count 0

	count :: CounterT Int IO ()
	count = do
		x1 <- bump 1
		x2 <- bump 5
		x3 <- bump 0
		x4 <- bump 1
		lift (putStrLn $ show [x1,x2,x3,x4])

I'd better get back to work now.

Cheers,
Andrew Bromage