{-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies,
             UndecidableInstances, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Safe #-}
{-| This library provides a collection of monad transformers that
    can be combined to produce various monads.
-}
module MonadLib (
  -- * Types
  -- $Types
  Id, Lift, IdT, ReaderT, WriterT,
  StateT,
  ExceptionT,
  --
  -- $WriterM_ExceptionT
  ChoiceT, ContT,

  -- * Lifting
  -- $Lifting
  MonadT(..), BaseM(..),

  -- * Effect Classes
  -- $Effects
  ReaderM(..), WriterM(..), StateM(..), ExceptionM(..), ContM(..), AbortM(..),
  Label, labelCC, labelCC_, jump, labelC, callCC,

  -- * Execution

  -- ** Eliminating Effects
  -- $Execution
  runId, runLift,
  runIdT, runReaderT, runWriterT,
  runStateT, runExceptionT, runContT,
  runChoiceT, findOne, findAll,
  RunM(..),

  -- ** Nested Execution
  -- $Nested_Exec
  RunReaderM(..), RunWriterM(..), RunExceptionM(..),

  -- * Utility functions
  asks, puts, sets, sets_, raises,
  mapReader, mapWriter, mapException,
  handle,
  WithBase,

  module Control.Monad
) where

import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import Control.Monad.ST (ST)
import qualified Control.Exception as IO (throwIO,try,SomeException)
import System.Exit(ExitCode,exitWith)
import Data.Kind(Type)
import Prelude hiding (Ordering(..))
import qualified Control.Monad.Fail as MF


-- $Types
--
-- The following types define the representations of the
-- computation types supported by the library.
-- Each type adds support for a different effect.

-- | Computations with no effects.
newtype Id a              = I a

-- | Computation with no effects (strict).
data Lift a               = L a

-- | Adds no new features.  Useful as a placeholder.
newtype IdT m a           = IT (m a)

-- | Add support for propagating a context of type @i@.
newtype ReaderT i m a     = R (i -> m a)

-- | Add support for collecting values of type @i@.
-- The type @i@ should be a monoid, whose unit is used to represent
-- a lack of a value, and whose binary operation is used to combine
-- multiple values.
-- This transformer is strict in its output component.
newtype WriterT i m a = W { forall i (m :: * -> *) a. WriterT i m a -> m (P a i)
unW :: m (P a i) }
data P a i = P a !i

-- | Add support for threading state of type @i@.
newtype StateT     i m a  = S (i -> m (a,i))

-- | Add support for exceptions of type @i@.
newtype ExceptionT i m a  = X (m (Either i a))

-- | Add support for multiple answers.
data ChoiceT m a          = NoAnswer
                          | Answer a
                          | Choice (ChoiceT m a) (ChoiceT m a)
                          | ChoiceEff (m (ChoiceT m a))

-- | Add support for continuations within a prompt of type @i@.
newtype ContT i m a  = C ((a -> m i) -> m i)

-- $Execution
--
-- The following functions eliminate the outermost effect
-- of a computation by translating a computation into an
-- equivalent computation in the underlying monad.
-- (The exceptions are 'Id' and 'Lift' which are not transformers
-- but ordinary monads and so, their run operations simply
-- eliminate the monad.)


-- | Get the result of a pure computation.
runId         :: Id a -> a
runId :: forall a. Id a -> a
runId (I a
a) = a
a

-- | Get the result of a pure strict computation.
runLift       :: Lift a -> a
runLift :: forall a. Lift a -> a
runLift (L a
a) = a
a


-- | Remove an identity layer.
runIdT        :: IdT m a -> m a
runIdT :: forall (m :: * -> *) a. IdT m a -> m a
runIdT (IT m a
a)  = m a
a

-- | Execute a reader computation in the given context.
runReaderT    :: i -> ReaderT i m a -> m a
runReaderT :: forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT i
i (R i -> m a
m) = i -> m a
m i
i

-- | Execute a writer computation.
-- Returns the result and the collected output.
runWriterT :: (Monad m) => WriterT i m a -> m (a,i)
runWriterT :: forall (m :: * -> *) i a. Monad m => WriterT i m a -> m (a, i)
runWriterT (W m (P a i)
m) = (P a i -> (a, i)) -> m (P a i) -> m (a, i)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM P a i -> (a, i)
forall {a} {b}. P a b -> (a, b)
to_pair m (P a i)
m
  where to_pair :: P a b -> (a, b)
to_pair ~(P a
a b
w) = (a
a,b
w)

-- | Execute a stateful computation in the given initial state.
-- The second component of the result is the final state.
runStateT     :: i -> StateT i m a -> m (a,i)
runStateT :: forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT i
i (S i -> m (a, i)
m) = i -> m (a, i)
m i
i

-- | Execute a computation with exceptions.
-- Successful results are tagged with 'Right',
-- exceptional results are tagged with 'Left'.
runExceptionT :: ExceptionT i m a -> m (Either i a)
runExceptionT :: forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT (X m (Either i a)
m) = m (Either i a)
m

-- | Execute a computation that may return multiple answers.
-- The resulting computation returns 'Nothing'
-- if no answers were found, or @Just (answer,new_comp)@,
-- where @answer@ is an answer, and @new_comp@ is a computation
-- that may produce more answers.
-- The search is depth-first and left-biased with respect to the
-- 'mplus' operation.
runChoiceT :: (Monad m) => ChoiceT m a -> m (Maybe (a,ChoiceT m a))
runChoiceT :: forall (m :: * -> *) a.
Monad m =>
ChoiceT m a -> m (Maybe (a, ChoiceT m a))
runChoiceT (Answer a
a)     = Maybe (a, ChoiceT m a) -> m (Maybe (a, ChoiceT m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, ChoiceT m a) -> Maybe (a, ChoiceT m a)
forall a. a -> Maybe a
Just (a
a,ChoiceT m a
forall (m :: * -> *) a. ChoiceT m a
NoAnswer))
runChoiceT ChoiceT m a
NoAnswer       = Maybe (a, ChoiceT m a) -> m (Maybe (a, ChoiceT m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, ChoiceT m a)
forall a. Maybe a
Nothing
runChoiceT (Choice ChoiceT m a
l ChoiceT m a
r)   = do Maybe (a, ChoiceT m a)
x <- ChoiceT m a -> m (Maybe (a, ChoiceT m a))
forall (m :: * -> *) a.
Monad m =>
ChoiceT m a -> m (Maybe (a, ChoiceT m a))
runChoiceT ChoiceT m a
l
                               case Maybe (a, ChoiceT m a)
x of
                                 Maybe (a, ChoiceT m a)
Nothing      -> ChoiceT m a -> m (Maybe (a, ChoiceT m a))
forall (m :: * -> *) a.
Monad m =>
ChoiceT m a -> m (Maybe (a, ChoiceT m a))
runChoiceT ChoiceT m a
r
                                 Just (a
a,ChoiceT m a
l1)  -> Maybe (a, ChoiceT m a) -> m (Maybe (a, ChoiceT m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, ChoiceT m a) -> Maybe (a, ChoiceT m a)
forall a. a -> Maybe a
Just (a
a,ChoiceT m a -> ChoiceT m a -> ChoiceT m a
forall (m :: * -> *) a. ChoiceT m a -> ChoiceT m a -> ChoiceT m a
Choice ChoiceT m a
l1 ChoiceT m a
r))
runChoiceT (ChoiceEff m (ChoiceT m a)
m)  = ChoiceT m a -> m (Maybe (a, ChoiceT m a))
forall (m :: * -> *) a.
Monad m =>
ChoiceT m a -> m (Maybe (a, ChoiceT m a))
runChoiceT (ChoiceT m a -> m (Maybe (a, ChoiceT m a)))
-> m (ChoiceT m a) -> m (Maybe (a, ChoiceT m a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (ChoiceT m a)
m

-- | Execute a computation that may return multiple answers,
-- returning at most one answer.
findOne :: (Monad m) => ChoiceT m a -> m (Maybe a)
findOne :: forall (m :: * -> *) a. Monad m => ChoiceT m a -> m (Maybe a)
findOne ChoiceT m a
m = ((a, ChoiceT m a) -> a) -> Maybe (a, ChoiceT m a) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ChoiceT m a) -> a
forall a b. (a, b) -> a
fst (Maybe (a, ChoiceT m a) -> Maybe a)
-> m (Maybe (a, ChoiceT m a)) -> m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ChoiceT m a -> m (Maybe (a, ChoiceT m a))
forall (m :: * -> *) a.
Monad m =>
ChoiceT m a -> m (Maybe (a, ChoiceT m a))
runChoiceT ChoiceT m a
m

-- | Execute a computation that may return multiple answers,
-- collecting all possible answers.
findAll :: (Monad m) => ChoiceT m a -> m [a]
findAll :: forall (m :: * -> *) a. Monad m => ChoiceT m a -> m [a]
findAll ChoiceT m a
m = Maybe (a, ChoiceT m a) -> m [a]
forall {m :: * -> *} {a}.
Monad m =>
Maybe (a, ChoiceT m a) -> m [a]
all_res (Maybe (a, ChoiceT m a) -> m [a])
-> m (Maybe (a, ChoiceT m a)) -> m [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChoiceT m a -> m (Maybe (a, ChoiceT m a))
forall (m :: * -> *) a.
Monad m =>
ChoiceT m a -> m (Maybe (a, ChoiceT m a))
runChoiceT ChoiceT m a
m
  where all_res :: Maybe (a, ChoiceT m a) -> m [a]
all_res Maybe (a, ChoiceT m a)
Nothing       = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        all_res (Just (a
a,ChoiceT m a
as)) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ChoiceT m a -> m [a]
forall (m :: * -> *) a. Monad m => ChoiceT m a -> m [a]
findAll ChoiceT m a
as

-- | Execute a computation with the given continuation.
runContT      :: (a -> m i) -> ContT i m a -> m i
runContT :: forall a (m :: * -> *) i. (a -> m i) -> ContT i m a -> m i
runContT a -> m i
i (C (a -> m i) -> m i
m) = (a -> m i) -> m i
m a -> m i
i


-- | Generalized running.
class Monad m => RunM m a r | m a -> r where
  runM :: m a -> r

instance RunM Id a a where
  runM :: Id a -> a
runM = Id a -> a
forall a. Id a -> a
runId

instance RunM Lift a a where
  runM :: Lift a -> a
runM = Lift a -> a
forall a. Lift a -> a
runLift

instance RunM IO a (IO a) where
  runM :: IO a -> IO a
runM = IO a -> IO a
forall a. a -> a
id

instance RunM m a r => RunM (IdT m) a r where
  runM :: IdT m a -> r
runM = m a -> r
forall (m :: * -> *) a r. RunM m a r => m a -> r
runM (m a -> r) -> (IdT m a -> m a) -> IdT m a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdT m a -> m a
forall (m :: * -> *) a. IdT m a -> m a
runIdT

instance RunM m a r => RunM (ReaderT i m) a (i -> r) where
  runM :: ReaderT i m a -> i -> r
runM ReaderT i m a
m i
i = m a -> r
forall (m :: * -> *) a r. RunM m a r => m a -> r
runM (i -> ReaderT i m a -> m a
forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT i
i ReaderT i m a
m)

instance (Monoid i, RunM m (a,i) r) => RunM (WriterT i m) a r where
  runM :: WriterT i m a -> r
runM = m (a, i) -> r
forall (m :: * -> *) a r. RunM m a r => m a -> r
runM (m (a, i) -> r)
-> (WriterT i m a -> m (a, i)) -> WriterT i m a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT i m a -> m (a, i)
forall (m :: * -> *) i a. Monad m => WriterT i m a -> m (a, i)
runWriterT

instance RunM m (a,i) r => RunM (StateT i m) a (i -> r) where
  runM :: StateT i m a -> i -> r
runM StateT i m a
m i
i = m (a, i) -> r
forall (m :: * -> *) a r. RunM m a r => m a -> r
runM (i -> StateT i m a -> m (a, i)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT i
i StateT i m a
m)

instance RunM m (Either i a) r => RunM (ExceptionT i m) a r where
  runM :: ExceptionT i m a -> r
runM = m (Either i a) -> r
forall (m :: * -> *) a r. RunM m a r => m a -> r
runM (m (Either i a) -> r)
-> (ExceptionT i m a -> m (Either i a)) -> ExceptionT i m a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionT i m a -> m (Either i a)
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT

instance RunM m i r => RunM (ContT i m) a ((a -> m i) -> r) where
  runM :: ContT i m a -> (a -> m i) -> r
runM ContT i m a
m a -> m i
k = m i -> r
forall (m :: * -> *) a r. RunM m a r => m a -> r
runM ((a -> m i) -> ContT i m a -> m i
forall a (m :: * -> *) i. (a -> m i) -> ContT i m a -> m i
runContT a -> m i
k ContT i m a
m)

instance RunM m (Maybe (a,ChoiceT m a)) r => RunM (ChoiceT m) a r where
  runM :: ChoiceT m a -> r
runM = m (Maybe (a, ChoiceT m a)) -> r
forall (m :: * -> *) a r. RunM m a r => m a -> r
runM (m (Maybe (a, ChoiceT m a)) -> r)
-> (ChoiceT m a -> m (Maybe (a, ChoiceT m a))) -> ChoiceT m a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceT m a -> m (Maybe (a, ChoiceT m a))
forall (m :: * -> *) a.
Monad m =>
ChoiceT m a -> m (Maybe (a, ChoiceT m a))
runChoiceT


-- $Lifting
--
-- The following operations allow us to promote computations
-- in the underlying monad to computations that support an extra
-- effect.  Computations defined in this way do not make use of
-- the new effect but can be combined with other operations that
-- utilize the effect.


class MonadT t where
  -- | Promote a computation from the underlying monad.
  lift :: (Monad m) => m a -> t m a

-- Notes:
--   * It is interesting to note that these use something the resembles
--     the non-transformer 'return's.
--   * These are more general then the lift in the MonadT class because
--     most of them can lift arbitrary functors (some, even arbitrary type ctrs)
instance MonadT IdT            where lift :: forall (m :: * -> *) a. Monad m => m a -> IdT m a
lift m a
m = m a -> IdT m a
forall (m :: * -> *) a. m a -> IdT m a
IT m a
m
instance MonadT (ReaderT    i) where lift :: forall (m :: * -> *) a. Monad m => m a -> ReaderT i m a
lift m a
m = (i -> m a) -> ReaderT i m a
forall i (m :: * -> *) a. (i -> m a) -> ReaderT i m a
R (\i
_ -> m a
m)
instance MonadT (StateT     i) where lift :: forall (m :: * -> *) a. Monad m => m a -> StateT i m a
lift m a
m = (i -> m (a, i)) -> StateT i m a
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S (\i
s -> (a -> (a, i)) -> m a -> m (a, i)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
a -> (a
a,i
s)) m a
m)
instance (Monoid i)
      => MonadT (WriterT i)    where lift :: forall (m :: * -> *) a. Monad m => m a -> WriterT i m a
lift m a
m = m (P a i) -> WriterT i m a
forall i (m :: * -> *) a. m (P a i) -> WriterT i m a
W ((a -> P a i) -> m a -> m (P a i)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
a -> a -> i -> P a i
forall a i. a -> i -> P a i
P a
a i
forall a. Monoid a => a
mempty) m a
m)
instance MonadT (ExceptionT i) where lift :: forall (m :: * -> *) a. Monad m => m a -> ExceptionT i m a
lift m a
m = m (Either i a) -> ExceptionT i m a
forall i (m :: * -> *) a. m (Either i a) -> ExceptionT i m a
X ((a -> Either i a) -> m a -> m (Either i a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either i a
forall a b. b -> Either a b
Right m a
m)
instance MonadT ChoiceT        where lift :: forall (m :: * -> *) a. Monad m => m a -> ChoiceT m a
lift m a
m = m (ChoiceT m a) -> ChoiceT m a
forall (m :: * -> *) a. m (ChoiceT m a) -> ChoiceT m a
ChoiceEff ((a -> ChoiceT m a) -> m a -> m (ChoiceT m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> ChoiceT m a
forall (m :: * -> *) a. a -> ChoiceT m a
Answer m a
m)
instance MonadT (ContT      i) where lift :: forall (m :: * -> *) a. Monad m => m a -> ContT i m a
lift m a
m = ((a -> m i) -> m i) -> ContT i m a
forall i (m :: * -> *) a. ((a -> m i) -> m i) -> ContT i m a
C (\a -> m i
k -> m a
m m a -> (a -> m i) -> m i
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m i
k)


-- Definitions for some of the methods that are the same for all transformers

t_inBase   :: (MonadT t, BaseM m n) => n a -> t m a
t_inBase :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadT t, BaseM m n) =>
n a -> t m a
t_inBase n a
m  = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (n a -> m a
forall a. n a -> m a
forall (m :: * -> *) (n :: * -> *) a. BaseM m n => n a -> m a
inBase n a
m)

t_return   :: (MonadT t, Monad m) => a -> t m a
t_return :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
a -> t m a
t_return a
x  = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)

t_fail     :: (MonadT t, MF.MonadFail m) => String -> t m a
t_fail :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadFail m) =>
String -> t m a
t_fail String
x    = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
MF.fail String
x)

