-- |
-- Module:     Control.ContStuff.MonadsTf
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- This package provides contstuff transformer class instances for the
-- monad transformers from the monads-tf package as well as monads-tf
-- transformer class instances for the monad transformers from
-- contstuff.  This makes using both transformer libraries in a single
-- project much more convenient as you get along with a single set of
-- lifting functions.

{-# LANGUAGE TypeFamilies #-}

module Control.ContStuff.MonadsTf
    ( -- * Exported from monads-tf
      MonadIO(..),
      MonadTrans,
      liftTF
    )
    where

import qualified Control.Monad.Trans as T
import qualified Control.ContStuff.Trans as C
import Control.ContStuff.Classes as C
import Control.Monad.Trans (MonadIO, MonadTrans, liftIO)
import Data.Monoid

import qualified Control.Monad.Cont          as T (ContT)
import qualified Control.Monad.Error         as T (Error, ErrorT)
import qualified Control.Monad.List          as T (ListT)
import qualified Control.Monad.RWS.Lazy      as T (RWST)
import qualified Control.Monad.RWS.Strict    as TS (RWST)
import qualified Control.Monad.Reader        as T (ReaderT)
import qualified Control.Monad.State.Lazy    as T (StateT)
import qualified Control.Monad.State.Strict  as TS (StateT)
import qualified Control.Monad.Writer.Lazy   as T (WriterT)
import qualified Control.Monad.Writer.Strict as TS (WriterT)


-- ====================== --
-- Interface to monads-tf --
-- ====================== --

-- | Interface to 'Control.Monad.Trans.lift'.

liftTF :: (Monad m, MonadTrans t) => m a -> t m a
liftTF = T.lift


-- ============================================== --
-- monads-tf instances for ContStuff transformers --
-- ============================================== --

instance MonadTrans (C.ChoiceT r i) where lift = C.lift
instance MonadTrans (C.ContT r)     where lift = C.lift
instance MonadTrans (C.EitherT r e) where lift = C.lift
instance MonadTrans (C.MaybeT r)    where lift = C.lift
instance MonadTrans (C.StateT r s)  where lift = C.lift

instance MonadIO m => MonadIO (C.ChoiceT r i m) where liftIO = liftTF . liftIO
instance MonadIO m => MonadIO (C.ContT r m)     where liftIO = liftTF . liftIO
instance MonadIO m => MonadIO (C.EitherT r e m) where liftIO = liftTF . liftIO
instance MonadIO m => MonadIO (C.MaybeT r m)    where liftIO = liftTF . liftIO
instance MonadIO m => MonadIO (C.StateT r s m)  where liftIO = liftTF . liftIO


-- ============================================== --
-- ContStuff instances for monads-tf transformers --
-- ============================================== --

instance Transformer (T.ContT r) where lift = liftTF
instance T.Error e => Transformer (T.ErrorT e) where lift = liftTF
instance Transformer (T.ListT) where lift = liftTF
instance Monoid w => Transformer (T.RWST r w s) where lift = liftTF
instance Monoid w => Transformer (TS.RWST r w s) where lift = liftTF
instance Transformer (T.ReaderT r) where lift = liftTF
instance Transformer (T.StateT s) where lift = liftTF
instance Transformer (TS.StateT s) where lift = liftTF
instance Monoid w => Transformer (T.WriterT w) where lift = liftTF
instance Monoid w => Transformer (TS.WriterT w) where lift = liftTF

instance (LiftBase m, Monad m) => LiftBase (T.ContT r m) where
    type Base (T.ContT r m) = Base m; base = lift . base
instance (T.Error e, LiftBase m, Monad m) => LiftBase (T.ErrorT e m) where
    type Base (T.ErrorT e m) = Base m; base = lift . base
instance (LiftBase m, Monad m) => LiftBase (T.ListT m) where
    type Base (T.ListT m) = Base m; base = lift . base
instance (LiftBase m, Monad m, Monoid w) => LiftBase (T.RWST r w s m) where
    type Base (T.RWST r w s m) = Base m; base = lift . base
instance (LiftBase m, Monad m, Monoid w) => LiftBase (TS.RWST r w s m) where
    type Base (TS.RWST r w s m) = Base m; base = lift . base
instance (LiftBase m, Monad m) => LiftBase (T.ReaderT r m) where
    type Base (T.ReaderT r m) = Base m; base = lift . base
instance (LiftBase m, Monad m) => LiftBase (T.StateT s m) where
    type Base (T.StateT s m) = Base m; base = lift . base
instance (LiftBase m, Monad m) => LiftBase (TS.StateT s m) where
    type Base (TS.StateT s m) = Base m; base = lift . base
instance (LiftBase m, Monad m, Monoid w) => LiftBase (T.WriterT w m) where
    type Base (T.WriterT w m) = Base m; base = lift . base
instance (LiftBase m, Monad m, Monoid w) => LiftBase (TS.WriterT w m) where
    type Base (TS.WriterT w m) = Base m; base = lift . base