{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.Monad.MultiWrap (-- * MultiWrap class
                                MultiWrap(..)
                               -- * Example
                               -- $example
                               )where

import Control.Monad.Trans (MonadTrans(..), MonadIO(..))
import Control.Monad.Wrap

-- | 'MultiWrap' is like 'MonadWrapIO', but for monads created by
-- 'MonadTrans' transformers.  This is useful, if, for example, you
-- implement your own monad, @ReaderTLike@, that is like a @ReaderT@
-- except that you don't want to make it a member of the @MonadReader@
-- class because you are already using @MonadReader@ for some
-- different state (or because you are implementing a library and the
-- user of the library should be free to use @ReaderT@).
--
-- As long as @ReaderTLike@ is a member of the 'MonadTrans' class and
-- assuming you have a @localLike@ function equivalent to 'local', you
-- should be able to run things like:
--
-- >    mwrap (localLike modifyConfig :: ReaderTLike IO a -> ReaderTLike IO a)
-- >          someComputation
--
-- You will generally have to specify the type of the wrap function or
-- computation explicitly, but as long as you specify the type,
-- 'mwrap' saves you from keeping track of how many nested levels of
-- transformer you have and from having to invoke 'wrap' repeatedly.
--
-- Note one difference from 'MonadWrap' and 'MonadWrapIO' is that
-- 'mresult' and 'mresultF' require an extra argument so as to specify
-- the inner monad in which you want to supply the result.  (E.g., in
-- the case of using 'catch' to produce a different return value in
-- case of exceptions, the inner monad would be 'IO', and the extra
-- argument might be supplied as @(undefined :: 'IO' Type)@.
--
-- Note that 'MultiWrap' only works for up to @N@ levels of nested
-- monad transformer.
class (Monad mOut) => MultiWrap mIn mOut a r | mIn mOut a -> r where
    mwrap :: (mIn r -> mIn r) -> mOut a -> mOut a
    mresultF :: mIn b
                -- ^ This argumet is here just for the type, because
                -- otherwise the @resultTrans@ has no way of knowing
                -- which inner monad you want.  The value of this
                -- argument is ignored, so it is safe to use
                -- @(undefined :: InnerMonad ())@ just as a way of
                -- specifying the type.
             -> mOut (a -> r)
    mresult :: mIn b -> a -> mOut r
    mresult b a = mresultF b >>= return . ($ a)

instance (Monad m) => MultiWrap m m a a where
    mwrap = ($)
    mresultF _ = return id

{- $example

> module Main where
> 
> import Control.Monad.MultiLift
> import Control.Monad.MultiWrap
> import Control.Monad.Reader
> import Control.Monad.State
> import Control.Monad.Trans
> import Control.Monad.Wrap
> 
> newtype Type1 = Type1 { unType1 :: String }
> type Reader1 = ReaderT Type1 IO
> 
> newtype Type2 = Type2 { unType2 :: String }
> type Reader2 = ReaderT Type2 Reader1
> 
> type Outer = StateT () Reader2
> 
> r3 :: Outer ()
> r3 = do
>   -- Note that you have to specify the inner type
>   s1 <- mlift (asks unType1 :: Reader1 String)
>   liftIO $ putStrLn $ "s1: " ++ s1
>   s2 <- mlift (asks unType2 :: Reader2 String)
>   liftIO $ putStrLn $ "s2: " ++ s2
> 
> r2 :: Outer ()
> r2 = do
>   mwrap (local augment :: Reader1 a -> Reader1 a) r3
>   where
>     augment (Type1 s) = Type1 $ s ++ " (augmented)"
> 
> r1 :: Reader2 ()
> r1 = do
>   liftM fst $ runStateT r3 ()
>   liftM fst $ runStateT r2 ()
>   -- runContWrapT r2 return
>   
> 
> main :: IO ()
> main = do
>   runReaderT (runReaderT r1 $ Type2 "this is the Reader2 contents")
>        $ Type1 "this is the Reader1 contents"

-}