#if !MIN_VERSION_base(4,11,0)
t_oldfail  :: (MonadT t, Monad m) => String -> t m a
t_oldfail x = lift (fail x)
#endif

t_mzero    :: (MonadT t, MonadPlus m) => t m a
t_mzero :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadPlus m) =>
t m a
t_mzero     = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift m a
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

t_ask      :: (MonadT t, ReaderM m i) => t m i
t_ask :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, ReaderM m i) =>
t m i
t_ask       = m i -> t m i
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift m i
forall (m :: * -> *) i. ReaderM m i => m i
ask

t_put      :: (MonadT t, WriterM m i) => i -> t m ()
t_put :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, WriterM m i) =>
i -> t m ()
t_put i
x     = m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (i -> m ()
forall (m :: * -> *) i. WriterM m i => i -> m ()
put i
x)

t_get      :: (MonadT t, StateM m i) => t m i
t_get :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
t m i
t_get       = m i -> t m i
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift m i
forall (m :: * -> *) i. StateM m i => m i
get

t_set      :: (MonadT t, StateM m i) => i -> t m ()
t_set :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
i -> t m ()
t_set i
i     = m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (i -> m ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set i
i)

t_raise    :: (MonadT t, ExceptionM m i) => i -> t m a
t_raise :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, ExceptionM m i) =>
i -> t m a
t_raise i
i   = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (i -> m a
forall a. i -> m a
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise i
i)

t_abort    :: (MonadT t, AbortM m i) => i -> t m a
t_abort :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, AbortM m i) =>
i -> t m a
t_abort i
i   = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (i -> m a
forall a. i -> m a
forall (m :: * -> *) i a. AbortM m i => i -> m a
abort i
i)
--------------------------------------------------------------------------------


class (Monad m, Monad n) => BaseM m n | m -> n where
  -- | Promote a computation from the base monad.
  inBase :: n a -> m a

instance BaseM IO IO         where inBase :: forall a. IO a -> IO a
inBase = IO a -> IO a
forall a. a -> a
id
instance BaseM Maybe Maybe   where inBase :: forall a. Maybe a -> Maybe a
inBase = Maybe a -> Maybe a
forall a. a -> a
id
instance BaseM [] []         where inBase :: forall a. [a] -> [a]
inBase = [a] -> [a]
forall a. a -> a
id
instance BaseM Id Id         where inBase :: forall a. Id a -> Id a
inBase = Id a -> Id a
forall a. a -> a
id
instance BaseM Lift Lift     where inBase :: forall a. Lift a -> Lift a
inBase = Lift a -> Lift a
forall a. a -> a
id
instance BaseM (ST s) (ST s) where inBase :: forall a. ST s a -> ST s a
inBase = ST s a -> ST s a
forall a. a -> a
id


instance (BaseM m n) => BaseM (IdT          m) n where inBase :: forall a. n a -> IdT m a
inBase = n a -> IdT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadT t, BaseM m n) =>
n a -> t m a
t_inBase
instance (BaseM m n) => BaseM (ReaderT    i m) n where inBase :: forall a. n a -> ReaderT i m a
inBase = n a -> ReaderT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadT t, BaseM m n) =>
n a -> t m a
t_inBase
instance (BaseM m n) => BaseM (StateT     i m) n where inBase :: forall a. n a -> StateT i m a
inBase = n a -> StateT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadT t, BaseM m n) =>
n a -> t m a
t_inBase
instance (BaseM m n,Monoid i)
                     => BaseM (WriterT i m) n    where inBase :: forall a. n a -> WriterT i m a
inBase = n a -> WriterT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadT t, BaseM m n) =>
n a -> t m a
t_inBase
instance (BaseM m n) => BaseM (ExceptionT i m) n where inBase :: forall a. n a -> ExceptionT i m a
inBase = n a -> ExceptionT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadT t, BaseM m n) =>
n a -> t m a
t_inBase
instance (BaseM m n) => BaseM (ChoiceT      m) n where inBase :: forall a. n a -> ChoiceT m a
inBase = n a -> ChoiceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadT t, BaseM m n) =>
n a -> t m a
t_inBase
instance (BaseM m n) => BaseM (ContT      i m) n where inBase :: forall a. n a -> ContT i m a
inBase = n a -> ContT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadT t, BaseM m n) =>
n a -> t m a
t_inBase


instance Monad Id where
  Id a
m >>= :: forall a b. Id a -> (a -> Id b) -> Id b
>>= a -> Id b
k  = a -> Id b
k (Id a -> a
forall a. Id a -> a
runId Id a
m)

#if !MIN_VERSION_base(4,11,0)
  fail = error
#endif

instance Monad Lift where
  L a
x >>= :: forall a b. Lift a -> (a -> Lift b) -> Lift b
>>= a -> Lift b
k = a -> Lift b
k a
x     -- Note: the pattern is important here
                      -- because it makes things strict

#if !MIN_VERSION_base(4,11,0)
  fail = error
#endif


-- Note: None of the transformers make essential use of the 'fail' method.
-- Instead, they delegate its behavior to the underlying monad.

instance (Monad m) => Monad (IdT m) where
  IdT m a
