{-# LANGUAGE CPP #-}
module Data.Functor.Bind.Trans (
BindTrans(..)
) where
import Control.Category
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707
import Control.Monad.Instances ()
#endif
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Strict as Strict
import Data.Functor.Bind
import Data.Semigroup hiding (Product)
import Prelude hiding (id, (.))
class MonadTrans t => BindTrans t where
liftB :: Bind b => b a -> t b a
instance BindTrans IdentityT where
liftB = IdentityT
instance BindTrans (ReaderT e) where
liftB = ReaderT . const
instance (Semigroup w, Monoid w) => BindTrans (Lazy.WriterT w) where
liftB = Lazy.WriterT . fmap (\a -> (a, mempty))
instance (Semigroup w, Monoid w) => BindTrans (Strict.WriterT w) where
liftB = Strict.WriterT . fmap (\a -> (a, mempty))
instance BindTrans (Lazy.StateT s) where
liftB m = Lazy.StateT $ \s -> fmap (\a -> (a, s)) m
instance BindTrans (Strict.StateT s) where
liftB m = Strict.StateT $ \s -> fmap (\a -> (a, s)) m
instance (Semigroup w, Monoid w) => BindTrans (Lazy.RWST r w s) where
liftB m = Lazy.RWST $ \ _r s -> fmap (\a -> (a, s, mempty)) m
instance (Semigroup w, Monoid w) => BindTrans (Strict.RWST r w s) where
liftB m = Strict.RWST $ \ _r s -> fmap (\a -> (a, s, mempty)) m
instance BindTrans (ContT r) where
liftB m = ContT (m >>-)