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

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

import Control.Monad.Trans.Class (MonadTrans(..))

-- | 'MultiLift' provides an 'mlift' method that invokes the 'lift'
-- method of 'MonadTrans' multiple times, based on the requested
-- argument and result type.  You will usually have to specify the
-- type of the argument explicitly.
--
-- Note that 'mlift' only works with up to 9 levels of nested monad
-- transformer.
class MultiLift mIn mOut where
    mlift :: mIn a -> mOut a

instance MultiLift m m where
    mlift = id


{- $example

> module Main where
> 
> import Control.Monad.MultiLift
> import Control.Monad.MultiWrap
> import Control.Monad.Reader
> 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
> 
> r2 :: Reader2 ()
> r2 = do
>   -- Note that you have to specify the inner type
>   s1 <- mlift (asks unType1 :: Reader1 String)
>   liftIO $ putStrLn $ "s1: " ++ s1 ++ "\n"
>   s2 <- asks unType2
>   liftIO $ putStrLn $ "s2: " ++ s2 ++ "\n"
> 
> r1 :: Reader1 ()
> r1 = do
>   runReaderT r2 $ Type2 "this is the Reader2 contents"
> 
> main :: IO ()
> main = do
>   runReaderT r1 $ Type1 "this is the Reader1 contents"

-}
instance (MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t1 m) where
    mlift = lift

instance (MonadTrans t2, Monad (t2 (t1 m)), MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t2 (t1 m)) where
    mlift = lift . lift

instance (MonadTrans t3, Monad (t3 (t2 (t1 m))), MonadTrans t2, Monad (t2 (t1 m)), MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t3 (t2 (t1 m))) where
    mlift = lift . lift . lift

instance (MonadTrans t4, Monad (t4 (t3 (t2 (t1 m)))), MonadTrans t3, Monad (t3 (t2 (t1 m))), MonadTrans t2, Monad (t2 (t1 m)), MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t4 (t3 (t2 (t1 m)))) where
    mlift = lift . lift . lift . lift

instance (MonadTrans t5, Monad (t5 (t4 (t3 (t2 (t1 m))))), MonadTrans t4, Monad (t4 (t3 (t2 (t1 m)))), MonadTrans t3, Monad (t3 (t2 (t1 m))), MonadTrans t2, Monad (t2 (t1 m)), MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t5 (t4 (t3 (t2 (t1 m))))) where
    mlift = lift . lift . lift . lift . lift

instance (MonadTrans t6, Monad (t6 (t5 (t4 (t3 (t2 (t1 m)))))), MonadTrans t5, Monad (t5 (t4 (t3 (t2 (t1 m))))), MonadTrans t4, Monad (t4 (t3 (t2 (t1 m)))), MonadTrans t3, Monad (t3 (t2 (t1 m))), MonadTrans t2, Monad (t2 (t1 m)), MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t6 (t5 (t4 (t3 (t2 (t1 m)))))) where
    mlift = lift . lift . lift . lift . lift . lift

instance (MonadTrans t7, Monad (t7 (t6 (t5 (t4 (t3 (t2 (t1 m))))))), MonadTrans t6, Monad (t6 (t5 (t4 (t3 (t2 (t1 m)))))), MonadTrans t5, Monad (t5 (t4 (t3 (t2 (t1 m))))), MonadTrans t4, Monad (t4 (t3 (t2 (t1 m)))), MonadTrans t3, Monad (t3 (t2 (t1 m))), MonadTrans t2, Monad (t2 (t1 m)), MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t7 (t6 (t5 (t4 (t3 (t2 (t1 m))))))) where
    mlift = lift . lift . lift . lift . lift . lift . lift

instance (MonadTrans t8, Monad (t8 (t7 (t6 (t5 (t4 (t3 (t2 (t1 m)))))))), MonadTrans t7, Monad (t7 (t6 (t5 (t4 (t3 (t2 (t1 m))))))), MonadTrans t6, Monad (t6 (t5 (t4 (t3 (t2 (t1 m)))))), MonadTrans t5, Monad (t5 (t4 (t3 (t2 (t1 m))))), MonadTrans t4, Monad (t4 (t3 (t2 (t1 m)))), MonadTrans t3, Monad (t3 (t2 (t1 m))), MonadTrans t2, Monad (t2 (t1 m)), MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t8 (t7 (t6 (t5 (t4 (t3 (t2 (t1 m)))))))) where
    mlift = lift . lift . lift . lift . lift . lift . lift . lift

instance (MonadTrans t9, Monad (t9 (t8 (t7 (t6 (t5 (t4 (t3 (t2 (t1 m))))))))), MonadTrans t8, Monad (t8 (t7 (t6 (t5 (t4 (t3 (t2 (t1 m)))))))), MonadTrans t7, Monad (t7 (t6 (t5 (t4 (t3 (t2 (t1 m))))))), MonadTrans t6, Monad (t6 (t5 (t4 (t3 (t2 (t1 m)))))), MonadTrans t5, Monad (t5 (t4 (t3 (t2 (t1 m))))), MonadTrans t4, Monad (t4 (t3 (t2 (t1 m)))), MonadTrans t3, Monad (t3 (t2 (t1 m))), MonadTrans t2, Monad (t2 (t1 m)), MonadTrans t1, Monad (t1 m), Monad m) => MultiLift m (t9 (t8 (t7 (t6 (t5 (t4 (t3 (t2 (t1 m))))))))) where
    mlift = lift . lift . lift . lift . lift . lift . lift . lift . lift