{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Functor.Bind.Trans
-- Copyright   :  (C) 2011-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Data.Functor.Bind.Trans (
  BindTrans(..)
  ) where

-- import _everything_
import Control.Category
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
-- import Control.Monad.Trans.Error
import Control.Monad.Trans.Identity
-- import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
-- import Control.Monad.Trans.List
#if MIN_VERSION_transformers(0,5,6)
import qualified Control.Monad.Trans.RWS.CPS as CPS
import qualified Control.Monad.Trans.Writer.CPS as CPS
#endif
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.Orphans ()
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup hiding (Product)
#endif
import Prelude hiding (id, (.))

-- | A subset of monad transformers can transform any 'Bind' as well.
class MonadTrans t => BindTrans t where
  liftB :: Bind b => b a -> t b a

instance BindTrans IdentityT where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> IdentityT b a
liftB = b a -> IdentityT b a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT

instance BindTrans (ReaderT e) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> ReaderT e b a
liftB = (e -> b a) -> ReaderT e b a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> b a) -> ReaderT e b a)
-> (b a -> e -> b a) -> b a -> ReaderT e b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b a -> e -> b a
forall a b. a -> b -> a
const

instance Monoid w => BindTrans (Lazy.WriterT w) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> WriterT w b a
liftB = b (a, w) -> WriterT w b a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (b (a, w) -> WriterT w b a)
-> (b a -> b (a, w)) -> b a -> WriterT w b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> (a, w)) -> b a -> b (a, w)
forall a b. (a -> b) -> b a -> b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, w
forall a. Monoid a => a
mempty))

instance Monoid w => BindTrans (Strict.WriterT w) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> WriterT w b a
liftB = b (a, w) -> WriterT w b a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (b (a, w) -> WriterT w b a)
-> (b a -> b (a, w)) -> b a -> WriterT w b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> (a, w)) -> b a -> b (a, w)
forall a b. (a -> b) -> b a -> b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, w
forall a. Monoid a => a
mempty))

#if MIN_VERSION_transformers(0,5,6)
-- | @since 5.3.6
instance Monoid w => BindTrans (CPS.WriterT w) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> WriterT w b a
liftB = b (a, w) -> WriterT w b a
forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
CPS.writerT (b (a, w) -> WriterT w b a)
-> (b a -> b (a, w)) -> b a -> WriterT w b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> (a, w)) -> b a -> b (a, w)
forall a b. (a -> b) -> b a -> b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, w
forall a. Monoid a => a
mempty))
#endif

instance BindTrans (Lazy.StateT s) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> StateT s b a
liftB b a
m = (s -> b (a, s)) -> StateT s b a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> b (a, s)) -> StateT s b a)
-> (s -> b (a, s)) -> StateT s b a
forall a b. (a -> b) -> a -> b
$ \s
s -> (a -> (a, s)) -> b a -> b (a, s)
forall a b. (a -> b) -> b a -> b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, s
s)) b a
m

instance BindTrans (Strict.StateT s) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> StateT s b a
liftB b a
m = (s -> b (a, s)) -> StateT s b a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> b (a, s)) -> StateT s b a)
-> (s -> b (a, s)) -> StateT s b a
forall a b. (a -> b) -> a -> b
$ \s
s -> (a -> (a, s)) -> b a -> b (a, s)
forall a b. (a -> b) -> b a -> b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, s
s)) b a
m

instance Monoid w => BindTrans (Lazy.RWST r w s) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> RWST r w s b a
liftB b a
m = (r -> s -> b (a, s, w)) -> RWST r w s b a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> b (a, s, w)) -> RWST r w s b a)
-> (r -> s -> b (a, s, w)) -> RWST r w s b a
forall a b. (a -> b) -> a -> b
$ \ r
_r s
s -> (a -> (a, s, w)) -> b a -> b (a, s, w)
forall a b. (a -> b) -> b a -> b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, s
s, w
forall a. Monoid a => a
mempty)) b a
m

instance Monoid w => BindTrans (Strict.RWST r w s) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> RWST r w s b a
liftB b a
m = (r -> s -> b (a, s, w)) -> RWST r w s b a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> b (a, s, w)) -> RWST r w s b a)
-> (r -> s -> b (a, s, w)) -> RWST r w s b a
forall a b. (a -> b) -> a -> b
$ \ r
_r s
s -> (a -> (a, s, w)) -> b a -> b (a, s, w)
forall a b. (a -> b) -> b a -> b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, s
s, w
forall a. Monoid a => a
mempty)) b a
m

#if MIN_VERSION_transformers(0,5,6)
-- | @since 5.3.6
instance Monoid w => BindTrans (CPS.RWST r w s) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> RWST r w s b a
liftB b a
m = (r -> s -> b (a, s, w)) -> RWST r w s b a
forall (m :: * -> *) w r s a.
(Functor m, Monoid w) =>
(r -> s -> m (a, s, w)) -> RWST r w s m a
CPS.rwsT ((r -> s -> b (a, s, w)) -> RWST r w s b a)
-> (r -> s -> b (a, s, w)) -> RWST r w s b a
forall a b. (a -> b) -> a -> b
$ \ r
_r s
s -> (a -> (a, s, w)) -> b a -> b (a, s, w)
forall a b. (a -> b) -> b a -> b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, s
s, w
forall a. Monoid a => a
mempty)) b a
m
#endif

instance BindTrans (ContT r) where
  liftB :: forall (b :: * -> *) a. Bind b => b a -> ContT r b a
liftB b a
m = ((a -> b r) -> b r) -> ContT r b a
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (b a
m b a -> (a -> b r) -> b r
forall a b. b a -> (a -> b b) -> b b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>-)