m >>= :: forall a b. IdT m a -> (a -> IdT m b) -> IdT m b
>>= a -> IdT m b
k = m b -> IdT m b
forall (m :: * -> *) a. m a -> IdT m a
IT (IdT m a -> m a
forall (m :: * -> *) a. IdT m a -> m a
runIdT IdT m a
m m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IdT m b -> m b
forall (m :: * -> *) a. IdT m a -> m a
runIdT (IdT m b -> m b) -> (a -> IdT m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IdT m b
k))

#if !MIN_VERSION_base(4,11,0)
  fail = t_oldfail
#endif

instance (Monad m) => Monad (ReaderT i m) where
  ReaderT i m a
m >>= :: forall a b. ReaderT i m a -> (a -> ReaderT i m b) -> ReaderT i m b
>>= a -> ReaderT i m b
k = (i -> m b) -> ReaderT i m b
forall i (m :: * -> *) a. (i -> m a) -> ReaderT i m a
R (\i
r -> i -> ReaderT i m a -> m a
forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT i
r ReaderT i m a
m m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> i -> ReaderT i m b -> m b
forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT i
r (a -> ReaderT i m b
k a
a))

#if !MIN_VERSION_base(4,11,0)
  fail = t_oldfail
#endif

instance (Monad m) => Monad (StateT i m) where
  StateT i m a
m >>= :: forall a b. StateT i m a -> (a -> StateT i m b) -> StateT i m b
>>= a -> StateT i m b
k = (i -> m (b, i)) -> StateT i m b
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S (\i
s -> i -> StateT i m a -> m (a, i)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT i
s StateT i m a
m m (a, i) -> ((a, i) -> m (b, i)) -> m (b, i)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ~(a
a,i
s') -> i -> StateT i m b -> m (b, i)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT i
s' (a -> StateT i m b
k a
a))

#if !MIN_VERSION_base(4,11,0)
  fail = t_oldfail
#endif

instance (Monad m,Monoid i) => Monad (WriterT i m) where
  WriterT i m a
m >>= :: forall a b. WriterT i m a -> (a -> WriterT i m b) -> WriterT i m b
>>= a -> WriterT i m b
k = m (P b i) -> WriterT i m b
forall i (m :: * -> *) a. m (P a i) -> WriterT i m a
W (m (P b i) -> WriterT i m b) -> m (P b i) -> WriterT i m b
forall a b. (a -> b) -> a -> b
$ WriterT i m a -> m (P a i)
forall i (m :: * -> *) a. WriterT i m a -> m (P a i)
unW WriterT i m a
m     m (P a i) -> (P a i -> m (P b i)) -> m (P b i)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ~(P a
a i
w1) ->
                WriterT i m b -> m (P b i)
forall i (m :: * -> *) a. WriterT i m a -> m (P a i)
unW (a -> WriterT i m b
k a
a) m (P b i) -> (P b i -> m (P b i)) -> m (P b i)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ~(P b
b i
w2) ->
                P b i -> m (P b i)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> i -> P b i
forall a i. a -> i -> P a i
P b
b (i -> i -> i
forall a. Monoid a => a -> a -> a
mappend i
w1 i
w2))

#if !MIN_VERSION_base(4,11,0)
  fail = t_oldfail
#endif

instance (Monad m) => Monad (ExceptionT i m) where
  ExceptionT i m a
m >>= :: forall a b.
ExceptionT i m a -> (a -> ExceptionT i m b) -> ExceptionT i m b
>>= a -> ExceptionT i m b
k = m (Either i b) -> ExceptionT i m b
forall i (m :: * -> *) a. m (Either i a) -> ExceptionT i m a
X (m (Either i b) -> ExceptionT i m b)
-> m (Either i b) -> ExceptionT i m b
forall a b. (a -> b) -> a -> b
$ ExceptionT i m a -> m (Either i a)
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT ExceptionT i m a
m m (Either i a) -> (Either i a -> m (Either i b)) -> m (Either i b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either i a
e ->
                case Either i a
e of
                  Left i
x  -> Either i b -> m (Either i b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Either i b
forall a b. a -> Either a b
Left i
x)
                  Right a
a -> ExceptionT i m b -> m (Either i b)
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT (a -> ExceptionT i m b
k a
a)

#if !MIN_VERSION_base(4,11,0)
  fail = t_oldfail
#endif

instance (Monad m) => Monad (ChoiceT m) where

  Answer a
a  >>= :: forall a b. ChoiceT m a -> (a -> ChoiceT m b) -> ChoiceT m b
>>= a -> ChoiceT m b
k     = a -> ChoiceT m b
k a
a
  ChoiceT m a
NoAnswer >>= a -> ChoiceT m b
_      = ChoiceT m b
forall (m :: * -> *) a. ChoiceT m a
NoAnswer
  Choice ChoiceT m a
m1 ChoiceT m a
m2 >>= a -> ChoiceT m b
k  = ChoiceT m b -> ChoiceT m b -> ChoiceT m b
forall (m :: * -> *) a. ChoiceT m a -> ChoiceT m a -> ChoiceT m a
Choice (ChoiceT m a
m1 ChoiceT m a -> (a -> ChoiceT m b) -> ChoiceT m b
forall a b. ChoiceT m a -> (a -> ChoiceT m b) -> ChoiceT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ChoiceT m b
k) (ChoiceT m a
m2 ChoiceT m a -> (a -> ChoiceT m b) -> ChoiceT m b
forall a b. ChoiceT m a -> (a -> ChoiceT m b) -> ChoiceT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ChoiceT m b
k)
  ChoiceEff m (ChoiceT m a)
m >>= a -> ChoiceT m b
k   = m (ChoiceT m b) -> ChoiceT m b
forall (m :: * -> *) a. m (ChoiceT m a) -> ChoiceT m a
ChoiceEff ((ChoiceT m a -> ChoiceT m b) -> m (ChoiceT m a) -> m (ChoiceT m b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ChoiceT m a -> (a -> ChoiceT m b) -> ChoiceT m b
forall a b. ChoiceT m a -> (a -> ChoiceT m b) -> ChoiceT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ChoiceT m b
k) m (ChoiceT m a)
m)

#if !MIN_VERSION_base(4,11,0)
  fail = t_oldfail
#endif

instance (Monad m) => Monad (ContT i m) where
  ContT i m a
m >>= :: forall a b. ContT i m a -> (a -> ContT i m b) -> ContT i m b
>>= a -> ContT i m b
k = ((b -> m i) -> m i) -> ContT i m b
forall i (m :: * -> *) a. ((a -> m i) -> m i) -> ContT i m a
C (((b -> m i) -> m i) -> ContT i m b)
-> ((b -> m i) -> m i) -> ContT i m b
forall a b. (a -> b) -> a -> b
$ \b -> m i
c -> (a -> m i) -> ContT i m a -> m i
forall a (m :: * -> *) i. (a -> m i) -> ContT i m a -> m i
runContT (\a
a -> (b -> m i) -> ContT i m b -> m i
forall a (m :: * -> *) i. (a -> m i) -> ContT i m a -> m i
runContT b -> m i
c (a -> ContT i m b
k a
a)) ContT i m a
m

#if !MIN_VERSION_base(4,11,0)
  fail = t_oldfail
#endif

instance                       Functor Id               where fmap :: forall a b. (a -> b) -> Id a -> Id b
fmap = (a -> b) -> Id a -> Id b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance                       Functor Lift             where fmap :: forall a b. (a -> b) -> Lift a -> Lift b
fmap = (a -> b) -> Lift a -> Lift b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m)          => Functor (IdT          m) where fmap :: forall a b. (a -> b) -> IdT m a -> IdT m b
fmap = (a -> b) -> IdT m a -> IdT m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m)          => Functor (ReaderT    i m) where fmap :: forall a b. (a -> b) -> ReaderT i m a -> ReaderT i m b
fmap = (a -> b) -> ReaderT i m a -> ReaderT i m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m)          => Functor (StateT     i m) where fmap :: forall a b. (a -> b) -> StateT i m a -> StateT i m b
fmap = (a -> b) -> StateT i m a -> StateT i m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m,Monoid i) => Functor (WriterT i m)    where fmap :: forall a b. (a -> b) -> WriterT i m a -> WriterT i m b
fmap = (a -> b) -> WriterT i m a -> WriterT i m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m)          => Functor (ExceptionT i m) where fmap :: forall a b. (a -> b) -> ExceptionT i m a -> ExceptionT i m b
fmap = (a -> b) -> ExceptionT i m a -> ExceptionT i m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m)          => Functor (ChoiceT      m) where fmap :: forall a b. (a -> b) -> ChoiceT m a -> ChoiceT m b
fmap = (a -> b) -> ChoiceT m a -> ChoiceT m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m)          => Functor (ContT      i m) where fmap :: forall a b. (a -> b) -> ContT i m a -> ContT i m b
fmap = (a -> b) -> ContT i m a -> ContT i m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

-- Applicative support ---------------------------------------------------------

-- NOTE: It may be possible to make these more general
-- (i.e., have Applicative, or even Functor transformers)

instance              Applicative Id            where <*> :: forall a b. Id (a -> b) -> Id a -> Id b
(<*>) = Id (a -> b) -> Id a -> Id b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> Id a
pure a
x = a -> Id a
forall a. a -> Id a
I a
x
instance              Applicative Lift          where <*> :: forall a b. Lift (a -> b) -> Lift a -> Lift b
(<*>) = Lift (a -> b) -> Lift a -> Lift b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> Lift a
pure a
x = a -> Lift a
forall a. a -> Lift a
L a
x
instance (Monad m) => Applicative (IdT m)       where <*> :: forall a b. IdT m (a -> b) -> IdT m a -> IdT m b
(<*>) = IdT m (a -> b) -> IdT m a -> IdT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> IdT m a
pure = a -> IdT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
a -> t m a
t_return
instance (Monad m) => Applicative (ReaderT i m) where <*> :: forall a b. ReaderT i m (a -> b) -> ReaderT i m a -> ReaderT i m b
(<*>) = ReaderT i m (a -> b) -> ReaderT i m a -> ReaderT i m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> ReaderT i m a
pure = a -> ReaderT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
a -> t m a
t_return
instance (Monad m) => Applicative (StateT i m)  where <*> :: forall a b. StateT i m (a -> b) -> StateT i m a -> StateT i m b
(<*>) = StateT i m (a -> b) -> StateT i m a -> StateT i m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> StateT i m a
pure = a -> StateT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
a -> t m a
t_return
instance (Monad m,Monoid i)
                   => Applicative (WriterT i m) where <*> :: forall a b. WriterT i m (a -> b) -> WriterT i m a -> WriterT i m b
(<*>) = WriterT i m (a -> b) -> WriterT i m a -> WriterT i m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> WriterT i m a
pure = a -> WriterT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
a -> t m a
t_return
instance (Monad m) => Applicative (ExceptionT i m)
                                                where <*> :: forall a b.
