module Control.Monad.Trans.Free.Church.Alternate where

import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Base
import qualified Control.Monad.Fail as Fail
import Control.Effect.Internal.Union
import Control.Effect.Internal.Utils
import Control.Effect.Type.Unravel
import Control.Effect.Type.ListenPrim
import Control.Effect.Type.ReaderPrim
import Control.Effect.Type.Regional
import Control.Effect.Type.Optional
import Control.Monad.Catch hiding (handle)

newtype FreeT f (m :: Type -> Type) a = FreeT {
    FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT :: forall r
             . (forall x. f x -> (x -> m r) -> m r)
            -> (a -> m r) -> m r
  }

data Coyoneda f a where
  Coyoneda :: (x -> a) -> f x -> Coyoneda f a

newtype LayeredFreeT f m a = LayeredFreeT {
    LayeredFreeT f m a
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
unLayeredFreeT :: m (Either a (Coyoneda f (LayeredFreeT f m a)))
  }

toLayeredFreeT :: Monad m => FreeT f m a -> LayeredFreeT f m a
toLayeredFreeT :: FreeT f m a -> LayeredFreeT f m a
toLayeredFreeT FreeT f m a
free =
  m (Either a (Coyoneda f (LayeredFreeT f m a)))
-> LayeredFreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (Coyoneda f (LayeredFreeT f m a)))
-> LayeredFreeT f m a
LayeredFreeT (m (Either a (Coyoneda f (LayeredFreeT f m a)))
 -> LayeredFreeT f m a)
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
-> LayeredFreeT f m a
forall a b. (a -> b) -> a -> b
$ FreeT f m a
-> (forall x.
    f x
    -> (x -> m (Either a (Coyoneda f (LayeredFreeT f m a))))
    -> m (Either a (Coyoneda f (LayeredFreeT f m a))))
-> (a -> m (Either a (Coyoneda f (LayeredFreeT f m a))))
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m a
free
                         (\f x
fx x -> m (Either a (Coyoneda f (LayeredFreeT f m a)))
c -> Either a (Coyoneda f (LayeredFreeT f m a))
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (Coyoneda f (LayeredFreeT f m a))
 -> m (Either a (Coyoneda f (LayeredFreeT f m a))))
-> Either a (Coyoneda f (LayeredFreeT f m a))
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
forall a b. (a -> b) -> a -> b
$ Coyoneda f (LayeredFreeT f m a)
-> Either a (Coyoneda f (LayeredFreeT f m a))
forall a b. b -> Either a b
Right (Coyoneda f (LayeredFreeT f m a)
 -> Either a (Coyoneda f (LayeredFreeT f m a)))
-> Coyoneda f (LayeredFreeT f m a)
-> Either a (Coyoneda f (LayeredFreeT f m a))
forall a b. (a -> b) -> a -> b
$ (x -> LayeredFreeT f m a) -> f x -> Coyoneda f (LayeredFreeT f m a)
forall x a (f :: * -> *). (x -> a) -> f x -> Coyoneda f a
Coyoneda (m (Either a (Coyoneda f (LayeredFreeT f m a)))
-> LayeredFreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (Coyoneda f (LayeredFreeT f m a)))
-> LayeredFreeT f m a
LayeredFreeT (m (Either a (Coyoneda f (LayeredFreeT f m a)))
 -> LayeredFreeT f m a)
-> (x -> m (Either a (Coyoneda f (LayeredFreeT f m a))))
-> x
-> LayeredFreeT f m a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. x -> m (Either a (Coyoneda f (LayeredFreeT f m a)))
c) f x
fx)
                         (Either a (Coyoneda f (LayeredFreeT f m a))
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (Coyoneda f (LayeredFreeT f m a))
 -> m (Either a (Coyoneda f (LayeredFreeT f m a))))
-> (a -> Either a (Coyoneda f (LayeredFreeT f m a)))
-> a
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (Coyoneda f (LayeredFreeT f m a))
forall a b. a -> Either a b
Left)

fromLayeredFreeT :: Monad m => LayeredFreeT f m a -> FreeT f m a
fromLayeredFreeT :: LayeredFreeT f m a -> FreeT f m a
fromLayeredFreeT LayeredFreeT f m a
stack0 = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
 -> FreeT f m a)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
