{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
#else
-- Manual Typeable instances
{-# LANGUAGE Trustworthy #-}
#endif
#include "free-common.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.Trans.Iter
-- Copyright   :  (C) 2013 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  MPTCs, fundeps
--
-- Based on <http://www.ioc.ee/~tarmo/tday-veskisilla/uustalu-slides.pdf Capretta's Iterative Monad Transformer>
--
-- Unlike 'Free', this is a true monad transformer.
----------------------------------------------------------------------------
module Control.Monad.Trans.Iter
  (
  -- |
  -- Functions in Haskell are meant to be pure. For example, if an expression
  -- has type Int, there should exist a value of the type such that the expression
  -- can be replaced by that value in any context without changing the meaning
  -- of the program.
  --
  -- Some computations may perform side effects (@unsafePerformIO@), throw an
  -- exception (using @error@); or not terminate
  -- (@let infinity = 1 + infinity in infinity@).
  --
  -- While the 'IO' monad encapsulates side-effects, and the 'Either'
  -- monad encapsulates errors, the 'Iter' monad encapsulates
  -- non-termination. The 'IterT' transformer generalizes non-termination to any monadic
  -- computation.
  --
  -- Computations in 'IterT' (or 'Iter') can be composed in two ways:
  --
  -- * /Sequential:/ Using the 'Monad' instance, the result of a computation
  --   can be fed into the next.
  --
  -- * /Parallel:/ Using the 'MonadPlus' instance, several computations can be
  --   executed concurrently, and the first to finish will prevail.
  --   See also the <examples/Cabbage.lhs cabbage example>.

  -- * The iterative monad transformer
    IterT(..)
  -- * Capretta's iterative monad
  , Iter, iter, runIter
  -- * Combinators
  , delay
  , hoistIterT
  , liftIter
  , cutoff
  , never
  , untilJust
  , interleave, interleave_
  -- * Consuming iterative monads
  , retract
  , fold
  , foldM
  -- * IterT ~ FreeT Identity
  , MonadFree(..)
  -- * Examples
  -- $examples
  ) where

import Control.Applicative
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
import Control.Monad (ap, liftM, MonadPlus(..), join)
import Control.Monad.Fix
import Control.Monad.Trans.Class
import qualified Control.Monad.Fail as Fail
import Control.Monad.Free.Class
import Control.Monad.State.Class
import Control.Monad.Error.Class
import Control.Monad.Reader.Class
import Control.Monad.Writer.Class
import Control.Monad.Cont.Class
import Control.Monad.IO.Class
import Data.Bifunctor
import Data.Bitraversable
import Data.Either
import Data.Functor.Bind hiding (join)
import Data.Functor.Classes.Compat
import Data.Functor.Identity
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Typeable
import Data.Data

#if !(MIN_VERSION_base(4,8,0))
import Data.Foldable hiding (fold)
import Data.Traversable hiding (mapM)
#endif

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif

-- | The monad supporting iteration based over a base monad @m@.
--
-- @
-- 'IterT' ~ 'FreeT' 'Identity'
-- @
newtype IterT m a = IterT { IterT m a -> m (Either a (IterT m a))
runIterT :: m (Either a (IterT m a)) }
#if __GLASGOW_HASKELL__ >= 707
  deriving (Typeable)
#endif

-- | Plain iterative computations.
type Iter = IterT Identity

-- | Builds an iterative computation from one first step.
--
-- prop> runIter . iter == id
iter :: Either a (Iter a) -> Iter a
iter :: Either a (Iter a) -> Iter a
iter = Identity (Either a (Iter a)) -> Iter a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (Identity (Either a (Iter a)) -> Iter a)
-> (Either a (Iter a) -> Identity (Either a (Iter a)))
-> Either a (Iter a)
-> Iter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (Iter a) -> Identity (Either a (Iter a))
forall a. a -> Identity a
Identity
{-# INLINE iter #-}

-- | Executes the first step of an iterative computation
--
-- prop> iter . runIter == id
runIter :: Iter a -> Either a (Iter a)
runIter :: Iter a -> Either a (Iter a)
runIter = Identity (Either a (Iter a)) -> Either a (Iter a)
forall a. Identity a -> a
runIdentity (Identity (Either a (Iter a)) -> Either a (Iter a))
-> (Iter a -> Identity (Either a (Iter a)))
-> Iter a
-> Either a (Iter a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iter a -> Identity (Either a (Iter a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT
{-# INLINE runIter #-}

#ifdef LIFTED_FUNCTOR_CLASSES
instance (Eq1 m) => Eq1 (IterT m) where
  liftEq :: (a -> b -> Bool) -> IterT m a -> IterT m b -> Bool
liftEq a -> b -> Bool
eq = IterT m a -> IterT m b -> Bool
forall (f :: * -> *). Eq1 f => IterT f a -> IterT f b -> Bool
go
    where
      go :: IterT f a -> IterT f b -> Bool
go (IterT f (Either a (IterT f a))
x) (IterT f (Either b (IterT f b))
y) = (Either a (IterT f a) -> Either b (IterT f b) -> Bool)
-> f (Either a (IterT f a)) -> f (Either b (IterT f b)) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool)
-> (IterT f a -> IterT f b -> Bool)
-> Either a (IterT f a)
-> Either b (IterT f b)
-> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
eq IterT f a -> IterT f b -> Bool
go) f (Either a (IterT f a))
x f (Either b (IterT f b))
y
#else
instance (Functor m, Eq1 m) => Eq1 (IterT m) where
  eq1 = on eq1 (fmap (fmap Lift1) . runIterT)
#endif

#ifdef LIFTED_FUNCTOR_CLASSES
instance (Eq1 m, Eq a) => Eq (IterT m a) where
#else
instance (Functor m, Eq1 m, Eq a) => Eq (IterT m a) where
#endif
  == :: IterT m a -> IterT m a -> Bool
(==) = IterT m a -> IterT m a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1

#ifdef LIFTED_FUNCTOR_CLASSES
instance (Ord1 m) => Ord1 (IterT m) where
  liftCompare :: (a -> b -> Ordering) -> IterT m a -> IterT m b -> Ordering
liftCompare a -> b -> Ordering
cmp = IterT m a -> IterT m b -> Ordering
forall (f :: * -> *). Ord1 f => IterT f a -> IterT f b -> Ordering
go
    where
      go :: IterT f a -> IterT f b -> Ordering
go (IterT f (Either a (IterT f a))
x) (IterT f (Either b (IterT f b))
y) = (Either a (IterT f a) -> Either b (IterT f b) -> Ordering)
-> f (Either a (IterT f a)) -> f (Either b (IterT f b)) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering)
-> (IterT f a -> IterT f b -> Ordering)
-> Either a (IterT f a)
-> Either b (IterT f b)
-> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmp IterT f a -> IterT f b -> Ordering
go) f (Either a (IterT f a))
x f (Either b (IterT f b))
y
#else
instance (Functor m, Ord1 m) => Ord1 (IterT m) where
  compare1 = on compare1 (fmap (fmap Lift1) . runIterT)
#endif

#ifdef LIFTED_FUNCTOR_CLASSES
instance (Ord1 m, Ord a) => Ord (IterT m a) where
#else
instance (Functor m, Ord1 m, Ord a) => Ord (IterT m a) where
#endif
  compare :: IterT m a -> IterT m a -> Ordering
compare = IterT m a -> IterT m a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1

#ifdef LIFTED_FUNCTOR_CLASSES
instance (Show1 m) => Show1 (IterT m) where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> IterT m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl = Int -> IterT m a -> ShowS
go
    where
      goList :: [IterT m a] -> ShowS
goList = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [IterT m a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl
      go :: Int -> IterT m a -> ShowS
go Int
d (IterT m (Either a (IterT m a))
x) = (Int -> m (Either a (IterT m a)) -> ShowS)
-> String -> Int -> m (Either a (IterT m a)) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith
        ((Int -> Either a (IterT m a) -> ShowS)
-> ([Either a (IterT m a)] -> ShowS)
-> Int
-> m (Either a (IterT m a))
-> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> IterT m a -> ShowS)
-> ([IterT m a] -> ShowS)
-> Int
-> Either a (IterT m a)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> IterT m a -> ShowS
go [IterT m a] -> ShowS
goList) ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> IterT m a -> ShowS)
-> ([IterT m a] -> ShowS)
-> [Either a (IterT m a)]
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> IterT m a -> ShowS
go [IterT m a] -> ShowS
goList))
        String
