{-# OPTIONS
   -fglasgow-exts
   -fno-warn-orphans
   #-}
-- Search for -fallow-undecidable-instances to see why this is needed

{-# LANGUAGE ScopedTypeVariables, UndecidableInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.WriterX
-- Copyright   :  (c) Mark Snyder 2008.
-- License     :  BSD-style
-- Maintainer  :  Mark Snyder, marks@ittc.ku.edu
-- Stability   :  experimental
-- Portability :  non-portable (multi-param classes, functional dependencies)
-----------------------------------------------------------------------------

module Control.Monad.WriterX (
    module Control.Monad.WriterX.Lazy,
    module Control.Monad.Index
  ) where

import Control.Monad.WriterX.Lazy

import Control.Monad.Index

import Control.Monad.Error
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.State



instance (Error e, MonadWriterX ix w m, Index ix) => MonadWriterX ix w (ErrorT e m) where
    tellx (ixv::ix)     = lift . tellx ixv
    listenx (ixv::ix) m = ErrorT $ do
        (a, w) <- listenx ixv (runErrorT m)
        case a of
            Left  l -> return $ Left  l
            Right r -> return $ Right (r, w)
    passx (ixv::ix)   m = ErrorT $ passx ixv $ do
        a <- runErrorT m
        case a of
            Left  l      -> return (Left  l, id)
            Right (r, f) -> return (Right r, f)


instance (MonadWriterX ixw w m, Index ixw, Monoid w2) => MonadWriterX ixw w (WriterT w2 m) where
   tellx (ixv::ixw)     = lift . tellx ixv
   listenx (ixv::ixw) m = WriterT $ do
       ~((a,s'),w) <- listenx ixv (runWriterT m)
       return ((a,w),s')
   passx (ixv::ixw)   m = WriterT $ passx ixv $ do
       ~((a,f),s') <- runWriterT m
       return ((a,s'),f)


instance (MonadWriterX ixw w m, Index ixw) => MonadWriterX ixw w (StateT s m) where
   tellx (ixv::ixw)     = lift . tellx ixv
   listenx (ixv::ixw) m = StateT $ \s -> do
       ~((a,s'),w) <- listenx ixv (runStateT m s)
       return ((a,w),s')
   passx (ixv::ixw)   m = StateT $ \s -> passx ixv $ do
       ~((a,f),s') <- runStateT m s
       return ((a,s'),f)

instance (Index ixw, MonadWriterX ixw w m) => MonadWriterX ixw w (ReaderT r m) where
    tellx (ixv::ixw)     = lift  . tellx ixv
    listenx (ixv::ixw) m = ReaderT $ \w -> listenx ixv (runReaderT m w)
    passx (ixv::ixw)   m = ReaderT $ \w -> passx ixv   (runReaderT m w)