ExceptionT i m (a -> b) -> ExceptionT i m a -> ExceptionT i m b
(<*>) = ExceptionT i m (a -> b) -> ExceptionT i m a -> ExceptionT i m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> ExceptionT i m a
pure = a -> ExceptionT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
a -> t m a
t_return
instance (Monad m) => Applicative (ChoiceT m)   where <*> :: forall a b. ChoiceT m (a -> b) -> ChoiceT m a -> ChoiceT m b
(<*>) = ChoiceT m (a -> b) -> ChoiceT m a -> ChoiceT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> ChoiceT m a
pure = a -> ChoiceT m a
forall (m :: * -> *) a. a -> ChoiceT m a
Answer
instance (Monad m) => Applicative (ContT i m)   where <*> :: forall a b. ContT i m (a -> b) -> ContT i m a -> ContT i m b
(<*>) = ContT i m (a -> b) -> ContT i m a -> ContT i m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: forall a. a -> ContT i m a
pure = a -> ContT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
a -> t m a
t_return

instance (MonadPlus m)
           => Alternative (IdT m)           where <|> :: forall a. IdT m a -> IdT m a -> IdT m a
(<|>) = IdT m a -> IdT m a -> IdT m a
forall a. IdT m a -> IdT m a -> IdT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus; empty :: forall a. IdT m a
empty = IdT m a
forall a. IdT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (MonadPlus m)
           => Alternative (ReaderT i m)     where <|> :: forall a. ReaderT i m a -> ReaderT i m a -> ReaderT i m a
(<|>) = ReaderT i m a -> ReaderT i m a -> ReaderT i m a
forall a. ReaderT i m a -> ReaderT i m a -> ReaderT i m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus; empty :: forall a. ReaderT i m a
empty = ReaderT i m a
forall a. ReaderT i m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (MonadPlus m)
           => Alternative (StateT i m)      where <|> :: forall a. StateT i m a -> StateT i m a -> StateT i m a
(<|>) = StateT i m a -> StateT i m a -> StateT i m a
forall a. StateT i m a -> StateT i m a -> StateT i m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus; empty :: forall a. StateT i m a
empty = StateT i m a
forall a. StateT i m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (MonadPlus m,Monoid i)
           => Alternative (WriterT i m)     where <|> :: forall a. WriterT i m a -> WriterT i m a -> WriterT i m a
(<|>) = WriterT i m a -> WriterT i m a -> WriterT i m a
forall a. WriterT i m a -> WriterT i m a -> WriterT i m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus; empty :: forall a. WriterT i m a
empty = WriterT i m a
forall a. WriterT i m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (MonadPlus m)
           => Alternative (ExceptionT i m)  where <|> :: forall a. ExceptionT i m a -> ExceptionT i m a -> ExceptionT i m a
(<|>) = ExceptionT i m a -> ExceptionT i m a -> ExceptionT i m a
forall a. ExceptionT i m a -> ExceptionT i m a -> ExceptionT i m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus; empty :: forall a. ExceptionT i m a
empty = ExceptionT i m a
forall a. ExceptionT i m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (Monad m)
           => Alternative (ChoiceT m)       where <|> :: forall a. ChoiceT m a -> ChoiceT m a -> ChoiceT m a
(<|>) = ChoiceT m a -> ChoiceT m a -> ChoiceT m a
forall a. ChoiceT m a -> ChoiceT m a -> ChoiceT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus; empty :: forall a. ChoiceT m a
empty = ChoiceT m a
forall a. ChoiceT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (MonadPlus m)
           => Alternative (ContT i m)       where <|> :: forall a. ContT i m a -> ContT i m a -> ContT i m a
(<|>) = ContT i m a -> ContT i m a -> ContT i m a
forall a. ContT i m a -> ContT i m a -> ContT i m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus; empty :: forall a. ContT i m a
empty = ContT i m a
forall a. ContT i m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero



-- $Monadic_Value_Recursion
--
-- Recursion that does not duplicate side-effects.
-- For details see Levent Erkok's dissertation.
--
-- Monadic types built with 'ContT' and 'ChoiceT' do not support
-- monadic value recursion.

instance MonadFix Id where
  mfix :: forall a. (a -> Id a) -> Id a
mfix a -> Id a
f  = let m :: Id a
m = a -> Id a
f (Id a -> a
forall a. Id a -> a
runId Id a
m) in Id a
m

instance MonadFix Lift where
  mfix :: forall a. (a -> Lift a) -> Lift a
mfix a -> Lift a
f  = let m :: Lift a
m = a -> Lift a
f (Lift a -> a
forall a. Lift a -> a
runLift Lift a
m) in Lift a
m

instance (MonadFix m) => MonadFix (IdT m) where
  mfix :: forall a. (a -> IdT m a) -> IdT m a
mfix a -> IdT m a
f  = m a -> IdT m a
forall (m :: * -> *) a. m a -> IdT m a
IT ((a -> m a) -> m a
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (IdT m a -> m a
forall (m :: * -> *) a. IdT m a -> m a
runIdT (IdT m a -> m a) -> (a -> IdT m a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IdT m a
f))

instance (MonadFix m) => MonadFix (ReaderT i m) where
  mfix :: forall a. (a -> ReaderT i m a) -> ReaderT i m a
mfix a -> ReaderT i m a
f  = (i -> m a) -> ReaderT i m a
forall i (m :: * -> *) a. (i -> m a) -> ReaderT i m a
R ((i -> m a) -> ReaderT i m a) -> (i -> m a) -> ReaderT i m a
forall a b. (a -> b) -> a -> b
$ \i
r -> (a -> m a) -> m a
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (i -> ReaderT i m a -> m a
forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT i
r (ReaderT i m a -> m a) -> (a -> ReaderT i m a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT i m a
f)

instance (MonadFix m) => MonadFix (StateT i m) where
  mfix :: forall a. (a -> StateT i m a) -> StateT i m a
mfix a -> StateT i m a
f  = (i -> m (a, i)) -> StateT i m a
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S ((i -> m (a, i)) -> StateT i m a)
-> (i -> m (a, i)) -> StateT i m a
forall a b. (a -> b) -> a -> b
$ \i
s -> ((a, i) -> m (a, i)) -> m (a, i)
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (i -> StateT i m a -> m (a, i)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT i
s (StateT i m a -> m (a, i))
-> ((a, i) -> StateT i m a) -> (a, i) -> m (a, i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT i m a
f (a -> StateT i m a) -> ((a, i) -> a) -> (a, i) -> StateT i m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, i) -> a
forall a b. (a, b) -> a
fst)

instance (MonadFix m,Monoid i) => MonadFix (WriterT i m) where
  mfix :: forall a. (a -> WriterT i m a) -> WriterT i m a
mfix a -> WriterT i m a
f  = m (P a i) -> WriterT i m a
forall i (m :: * -> *) a. m (P a i) -> WriterT i m a
W (m (P a i) -> WriterT i m a) -> m (P a i) -> WriterT i m a
forall a b. (a -> b) -> a -> b
$ (P a i -> m (P a i)) -> m (P a i)
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (WriterT i m a -> m (P a i)
forall i (m :: * -> *) a. WriterT i m a -> m (P a i)
unW (WriterT i m a -> m (P a i))
-> (P a i -> WriterT i m a) -> P a i -> m (P a i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WriterT i m a
f (a -> WriterT i m a) -> (P a i -> a) -> P a i -> WriterT i m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P a i -> a
forall {a} {i}. P a i -> a
val)
    where val :: P a i -> a
val ~(P a
a i
_) = a
a

-- No instance for ChoiceT

instance (MonadFix m) => MonadFix (ExceptionT i m) where
  mfix :: forall a. (a -> ExceptionT i m a) -> ExceptionT i m a
mfix a -> ExceptionT i m a
f  = m (Either i a) -> ExceptionT i m a
forall i (m :: * -> *) a. m (Either i a) -> ExceptionT i m a
X (m (Either i a) -> ExceptionT i m a)
-> m (Either i a) -> ExceptionT i m a
forall a b. (a -> b) -> a -> b
$ (Either i a -> m (Either i a)) -> m (Either i a)
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (ExceptionT i m a -> m (Either i a)
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT (ExceptionT i m a -> m (Either i a))
-> (Either i a -> ExceptionT i m a) -> Either i a -> m (Either i a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExceptionT i m a
f (a -> ExceptionT i m a)
-> (Either i a -> a) -> Either i a -> ExceptionT i m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either i a -> a
forall {a} {b}. Either a b -> b
fromRight)
    where fromRight :: Either a b -> b
fromRight (Right b
a) = b
a
          fromRight Either a b
_         = String -> b
forall a. HasCallStack => String -> a
error String
"ExceptionT: mfix looped."

-- No instance for ContT

instance (MonadPlus m) => MonadPlus (IdT m) where
  mzero :: forall a. IdT m a
mzero               = IdT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadPlus m) =>
t m a
t_mzero
  mplus :: forall a. IdT m a -> IdT m a -> IdT m a
mplus (IT m a
m) (IT m a
n) = m a -> IdT m a
forall (m :: * -> *) a. m a -> IdT m a
IT (m a -> m a -> m a
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m a
m m a
n)

instance (MonadPlus m) => MonadPlus (ReaderT i m) where
  mzero :: forall a. ReaderT i m a
mzero             = ReaderT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadPlus m) =>
t m a
t_mzero
  mplus :: forall a. ReaderT i m a -> ReaderT i m a -> ReaderT i m a
mplus (R i -> m a
m) (R i -> m a
n) = (i -> m a) -> ReaderT i m a
forall i (m :: * -> *) a. (i -> m a) -> ReaderT i m a
R (\i
r -> m a -> m a -> m a
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (i -> m a
m i
r) (i -> m a
n i
r))

instance (MonadPlus m) => MonadPlus (StateT i m) where
  mzero :: forall a. StateT i m a
mzero             = StateT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadPlus m) =>
t m a
t_mzero
  mplus :: forall a. StateT i m a -> StateT i m a -> StateT i m a
mplus (S i -> m (a, i)
m) (S i -> m (a, i)
n) = (i -> m (a, i)) -> StateT i m a
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S (\i
s -> m (a, i) -> m (a, i) -> m (a, i)
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (i -> m (a, i)
m i
s) (i -> m (a, i)
n i
s))

instance (MonadPlus m,Monoid i) => MonadPlus (WriterT i m) where
  mzero :: forall a. WriterT i m a
mzero               = WriterT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadPlus m) =>
t m a
t_mzero
  mplus :: forall a. WriterT i m a -> WriterT i m a -> WriterT i m a
mplus (W m (P a i)
m) (W m (P a i)
n) = m (P a i) -> WriterT i m a
forall i (m :: * -> *) a. m (P a i) -> WriterT i m a
W (m (P a i) -> m (P a i) -> m (P a i)
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m (P a i)
m m (P a i)
n)

instance (MonadPlus m) => MonadPlus (ExceptionT i m) where
  mzero :: forall a. ExceptionT i m a
mzero             = ExceptionT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadPlus m) =>
t m a
t_mzero
  mplus :: forall a. ExceptionT i m a -> ExceptionT i m a -> ExceptionT i m a
mplus (X m (Either i a)
m) (X m (Either i a)
n) = m (Either i a) -> ExceptionT i m a
forall i (m :: * -> *) a. m (Either i a) -> ExceptionT i m a
X (m (Either i a) -> m (Either i a) -> m (Either i a)
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m (Either i a)
m m (Either i a)
n)

instance (Monad m) => MonadPlus (ChoiceT m) where
  mzero :: forall a. ChoiceT m a
