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

import Control.Applicative
import Control.Monad.Trans
import Control.Monad.Base
import qualified Control.Monad.Fail as Fail
import Control.Effect.Internal.Union
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 a = FreeT {
    FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT :: forall r
             . (forall x. m x -> (x -> r) -> r)
            -> (forall x. f x -> (x -> r) -> r)
            -> (a -> r) -> r
  }

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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
 -> FreeT f m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
_ forall x. f x -> (x -> r) -> r
handler a -> r
c -> f a
f f a -> (a -> r) -> r
forall x. f x -> (x -> r) -> r
`handler` a -> 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. m x -> (x -> m b) -> m b)
-> (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. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
free forall x. m x -> (x -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (((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 (f :: * -> *) a. Applicative f => a -> f a
pure (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
-> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
 -> FreeT f m b)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
-> FreeT f m b
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler b -> r
c ->
    FreeT f m a
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (a -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
cnt forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler (b -> r
c (b -> r) -> (a -> b) -> a -> 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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
 -> FreeT f m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
_ forall x. f x -> (x -> r) -> r
_ a -> r
c -> a -> 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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
-> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
 -> FreeT f m b)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
-> FreeT f m b
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler b -> r
c ->
    FreeT f m (a -> b)
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> ((a -> b) -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m (a -> b)
ff forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler (((a -> b) -> r) -> r) -> ((a -> b) -> r) -> r
forall a b. (a -> b) -> a -> b
$ \a -> b
f ->
    FreeT f m a
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (a -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
fa forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler (b -> r
c (b -> r) -> (a -> b) -> a -> 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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (c -> r) -> r)
-> FreeT f m c
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (c -> r) -> r)
 -> FreeT f m c)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (c -> r) -> r)
-> FreeT f m c
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler c -> r
c ->
    FreeT f m a
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (a -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
fa forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler ((a -> r) -> r) -> (a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \a
a ->
    FreeT f m b
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (b -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m b
fb forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler (c -> r
c (c -> r) -> (b -> c) -> b -> 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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
-> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
 -> FreeT f m b)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (b -> r) -> r)
-> FreeT f m b
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler b -> r
c ->
    FreeT f m a
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (a -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
m forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler ((a -> r) -> r) -> (a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \a
a ->
    FreeT f m b
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (b -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT (a -> FreeT f m b
f a
a) forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler b -> 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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
 -> FreeT f m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
_ a -> r
c -> m a
m m a -> (a -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` a -> 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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
 -> FreeT f m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler a -> r
c ->
    FreeT f m a
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (a -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
main
            (\m x
m x -> r
cn ->
               (m r -> (r -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` r -> r
forall a. a -> a
id) (m r -> r) -> m r -> r
forall a b. (a -> b) -> a -> b
$
                (x -> r) -> m x -> m r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> r
cn m x
m
                  m r -> (e -> m r) -> m r
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch`
                \e
e -> r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> m r) -> r -> m r
forall a b. (a -> b) -> a -> b
$ FreeT f m a
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (a -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT (e -> FreeT f m a
handle e
e) forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler a -> r
c
            )
            forall x. f x -> (x -> r) -> r
handler
            a -> r
c
  {-# 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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> ((w, x) -> r) -> r)
-> FreeT f m (w, x)
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> ((w, x) -> r) -> r)
 -> FreeT f m (w, x))
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> ((w, x) -> r) -> r)
-> FreeT f m (w, x)
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler (w, x) -> r
c ->
    FreeT f m x
-> (forall x. m x -> (x -> w -> r) -> w -> r)
-> (forall x. f x -> (x -> w -> r) -> w -> r)
-> (x -> w -> r)
-> w
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m x
main
            (\m x
m x -> w -> r
cn w
acc ->
               ListenPrim w m (w, x) -> m (w, x)
forall x. ListenPrim w m x -> m x
alg (m x -> ListenPrim w m (w, x)
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen m x
m) m (w, x) -> ((w, x) -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` \(w
s, x
a) ->
                  x -> w -> r
cn x
a (w -> r) -> w -> r
forall a b. (a -> b) -> a -> b
$! w
acc w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
s
            )
            (\f x
eff x -> w -> r
cn w
acc -> f x -> (x -> r) -> r
forall x. f x -> (x -> r) -> r
handler f x
eff (x -> w -> r
`cn` w
acc))
            (\x
a w
acc -> (w, x) -> r
c (w
acc, x
a))
            w
forall a. Monoid a => a
mempty
  {-# INLINE threadEff #-}

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
alg (Regionally s
s FreeT f m a
m) = (forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
 -> FreeT f m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler a -> r
c ->
    FreeT f m a
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (a -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
m (m x -> (x -> r) -> r
forall x. m x -> (x -> r) -> r
bind (m x -> (x -> r) -> r) -> (m x -> m x) -> m x -> (x -> r) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regional s m x -> m x
forall x. Regional s m x -> m x
alg (Regional s m x -> m x) -> (m x -> Regional s m x) -> m x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m x -> Regional s m x
forall s (m :: * -> *) a. s -> m a -> Regional s m a
Regionally s
s) forall x. f x -> (x -> r) -> r
handler a -> r
c
  {-# 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. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
 -> FreeT f m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. f x -> (x -> r) -> r
handler a -> r
c ->
    FreeT f m a
-> (forall x. m x -> (x -> r) -> r)
-> (forall x. f x -> (x -> r) -> r)
-> (a -> r)
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
main
            (\m x
m x -> r
cn ->
               (m r -> (r -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` r -> r
forall a. a -> a
id) (m r -> r) -> m r -> r
forall a b. (a -> b) -> a -> b
$ Optional s m r -> m r
forall x. Optional s m x -> m x
alg (Optional s m r -> m r) -> Optional s m r -> m r
forall a b. (a -> b) -> a -> b
$ s r -> m r -> Optional s m r
forall (s :: * -> *) a (m :: * -> *). s a -> m a -> Optional s m a
Optionally ((a -> r) -> s a -> s r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> r
c s a
sa) ((x -> r) -> m x -> m r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> r
cn m x
m)
            )
            forall x. f x -> (x -> r) -> r
handler
            a -> r
c
  {-# 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) =
    FreeT f m a
-> (forall x. m x -> (x -> FreeT f m a) -> FreeT f m a)
-> (forall x. f x -> (x -> FreeT f m a) -> FreeT f m a)
-> (a -> FreeT f m a)
-> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT f m a
main
            (\m x
m x -> FreeT f m a
cn ->
               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
$ Unravel p m a -> m a
forall x. Unravel p m x -> m x
alg (Unravel p m a -> m a) -> Unravel p m a -> m a
forall a b. (a -> b) -> a -> b
$ 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)
                                    ((x -> a) -> m x -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FreeT f m a -> a
cataM (FreeT f m a -> a) -> (x -> FreeT f m a) -> x -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> FreeT f m a
cn) m x
m)
            )
            (\f x
f x -> FreeT f m a
c -> f x -> FreeT f m x
forall (f :: * -> *) a (m :: * -> *). f a -> FreeT f m a
liftF f x
f 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
>>= x -> FreeT f m a
c)
            a -> FreeT f 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 #-}