"IterT" Int
d m (Either a (IterT m a))
x
#else
instance (Functor m, Show1 m) => Show1 (IterT m) where
  showsPrec1 d (IterT m) = showParen (d > 10) $
    showString "IterT " . showsPrec1 11 (fmap (fmap Lift1) m)
#endif

#ifdef LIFTED_FUNCTOR_CLASSES
instance (Show1 m, Show a) => Show (IterT m a) where
#else
instance (Functor m, Show1 m, Show a) => Show (IterT m a) where
#endif
  showsPrec :: Int -> IterT m a -> ShowS
showsPrec = Int -> IterT m a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

#ifdef LIFTED_FUNCTOR_CLASSES
instance (Read1 m) => Read1 (IterT m) where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (IterT m a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = Int -> ReadS (IterT m a)
go
    where
      goList :: ReadS [IterT m a]
goList = (Int -> ReadS a) -> ReadS [a] -> ReadS [IterT m a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl
      go :: Int -> ReadS (IterT m a)
go = (String -> ReadS (IterT m a)) -> Int -> ReadS (IterT m a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (IterT m a)) -> Int -> ReadS (IterT m a))
-> (String -> ReadS (IterT m a)) -> Int -> ReadS (IterT m a)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS (m (Either a (IterT m a))))
-> String
-> (m (Either a (IterT m a)) -> IterT m a)
-> String
-> ReadS (IterT m a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith
        ((Int -> ReadS (Either a (IterT m a)))
-> ReadS [Either a (IterT m a)]
-> Int
-> ReadS (m (Either a (IterT m a)))
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS (IterT m a))
-> ReadS [IterT m a]
-> Int
-> ReadS (Either a (IterT m a))
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
rp ReadS [a]
rl Int -> ReadS (IterT m a)
go ReadS [IterT m a]
goList) ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS (IterT m a))
-> ReadS [IterT m a]
-> ReadS [Either a (IterT m a)]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2 Int -> ReadS a
rp ReadS [a]
rl Int -> ReadS (IterT m a)
go ReadS [IterT m a]
goList))
        String
"IterT" m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT
#else
instance (Functor m, Read1 m) => Read1 (IterT m) where
  readsPrec1 d =  readParen (d > 10) $ \r ->
    [ (IterT (fmap (fmap lower1) m),t) | ("IterT",s) <- lex r, (m,t) <- readsPrec1 11 s]
#endif

#ifdef LIFTED_FUNCTOR_CLASSES
instance (Read1 m, Read a) => Read (IterT m a) where
#else
instance (Functor m, Read1 m, Read a) => Read (IterT m a) where
#endif
  readsPrec :: Int -> ReadS (IterT m a)