mzero             = ChoiceT m a
forall (m :: * -> *) a. ChoiceT m a
NoAnswer
  mplus :: forall a. ChoiceT m a -> ChoiceT m a -> ChoiceT m a
mplus ChoiceT m a
m ChoiceT m a
n         = ChoiceT m a -> ChoiceT m a -> ChoiceT m a
forall (m :: * -> *) a. ChoiceT m a -> ChoiceT m a -> ChoiceT m a
Choice ChoiceT m a
m ChoiceT m a
n

-- Alternatives share the continuation.
instance (MonadPlus m) => MonadPlus (ContT i m) where
  mzero :: forall a. ContT i m a
mzero             = ContT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadPlus m) =>
t m a
t_mzero
  mplus :: forall a. ContT i m a -> ContT i m a -> ContT i m a
mplus (C (a -> m i) -> m i
m) (C (a -> m i) -> m i
n) = ((a -> m i) -> m i) -> ContT i m a
forall i (m :: * -> *) a. ((a -> m i) -> m i) -> ContT i m a
C (\a -> m i
k -> (a -> m i) -> m i
m a -> m i
k m i -> m i -> m i
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (a -> m i) -> m i
n a -> m i
k)


-- $Effects
--
-- The following classes define overloaded operations
-- that can be used to define effectful computations.


-- | Classifies monads that provide access to a context of type @i@.
class (Monad m) => ReaderM m i | m -> i where
  -- | Get the context.
  ask :: m i

instance (Monad m) => ReaderM (ReaderT i m) i where
  ask :: ReaderT i m i
ask = (i -> m i) -> ReaderT i m i
forall i (m :: * -> *) a. (i -> m a) -> ReaderT i m a
R i -> m i
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance (ReaderM m j) => ReaderM (IdT m) j           where ask :: IdT m j
ask = IdT m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, ReaderM m i) =>
t m i
t_ask
instance (ReaderM m j,Monoid i)
                       => ReaderM (WriterT i m) j     where ask :: WriterT i m j
ask = WriterT i m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, ReaderM m i) =>
t m i
t_ask
instance (ReaderM m j) => ReaderM (StateT i m) j      where ask :: StateT i m j
ask = StateT i m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, ReaderM m i) =>
t m i
t_ask
instance (ReaderM m j) => ReaderM (ExceptionT i m) j  where ask :: ExceptionT i m j
ask = ExceptionT i m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, ReaderM m i) =>
t m i
t_ask
instance (ReaderM m j) => ReaderM (ChoiceT m) j       where ask :: ChoiceT m j
ask = ChoiceT m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, ReaderM m i) =>
t m i
t_ask
instance (ReaderM m j) => ReaderM (ContT i m) j       where ask :: ContT i m j
ask = ContT i m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, ReaderM m i) =>
t m i
t_ask


-- | Classifies monads that can collect values of type @i@.
class (Monad m) => WriterM m i | m -> i where
  -- | Add a value to the collection.
  put  :: i -> m ()

instance (Monad m,Monoid i) => WriterM (WriterT i m) i where
  put :: i -> WriterT i m ()
put i
x = m (P () i) -> WriterT i m ()
forall i (m :: * -> *) a. m (P a i) -> WriterT i m a
W (P () i -> m (P () i)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> i -> P () i
forall a i. a -> i -> P a i
P () i
x))

instance (WriterM m j) => WriterM (IdT          m) j where put :: j -> IdT m ()
put = j -> IdT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, WriterM m i) =>
i -> t m ()
t_put
instance (WriterM m j) => WriterM (ReaderT    i m) j where put :: j -> ReaderT i m ()
put = j -> ReaderT i m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, WriterM m i) =>
i -> t m ()
t_put
instance (WriterM m j) => WriterM (StateT     i m) j where put :: j -> StateT i m ()
put = j -> StateT i m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, WriterM m i) =>
i -> t m ()
t_put
instance (WriterM m j) => WriterM (ExceptionT i m) j where put :: j -> ExceptionT i m ()
put = j -> ExceptionT i m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, WriterM m i) =>
i -> t m ()
t_put
instance (WriterM m j) => WriterM (ChoiceT      m) j where put :: j -> ChoiceT m ()
put = j -> ChoiceT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, WriterM m i) =>
i -> t m ()
t_put
instance (WriterM m j) => WriterM (ContT      i m) j where put :: j -> ContT i m ()
put = j -> ContT i m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, WriterM m i) =>
i -> t m ()
t_put

-- | Classifies monads that propagate a state component of type @i@.
class (Monad m) => StateM m i | m -> i where
  -- | Get the state.
  get :: m i
  -- | Set the state.
  set :: i -> m ()

instance (Monad m) => StateM (StateT i m) i where
  get :: StateT i m i
get   = (i -> m (i, i)) -> StateT i m i
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S (\i
s -> (i, i) -> m (i, i)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (i
s,i
s))
  set :: i -> StateT i m ()
set i
s = (i -> m ((), i)) -> StateT i m ()
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S (\i
_ -> ((), i) -> m ((), i)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((),i
s))

instance (StateM m j) => StateM (IdT m) j where
  get :: IdT m j
get = IdT m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
t m i
t_get; set :: j -> IdT m ()
set = j -> IdT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
i -> t m ()
t_set
instance (StateM m j) => StateM (ReaderT i m) j where
  get :: ReaderT i m j
get = ReaderT i m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
t m i
t_get; set :: j -> ReaderT i m ()
set = j -> ReaderT i m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
i -> t m ()
t_set
instance (StateM m j,Monoid i) => StateM (WriterT i m) j where
  get :: WriterT i m j
get = WriterT i m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
t m i
t_get; set :: j -> WriterT i m ()
set = j -> WriterT i m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
i -> t m ()
t_set
instance (StateM m j) => StateM (ExceptionT i m) j where
  get :: ExceptionT i m j
get = ExceptionT i m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
t m i
t_get; set :: j -> ExceptionT i m ()
set = j -> ExceptionT i m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
i -> t m ()
t_set
instance (StateM m j) => StateM (ChoiceT m) j where
  get :: ChoiceT m j
get = ChoiceT m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
t m i
t_get; set :: j -> ChoiceT m ()
set = j -> ChoiceT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
i -> t m ()
t_set
instance (StateM m j) => StateM (ContT i m) j where
  get :: ContT i m j
get = ContT i m j
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
t m i
t_get; set :: j -> ContT i m ()
set = j -> ContT i m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i.
(MonadT t, StateM m i) =>
i -> t m ()
t_set

-- | Classifies monads that support raising exceptions of type @i@.
class (Monad m) => ExceptionM m i | m -> i where
  -- | Raise an exception.
  raise :: i -> m a

#ifdef USE_BASE3
instance ExceptionM IO IO.Exception where
  raise = IO.throwIO
#else
instance ExceptionM IO IO.SomeException where
  raise :: forall a. SomeException -> IO a
raise = SomeException -> IO a
forall e a. Exception e => e -> IO a
IO.throwIO
#endif

instance (Monad m) => ExceptionM (ExceptionT i m) i where
  raise :: forall a. i -> ExceptionT i m a
raise i
x = m (Either i a) -> ExceptionT i m a
forall i (m :: * -> *) a. m (Either i a) -> ExceptionT i m a
X (Either i a -> m (Either i a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Either i a
forall a b. a -> Either a b
Left i
x))

instance (ExceptionM m j) => ExceptionM (IdT m) j where
  raise :: forall a. j -> IdT m a
raise = j -> IdT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, ExceptionM m i) =>
i -> t m a
t_raise
instance (ExceptionM m j) => ExceptionM (ReaderT i m) j where
  raise :: forall a. j -> ReaderT i m a
raise = j -> ReaderT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, ExceptionM m i) =>
i -> t m a
t_raise
instance (ExceptionM m j,Monoid i) => ExceptionM (WriterT i m) j where
  raise :: forall a. j -> WriterT i m a
raise = j -> WriterT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, ExceptionM m i) =>
i -> t m a
t_raise
instance (ExceptionM m j) => ExceptionM (StateT  i m) j where
  raise :: forall a. j -> StateT i m a
raise = j -> StateT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, ExceptionM m i) =>
i -> t m a
t_raise
instance (ExceptionM m j) => ExceptionM (ChoiceT   m) j where
  raise :: forall a. j -> ChoiceT m a
raise = j -> ChoiceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, ExceptionM m i) =>
i -> t m a
t_raise
instance (ExceptionM m j) => ExceptionM (ContT   i m) j where
  raise :: forall a. j -> ContT i m a
raise = j -> ContT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, ExceptionM m i) =>
i -> t m a
t_raise


-- The following instances differ from the others because the
-- liftings are not as uniform (although they certainly follow a pattern).

-- | Classifies monads that provide access to a computation's continuation.
class Monad m => ContM m where
  -- | Capture the current continuation.
  callWithCC :: ((a -> Label m) -> m a) -> m a


-- This captures a common pattern in the lifted definitions of `callWithCC`.
liftJump :: (ContM m, MonadT t) =>
  (a -> b) ->
  ((a -> Label (t m)) -> t m a) ->
  ((b -> Label    m ) -> t m a)
liftJump :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(ContM m, MonadT t) =>
(a -> b)
-> ((a -> Label (t m)) -> t m a) -> (b -> Label m) -> t m a
liftJump a -> b
ans (a -> Label (t m)) -> t m a
f b -> Label m
l = (a -> Label (t m)) -> t m a
f ((a -> Label (t m)) -> t m a) -> (a -> Label (t m)) -> t m a
forall a b. (a -> b) -> a -> b
$ \a
a -> (forall b. t m b) -> Label (t m)
forall (m :: * -> *). (forall b. m b) -> Label m
Lab (m b -> t m b
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (m b -> t m b) -> m b -> t m b
forall a b. (a -> b) -> a -> b
$ Label m -> m b
forall (m :: * -> *) a. Label m -> m a
jump (Label m -> m b) -> Label m -> m b
forall a b. (a -> b) -> a -> b
$ b -> Label m
l (b -> Label m) -> b -> Label m
forall a b. (a -> b) -> a -> b
$ a -> b
ans a
a)


instance (ContM m) => ContM (IdT m) where
  callWithCC :: forall a. ((a -> Label (IdT m)) -> IdT m a) -> IdT m a
