{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__)
{-# LANGUAGE DefaultSignatures #-}
#endif
{-# OPTIONS -Wno-deprecations #-}
-----------------------------------------------------------------------------

-- |

-- Copyright   :  (C) 2012-2015 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

--

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  experimental

-- Portability :  portable

--

-- This module provides the 'Bound' class, for performing substitution into

-- things that are not necessarily full monad transformers.

----------------------------------------------------------------------------

module Bound.Class
  ( Bound(..)
  , (=<<<)
  ) where

import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.RWS
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer
#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
#endif

infixl 1 >>>=

-- | Instances of 'Bound' generate left modules over monads.

--

-- This means they should satisfy the following laws:

--

-- @

-- m '>>>=' 'return' ≡ m

-- m '>>>=' (λ x → k x '>>=' h) ≡ (m '>>>=' k) '>>>=' h

-- @

--

-- This guarantees that a typical Monad instance for an expression type

-- where Bound instances appear will satisfy the Monad laws (see doc/BoundLaws.hs).

--

-- If instances of 'Bound' are monad transformers, then @m '>>>=' f ≡ m '>>=' 'lift' '.' f@

-- implies the above laws, and is in fact the default definition.

--

-- This is useful for types like expression lists, case alternatives,

-- schemas, etc. that may not be expressions in their own right, but often

-- contain expressions.

--

-- /Note:/ 'Control.Monad.Free.Free' isn't "really" a monad transformer, even if

-- the kind matches. Therefore there isn't @'Bound' 'Control.Monad.Free.Free'@ instance.

class Bound t where
  -- | Perform substitution

  --

  -- If @t@ is an instance of @MonadTrans@ and you are compiling on GHC >= 7.4, then this

  -- gets the default definition:

  --

  -- @m '>>>=' f = m '>>=' 'lift' '.' f@

  (>>>=) :: Monad f => t f a -> (a -> f c) -> t f c
#if defined(__GLASGOW_HASKELL__)
  default (>>>=) :: (MonadTrans t, Monad f, Monad (t f)) =>
                    t f a -> (a -> f c) -> t f c
  t f a
m >>>= a -> f c
f = t f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
  {-# INLINE (>>>=) #-}
#endif

instance Bound (ContT c) where
  ContT c f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
ContT c f a -> (a -> f c) -> ContT c f c
>>>= a -> f c
f = ContT c f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
  {-# INLINE (>>>=) #-}

instance Bound IdentityT where
 IdentityT f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
IdentityT f a -> (a -> f c) -> IdentityT f c
>>>= a -> f c
f = IdentityT f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
 {-# INLINE (>>>=) #-}

instance Bound MaybeT where
 MaybeT f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
MaybeT f a -> (a -> f c) -> MaybeT f c
>>>= a -> f c
f = MaybeT f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
 {-# INLINE (>>>=) #-}

instance Monoid w => Bound (RWST r w s) where
 RWST r w s f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
RWST r w s f a -> (a -> f c) -> RWST r w s f c
>>>= a -> f c
f = RWST r w s f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
 {-# INLINE (>>>=) #-}

instance Bound (ReaderT r) where
 ReaderT r f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
ReaderT r f a -> (a -> f c) -> ReaderT r f c
>>>= a -> f c
f = ReaderT r f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
 {-# INLINE (>>>=) #-}

instance Bound (StateT s) where
 StateT s f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
StateT s f a -> (a -> f c) -> StateT s f c
>>>= a -> f c
f = StateT s f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
 {-# INLINE (>>>=) #-}

instance Monoid w => Bound (WriterT w) where
 WriterT w f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
WriterT w f a -> (a -> f c) -> WriterT w f c
>>>= a -> f c
f = WriterT w f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
 {-# INLINE (>>>=) #-}

#if !(MIN_VERSION_transformers(0,6,0))
instance Error e => Bound (ErrorT e) where
 ErrorT e f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
ErrorT e f a -> (a -> f c) -> ErrorT e f c
>>>= a -> f c
f = ErrorT e f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
 {-# INLINE (>>>=) #-}

instance Bound ListT where
 ListT f a
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
ListT f a -> (a -> f c) -> ListT f c
>>>= a -> f c
f = ListT f a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f
 {-# INLINE (>>>=) #-}
#endif

infixr 1 =<<<
-- | A flipped version of ('>>>=').

--

-- @('=<<<') = 'flip' ('>>>=')@

(=<<<) :: (Bound t, Monad f) => (a -> f c) -> t f a -> t f c
=<<< :: forall (t :: (* -> *) -> * -> *) (f :: * -> *) a c.
(Bound t, Monad f) =>
(a -> f c) -> t f a -> t f c
(=<<<) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: (* -> *) -> * -> *) (f :: * -> *) a c.
(Bound t, Monad f) =>
t f a -> (a -> f c) -> t f c
(>>>=)
{-# INLINE (=<<<) #-}