readsPrec = Int -> ReadS (IterT m a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1

instance Monad m => Functor (IterT m) where
  fmap :: (a -> b) -> IterT m a -> IterT m b
fmap a -> b
f = m (Either b (IterT m b)) -> IterT m b
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either b (IterT m b)) -> IterT m b)
-> (IterT m a -> m (Either b (IterT m b)))
-> IterT m a
-> IterT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a (IterT m a) -> Either b (IterT m b))
-> m (Either a (IterT m a)) -> m (Either b (IterT m b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> b)
-> (IterT m a -> IterT m b)
-> Either a (IterT m a)
-> Either b (IterT m b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((a -> b) -> IterT m a -> IterT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (m (Either a (IterT m a)) -> m (Either b (IterT m b)))
-> (IterT m a -> m (Either a (IterT m a)))
-> IterT m a
-> m (Either b (IterT m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT
  {-# INLINE fmap #-}

instance Monad m => Applicative (IterT m) where
  pure :: a -> IterT m a
pure = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> (a -> m (Either a (IterT m a))) -> a -> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (a -> Either a (IterT m a)) -> a -> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (IterT m a)
forall a b. a -> Either a b
Left
  {-# INLINE pure #-}
  <*> :: IterT m (a -> b) -> IterT m a -> IterT m b
(<*>) = IterT m (a -> b) -> IterT m a -> IterT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  {-# INLINE (<*>) #-}

instance Monad m => Monad (IterT m) where
  return :: a -> IterT m a
return = a -> IterT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  IterT m (Either a (IterT m a))
m >>= :: IterT m a -> (a -> IterT m b) -> IterT m b
>>= a -> IterT m b
k = m (Either b (IterT m b)) -> IterT m b
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either b (IterT m b)) -> IterT m b)
-> m (Either b (IterT m b)) -> IterT m b
forall a b. (a -> b) -> a -> b
$ m (Either a (IterT m a))
m m (Either a (IterT m a))
-> (Either a (IterT m a) -> m (Either b (IterT m b)))
-> m (Either b (IterT m b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m (Either b (IterT m b)))
-> (IterT m a -> m (Either b (IterT m b)))
-> Either a (IterT m a)
-> m (Either b (IterT m b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IterT m b -> m (Either b (IterT m b))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT (IterT m b -> m (Either b (IterT m b)))
-> (a -> IterT m b) -> a -> m (Either b (IterT m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IterT m b
k) (Either b (IterT m b) -> m (Either b (IterT m b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b (IterT m b) -> m (Either b (IterT m b)))
-> (IterT m a -> Either b (IterT m b))
-> IterT m a
-> m (Either b (IterT m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m b -> Either b (IterT m b)
forall a b. b -> Either a b
Right (IterT m b -> Either b (IterT m b))
-> (IterT m a -> IterT m b) -> IterT m a -> Either b (IterT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IterT m a -> (a -> IterT m b) -> IterT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IterT m b
k))
  {-# INLINE (>>=) #-}
#if !MIN_VERSION_base(4,13,0)
  fail = Fail.fail
  {-# INLINE fail #-}
#endif

instance Monad m => Fail.MonadFail (IterT m) where
  fail :: String -> IterT m a
fail String
_ = IterT m a
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, MonadFree f m) =>
m a
never
  {-# INLINE fail #-}

instance Monad m => Apply (IterT m) where
  <.> :: IterT m (a -> b) -> IterT m a -> IterT m b
(<.>) = IterT m (a -> b) -> IterT m a -> IterT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  {-# INLINE (<.>) #-}

instance Monad m => Bind (IterT m) where
  >>- :: IterT m a -> (a -> IterT m b) -> IterT m b
(>>-) = IterT m a -> (a -> IterT m b) -> IterT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
  {-# INLINE (>>-) #-}

instance MonadFix m => MonadFix (IterT m) where
  mfix :: (a -> IterT m a) -> IterT m a
mfix a -> IterT m a
f = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> m (Either a (IterT m a)) -> IterT m a
forall a b. (a -> b) -> a -> b
$ (Either a (IterT m a) -> m (Either a (IterT m a)))
-> m (Either a (IterT m a))
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((Either a (IterT m a) -> m (Either a (IterT m a)))
 -> m (Either a (IterT m a)))
-> (Either a (IterT m a) -> m (Either a (IterT m a)))
-> m (Either a (IterT m a))
forall a b. (a -> b) -> a -> b
$ IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT (IterT m a -> m (Either a (IterT m a)))
-> (Either a (IterT m a) -> IterT m a)
-> Either a (IterT m a)
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IterT m a
f (a -> IterT m a)
-> (Either a (IterT m a) -> a) -> Either a (IterT m a) -> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> (IterT m a -> a) -> Either a (IterT m a) -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id (String -> IterT m a -> a
forall a. HasCallStack => String -> a
error String
"mfix (IterT m): Right")
  {-# INLINE mfix #-}

instance Monad m => Alternative (IterT m) where
  empty :: IterT m a
empty = IterT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  {-# INLINE empty #-}
  <|> :: IterT m a -> IterT m a -> IterT m a
(<|>) = IterT m a -> IterT m a -> IterT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  {-# INLINE (<|>) #-}

-- | Capretta's 'race' combinator. Satisfies left catch.
instance Monad m => MonadPlus (IterT m) where
  mzero :: IterT m a
mzero = IterT m a
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, MonadFree f m) =>
m a
never
  {-# INLINE mzero #-}
  (IterT m (Either a (IterT m a))
x) mplus :: IterT m a -> IterT m a -> IterT m a
`mplus` (IterT m (Either a (IterT m a))
y) = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> m (Either a (IterT m a)) -> IterT m a
forall a b. (a -> b) -> a -> b
$ m (Either a (IterT m a))
x m (Either a (IterT m a))
-> (Either a (IterT m a) -> m (Either a (IterT m a)))
-> m (Either a (IterT m a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m (Either a (IterT m a)))
-> (IterT m a -> m (Either a (IterT m a)))
-> Either a (IterT m a)
-> m (Either a (IterT m a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                                (Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (a -> Either a (IterT m a)) -> a -> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (IterT m a)
forall a b. a -> Either a b
Left)
                                (((Either a (IterT m a) -> Either a (IterT m a))
 -> m (Either a (IterT m a)) -> m (Either a (IterT m a)))
-> m (Either a (IterT m a))
-> (Either a (IterT m a) -> Either a (IterT m a))
-> m (Either a (IterT m a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Either a (IterT m a) -> Either a (IterT m a))
-> m (Either a (IterT m a)) -> m (Either a (IterT m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM m (Either a (IterT m a))
y ((Either a (IterT m a) -> Either a (IterT m a))
 -> m (Either a (IterT m a)))
-> (IterT m a -> Either a (IterT m a) -> Either a (IterT m a))
-> IterT m a
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IterT m a -> IterT m a)
-> Either a (IterT m a) -> Either a (IterT m a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((IterT m a -> IterT m a)
 -> Either a (IterT m a) -> Either a (IterT m a))
-> (IterT m a -> IterT m a -> IterT m a)
-> IterT m a
-> Either a (IterT m a)
-> Either a (IterT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> IterT m a -> IterT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus)
  {-# INLINE mplus #-}

instance MonadTrans IterT where
  lift :: m a -> IterT m a
lift = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> (m a -> m (Either a (IterT m a))) -> m a -> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either a (IterT m a)) -> m a -> m (Either a (IterT m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either a (IterT m a)
forall a b. a -> Either a b
Left
  {-# INLINE lift #-}

instance Foldable m => Foldable (IterT m) where
  foldMap :: (a -> m) -> IterT m a -> m
foldMap a -> m
f = (Either a (IterT m a) -> m) -> m (Either a (IterT m a)) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (IterT m a -> m) -> Either a (IterT m a) -> m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m
f ((a -> m) -> IterT m a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)) (m (Either a (IterT m a)) -> m)
-> (IterT m a -> m (Either a (IterT m a))) -> IterT m a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT
  {-# INLINE foldMap #-}

instance Foldable1 m => Foldable1 (IterT m) where
  foldMap1 :: (a -> m) -> IterT m a -> m
foldMap1 a -> m
f = (Either a (IterT m a) -> m) -> m (Either a (IterT m a)) -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 ((a -> m) -> (IterT m a -> m) -> Either a (IterT m a) -> m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m
f ((a -> m) -> IterT m a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f)) (m (Either a (IterT m a)) -> m)
-> (IterT m a -> m (Either a (IterT m a))) -> IterT m a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT
  {-# INLINE foldMap1 #-}

instance (Monad m, Traversable m) => Traversable (IterT m) where
  traverse :: (a -> f b) -> IterT m a -> f (IterT m b)
traverse a -> f b
f (IterT m (Either a (IterT m a))
m) = m (Either b (IterT m b)) -> IterT m b
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either b (IterT m b)) -> IterT m b)
-> f (m (Either b (IterT m b))) -> f (IterT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either a (IterT m a) -> f (Either b (IterT m b)))
-> m (Either a (IterT m a)) -> f (m (Either b (IterT m b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b)
-> (IterT m a -> f (IterT m b))
-> Either a (IterT m a)
-> f (Either b (IterT m b))
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f ((a -> f b) -> IterT m a -> f (IterT m b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f)) m (Either a (IterT m a))
m
  {-# INLINE traverse #-}

instance (Monad m, Traversable1 m) => Traversable1 (IterT m) where
  traverse1 :: (a -> f b) -> IterT m a -> f (IterT m b)
traverse1 a -> f b
f (IterT m (Either a (IterT m a))
m) = m (Either b (IterT m b)) -> IterT m b
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either b (IterT m b)) -> IterT m b)
-> f (m (Either b (IterT m b))) -> f (IterT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either a (IterT m a) -> f (Either b (IterT m b)))
-> m (Either a (IterT m a)) -> f (m (Either b (IterT m b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 Either a (IterT m a) -> f (Either b (IterT m b))
forall (t :: * -> *).
Traversable1 t =>
Either a (t a) -> f (Either b (t b))
go m (Either a (IterT m a))
m where
    go :: Either a (t a) -> f (Either b (t b))
go (Left a
a) = b -> Either b (t b)
forall a b. a -> Either a b
Left (b -> Either b (t b)) -> f b -> f (Either b (t b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    go (Right t a
a) = t b -> Either b (t b)
forall a b. b -> Either a b
Right (t b -> Either b (t b)) -> f (t b) -> f (Either b (t b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 a -> f b
f t a
a
  {-# INLINE traverse1 #-}

instance MonadReader e m => MonadReader e (IterT m) where
  ask :: IterT m e
ask = m e -> IterT m e
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m e
forall r (m :: * -> *). MonadReader r m => m r
ask
  {-# INLINE ask #-}
  local :: (e -> e) -> IterT m a -> IterT m a
local e -> e
f = (forall a. m a -> m a) -> IterT m a -> IterT m a
forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> n a) -> IterT m b -> IterT n b
hoistIterT ((e -> e) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local e -> e
f)
  {-# INLINE local #-}

instance MonadWriter w m => MonadWriter w (IterT m) where
  tell :: w -> IterT m ()
tell = m () -> IterT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> IterT m ()) -> (w -> m ()) -> w -> IterT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  {-# INLINE tell #-}
  listen :: IterT m a -> IterT m (a, w)
listen (IterT m (Either a (IterT m a))
m) = m (Either (a, w) (IterT m (a, w))) -> IterT m (a, w)
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either (a, w) (IterT m (a, w))) -> IterT m (a, w))
-> m (Either (a, w) (IterT m (a, w))) -> IterT m (a, w)
forall a b. (a -> b) -> a -> b
$ ((Either a (IterT m (a, w)), w) -> Either (a, w) (IterT m (a, w)))
-> m (Either a (IterT m (a, w)), w)
-> m (Either (a, w) (IterT m (a, w)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Either a (IterT m (a, w)), w) -> Either (a, w) (IterT m (a, w))
forall (f :: * -> *) (p :: * -> * -> *) c a a.
(Functor f, Bifunctor p, Monoid c) =>
(Either a (f (p a c)), c) -> Either (a, c) (f (p a c))
concat' (m (Either a (IterT m (a, w)), w)
 -> m (Either (a, w) (IterT m (a, w))))
-> m (Either a (IterT m (a, w)), w)
-> m (Either (a, w) (IterT m (a, w)))
forall a b. (a -> b) -> a -> b
$ m (Either a (IterT m (a, w))) -> m (Either a (IterT m (a, w)), w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen ((IterT m a -> IterT m (a, w))
-> Either a (IterT m a) -> Either a (IterT m (a, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IterT m a -> IterT m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (Either a (IterT m a) -> Either a (IterT m (a, w)))
-> m (Either a (IterT m a)) -> m (Either a (IterT m (a, w)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Either a (IterT m a))
m)
    where
      concat' :: (Either a (f (p a c)), c) -> Either (a, c) (f (p a c))
concat' (Left  a
x, c
w) = (a, c) -> Either (a, c) (f (p a c))
forall a b. a -> Either a b
Left (a
x, c
w)
      concat' (Right f (p a c)
y, c
w) = f (p a c) -> Either (a, c) (f (p a c))
forall a b. b -> Either a b
Right (f (p a c) -> Either (a, c) (f (p a c)))
-> f (p a c) -> Either (a, c) (f (p a c))
forall a b. (a -> b) -> a -> b
$ (c -> c) -> p a c -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (c
w c -> c -> c
forall a. Monoid a => a -> a -> a
`mappend`) (p a c -> p a c) -> f (p a c) -> f (p a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p a c)
y
  pass :: IterT m (a, w -> w) -> IterT m a
pass IterT m (a, w -> w)
m = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> (IterT m ((a, w -> w), w) -> m (Either a (IterT m a)))
-> IterT m ((a, w -> w), w)
-> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either ((a, w -> w), w) (IterT m ((a, w -> w), w)))
-> m (Either a (IterT m a))
forall a t.
m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t)))
-> m (Either a (IterT m a))
pass' (m (Either ((a, w -> w), w) (IterT m ((a, w -> w), w)))
 -> m (Either a (IterT m a)))
-> (IterT m ((a, w -> w), w)
    -> m (Either ((a, w -> w), w) (IterT m ((a, w -> w), w))))
-> IterT m ((a, w -> w), w)
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m ((a, w -> w), w)
-> m (Either ((a, w -> w), w) (IterT m ((a, w -> w), w)))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT (IterT m ((a, w -> w), w)
 -> m (Either ((a, w -> w), w) (IterT m ((a, w -> w), w))))
-> (IterT m ((a, w -> w), w) -> IterT m ((a, w -> w), w))
-> IterT m ((a, w -> w), w)
-> m (Either ((a, w -> w), w) (IterT m ((a, w -> w), w)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> m a)
-> IterT m ((a, w -> w), w) -> IterT m ((a, w -> w), w)
forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> n a) -> IterT m b -> IterT n b
hoistIterT forall a. m a -> m a
clean (IterT m ((a, w -> w), w) -> IterT m a)
-> IterT m ((a, w -> w), w) -> IterT m a
forall a b. (a -> b) -> a -> b
$ IterT m (a, w -> w) -> IterT m ((a, w -> w), w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen IterT m (a, w -> w)
m
    where
      clean :: m a -> m a
clean = m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (a, w -> w) -> m a) -> (m a -> m (a, w -> w)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, w -> w)) -> m a -> m (a, w -> w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
x -> (a
x, w -> w -> w
forall a b. a -> b -> a
const w
forall a. Monoid a => a
mempty))
      pass' :: m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t)))
-> m (Either a (IterT m a))
pass' = m (m (Either a (IterT m a))) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (Either a (IterT m a))) -> m (Either a (IterT m a)))
-> (m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t)))
    -> m (m (Either a (IterT m a))))
-> m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t)))
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ((a, t -> w), t) (IterT m ((a, t -> w), t))
 -> m (Either a (IterT m a)))
-> m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t)))
-> m (m (Either a (IterT m a)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either ((a, t -> w), t) (IterT m ((a, t -> w), t))
-> m (Either a (IterT m a))
g
      g :: Either ((a, t -> w), t) (IterT m ((a, t -> w), t))
-> m (Either a (IterT m a))
g (Left  ((a
x, t -> w
f), t
w)) = w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (t -> w
f t
w) m () -> m (Either a (IterT m a)) -> m (Either a (IterT m a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either a (IterT m a)
forall a b. a -> Either a b
Left a
x)
      g (Right IterT m ((a, t -> w), t)
f)           = Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (IterT m ((a, t -> w), t) -> Either a (IterT m a))
-> IterT m ((a, t -> w), t)
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> Either a (IterT m a)
forall a b. b -> Either a b
Right (IterT m a -> Either a (IterT m a))
-> (IterT m ((a, t -> w), t) -> IterT m a)
-> IterT m ((a, t -> w), t)
-> Either a (IterT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> (IterT m ((a, t -> w), t) -> m (Either a (IterT m a)))
-> IterT m ((a, t -> w), t)
-> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t)))
-> m (Either a (IterT m a))
pass' (m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t)))
 -> m (Either a (IterT m a)))
-> (IterT m ((a, t -> w), t)
    -> m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t))))
-> IterT m ((a, t -> w), t)
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m ((a, t -> w), t)
-> m (Either ((a, t -> w), t) (IterT m ((a, t -> w), t)))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT (IterT m ((a, t -> w), t) -> m (Either a (IterT m a)))
-> IterT m ((a, t -> w), t) -> m (Either a (IterT m a))
forall a b. (a -> b) -> a -> b
$ IterT m ((a, t -> w), t)
f
#if MIN_VERSION_mtl(2,1,1)
  writer :: (a, w) -> IterT m a
writer (a, w)
w = m a -> IterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (a, w)
w)
  {-# INLINE writer #-}
#endif

instance MonadState s m => MonadState s (IterT m) where
  get :: IterT m s
get = m s -> IterT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  {-# INLINE get #-}
  put :: s -> IterT m ()
put s
s = m () -> IterT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s)
  {-# INLINE put #-}
#if MIN_VERSION_mtl(2,1,1)
  state :: (s -> (a, s)) -> IterT m a
state s -> (a, s)
f = m a -> IterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f)
  {-# INLINE state #-}
#endif

instance MonadError e m => MonadError e (IterT m) where
  throwError :: e -> IterT m a
throwError = m a -> IterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IterT m a) -> (e -> m a) -> e -> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  {-# INLINE throwError #-}
  IterT m (Either a (IterT m a))
m catchError :: IterT m a -> (e -> IterT m a) -> IterT m a
`catchError` e -> IterT m a
f = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> m (Either a (IterT m a)) -> IterT m a
forall a b. (a -> b) -> a -> b
$ (Either a (IterT m a) -> Either a (IterT m a))
-> m (Either a (IterT m a)) -> m (Either a (IterT m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((IterT m a -> IterT m a)
-> Either a (IterT m a) -> Either a (IterT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IterT m a -> (e -> IterT m a) -> IterT m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` e -> IterT m a
f)) m (Either a (IterT m a))
m m (Either a (IterT m a))
-> (e -> m (Either a (IterT m a))) -> m (Either a (IterT m a))
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT (IterT m a -> m (Either a (IterT m a)))
-> (e -> IterT m a) -> e -> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IterT m a
f)

instance MonadIO m => MonadIO (IterT m) where
  liftIO :: IO a -> IterT m a
liftIO = m a -> IterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IterT m a) -> (IO a -> m a) -> IO a -> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadCont m => MonadCont (IterT m) where
  callCC :: ((a -> IterT m b) -> IterT m a) -> IterT m a
callCC (a -> IterT m b) -> IterT m a
f = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> m (Either a (IterT m a)) -> IterT m a
forall a b. (a -> b) -> a -> b
$ ((Either a (IterT m a) -> m b) -> m (Either a (IterT m a)))
-> m (Either a (IterT m a))
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (\Either a (IterT m a) -> m b
k -> IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT (IterT m a -> m (Either a (IterT m a)))
-> IterT m a -> m (Either a (IterT m a))
forall a b. (a -> b) -> a -> b
$ (a -> IterT m b) -> IterT m a
f (m b -> IterT m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> IterT m b) -> (a -> m b) -> a -> IterT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (IterT m a) -> m b
k (Either a (IterT m a) -> m b)
-> (a -> Either a (IterT m a)) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (IterT m a)
forall a b. a -> Either a b
Left))

instance Monad m => MonadFree Identity (IterT m) where
  wrap :: Identity (IterT m a) -> IterT m a
wrap = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> (Identity (IterT m a) -> m (Either a (IterT m a)))
-> Identity (IterT m a)
-> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (Identity (IterT m a) -> Either a (IterT m a))
-> Identity (IterT m a)
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> Either a (IterT m a)
forall a b. b -> Either a b
Right (IterT m a -> Either a (IterT m a))
-> (Identity (IterT m a) -> IterT m a)
-> Identity (IterT m a)
-> Either a (IterT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (IterT m a) -> IterT m a
forall a. Identity a -> a
runIdentity
  {-# INLINE wrap #-}

instance MonadThrow m => MonadThrow (IterT m) where
  throwM :: e -> IterT m a
throwM = m a -> IterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IterT m a) -> (e -> m a) -> e -> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
  {-# INLINE throwM #-}

instance MonadCatch m => MonadCatch (IterT m) where
  catch :: IterT m a -> (e -> IterT m a) -> IterT m a
catch (IterT m (Either a (IterT m a))
m) e -> IterT m a
f = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> m (Either a (IterT m a)) -> IterT m a
forall a b. (a -> b) -> a -> b
$ (Either a (IterT m a) -> Either a (IterT m a))
-> m (Either a (IterT m a)) -> m (Either a (IterT m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((IterT m a -> IterT m a)
-> Either a (IterT m a) -> Either a (IterT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IterT m a -> (e -> IterT m a) -> IterT m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Control.Monad.Catch.catch` e -> IterT m a
f)) m (Either a (IterT m a))
m m (Either a (IterT m a))
-> (e -> m (Either a (IterT m a))) -> m (Either a (IterT m a))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Control.Monad.Catch.catch` (IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT (IterT m a -> m (Either a (IterT m a)))
-> (e -> IterT m a) -> e -> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IterT m a
f)
  {-# INLINE catch #-}

-- | Adds an extra layer to a free monad value.
--
-- In particular, for the iterative monad 'Iter', this makes the
-- computation require one more step, without changing its final
-- result.
--
-- prop> runIter (delay ma) == Right ma
delay :: (Monad f, MonadFree f m) => m a -> m a
delay :: m a -> m a
delay = f (m a) -> m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (f (m a) -> m a) -> (m a -> f (m a)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> f (m a)
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE delay #-}

-- |
-- 'retract' is the left inverse of 'lift'
--
-- @
-- 'retract' . 'lift' = 'id'
-- @
retract :: Monad m => IterT m a -> m a
retract :: IterT m a -> m a
retract IterT m a
m = IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT IterT m a
m m (Either a (IterT m a)) -> (Either a (IterT m a) -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m a) -> (IterT m a -> m a) -> Either a (IterT m a) -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IterT m a -> m a
forall (m :: * -> *) a. Monad m => IterT m a -> m a
retract

-- | Tear down a 'Free' 'Monad' using iteration.
fold :: Monad m => (m a -> a) -> IterT m a -> a
fold :: (m a -> a) -> IterT m a -> a
fold m a -> a
phi (IterT m (Either a (IterT m a))
m) = m a -> a
phi ((a -> a) -> (IterT m a -> a) -> Either a (IterT m a) -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id ((m a -> a) -> IterT m a -> a
forall (m :: * -> *) a. Monad m => (m a -> a) -> IterT m a -> a
fold m a -> a
phi) (Either a (IterT m a) -> a) -> m (Either a (IterT m a)) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Either a (IterT m a))
m)

-- | Like 'fold' with monadic result.
foldM :: (Monad m, Monad n) => (m (n a) -> n a) -> IterT m a -> n a
foldM :: (m (n a) -> n a) -> IterT m a -> n a
foldM m (n a) -> n a
phi (IterT m (Either a (IterT m a))
m) = m (n a) -> n a
phi ((a -> n a) -> (IterT m a -> n a) -> Either a (IterT m a) -> n a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> n a
forall (m :: * -> *) a. Monad m => a -> m a
return ((m (n a) -> n a) -> IterT m a -> n a
forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(m (n a) -> n a) -> IterT m a -> n a
foldM m (n a) -> n a
phi) (Either a (IterT m a) -> n a)
-> m (Either a (IterT m a)) -> m (n a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Either a (IterT m a))
m)

-- | Lift a monad homomorphism from @m@ to @n@ into a Monad homomorphism from @'IterT' m@ to @'IterT' n@.
hoistIterT :: Monad n => (forall a. m a -> n a) -> IterT m b -> IterT n b
hoistIterT :: (forall a. m a -> n a) -> IterT m b -> IterT n b
hoistIterT forall a. m a -> n a
f (IterT m (Either b (IterT m b))
as) = n (Either b (IterT n b)) -> IterT n b
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT ((IterT m b -> IterT n b)
-> Either b (IterT m b) -> Either b (IterT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. m a -> n a) -> IterT m b -> IterT n b
forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> n a) -> IterT m b -> IterT n b
hoistIterT forall a. m a -> n a
f) (Either b (IterT m b) -> Either b (IterT n b))
-> n (Either b (IterT m b)) -> n (Either b (IterT n b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Either b (IterT m b)) -> n (Either b (IterT m b))
forall a. m a -> n a
f m (Either b (IterT m b))
as)

-- | Lifts a plain, non-terminating computation into a richer environment.
-- 'liftIter' is a 'Monad' homomorphism.
liftIter :: (Monad m) => Iter a -> IterT m a
liftIter :: Iter a -> IterT m a
liftIter = (forall a. Identity a -> m a) -> Iter a -> IterT m a
forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> n a) -> IterT m b -> IterT n b
hoistIterT (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Identity a -> a) -> Identity a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)

-- | A computation that never terminates
never :: (Monad f, MonadFree f m) => m a
never :: m a
never = m a -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, MonadFree f m) =>
m a -> m a
delay m a
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, MonadFree f m) =>
m a
never

-- | Repeatedly run a computation until it produces a 'Just' value.
-- This can be useful when paired with a monad that has side effects.
--
-- For example, we may have @genId :: IO (Maybe Id)@ that uses a random
-- number generator to allocate ids, but fails if it finds a collision.
-- We can repeatedly run this with
--
-- @
-- 'retract' ('untilJust' genId) :: IO Id
-- @
untilJust :: (Monad m) => m (Maybe a) -> IterT m a
untilJust :: m (Maybe a) -> IterT m a
untilJust m (Maybe a)
f = IterT m a -> (a -> IterT m a) -> Maybe a -> IterT m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IterT m a -> IterT m a
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, MonadFree f m) =>
m a -> m a
delay (m (Maybe a) -> IterT m a
forall (m :: * -> *) a. Monad m => m (Maybe a) -> IterT m a
untilJust m (Maybe a)
f)) a -> IterT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IterT m a) -> IterT m (Maybe a) -> IterT m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe a) -> IterT m (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe a)
f
{-# INLINE untilJust #-}

-- | Cuts off an iterative computation after a given number of
-- steps. If the number of steps is 0 or less, no computation nor
-- monadic effects will take place.
--
-- The step where the final value is produced also counts towards the limit.
--
-- Some examples (@n ≥ 0@):
--
-- @
-- 'cutoff' 0     _        ≡ 'return' 'Nothing'
-- 'cutoff' (n+1) '.' 'return' ≡ 'return' '.' 'Just'
-- 'cutoff' (n+1) '.' 'lift'   ≡ 'lift' '.' 'liftM' 'Just'
-- 'cutoff' (n+1) '.' 'delay'  ≡ 'delay' . 'cutoff' n
-- 'cutoff' n     'never'    ≡ 'iterate' 'delay' ('return' 'Nothing') '!!' n
-- @
--
-- Calling @'retract' '.' 'cutoff' n@ is always terminating, provided each of the
-- steps in the iteration is terminating.
cutoff :: (Monad m) => Integer -> IterT m a -> IterT m (Maybe a)
cutoff :: Integer -> IterT m a -> IterT m (Maybe a)
cutoff Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = IterT m (Maybe a) -> IterT m a -> IterT m (Maybe a)
forall a b. a -> b -> a
const (IterT m (Maybe a) -> IterT m a -> IterT m (Maybe a))
-> IterT m (Maybe a) -> IterT m a -> IterT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> IterT m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
cutoff Integer
n          = m (Either (Maybe a) (IterT m (Maybe a))) -> IterT m (Maybe a)
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either (Maybe a) (IterT m (Maybe a))) -> IterT m (Maybe a))
-> (IterT m a -> m (Either (Maybe a) (IterT m (Maybe a))))
-> IterT m a
-> IterT m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a (IterT m a) -> Either (Maybe a) (IterT m (Maybe a)))
-> m (Either a (IterT m a))
-> m (Either (Maybe a) (IterT m (Maybe a)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> Either (Maybe a) (IterT m (Maybe a)))
-> (IterT m a -> Either (Maybe a) (IterT m (Maybe a)))
-> Either a (IterT m a)
-> Either (Maybe a) (IterT m (Maybe a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> Either (Maybe a) (IterT m (Maybe a))
forall a b. a -> Either a b
Left (Maybe a -> Either (Maybe a) (IterT m (Maybe a)))
-> (a -> Maybe a) -> a -> Either (Maybe a) (IterT m (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)
                                       (IterT m (Maybe a) -> Either (Maybe a) (IterT m (Maybe a))
forall a b. b -> Either a b
Right (IterT m (Maybe a) -> Either (Maybe a) (IterT m (Maybe a)))
-> (IterT m a -> IterT m (Maybe a))
-> IterT m a
-> Either (Maybe a) (IterT m (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> IterT m a -> IterT m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
Integer -> IterT m a -> IterT m (Maybe a)
cutoff (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))) (m (Either a (IterT m a))
 -> m (Either (Maybe a) (IterT m (Maybe a))))
-> (IterT m a -> m (Either a (IterT m a)))
-> IterT m a
-> m (Either (Maybe a) (IterT m (Maybe a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT

-- | Interleaves the steps of a finite list of iterative computations, and
--   collects their results.
--
--   The resulting computation has as many steps as the longest computation
--   in the list.
interleave :: Monad m => [IterT m a] -> IterT m [a]
interleave :: [IterT m a] -> IterT m [a]
interleave [IterT m a]
ms = m (Either [a] (IterT m [a])) -> IterT m [a]
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either [a] (IterT m [a])) -> IterT m [a])
-> m (Either [a] (IterT m [a])) -> IterT m [a]
forall a b. (a -> b) -> a -> b
$ do
  [Either a (IterT m a)]
xs <- (IterT m a -> m (Either a (IterT m a)))
-> [IterT m a] -> m [Either a (IterT m a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT [IterT m a]
ms
  if [IterT m a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Either a (IterT m a)] -> [IterT m a]
forall a b. [Either a b] -> [b]
rights [Either a (IterT m a)]
xs)
     then Either [a] (IterT m [a]) -> m (Either [a] (IterT m [a]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [a] (IterT m [a]) -> m (Either [a] (IterT m [a])))
-> ([a] -> Either [a] (IterT m [a]))
-> [a]
-> m (Either [a] (IterT m [a]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Either [a] (IterT m [a])
forall a b. a -> Either a b
Left ([a] -> m (Either [a] (IterT m [a])))
-> [a] -> m (Either [a] (IterT m [a]))
forall a b. (a -> b) -> a -> b
$ [Either a (IterT m a)] -> [a]
forall a b. [Either a b] -> [a]
lefts [Either a (IterT m a)]
xs
     else Either [a] (IterT m [a]) -> m (Either [a] (IterT m [a]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [a] (IterT m [a]) -> m (Either [a] (IterT m [a])))
-> ([IterT m a] -> Either [a] (IterT m [a]))
-> [IterT m a]
-> m (Either [a] (IterT m [a]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m [a] -> Either [a] (IterT m [a])
forall a b. b -> Either a b
Right (IterT m [a] -> Either [a] (IterT m [a]))
-> ([IterT m a] -> IterT m [a])
-> [IterT m a]
-> Either [a] (IterT m [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IterT m a] -> IterT m [a]
forall (m :: * -> *) a. Monad m => [IterT m a] -> IterT m [a]
interleave ([IterT m a] -> m (Either [a] (IterT m [a])))
-> [IterT m a] -> m (Either [a] (IterT m [a]))
forall a b. (a -> b) -> a -> b
$ (Either a (IterT m a) -> IterT m a)
-> [Either a (IterT m a)] -> [IterT m a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> IterT m a)
-> (IterT m a -> IterT m a) -> Either a (IterT m a) -> IterT m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> IterT m a
forall (m :: * -> *) a. Monad m => a -> m a
return IterT m a -> IterT m a
forall a. a -> a
id) [Either a (IterT m a)]
xs
{-# INLINE interleave #-}

-- | Interleaves the steps of a finite list of computations, and discards their
--   results.
--
--   The resulting computation has as many steps as the longest computation
--   in the list.
--
--   Equivalent to @'void' '.' 'interleave'@.
interleave_ :: (Monad m) => [IterT m a] -> IterT m ()
interleave_ :: [IterT m a] -> IterT m ()
interleave_ [] = () -> IterT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
interleave_ [IterT m a]
xs = m (Either () (IterT m ())) -> IterT m ()
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either () (IterT m ())) -> IterT m ())
-> m (Either () (IterT m ())) -> IterT m ()
forall a b. (a -> b) -> a -> b
$ ([Either a (IterT m a)] -> Either () (IterT m ()))
-> m [Either a (IterT m a)] -> m (Either () (IterT m ()))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (IterT m () -> Either () (IterT m ())
forall a b. b -> Either a b
Right (IterT m () -> Either () (IterT m ()))
-> ([Either a (IterT m a)] -> IterT m ())
-> [Either a (IterT m a)]
-> Either () (IterT m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IterT m a] -> IterT m ()
forall (m :: * -> *) a. Monad m => [IterT m a] -> IterT m ()
interleave_ ([IterT m a] -> IterT m ())
-> ([Either a (IterT m a)] -> [IterT m a])
-> [Either a (IterT m a)]
-> IterT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a (IterT m a)] -> [IterT m a]
forall a b. [Either a b] -> [b]
rights) (m [Either a (IterT m a)] -> m (Either () (IterT m ())))
-> m [Either a (IterT m a)] -> m (Either () (IterT m ()))
forall a b. (a -> b) -> a -> b
$ (IterT m a -> m (Either a (IterT m a)))
-> [IterT m a] -> m [Either a (IterT m a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT [IterT m a]
xs
{-# INLINE interleave_ #-}

instance (Monad m, Semigroup a, Monoid a) => Monoid (IterT m a) where
  mempty :: IterT m a
mempty = a -> IterT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
  mappend :: IterT m a -> IterT m a -> IterT m a
mappend = IterT m a -> IterT m a -> IterT m a
forall a. Semigroup a => a -> a -> a
(<>)
  mconcat :: [IterT m a] -> IterT m a
mconcat = [Either a (IterT m a)] -> IterT m a
forall (m :: * -> *) a.
(Monad m, Monoid a) =>
[Either a (IterT m a)] -> IterT m a
mconcat' ([Either a (IterT m a)] -> IterT m a)
-> ([IterT m a] -> [Either a (IterT m a)])
-> [IterT m a]
-> IterT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IterT m a -> Either a (IterT m a))
-> [IterT m a] -> [Either a (IterT m a)]
forall a b. (a -> b) -> [a] -> [b]
map IterT m a -> Either a (IterT m a)
forall a b. b -> Either a b
Right
    where
      mconcat' :: (Monad m, Monoid a) => [Either a (IterT m a)] -> IterT m a
      mconcat' :: [Either a (IterT m a)] -> IterT m a
mconcat' [Either a (IterT m a)]
ms = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> m (Either a (IterT m a)) -> IterT m a
forall a b. (a -> b) -> a -> b
$ do
        [Either a (IterT m a)]
xs <- (Either a (IterT m a) -> m (Either a (IterT m a)))
-> [Either a (IterT m a)] -> m [Either a (IterT m a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> m (Either a (IterT m a)))
-> (IterT m a -> m (Either a (IterT m a)))
-> Either a (IterT m a)
-> m (Either a (IterT m a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (a -> Either a (IterT m a)) -> a -> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (IterT m a)
forall a b. a -> Either a b
Left) IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT) [Either a (IterT m a)]
ms
        case [Either a (IterT m a)] -> [Either a (IterT m a)]
forall a b. Monoid a => [Either a b] -> [Either a b]
compact [Either a (IterT m a)]
xs of
          [l :: Either a (IterT m a)
l@(Left a
_)] -> Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return Either a (IterT m a)
l
          [Either a (IterT m a)]
xs' -> Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (IterT m a -> Either a (IterT m a))
-> IterT m a
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> Either a (IterT m a)
forall a b. b -> Either a b
Right (IterT m a -> m (Either a (IterT m a)))
-> IterT m a -> m (Either a (IterT m a))
forall a b. (a -> b) -> a -> b
$ [Either a (IterT m a)] -> IterT m a
forall (m :: * -> *) a.
(Monad m, Monoid a) =>
[Either a (IterT m a)] -> IterT m a
mconcat' [Either a (IterT m a)]
xs'
      {-# INLINE mconcat' #-}

      compact :: (Monoid a) => [Either a b] -> [Either a b]
      compact :: [Either a b] -> [Either a b]
compact []               = []
      compact (r :: Either a b
r@(Right b
_):[Either a b]
xs) = Either a b
rEither a b -> [Either a b] -> [Either a b]
forall a. a -> [a] -> [a]
:([Either a b] -> [Either a b]
forall a b. Monoid a => [Either a b] -> [Either a b]
compact [Either a b]
xs)
      compact (   Left a
a  :[Either a b]
xs)  = a -> [Either a b] -> [Either a b]
forall t b. Monoid t => t -> [Either t b] -> [Either t b]
compact' a
a [Either a b]
xs

      compact' :: t -> [Either t b] -> [Either t b]
compact' t
a []               = [t -> Either t b
forall a b. a -> Either a b
Left t
a]
      compact' t
a (r :: Either t b
r@(Right b
_):[Either t b]
xs) = (t -> Either t b
forall a b. a -> Either a b
Left t
a)Either t b -> [Either t b] -> [Either t b]
forall a. a -> [a] -> [a]
:(Either t b
rEither t b -> [Either t b] -> [Either t b]
forall a. a -> [a] -> [a]
:([Either t b] -> [Either t b]
forall a b. Monoid a => [Either a b] -> [Either a b]
compact [Either t b]
xs))
      compact' t
a (  (Left t
a'):[Either t b]
xs) = t -> [Either t b] -> [Either t b]
compact' (t
a t -> t -> t
forall a. Monoid a => a -> a -> a
`mappend` t
a') [Either t b]
xs

instance (Monad m, Semigroup a) => Semigroup (IterT m a) where
  IterT m a
x <> :: IterT m a -> IterT m a -> IterT m a
<> IterT m a
y = m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (m (Either a (IterT m a)) -> IterT m a)
-> m (Either a (IterT m a)) -> IterT m a
forall a b. (a -> b) -> a -> b
$ do
    Either a (IterT m a)
x' <- IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT IterT m a
x
    Either a (IterT m a)
y' <- IterT m a -> m (Either a (IterT m a))
forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT IterT m a
y
    case (Either a (IterT m a)
x', Either a (IterT m a)
y') of
      ( Left a
a, Left a
b)  -> Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (a -> Either a (IterT m a)) -> a -> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (IterT m a)
forall a b. a -> Either a b
Left  (a -> m (Either a (IterT m a))) -> a -> m (Either a (IterT m a))
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b
      ( Left a
a, Right IterT m a
b) -> Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (IterT m a -> Either a (IterT m a))
-> IterT m a
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> Either a (IterT m a)
forall a b. b -> Either a b
Right (IterT m a -> m (Either a (IterT m a)))
-> IterT m a -> m (Either a (IterT m a))
forall a b. (a -> b) -> a -> b
$ (a -> a) -> IterT m a -> IterT m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<>) IterT m a
b
      (Right IterT m a
a, Left a
b)  -> Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (IterT m a -> Either a (IterT m a))
-> IterT m a
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> Either a (IterT m a)
forall a b. b -> Either a b
Right (IterT m a -> m (Either a (IterT m a)))
-> IterT m a -> m (Either a (IterT m a))
forall a b. (a -> b) -> a -> b
$ (a -> a) -> IterT m a -> IterT m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b) IterT m a
a
      (Right IterT m a
a, Right IterT m a
b) -> Either a (IterT m a) -> m (Either a (IterT m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (IterT m a) -> m (Either a (IterT m a)))
-> (IterT m a -> Either a (IterT m a))
-> IterT m a
-> m (Either a (IterT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IterT m a -> Either a (IterT m a)
forall a b. b -> Either a b
Right (IterT m a -> m (Either a (IterT m a)))
-> IterT m a -> m (Either a (IterT m a))
forall a b. (a -> b) -> a -> b
$ IterT m a
a IterT m a -> IterT m a -> IterT m a
forall a. Semigroup a => a -> a -> a
<> IterT m a
b

#if __GLASGOW_HASKELL__ < 707
instance Typeable1 m => Typeable1 (IterT m) where
  typeOf1 t = mkTyConApp freeTyCon [typeOf1 (f t)] where
    f :: IterT m a -> m a
    f = undefined

freeTyCon :: TyCon
#if __GLASGOW_HASKELL__ < 704
freeTyCon = mkTyCon "Control.Monad.Iter.IterT"
#else
freeTyCon = mkTyCon3 "free" "Control.Monad.Iter" "IterT"
#endif
{-# NOINLINE freeTyCon #-}

#else
#define Typeable1 Typeable
#endif

instance
  ( Typeable1 m, Typeable a
  , Data (m (Either a (IterT m a)))
  , Data a
  ) => Data (IterT m a) where
    gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IterT m a -> c (IterT m a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (IterT m (Either a (IterT m a))
as) = (m (Either a (IterT m a)) -> IterT m a)
-> c (m (Either a (IterT m a)) -> IterT m a)
forall g. g -> c g
z m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT c (m (Either a (IterT m a)) -> IterT m a)
-> m (Either a (IterT m a)) -> c (IterT m a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` m (Either a (IterT m a))
as
    toConstr :: IterT m a -> Constr
toConstr IterT{} = Constr
iterConstr
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IterT m a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
        Int
1 -> c (m (Either a (IterT m a)) -> IterT m a) -> c (IterT m a)
forall b r. Data b => c (b -> r) -> c r
k ((m (Either a (IterT m a)) -> IterT m a)
-> c (m (Either a (IterT m a)) -> IterT m a)
forall r. r -> c r
z m (Either a (IterT m a)) -> IterT m a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT)
        Int
_ -> String -> c (IterT m a)
forall a. HasCallStack => String -> a
error String
"gunfold"
    dataTypeOf :: IterT m a -> DataType
dataTypeOf IterT m a
_ = DataType
iterDataType
    dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (IterT m a))
dataCast1 forall d. Data d => c (t d)
f  = c (t a) -> Maybe (c (IterT m a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f

iterConstr :: Constr
iterConstr :: Constr
iterConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
iterDataType String
"IterT" [] Fixity
Prefix
{-# NOINLINE iterConstr #-}

iterDataType :: DataType
iterDataType :: DataType
iterDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Monad.Iter.IterT" [Constr
iterConstr]
{-# NOINLINE iterDataType #-}

{- $examples

* <examples/MandelbrotIter.lhs Rendering the Mandelbrot set>

* <examples/Cabbage.lhs The wolf, the sheep and the cabbage>

-}