callWithCC (a -> Label (IdT m)) -> IdT m a
f = m a -> IdT m a
forall (m :: * -> *) a. m a -> IdT m a
IT (m a -> IdT m a) -> m a -> IdT m a
forall a b. (a -> b) -> a -> b
$ ((a -> Label m) -> m a) -> m a
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC (((a -> Label m) -> m a) -> m a) -> ((a -> Label m) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a -> Label m
k -> IdT m a -> m a
forall (m :: * -> *) a. IdT m a -> m a
runIdT (IdT m a -> m a) -> IdT m a -> m a
forall a b. (a -> b) -> a -> b
$ (a -> a)
-> ((a -> Label (IdT m)) -> IdT m a) -> (a -> Label m) -> IdT m a
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(ContM m, MonadT t) =>
(a -> b)
-> ((a -> Label (t m)) -> t m a) -> (b -> Label m) -> t m a
liftJump a -> a
forall a. a -> a
id (a -> Label (IdT m)) -> IdT m a
f a -> Label m
k

instance (ContM m) => ContM (ReaderT i m) where
  callWithCC :: forall a.
((a -> Label (ReaderT i m)) -> ReaderT i m a) -> ReaderT i m a
callWithCC (a -> Label (ReaderT i m)) -> ReaderT i m a
f = (i -> m a) -> ReaderT i m a
forall i (m :: * -> *) a. (i -> m a) -> ReaderT i m a
R ((i -> m a) -> ReaderT i m a) -> (i -> m a) -> ReaderT i m a
forall a b. (a -> b) -> a -> b
$ \i
r -> ((a -> Label m) -> m a) -> m a
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC (((a -> Label m) -> m a) -> m a) -> ((a -> Label m) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a -> Label m
k -> i -> ReaderT i m a -> m a
forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT i
r (ReaderT i m a -> m a) -> ReaderT i m a -> m a
forall a b. (a -> b) -> a -> b
$ (a -> a)
-> ((a -> Label (ReaderT i m)) -> ReaderT i m a)
-> (a -> Label m)
-> ReaderT i m a
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(ContM m, MonadT t) =>
(a -> b)
-> ((a -> Label (t m)) -> t m a) -> (b -> Label m) -> t m a
liftJump a -> a
forall a. a -> a
id (a -> Label (ReaderT i m)) -> ReaderT i m a
f a -> Label m
k

instance (ContM m) => ContM (StateT i m) where
  callWithCC :: forall a.
((a -> Label (StateT i m)) -> StateT i m a) -> StateT i m a
callWithCC (a -> Label (StateT i m)) -> StateT i m a
f = (i -> m (a, i)) -> StateT i m a
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S ((i -> m (a, i)) -> StateT i m a)
-> (i -> m (a, i)) -> StateT i m a
forall a b. (a -> b) -> a -> b
$ \i
s -> (((a, i) -> Label m) -> m (a, i)) -> m (a, i)
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC ((((a, i) -> Label m) -> m (a, i)) -> m (a, i))
-> (((a, i) -> Label m) -> m (a, i)) -> m (a, i)
forall a b. (a -> b) -> a -> b
$ \(a, i) -> Label m
k -> i -> StateT i m a -> m (a, i)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT i
s (StateT i m a -> m (a, i)) -> StateT i m a -> m (a, i)
forall a b. (a -> b) -> a -> b
$ (a -> (a, i))
-> ((a -> Label (StateT i m)) -> StateT i m a)
-> ((a, i) -> Label m)
-> StateT i m a
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(ContM m, MonadT t) =>
(a -> b)
-> ((a -> Label (t m)) -> t m a) -> (b -> Label m) -> t m a
liftJump (i -> a -> (a, i)
forall {b} {a}. b -> a -> (a, b)
ans i
s) (a -> Label (StateT i m)) -> StateT i m a
f (a, i) -> Label m
k
    where ans :: b -> a -> (a, b)
ans b
s a
a = (a
a,b
s)

instance (ContM m,Monoid i) => ContM (WriterT i m) where
  callWithCC :: forall a.
((a -> Label (WriterT i m)) -> WriterT i m a) -> WriterT i m a
callWithCC (a -> Label (WriterT i m)) -> WriterT i m a
f = m (P a i) -> WriterT i m a
forall i (m :: * -> *) a. m (P a i) -> WriterT i m a
W (m (P a i) -> WriterT i m a) -> m (P a i) -> WriterT i m a
forall a b. (a -> b) -> a -> b
$ ((P a i -> Label m) -> m (P a i)) -> m (P a i)
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC (((P a i -> Label m) -> m (P a i)) -> m (P a i))
-> ((P a i -> Label m) -> m (P a i)) -> m (P a i)
forall a b. (a -> b) -> a -> b
$ \P a i -> Label m
k -> WriterT i m a -> m (P a i)
forall i (m :: * -> *) a. WriterT i m a -> m (P a i)
unW (WriterT i m a -> m (P a i)) -> WriterT i m a -> m (P a i)
forall a b. (a -> b) -> a -> b
$ (a -> P a i)
-> ((a -> Label (WriterT i m)) -> WriterT i m a)
-> (P a i -> Label m)
-> WriterT i m a
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(ContM m, MonadT t) =>
(a -> b)
-> ((a -> Label (t m)) -> t m a) -> (b -> Label m) -> t m a
liftJump (a -> i -> P a i
forall a i. a -> i -> P a i
`P` i
forall a. Monoid a => a
mempty) (a -> Label (WriterT i m)) -> WriterT i m a
f P a i -> Label m
k

instance (ContM m) => ContM (ExceptionT i m) where
  callWithCC :: forall a.
((a -> Label (ExceptionT i m)) -> ExceptionT i m a)
-> ExceptionT i m a
callWithCC (a -> Label (ExceptionT i m)) -> ExceptionT i m a
f = m (Either i a) -> ExceptionT i m a
forall i (m :: * -> *) a. m (Either i a) -> ExceptionT i m a
X (m (Either i a) -> ExceptionT i m a)
-> m (Either i a) -> ExceptionT i m a
forall a b. (a -> b) -> a -> b
$ ((Either i a -> Label m) -> m (Either i a)) -> m (Either i a)
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC (((Either i a -> Label m) -> m (Either i a)) -> m (Either i a))
-> ((Either i a -> Label m) -> m (Either i a)) -> m (Either i a)
forall a b. (a -> b) -> a -> b
$ \Either i a -> Label m
k -> ExceptionT i m a -> m (Either i a)
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT (ExceptionT i m a -> m (Either i a))
-> ExceptionT i m a -> m (Either i a)
forall a b. (a -> b) -> a -> b
$ (a -> Either i a)
-> ((a -> Label (ExceptionT i m)) -> ExceptionT i m a)
-> (Either i a -> Label m)
-> ExceptionT i m a
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(ContM m, MonadT t) =>
(a -> b)
-> ((a -> Label (t m)) -> t m a) -> (b -> Label m) -> t m a
liftJump a -> Either i a
forall a b. b -> Either a b
Right (a -> Label (ExceptionT i m)) -> ExceptionT i m a
f Either i a -> Label m
k

instance (ContM m) => ContM (ChoiceT m) where
  callWithCC :: forall a. ((a -> Label (ChoiceT m)) -> ChoiceT m a) -> ChoiceT m a
callWithCC (a -> Label (ChoiceT m)) -> ChoiceT m a
f = m (ChoiceT m a) -> ChoiceT m a
forall (m :: * -> *) a. m (ChoiceT m a) -> ChoiceT m a
ChoiceEff (m (ChoiceT m a) -> ChoiceT m a) -> m (ChoiceT m a) -> ChoiceT m a
forall a b. (a -> b) -> a -> b
$ ((ChoiceT m a -> Label m) -> m (ChoiceT m a)) -> m (ChoiceT m a)
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC (((ChoiceT m a -> Label m) -> m (ChoiceT m a)) -> m (ChoiceT m a))
-> ((ChoiceT m a -> Label m) -> m (ChoiceT m a)) -> m (ChoiceT m a)
forall a b. (a -> b) -> a -> b
$ \ChoiceT m a -> Label m
k -> ChoiceT m a -> m (ChoiceT m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChoiceT m a -> m (ChoiceT m a)) -> ChoiceT m a -> m (ChoiceT m a)
forall a b. (a -> b) -> a -> b
$ (a -> ChoiceT m a)
-> ((a -> Label (ChoiceT m)) -> ChoiceT m a)
-> (ChoiceT m a -> Label m)
-> ChoiceT m a
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(ContM m, MonadT t) =>
(a -> b)
-> ((a -> Label (t m)) -> t m a) -> (b -> Label m) -> t m a
liftJump a -> ChoiceT m a
forall (m :: * -> *) a. a -> ChoiceT m a
Answer (a -> Label (ChoiceT m)) -> ChoiceT m a
f ChoiceT m a -> Label m
k
    -- ??? What does this do ???

instance (Monad m) => ContM (ContT i m) where
  callWithCC :: forall a. ((a -> Label (ContT i m)) -> ContT i m a) -> ContT i m a
callWithCC (a -> Label (ContT i m)) -> ContT i m a
f = ((a -> m i) -> m i) -> ContT i m a
forall i (m :: * -> *) a. ((a -> m i) -> m i) -> ContT i m a
C (((a -> m i) -> m i) -> ContT i m a)
-> ((a -> m i) -> m i) -> ContT i m a
forall a b. (a -> b) -> a -> b
$ \a -> m i
k -> (a -> m i) -> ContT i m a -> m i
forall a (m :: * -> *) i. (a -> m i) -> ContT i m a -> m i
runContT a -> m i
k (ContT i m a -> m i) -> ContT i m a -> m i
forall a b. (a -> b) -> a -> b
$ (a -> Label (ContT i m)) -> ContT i m a
f ((a -> Label (ContT i m)) -> ContT i m a)
-> (a -> Label (ContT i m)) -> ContT i m a
forall a b. (a -> b) -> a -> b
$ \a
a -> (forall b. ContT i m b) -> Label (ContT i m)
forall (m :: * -> *). (forall b. m b) -> Label m
Lab (((b -> m i) -> m i) -> ContT i m b
forall i (m :: * -> *) a. ((a -> m i) -> m i) -> ContT i m a
C (((b -> m i) -> m i) -> ContT i m b)
-> ((b -> m i) -> m i) -> ContT i m b
forall a b. (a -> b) -> a -> b
$ \b -> m i
_ -> a -> m i
k a
a)

-- $Nested_Exec
--
-- The following classes define operations that are overloaded
-- versions of the @run@ operations.   Unlike the @run@ operations,
-- these functions do not change the type of the computation (i.e., they
-- do not remove a layer).  Instead, they perform the effects in
-- a ``separate effect thread''.

-- | Classifies monads that support changing the context for a
-- sub-computation.
class (ReaderM m i) => RunReaderM m i | m -> i where
  -- | Change the context for the duration of a sub-computation.
  local        :: i -> m a -> m a
  -- prop(?): local i (m1 >> m2) = local i m1 >> local i m2

instance (Monad m)        => RunReaderM (ReaderT    i m) i where
  local :: forall a. i -> ReaderT i m a -> ReaderT i m a
local i
i ReaderT i m a
m     = m a -> ReaderT i m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (i -> ReaderT i m a -> m a
forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT i
i ReaderT i m a
m)

instance (RunReaderM m j) => RunReaderM (IdT m) j where
  local :: forall a. j -> IdT m a -> IdT m a
local j
i (IT m a
m) = m a -> IdT m a
forall (m :: * -> *) a. m a -> IdT m a
IT (j -> m a -> m a
forall a. j -> m a -> m a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local j
i m a
m)
instance (RunReaderM m j,Monoid i) => RunReaderM (WriterT i m) j where
  local :: forall a. j -> WriterT i m a -> WriterT i m a
local j
i (W m (P a i)
m) = m (P a i) -> WriterT i m a
forall i (m :: * -> *) a. m (P a i) -> WriterT i m a
W (j -> m (P a i) -> m (P a i)
forall a. j -> m a -> m a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local j
i m (P a i)
m)
instance (RunReaderM m j) => RunReaderM (StateT     i m) j where
  local :: forall a. j -> StateT i m a -> StateT i m a
local j
i (S i -> m (a, i)
m) = (i -> m (a, i)) -> StateT i m a
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S (j -> m (a, i) -> m (a, i)
forall a. j -> m a -> m a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local j
i (m (a, i) -> m (a, i)) -> (i -> m (a, i)) -> i -> m (a, i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> m (a, i)
m)
instance (RunReaderM m j) => RunReaderM (ExceptionT i m) j where
  local :: forall a. j -> ExceptionT i m a -> ExceptionT i m a
local j
i (X m (Either i a)
m) = m (Either i a) -> ExceptionT i m a
forall i (m :: * -> *) a. m (Either i a) -> ExceptionT i m a
X (j -> m (Either i a) -> m (Either i a)
forall a. j -> m a -> m a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local j
i m (Either i a)
m)

instance (RunReaderM m j) => RunReaderM (ContT i m) j where
  local :: forall a. j -> ContT i m a -> ContT i m a
local j
i (C (a -> m i) -> m i
m) = ((a -> m i) -> m i) -> ContT i m a
forall i (m :: * -> *) a. ((a -> m i) -> m i) -> ContT i m a
C (j -> m i -> m i
forall a. j -> m a -> m a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local j
i (m i -> m i) -> ((a -> m i) -> m i) -> (a -> m i) -> m i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m i) -> m i
m)

-- | Classifies monads that support collecting the output of
-- a sub-computation.
class WriterM m i => RunWriterM m i | m -> i where
  -- | Collect the output from a sub-computation.
  collect :: m a -> m (a,i)

instance (Monad m,Monoid i) => RunWriterM (WriterT i m) i where
  collect :: forall a. WriterT i m a -> WriterT i m (a, i)
collect WriterT i m a
m = m (a, i) -> WriterT i m (a, i)
forall (m :: * -> *) a. Monad m => m a -> WriterT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (WriterT i m a -> m (a, i)
forall (m :: * -> *) i a. Monad m => WriterT i m a -> m (a, i)
runWriterT WriterT i m a
m)

instance (RunWriterM m j) => RunWriterM (IdT m) j where
  collect :: forall a. IdT m a -> IdT m (a, j)
collect (IT m a
m) = m (a, j) -> IdT m (a, j)
forall (m :: * -> *) a. m a -> IdT m a
IT (m a -> m (a, j)
forall a. m a -> m (a, j)
forall (m :: * -> *) i a. RunWriterM m i => m a -> m (a, i)
collect m a
m)
instance (RunWriterM m j) => RunWriterM (ReaderT i m) j where
  collect :: forall a. ReaderT i m a -> ReaderT i m (a, j)
collect (R i -> m a
m) = (i -> m (a, j)) -> ReaderT i m (a, j)
forall i (m :: * -> *) a. (i -> m a) -> ReaderT i m a
R (m a -> m (a, j)
forall a. m a -> m (a, j)
forall (m :: * -> *) i a. RunWriterM m i => m a -> m (a, i)
collect (m a -> m (a, j)) -> (i -> m a) -> i -> m (a, j)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> m a
m)
instance (RunWriterM m j) => RunWriterM (StateT i m) j where
  collect :: forall a. StateT i m a -> StateT i m (a, j)
collect (S i -> m (a, i)
m) = (i -> m ((a, j), i)) -> StateT i m (a, j)
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S ((((a, i), j) -> ((a, j), i)) -> m ((a, i), j) -> m ((a, j), i)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a, i), j) -> ((a, j), i)
forall {a} {b} {b}. ((a, b), b) -> ((a, b), b)
swap (m ((a, i), j) -> m ((a, j), i))
-> (i -> m ((a, i), j)) -> i -> m ((a, j), i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, i) -> m ((a, i), j)
forall a. m a -> m (a, j)
forall (m :: * -> *) i a. RunWriterM m i => m a -> m (a, i)
collect (m (a, i) -> m ((a, i), j))
-> (i -> m (a, i)) -> i -> m ((a, i), j)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> m (a, i)
m)
    where swap :: ((a, b), b) -> ((a, b), b)
