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

-- | 'MonadWrapBase' is a generalized version of 'MonadWrapIO' to work
-- around transformed versions of other base monads.
module Control.Monad.WrapBase (MonadWrapBase(..)) where

import Control.Monad.ST
import qualified Control.Monad.ST.Lazy as L
import Control.Monad.Trans.Class
import Data.Functor.Identity
import GHC.Conc

import Control.Monad.Wrap

class (Monad m) => MonadWrapBase m b a r | m -> b, m b a -> r where
    wrapBase :: (b r -> b r) -> m a -> m a
    default wrapBase :: (m a -> m a) -> m a -> m a
    wrapBase = ($)
    resultBase :: a -> m r
    resultBase a = resultFBase >>= return . ($ a)
    resultFBase :: m (a -> r)
    default resultFBase :: m (a -> a)
    resultFBase = return id

instance (Monad m, MonadTrans t, Monad (t m), MonadWrapBase m b ar r,
          MonadWrap t a ar) => MonadWrapBase (t m) b a r where
    wrapBase f = wrap (wrapBase f)
    resultFBase = do outer <- resultF
                     inner <- lift resultFBase
                     return $ inner . outer

instance MonadWrapBase [] [] a a
instance MonadWrapBase IO IO a a
instance MonadWrapBase STM STM a a
instance MonadWrapBase Maybe Maybe a a
instance MonadWrapBase Identity Identity a a
instance MonadWrapBase ((->) r) ((->) r) a a
instance MonadWrapBase (Either e) (Either e) a a
instance MonadWrapBase (ST s) (ST s) a a
instance MonadWrapBase (L.ST s) (L.ST s) a a