{-# LANGUAGE UnboxedTuples #-}
module Util.ReaderWriter(ReaderWriter(),runReaderWriter) where

import Data.Monoid
import Control.Monad.Reader
import Control.Monad.Writer
-- strict unboxed ReaderWriter monad

newtype ReaderWriter r w a = ReaderWriter { _runReaderWriter :: r -> (# a, w #) }

runReaderWriter :: ReaderWriter r w a -> r -> (a,w)
runReaderWriter (ReaderWriter m) r = case m r of
    (# a, w #) -> (a,w)

instance Functor (ReaderWriter r w) where
	fmap f (ReaderWriter g) = ReaderWriter $ \r -> case g r of
            (# a, w #) -> (# f a, w #)

instance (Monoid w) => Monad (ReaderWriter r w) where
	return a = ReaderWriter $ \_ -> (# a, mempty #)
	(ReaderWriter m) >>= k  = ReaderWriter $ \r -> case m r of
            (# a,w #) -> case k a of
                ReaderWriter g -> case g r of
                    (# b, w' #) -> let w'' = w `mappend` w' in w'' `seq` (# b, w'' #)
        (ReaderWriter f) >> (ReaderWriter g) = ReaderWriter $ \r -> case f r of
            (# _, w #) -> case g r of
                (# a, w' #) -> let w'' = w `mappend` w' in w'' `seq` (# a, w'' #)

instance (Monoid w) => MonadWriter w (ReaderWriter r w) where
	tell   w = ReaderWriter $ \ _ -> w `seq` (# (), w #)
	listen (ReaderWriter m) = ReaderWriter $ \r -> case m r of
            (# a , w #) -> (# (a,w), w #)
	pass  (ReaderWriter m) = ReaderWriter $ \r -> case m r of
           (# (a, f), w #) -> let w' = f w in w' `seq` (# a, w' #)

instance Monoid w => MonadReader r (ReaderWriter r w) where
	ask       = ReaderWriter $ \r -> (# r, mempty #)
	local f (ReaderWriter m) = ReaderWriter $ \r -> m (f r)