swap (~(a
a,b
s),b
w) = ((a
a,b
w),b
s)
instance (RunWriterM m j) => RunWriterM (ExceptionT i m) j where
  collect :: forall a. ExceptionT i m a -> ExceptionT i m (a, j)
collect (X m (Either i a)
m) = m (Either i (a, j)) -> ExceptionT i m (a, j)
forall i (m :: * -> *) a. m (Either i a) -> ExceptionT i m a
X (((Either i a, j) -> Either i (a, j))
-> m (Either i a, j) -> m (Either i (a, j))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either i a, j) -> Either i (a, j)
forall {a} {a} {b}. (Either a a, b) -> Either a (a, b)
swap (m (Either i a) -> m (Either i a, j)
forall a. m a -> m (a, j)
forall (m :: * -> *) i a. RunWriterM m i => m a -> m (a, i)
collect m (Either i a)
m))
    where swap :: (Either a a, b) -> Either a (a, b)
swap (Right a
a,b
w)  = (a, b) -> Either a (a, b)
forall a b. b -> Either a b
Right (a
a,b
w)
          swap (Left a
x,b
_)   = a -> Either a (a, b)
forall a b. a -> Either a b
Left a
x
instance (RunWriterM m j, MonadFix m) => RunWriterM (ContT i m) j where
  collect :: forall a. ContT i m a -> ContT i m (a, j)
