{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

module Data.Monoid.Monad.RWS.Lazy
    ( module Control.Monad.RWS.Lazy
    , module Data.Monoid.Reducer
    )  where

import Control.Monad.RWS.Lazy
import Data.Monoid.Reducer

instance (Monoid w, Monoid m) => Monoid (RWS r w s m) where
    mempty = return mempty
    mappend = liftM2 mappend

instance (Monad m, Monoid w, Monoid n) => Monoid (RWST r w s m n) where
    mempty = return mempty 
    mappend = liftM2 mappend

instance (Monoid w, Monoid m) => Reducer m (RWS r w s m) where
    unit = return

instance (Monad m, Monoid w, Monoid n) => Reducer n (RWST r w s m n) where
    unit = return

instance (Monad m, Monoid w, Monoid n) => Reducer (m n) (RWST r w s m n) where
    unit = lift