h a -> m r
c ->
  let
    go :: LayeredFreeT f m a -> m r
go LayeredFreeT f m a
stack = LayeredFreeT f m a
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
forall (f :: * -> *) (m :: * -> *) a.
LayeredFreeT f m a
-> m (Either a (Coyoneda f (LayeredFreeT f m a)))
unLayeredFreeT LayeredFreeT f m a
stack m (Either a (Coyoneda f (LayeredFreeT f m a)))
-> (Either a (Coyoneda f (LayeredFreeT f m a)) -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left a
a -> a -> m r
c a
a
      Right (Coyoneda x -> LayeredFreeT f m a
cn f x
f) -> f x -> (x -> m r) -> m r
forall x. f x -> (x -> m r) -> m r
h f x
f (LayeredFreeT f m a -> m r
go (LayeredFreeT f m a -> m r)
-> (x -> LayeredFreeT f m a) -> x -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> LayeredFreeT f m a
cn)
  in
    LayeredFreeT f m a -> m r
go LayeredFreeT f m a
stack0

class    (forall f. Threads (FreeT f) p) => FreeThreads p
instance (forall f. Threads (FreeT f) p) => FreeThreads p

liftF :: f a -> FreeT f m a
liftF :: f a -> FreeT f m a
liftF f a
f = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
 -> FreeT f m a)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
h a -> m r
c -> f a
f f a -> (a -> m r) -> m r
forall x. f x -> (x -> m r) -> m r
`h` a -> m r
c
{-# INLINE liftF #-}

foldFreeT :: Monad m
          => (a -> b)
          -> (forall x. (x -> m b) -> f x -> m b)
          -> FreeT f m a
          -> m b
foldFreeT :: (a -> b)
-> (forall x. (x -> m b) -> f x -> m b) -> FreeT f m a -> m b
foldFreeT a -> b
b forall x. (x -> m b) -> f x -> m b
c FreeT f m a
free = FreeT f m a
-> (forall x. f x -> (x -> m b) -> m b) -> (a -> m b) -> m b
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m a
free (((x -> m b) -> f x -> m b) -> f x -> (x -> m b) -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> m b) -> f x -> m b
forall x. (x -> m b) -> f x -> m b
c) (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
b)
{-# INLINE foldFreeT #-}

foldFreeT' :: Monad m
           => (m r -> r)
           -> (a -> r)
           -> (forall x. (x -> r) -> f x -> r)
           -> FreeT f m a
           -> r
foldFreeT' :: (m r -> r)
-> (a -> r) -> (forall x. (x -> r) -> f x -> r) -> FreeT f m a -> r
foldFreeT' m r -> r
bind a -> r
b forall x. (x -> r) -> f x -> r
h FreeT f m a
free =
  m r -> r
bind (m r -> r) -> m r -> r
forall a b. (a -> b) -> a -> b
$ FreeT f m a
-> (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m a
free (\f x
fx x -> m r
c -> r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> m r) -> r -> m r
forall a b. (a -> b) -> a -> b
$ (x -> r) -> f x -> r
forall x. (x -> r) -> f x -> r
h (m r -> r
bind (m r -> r) -> (x -> m r) -> x -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m r
c) f x
fx) (r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> m r) -> (a -> r) -> a -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> r
b)
{-# INLINE foldFreeT' #-}

instance Functor (FreeT f m) where
  fmap :: (a -> b) -> FreeT f m a -> FreeT f m b
fmap a -> b
f FreeT f m a
cnt = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
-> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
 -> FreeT f m b)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
-> FreeT f m b
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
handler b -> m r
c ->
    FreeT f m a