collect (C (a -> m i) -> m i
m) = (((a, j) -> m i) -> m i) -> ContT i m (a, j)
forall i (m :: * -> *) a. ((a -> m i) -> m i) -> ContT i m a
C ((((a, j) -> m i) -> m i) -> ContT i m (a, j))
-> (((a, j) -> m i) -> m i) -> ContT i m (a, j)
forall a b. (a -> b) -> a -> b
$ \(a, j) -> m i
k -> (i, j) -> i
forall a b. (a, b) -> a
fst ((i, j) -> i) -> m (i, j) -> m i
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM`
                                ((i, j) -> m (i, j)) -> m (i, j)
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\ ~(i
_,j
w) -> m i -> m (i, j)
forall a. m a -> m (a, j)
forall (m :: * -> *) i a. RunWriterM m i => m a -> m (a, i)
collect ((a -> m i) -> m i
m (\a
a -> (a, j) -> m i
k (a
a,j
w))))


-- $WriterM_ExceptionT
--
-- About the 'WriterM' instance:
-- If an exception is risen while we are collecting output,
-- then the output is lost.  If the output is important,
-- then use 'try' to ensure that no exception may occur.
-- Example:
--
-- > do (r,w) <- collect (try m)
-- >    case r of
-- >      Left err -> ...do something...
-- >      Right a  -> ...do something...

-- | Classifies monads that support handling of exceptions.
class ExceptionM m i => RunExceptionM m i | m -> i where
  -- | Convert computations that may raise an exception
  -- into computations that do not raise exception but instead,
  -- yield a tagged results.  Exceptions are tagged with "Left",
  -- successful computations are tagged with "Right".
  try :: m a -> m (Either i a)

instance RunExceptionM IO IO.SomeException where
  try :: forall a. IO a -> IO (Either SomeException a)
try = IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
IO.try

instance (Monad m) => RunExceptionM (ExceptionT i m) i where
  try :: forall a. ExceptionT i m a -> ExceptionT i m (Either i a)
try ExceptionT i m a
m = m (Either i a) -> ExceptionT i m (Either i a)
forall (m :: * -> *) a. Monad m => m a -> ExceptionT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (ExceptionT i m a -> m (Either i a)
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT ExceptionT i m a
m)

instance (RunExceptionM m i) => RunExceptionM (IdT m) i where
  try :: forall a. IdT m a -> IdT m (Either i a)
try (IT m a
m) = m (Either i a) -> IdT m (Either i a)
forall (m :: * -> *) a. m a -> IdT m a
IT (m a -> m (Either i a)
forall a. m a -> m (Either i a)
forall (m :: * -> *) i a.
RunExceptionM m i =>
m a -> m (Either i a)
try m a
m)
instance (RunExceptionM m i) => RunExceptionM (ReaderT j m) i where
  try :: forall a. ReaderT j m a -> ReaderT j m (Either i a)
try (R j -> m a
m) = (j -> m (Either i a)) -> ReaderT j m (Either i a)
forall i (m :: * -> *) a. (i -> m a) -> ReaderT i m a
R (m a -> m (Either i a)
forall a. m a -> m (Either i a)
forall (m :: * -> *) i a.
RunExceptionM m i =>
m a -> m (Either i a)
try (m a -> m (Either i a)) -> (j -> m a) -> j -> m (Either i a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> m a
m)
instance (RunExceptionM m i,Monoid j) => RunExceptionM (WriterT j m) i where
  try :: forall a. WriterT j m a -> WriterT j m (Either i a)
try (W m (P a j)
m) = m (P (Either i a) j) -> WriterT j m (Either i a)
forall i (m :: * -> *) a. m (P a i) -> WriterT i m a
W ((Either i (P a j) -> P (Either i a) j)
-> m (Either i (P a j)) -> m (P (Either i a) j)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either i (P a j) -> P (Either i a) j
forall {i} {a} {b}.
Monoid i =>
Either a (P b i) -> P (Either a b) i
swap (m (P a j) -> m (Either i (P a j))
forall a. m a -> m (Either i a)
forall (m :: * -> *) i a.
RunExceptionM m i =>
m a -> m (Either i a)
try m (P a j)
m))
    where swap :: Either a (P b i) -> P (Either a b) i
swap (Right (P b
a i
w))  = Either a b -> i -> P (Either a b) i
forall a i. a -> i -> P a i
P (b -> Either a b
forall a b. b -> Either a b
Right b
a) i
w
          swap (Left a
e)         = Either a b -> i -> P (Either a b) i
forall a i. a -> i -> P a i
P (a -> Either a b
forall a b. a -> Either a b
Left a
e) i
forall a. Monoid a => a
mempty
instance (RunExceptionM m i) => RunExceptionM (StateT j m) i where
  try :: forall a. StateT j m a -> StateT j m (Either i a)
try (S j -> m (a, j)
m) = (j -> m (Either i a, j)) -> StateT j m (Either i a)
forall i (m :: * -> *) a. (i -> m (a, i)) -> StateT i m a
S (\j
s -> (Either i (a, j) -> (Either i a, j))
-> m (Either i (a, j)) -> m (Either i a, j)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (j -> Either i (a, j) -> (Either i a, j)
forall {b} {a} {b}. b -> Either a (b, b) -> (Either a b, b)
swap j
s) (m (a, j) -> m (Either i (a, j))
forall a. m a -> m (Either i a)
forall (m :: * -> *) i a.
RunExceptionM m i =>
m a -> m (Either i a)
try (j -> m (a, j)
m j
s)))
    where swap :: b -> Either a (b, b) -> (Either a b, b)
swap b
_ (Right ~(b
a,b
s)) = (b -> Either a b
forall a b. b -> Either a b
Right b
a,b
s)
          swap b
s (Left a
e)       = (a -> Either a b
forall a b. a -> Either a b
Left a
e, b
s)

-- | Classifies monads that support aborting the program and returning
-- a given final result of type 'i'.
class Monad m => AbortM m i where

  -- | Abort the program with the given value as final result.
  abort :: i -> m a

instance Monad m => AbortM (ContT i m) i where
  abort :: forall a. i -> ContT i m a
abort i
i = ((a -> m i) -> m i) -> ContT i m a
forall i (m :: * -> *) a. ((a -> m i) -> m i) -> ContT i m a
C (\a -> m i
_ -> i -> m i
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return i
i)

instance AbortM IO ExitCode where
  abort :: forall a. ExitCode -> IO a
abort = ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith

instance AbortM m i => AbortM (IdT m) i           where abort :: forall a. i -> IdT m a
abort = i -> IdT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, AbortM m i) =>
i -> t m a
t_abort
instance AbortM m i => AbortM (ReaderT j m) i     where abort :: forall a. i -> ReaderT j m a
abort = i -> ReaderT j m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, AbortM m i) =>
i -> t m a
t_abort
instance (AbortM m i,Monoid j)
                    => AbortM (WriterT j m) i     where abort :: forall a. i -> WriterT j m a
abort = i -> WriterT j m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, AbortM m i) =>
i -> t m a
t_abort
instance AbortM m i => AbortM (StateT j m) i      where abort :: forall a. i -> StateT j m a
abort = i -> StateT j m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, AbortM m i) =>
i -> t m a
t_abort
instance AbortM m i => AbortM (ExceptionT j m) i  where abort :: forall a. i -> ExceptionT j m a
abort = i -> ExceptionT j m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, AbortM m i) =>
i -> t m a
t_abort
instance AbortM m i => AbortM (ChoiceT m) i       where abort :: forall a. i -> ChoiceT m a
abort = i -> ChoiceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) i a.
(MonadT t, AbortM m i) =>
i -> t m a
t_abort

--------------------------------------------------------------------------------
-- Some convenient functions for working with continuations.

-- | An explicit representation for monadic continuations.
newtype Label m     = Lab (forall b. m b)

-- | Capture the current continuation.
-- This function is like 'return', except that it also captures
-- the current continuation.  Later, we can use 'jump' to repeat the
-- computation from this point onwards but with a possibly different value.
labelCC            :: (ContM m) => a -> m (a, a -> Label m)
labelCC :: forall (m :: * -> *) a. ContM m => a -> m (a, a -> Label m)
labelCC a
x           = (((a, a -> Label m) -> Label m) -> m (a, a -> Label m))
-> m (a, a -> Label m)
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC (\(a, a -> Label m) -> Label m
l -> let label :: a -> Label m
label a
a = (forall b. m b) -> Label m
forall (m :: * -> *). (forall b. m b) -> Label m
Lab (Label m -> m b
forall (m :: * -> *) a. Label m -> m a
jump ((a, a -> Label m) -> Label m
l (a
a, a -> Label m
label)))
                                        in (a, a -> Label m) -> m (a, a -> Label m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, a -> Label m
label))

-- | Capture the current continuation.
-- Later we can use `jump` to restart the program from this point.
labelCC_           :: forall m. (ContM m) => m (Label m)
labelCC_ :: forall (m :: * -> *). ContM m => m (Label m)
labelCC_            = ((Label m -> Label m) -> m (Label m)) -> m (Label m)
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC (((Label m -> Label m) -> m (Label m)) -> m (Label m))
-> ((Label m -> Label m) -> m (Label m)) -> m (Label m)
forall a b. (a -> b) -> a -> b
$ \Label m -> Label m
k -> let x :: m a   -- Signature matters!!!
                                             x :: forall a. m a
x = Label m -> m a
forall (m :: * -> *) a. Label m -> m a
jump (Label m -> Label m
k ((forall a. m a) -> Label m
forall (m :: * -> *). (forall b. m b) -> Label m
Lab m b
forall a. m a
x))
                                         in m (Label m)
forall a. m a
x

-- | A version of `callWithCC` that avoids the need for an explicit
-- use of the `jump` function.
callCC             :: ContM m => ((a -> m b) -> m a) -> m a
callCC :: forall (m :: * -> *) a b. ContM m => ((a -> m b) -> m a) -> m a
callCC (a -> m b) -> m a
f            = ((a -> Label m) -> m a) -> m a
forall a. ((a -> Label m) -> m a) -> m a
forall (m :: * -> *) a. ContM m => ((a -> Label m) -> m a) -> m a
callWithCC (((a -> Label m) -> m a) -> m a) -> ((a -> Label m) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a -> Label m
l -> (a -> m b) -> m a
f ((a -> m b) -> m a) -> (a -> m b) -> m a
forall a b. (a -> b) -> a -> b
$ \a
a -> Label m -> m b
forall (m :: * -> *) a. Label m -> m a
jump (Label m -> m b) -> Label m -> m b
forall a b. (a -> b) -> a -> b
$ a -> Label m
l a
a

-- | Label a given continuation.
labelC             :: (forall b. m b) -> Label m
labelC :: forall (m :: * -> *). (forall b. m b) -> Label m
labelC forall b. m b
k            = (forall b. m b) -> Label m
forall (m :: * -> *). (forall b. m b) -> Label m
Lab m b
forall b. m b
k

-- | Restart a previously captured computation.
jump               :: Label m -> m a
jump :: forall (m :: * -> *) a. Label m -> m a
jump (Lab forall b. m b
k)       = m a
forall b. m b
k




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

-- | Apply a function to the environment.
-- Useful for accessing environmnt components.
asks :: ReaderM m r => (r -> a) -> m a
asks :: forall (m :: * -> *) r a. ReaderM m r => (r -> a) -> m a
asks r -> a
f      = do r
r <- m r
forall (m :: * -> *) i. ReaderM m i => m i
ask
                 a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> a
f r
r)

-- | Add content the output and return a result.
puts :: WriterM m w => (a,w) -> m a
puts :: forall (m :: * -> *) w a. WriterM m w => (a, w) -> m a
puts ~(a
a,w
w) = w -> m ()
forall (m :: * -> *) i. WriterM m i => i -> m ()
put w
w m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Update the state and return a result.
sets :: StateM m s => (s -> (a,s)) -> m a
sets :: forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets s -> (a, s)
f      = do s
s <- m s
forall (m :: * -> *) i. StateM m i => m i
get
                 let (a
a,s
s1) = s -> (a, s)
f s
s
                 s -> m ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set s
s1
                 a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Updates the state with the given function.
sets_ :: StateM m s => (s -> s) -> m ()
sets_ :: forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ s -> s
f     = do s
s <- m s
forall (m :: * -> *) i. StateM m i => m i
get
                 s -> m ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set (s -> s
f s
s)
-- | Either raise an exception or return a value.
-- 'Left' values signify the we should raise an exception,
-- 'Right' values indicate success.
raises :: ExceptionM m x => Either x a -> m a
raises :: forall (m :: * -> *) x a. ExceptionM m x => Either x a -> m a
raises (Right a
a)  = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
raises (Left x
x)   = x -> m a
forall a. x -> m a
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise x
x

-- for ChoiceT we already have "msum"
-- for ContT, not sure if it makes sense.

-- | Modify the environment for the duration of a computation.
mapReader        :: RunReaderM m r => (r -> r) -> m a -> m a
mapReader :: forall (m :: * -> *) r a. RunReaderM m r => (r -> r) -> m a -> m a
mapReader r -> r
f m a
m     = do r
r <- m r
forall (m :: * -> *) i. ReaderM m i => m i
ask
                       r -> m a -> m a
forall a. r -> m a -> m a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local (r -> r
f r
r) m a
m

-- | Modify the output of a computation.
mapWriter        :: RunWriterM m w => (w -> w) -> m a -> m a
mapWriter :: forall (m :: * -> *) w a. RunWriterM m w => (w -> w) -> m a -> m a
mapWriter w -> w
f m a
m     = do ~(a
a,w
w) <- m a -> m (a, w)
forall a. m a -> m (a, w)
forall (m :: * -> *) i a. RunWriterM m i => m a -> m (a, i)
collect m a
m
                       w -> m ()
forall (m :: * -> *) i. WriterM m i => i -> m ()
put (w -> w
f w
w)
                       a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Modify the exception that was risen by a computation.
mapException     :: RunExceptionM m x => (x -> x) -> m a -> m a
mapException :: forall (m :: * -> *) x a.
RunExceptionM m x =>
(x -> x) -> m a -> m a
mapException x -> x
f m a
m  = do Either x a
r <- m a -> m (Either x a)
forall a. m a -> m (Either x a)
forall (m :: * -> *) i a.
RunExceptionM m i =>
m a -> m (Either i a)
try m a
m
                       case Either x a
r of
                         Right a
a -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                         Left x
x  -> x -> m a
forall a. x -> m a
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (x -> x
f x
x)

-- | Apply the given exception handler, if a computation raises an exception.
handle           :: RunExceptionM m x => m a -> (x -> m a) -> m a
handle :: forall (m :: * -> *) x a.
RunExceptionM m x =>
m a -> (x -> m a) -> m a
handle m a
m x -> m a
f        = do Either x a
r <- m a -> m (Either x a)
forall a. m a -> m (Either x a)
forall (m :: * -> *) i a.
RunExceptionM m i =>
m a -> m (Either i a)
try m a
m
                       case Either x a
r of
                         Right a
a -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                         Left x
x  -> x -> m a
f x
x


{- | A convenience type family for defining stacks of monads.
The first entry in the list is the top-most layer of the monad stack
(i.e., the one that is furtherest from the base).  For example:

> newtype M a = M { unM ::
>   WithBase IO
>     '[ ReaderT    Int
>      , StateT     Char
>      , ExceptionT String
>      ] a
>   }

is equivalent to:

> newtype M a = M { unM ::
>   ReaderT    Int      (
>   StateT     Char     (
>   ExceptionT String
>   IO                  )) a
>   }

-}
type family WithBase base layers :: Type -> Type where
  WithBase b '[]        = b
  WithBase b (f ': fs)  = f (WithBase b fs)


instance MF.MonadFail m => MF.MonadFail (IdT          m) where fail :: forall a. String -> IdT m a
fail = String -> IdT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadFail m) =>
String -> t m a
t_fail
instance MF.MonadFail m => MF.MonadFail (ReaderT    i m) where fail :: forall a. String -> ReaderT i m a
fail = String -> ReaderT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadFail m) =>
String -> t m a
t_fail
instance (Monoid i, MF.MonadFail m)
                        => MF.MonadFail (WriterT    i m) where fail :: forall a. String -> WriterT i m a
fail = String -> WriterT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadFail m) =>
String -> t m a
t_fail
instance MF.MonadFail m => MF.MonadFail (StateT     i m) where fail :: forall a. String -> StateT i m a
fail = String -> StateT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadFail m) =>
String -> t m a
t_fail
instance MF.MonadFail m => MF.MonadFail (ExceptionT i m) where fail :: forall a. String -> ExceptionT i m a
fail = String -> ExceptionT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadFail m) =>
String -> t m a
t_fail
instance MF.MonadFail m => MF.MonadFail (ChoiceT      m) where fail :: forall a. String -> ChoiceT m a
fail = String -> ChoiceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadFail m) =>
String -> t m a
t_fail
instance MF.MonadFail m => MF.MonadFail (ContT      i m) where fail :: forall a. String -> ContT i m a
fail = String -> ContT i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, MonadFail m) =>
String -> t m a
t_fail