{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE StandaloneDeriving #-}

-----------------------------------------------------------------------------
-- |
-- 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
import Data.Functor.Identity
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Typeable
import Data.Data

#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 { forall (m :: * -> *) a. IterT m a -> m (Either a (IterT m a))
runIterT :: m (Either a (IterT m a)) }

-- | 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 :: forall a. Either a (Iter a) -> Iter a
iter = Identity (Either a (IterT Identity a)) -> IterT Identity a
forall (m :: * -> *) a. m (Either a (IterT m a)) -> IterT m a
IterT (Identity (Either a (IterT Identity a)) -> IterT Identity a)
-> (Either a (IterT Identity a)
    -> Identity (Either a (IterT Identity a)))
-> Either a (IterT Identity a)
-> IterT Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (IterT Identity a)
-> Identity (Either a (IterT Identity 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 :: forall a. 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 #-}

instance (Eq1 m) => Eq1 (IterT m) where
  liftEq :: forall a b. (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 a b. (a -> b -> Bool) -> f a -> 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 a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Either a c -> Either b d -> 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

instance (Eq1 m, Eq a) => Eq (IterT m a) where
  == :: 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

instance (Ord1 m) => Ord1 (IterT m) where
  liftCompare :: forall a b.
(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 a b. (a -> b -> Ordering) -> f a -> 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 a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Either a c -> Either b d -> 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

instance (Ord1 m, Ord a) => Ord (IterT m a) where
  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

instance (Show1 m) => Show1 (IterT m) where
  liftShowsPrec :: forall a.
(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 a.
(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 a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> 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 a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Either a b
-> 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 a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [Either a b]
-> 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

instance (Show1 m, Show a) => Show (IterT m a) where
  showsPrec :: Int -> IterT m a -> ShowS
showsPrec = Int -> IterT m a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance (Read1 m) => Read1 (IterT m) where
  liftReadsPrec :: forall a. (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 a. (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 a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (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 a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Either a b)
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 a b.
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Either a b]
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

instance (Read1 m, Read a) => Read (IterT m a) where
  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 :: forall a b. (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 a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
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 a b. (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 :: forall a. 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 a. a -> 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 #-}
  <*> :: forall a b. 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 :: forall a. a -> IterT m a
return = a -> IterT m a
forall a. a -> IterT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  IterT m (Either a (IterT m a))
m >>= :: forall a b. 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 a b. m a -> (a -> m b) -> 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 a. a -> m a
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 a b. 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 :: forall a. 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
  <.> :: forall a b. 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
  >>- :: forall a b. IterT m a -> (a -> IterT m b) -> IterT m b
(>>-) = IterT m a -> (a -> IterT m b) -> IterT m b
forall a 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 :: forall a. (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 a. (a -> m a) -> 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 :: forall a. IterT m a
empty = IterT m a
forall a. IterT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  {-# INLINE empty #-}
  <|> :: forall a. IterT m a -> IterT m a -> IterT m a
(<|>) = IterT m a -> IterT m a -> IterT m a
forall 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 :: forall a. 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 :: forall a. 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 a b. m a -> (a -> m b) -> m b
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 a. a -> 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 b c a. (b -> c) -> Either a b -> Either a c
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 a. 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 :: forall (m :: * -> *) a. Monad m => 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 :: forall m a. Monoid m => (a -> m) -> IterT m a -> m
foldMap a -> m
f = (Either a (IterT m a) -> m) -> m (Either a (IterT m a)) -> m
forall m a. Monoid m => (a -> m) -> 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 m a. Monoid m => (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 :: forall m a. Semigroup m => (a -> m) -> IterT m a -> m
foldMap1 a -> m
f = (Either a (IterT m a) -> m) -> m (Either a (IterT m a)) -> m
forall m a. Semigroup m => (a -> m) -> 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 m a. Semigroup m => (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 :: forall (f :: * -> *) a b.
Applicative f =>
(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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> m a -> f (m b)
traverse ((a -> f b)
-> (IterT m a -> f (IterT m b))
-> Either a (IterT m a)
-> f (Either b (IterT m b))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IterT m a -> f (IterT m 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 :: forall (f :: * -> *) a b.
Apply f =>
(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)
forall (f :: * -> *) a b. Apply f => (a -> f b) -> m a -> f (m 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)
forall (f :: * -> *) a b. 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 (m :: * -> *) a. Monad m => m a -> IterT m a
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 :: forall a. (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 a. (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 (m :: * -> *) a. Monad m => m a -> IterT m a
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 :: forall a. 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 a. m a -> m (a, 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 a b. (a -> b) -> Either a a -> Either a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IterT m a -> IterT m (a, w)
forall a. 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 b c a. (b -> c) -> p a b -> 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 :: forall a. 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 m a -> m a
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 a. IterT m a -> IterT m (a, 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 a. 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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either a (IterT m a) -> m (Either a (IterT m a))
forall a. a -> 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 a. a -> 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
  writer :: forall a. (a, w) -> IterT m a
writer (a, w)
w = m a -> IterT m a
forall (m :: * -> *) a. Monad m => m a -> IterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((a, w) -> m a
forall a. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (a, w)
w)
  {-# INLINE writer #-}

instance MonadState s m => MonadState s (IterT m) where
  get :: IterT m s
get = m s -> IterT m s
forall (m :: * -> *) a. Monad m => m a -> IterT m a
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 (m :: * -> *) a. Monad m => m a -> IterT m a
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 #-}
  state :: forall a. (s -> (a, s)) -> IterT m a
state s -> (a, s)
f = m a -> IterT m a
forall (m :: * -> *) a. Monad m => 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 a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f)
  {-# INLINE state #-}

instance MonadError e m => MonadError e (IterT m) where
  throwError :: forall a. e -> IterT m a
throwError = m a -> IterT m a
forall (m :: * -> *) a. Monad m => 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 a. 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 :: forall a. 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 a b. (a -> b) -> Either a a -> Either a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IterT m a -> (e -> IterT m a) -> IterT m a
forall a. 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 a. m a -> (e -> m a) -> 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 :: forall a. IO a -> IterT m a
liftIO = m a -> IterT m a
forall (m :: * -> *) a. Monad m => 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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadCont m => MonadCont (IterT m) where
  callCC :: forall a b. ((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 a b. ((a -> m b) -> m a) -> 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 (m :: * -> *) a. Monad m => m a -> IterT m a
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 :: forall a. 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 a. a -> 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 :: forall e a. (HasCallStack, Exception e) => e -> IterT m a
throwM = m a -> IterT m a
forall (m :: * -> *) a. Monad m => 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 a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
  {-# INLINE throwM #-}

instance MonadCatch m => MonadCatch (IterT m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
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 a b. (a -> b) -> Either a a -> Either a b
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 a.
(HasCallStack, Exception e) =>
IterT m a -> (e -> IterT m a) -> IterT m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, 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 e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, 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 :: forall (f :: * -> *) (m :: * -> *) a.
(Monad f, MonadFree f m) =>
m a -> m a
delay = f (m a) -> m a
forall a. 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 a. a -> f 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 :: forall (m :: * -> *) a. Monad m => 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 a b. m a -> (a -> m b) -> m b
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 a. 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 :: forall (m :: * -> *) a. Monad m => (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 :: 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 (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 a. 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 (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 (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 a b. (a -> b) -> Either b a -> Either b 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 m a -> n a
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 :: forall (m :: * -> *) a. Monad m => Iter a -> IterT m a
liftIter = (forall a. Identity a -> m a) -> IterT Identity 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 a. 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 :: forall (f :: * -> *) (m :: * -> *) a.
(Monad f, MonadFree f m) =>
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 :: forall (m :: * -> *) a. Monad m => 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 a. 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 (m :: * -> *) a. Monad m => m a -> IterT m 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 :: forall (m :: * -> *) a.
Monad m =>
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 a. a -> IterT m 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 :: forall (m :: * -> *) a. Monad m => [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. [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 a. a -> 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 a. a -> 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 a. 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_ :: forall (m :: * -> *) a. Monad m => [IterT m a] -> IterT m ()
interleave_ [] = () -> IterT m ()
forall a. a -> IterT m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. 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' :: forall (m :: * -> *) a.
(Monad m, Monoid a) =>
[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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> 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 a. a -> 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 a. a -> 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 :: forall a b. Monoid a => [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 a. a -> 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 a. a -> 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 a. a -> 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 a. a -> 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

deriving instance
  ( Typeable m
  , Data (m (Either a (IterT m a)))
  , Data a
  ) => Data (IterT m a)

{- $examples

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

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

-}