-> (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m a
cnt forall x. f x -> (x -> m r) -> m r
handler (b -> m r
c (b -> m r) -> (a -> b) -> a -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# INLINE fmap #-}

instance Applicative (FreeT f m) where
  pure :: a -> FreeT f m a
pure a
a = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
 -> FreeT f m a)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
_ a -> m r
c -> a -> m r
c a
a
  {-# INLINE pure #-}

  FreeT f m (a -> b)
ff <*> :: FreeT f m (a -> b) -> FreeT f m a -> FreeT f m b
<*> FreeT f m a
fa = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
-> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
 -> FreeT f m b)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
-> FreeT f m b
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
handler b -> m r
c ->
    FreeT f m (a -> b)
-> (forall x. f x -> (x -> m r) -> m r) -> ((a -> b) -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m (a -> b)
ff forall x. f x -> (x -> m r) -> m r
handler (((a -> b) -> m r) -> m r) -> ((a -> b) -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \a -> b
f ->
    FreeT f m a
-> (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m a
fa forall x. f x -> (x -> m r) -> m r
handler (b -> m r
c (b -> m r) -> (a -> b) -> a -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# INLINE (<*>) #-}

  liftA2 :: (a -> b -> c) -> FreeT f m a -> FreeT f m b -> FreeT f m c
liftA2 a -> b -> c
f FreeT f m a
fa FreeT f m b
fb = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (c -> m r) -> m r)
-> FreeT f m c
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (c -> m r) -> m r)
 -> FreeT f m c)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (c -> m r) -> m r)
-> FreeT f m c
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
handler c -> m r
c ->
    FreeT f m a
-> (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m a
fa forall x. f x -> (x -> m r) -> m r
handler ((a -> m r) -> m r) -> (a -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \a
a ->
    FreeT f m b
-> (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m b
fb forall x. f x -> (x -> m r) -> m r
handler (c -> m r
c (c -> m r) -> (b -> c) -> b -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f a
a)
  {-# INLINE liftA2 #-}

  FreeT f m a
fa *> :: FreeT f m a -> FreeT f m b -> FreeT f m b
*> FreeT f m b
fb = FreeT f m a
fa FreeT f m a -> (a -> FreeT f m b) -> FreeT f m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
_ -> FreeT f m b
fb
  {-# INLINE (*>) #-}

instance Monad (FreeT f m) where
  FreeT f m a
m >>= :: FreeT f m a -> (a -> FreeT f m b) -> FreeT f m b
>>= a -> FreeT f m b
f = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
-> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
 -> FreeT f m b)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r)
-> FreeT f m b
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
handler b -> m r
c ->
    FreeT f m a
-> (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m a
m forall x. f x -> (x -> m r) -> m r
handler ((a -> m r) -> m r) -> (a -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \a
a ->
    FreeT f m b
-> (forall x. f x -> (x -> m r) -> m r) -> (b -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT (a -> FreeT f m b
f a
a) forall x. f x -> (x -> m r) -> m r
handler b -> m r
c
  {-# INLINE (>>=) #-}

instance MonadBase b m => MonadBase b (FreeT f m) where
  liftBase :: b α -> FreeT f m α
liftBase = m α -> FreeT f m α
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> FreeT f m α) -> (b α -> m α) -> b α -> FreeT f m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
  {-# INLINE liftBase #-}

instance Fail.MonadFail m => Fail.MonadFail (FreeT f m) where
  fail :: String -> FreeT f m a
fail = m a -> FreeT f m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> FreeT f m a) -> (String -> m a) -> String -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail
  {-# INLINE fail #-}

instance MonadTrans (FreeT f) where
  lift :: m a -> FreeT f m a
lift m a
m = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
 -> FreeT f m a)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
_ a -> m r
c -> m a
m m a -> (a -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m r
c
  {-# INLINE lift #-}

instance MonadIO m => MonadIO (FreeT f m) where
  liftIO :: IO a -> FreeT f m a
liftIO = m a -> FreeT f m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> FreeT f m a) -> (IO a -> m a) -> IO a -> FreeT f 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
  {-# INLINE liftIO #-}

instance MonadThrow m => MonadThrow (FreeT f m) where
  throwM :: e -> FreeT f m a
throwM = m a -> FreeT f m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> FreeT f m a) -> (e -> m a) -> e -> FreeT f 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 (FreeT f m) where
  catch :: FreeT f m a -> (e -> FreeT f m a) -> FreeT f m a
catch FreeT f m a
main e -> FreeT f m a
handle = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
 -> FreeT f m a)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
handler a -> m r
c ->
    (m (m r) -> m r)
-> (a -> m r)
-> (forall x. (x -> m r) -> f x -> m r)
-> FreeT f m a
-> m r
forall (m :: * -> *) r a (f :: * -> *).
Monad m =>
(m r -> r)
-> (a -> r) -> (forall x. (x -> r) -> f x -> r) -> FreeT f m a -> r
foldFreeT' (m (m r) -> m r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m r) -> m r) -> (m (m r) -> m (m r)) -> m (m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (m r) -> (e -> m (m r)) -> m (m r)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> m r -> m (m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (m r -> m (m r)) -> m r -> m (m r)
forall a b. (a -> b) -> a -> b
$ FreeT f m a
-> (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT (e -> FreeT f m a
handle e
e) forall x. f x -> (x -> m r) -> m r
handler a -> m r
c))
               a -> m r
c
               ((f x -> (x -> m r) -> m r) -> (x -> m r) -> f x -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip f x -> (x -> m r) -> m r
forall x. f x -> (x -> m r) -> m r
handler)
               FreeT f m a
main
  {-# INLINE catch #-}

instance Monoid w => ThreadsEff (FreeT f) (ListenPrim w) where
  threadEff :: (forall x. ListenPrim w m x -> m x)
-> ListenPrim w (FreeT f m) a -> FreeT f m a
threadEff = (forall x.
 (forall x. ListenPrim w m x -> m x)
 -> FreeT f m x -> FreeT f m (w, x))
-> (forall x. ListenPrim w m x -> m x)
-> ListenPrim w (FreeT f m) a
-> FreeT f m a
forall o (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
(forall x.
 (forall y. ListenPrim o m y -> m y) -> t m x -> t m (o, x))
-> (forall y. ListenPrim o m y -> m y)
-> ListenPrim o (t m) a
-> t m a
threadListenPrim ((forall x.
  (forall x. ListenPrim w m x -> m x)
  -> FreeT f m x -> FreeT f m (w, x))
 -> (forall x. ListenPrim w m x -> m x)
 -> ListenPrim w (FreeT f m) a
 -> FreeT f m a)
-> (forall x.
    (forall x. ListenPrim w m x -> m x)
    -> FreeT f m x -> FreeT f m (w, x))
-> (forall x. ListenPrim w m x -> m x)
-> ListenPrim w (FreeT f m) a
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. ListenPrim w m x -> m x
alg FreeT f m x
main -> (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> ((w, x) -> m r) -> m r)
-> FreeT f m (w, x)
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> ((w, x) -> m r) -> m r)
 -> FreeT f m (w, x))
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> ((w, x) -> m r) -> m r)
-> FreeT f m (w, x)
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
h (w, x) -> m r
c ->
    (m (w -> m r) -> w -> m r)
-> (x -> w -> m r)
-> (forall x. (x -> w -> m r) -> f x -> w -> m r)
-> FreeT f m x
-> w
-> m r
forall (m :: * -> *) r a (f :: * -> *).
Monad m =>
(m r -> r)
-> (a -> r) -> (forall x. (x -> r) -> f x -> r) -> FreeT f m a -> r
foldFreeT' (\m (w -> m r)
m w
acc -> ListenPrim w m (w, w -> m r) -> m (w, w -> m r)
forall x. ListenPrim w m x -> m x
alg (m (w -> m r) -> ListenPrim w m (w, w -> m r)
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen m (w -> m r)
m) m (w, w -> m r) -> ((w, w -> m r) -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(w
s', w -> m r
f) -> w -> m r
f (w -> m r) -> w -> m r
forall a b. (a -> b) -> a -> b
$! w
acc w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
s'
               )
               (\x
a w
acc -> (w, x) -> m r
c (w
acc, x
a))
               (\x -> w -> m r
cn f x
fx w
acc -> f x -> (x -> m r) -> m r
forall x. f x -> (x -> m r) -> m r
h f x
fx (x -> w -> m r
`cn` w
acc))
               FreeT f m x
main
               w
forall a. Monoid a => a
mempty

instance ThreadsEff (FreeT f) (Regional s) where
  threadEff :: (forall x. Regional s m x -> m x)
-> Regional s (FreeT f m) a -> FreeT f m a
threadEff = (forall x. Regional s m x -> m x)
-> Regional s (FreeT f m) a -> FreeT f m a
forall (t :: Effect) s (m :: * -> *) a.
(ThreadsEff t (Optional (Const s)), Monad m) =>
(forall x. Regional s m x -> m x) -> Regional s (t m) a -> t m a
threadRegionalViaOptional
  {-# INLINE threadEff #-}

instance Functor s => ThreadsEff (FreeT f) (Optional s) where
  threadEff :: (forall x. Optional s m x -> m x)
-> Optional s (FreeT f m) a -> FreeT f m a
threadEff forall x. Optional s m x -> m x
alg (Optionally s a
sa FreeT f m a
main) = (forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
 -> FreeT f m a)
-> (forall r.
    (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. f x -> (x -> m r) -> m r
h a -> m r
c ->
    (m (m r) -> m r)
-> (a -> m r)
-> (forall x. (x -> m r) -> f x -> m r)
-> FreeT f m a
-> m r
forall (m :: * -> *) r a (f :: * -> *).
Monad m =>
(m r -> r)
-> (a -> r) -> (forall x. (x -> r) -> f x -> r) -> FreeT f m a -> r
foldFreeT' (\m (m r)
m -> m (m r) -> m r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m r) -> m r) -> m (m r) -> m r
forall a b. (a -> b) -> a -> b
$ Optional s m (m r) -> m (m r)
forall x. Optional s m x -> m x
alg (Optional s m (m r) -> m (m r)) -> Optional s m (m r) -> m (m r)
forall a b. (a -> b) -> a -> b
$ s (m r) -> m (m r) -> Optional s m (m r)
forall (s :: * -> *) a (m :: * -> *). s a -> m a -> Optional s m a
Optionally ((a -> m r) -> s a -> s (m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m r
c s a
sa) m (m r)
m)
               a -> m r
c
               ((f x -> (x -> m r) -> m r) -> (x -> m r) -> f x -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip f x -> (x -> m r) -> m r
forall x. f x -> (x -> m r) -> m r
h)
               FreeT f m a
main
  {-# INLINE threadEff #-}

instance ThreadsEff (FreeT f) (Unravel p) where
  threadEff :: (forall x. Unravel p m x -> m x)
-> Unravel p (FreeT f m) a -> FreeT f m a
threadEff forall x. Unravel p m x -> m x
alg (Unravel p a
p FreeT f m a -> a
cataM FreeT f m a
main) =
    let
      n :: m a -> m a
n = \m a
m' -> Unravel p m a -> m a
forall x. Unravel p m x -> m x
alg (p a -> (m a -> a) -> m a -> Unravel p m a
forall (p :: * -> *) a (m :: * -> *).
p a -> (m a -> a) -> m a -> Unravel p m a
Unravel p a
p (FreeT f m a -> a
cataM (FreeT f m a -> a) -> (m a -> FreeT f m a) -> m a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> FreeT f m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) m a
m')
    in
      m a -> FreeT f m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> FreeT f m a) -> m a -> FreeT f m a
forall a b. (a -> b) -> a -> b
$ m a -> m a
n
           (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ FreeT f m a
-> (forall x. f x -> (x -> m a) -> m a) -> (a -> m a) -> m a
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. f x -> (x -> m r) -> m r) -> (a -> m r) -> m r
unFreeT FreeT f m a
main
                     (\f x
fx x -> m a
cn -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ FreeT f m a -> a
cataM (FreeT f m a -> a) -> FreeT f m a -> a
forall a b. (a -> b) -> a -> b
$ f x -> FreeT f m x
forall (f :: * -> *) a (m :: * -> *). f a -> FreeT f m a
liftF f x
fx FreeT f m x -> (x -> FreeT f m a) -> FreeT f m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> FreeT f m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> FreeT f m a) -> (x -> m a) -> x -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
n (m a -> m a) -> (x -> m a) -> x -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m a
cn)
                     a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE threadEff #-}

instance ThreadsEff (FreeT f) (ReaderPrim i) where
  threadEff :: (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (FreeT f m) a -> FreeT f m a
threadEff = (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (FreeT f m) a -> FreeT f m a
forall i (t :: Effect) (m :: * -> *) a.
(Monad m, MonadTrans t, ThreadsEff t (Regional ())) =>
(forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (t m) a -> t m a
threadReaderPrimViaRegional
  {-# INLINE threadEff #-}