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

module Data.Monoid.Monad.Either
    ( module Control.Monad.Either -- from category extras
    , module Data.Monoid.Reducer
    )  where

import Control.Monad.Either
import Data.Monoid.Reducer

instance Monoid m => Monoid (Either e m) where
    mempty = return mempty
    x `mappend` y = do 
        x' <- x
        y' <- y
        return (x' `mappend` y')

instance Monoid m => Reducer m (Either e m) where
    unit = return

instance (Monad m, Monoid n) => Monoid (EitherT e m n) where
    mempty = return mempty 
    x `mappend` y = do
        x' <- x
        y' <- y
        return (x' `mappend` y')

instance (Monad m, Monoid n) => Reducer n (EitherT e m n) where
    unit = return

instance (Monad m, Monoid n) => Reducer (m n) (EitherT e m n) where
    unit = EitherT . liftM return

liftM :: Monad m => (a -> b) -> m a -> m b
liftM f x = do x' <- x; return (f x')