{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UnliftedNewtypes #-}
{-# OPTIONS_HADDOCK not-home #-}

module Bluefin.Internal where

import Bluefin.Internal.Exception.Scoped qualified as ScopedException
import Bluefin.Internal.OneWayCoercible
  ( OneWayCoercible (oneWayCoercibleImpl),
    OneWayCoercibleD,
    OneWayCoercion,
    gOneWayCoercible,
    oneWayCoercible,
    oneWayCoercion,
    trans3D,
    unsafeCoercionOfOneWayCoercion,
    unsafeOneWayCoerce,
    unsafeOneWayCoercible,
  )
import Bluefin.Internal.Vault (Vault)
import Bluefin.Internal.Vault qualified as Vault
import Control.Concurrent (forkIO, forkIOWithUnmask, killThread, myThreadId, throwTo)
import Control.Concurrent.Async qualified as Async
import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar, takeMVar)
import Control.Exception qualified
import Control.Monad (forever)
import Control.Monad.Base (MonadBase (liftBase))
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)
import Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM)
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Reader qualified as Reader
import Data.Coerce (Coercible, coerce)
import Data.Foldable (for_)
import Data.Function (fix)
import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)
import Data.Kind (Type)
import Data.Proxy (Proxy (Proxy))
import Data.Type.Coercion (Coercion (Coercion))
import GHC.Exts (Any, Proxy#, keepAlive#, proxy#)
import GHC.Generics (Generic, M1, Rec1, (:*:))
import GHC.IO (IO (..))
import System.IO.Unsafe (unsafePerformIO)
import System.Mem.Weak (addFinalizer)
import Unsafe.Coerce (unsafeCoerce)
import Prelude hiding (drop, head, read, return)

-- | Each inhabitant of @Effects@ is a set of effect tags, used for
-- effect tracking to ensure that effects don't escape the scope of
-- their handler
data Effects = Union Effects Effects

-- | @type (:&) :: Effects -> Effects -> Effects@
--
-- Union of sets of effect tags
infixr 9 :&

type (:&) = Union

type Env = IORef Vault

newtype Eff (es :: Effects) a = UnsafeMkEff {forall (es :: Effects) a. Eff es a -> Env -> IO a
unsafeUnEff :: Env -> IO a}
  deriving stock ((forall a b. (a -> b) -> Eff es a -> Eff es b)
-> (forall a b. a -> Eff es b -> Eff es a) -> Functor (Eff es)
forall a b. a -> Eff es b -> Eff es a
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (es :: Effects) a b. a -> Eff es b -> Eff es a
forall (es :: Effects) a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (es :: Effects) a b. (a -> b) -> Eff es a -> Eff es b
fmap :: forall a b. (a -> b) -> Eff es a -> Eff es b
$c<$ :: forall (es :: Effects) a b. a -> Eff es b -> Eff es a
<$ :: forall a b. a -> Eff es b -> Eff es a
Functor)
  deriving (Functor (Eff es)
Functor (Eff es) =>
(forall a. a -> Eff es a)
-> (forall a b. Eff es (a -> b) -> Eff es a -> Eff es b)
-> (forall a b c.
    (a -> b -> c) -> Eff es a -> Eff es b -> Eff es c)
-> (forall a b. Eff es a -> Eff es b -> Eff es b)
-> (forall a b. Eff es a -> Eff es b -> Eff es a)
-> Applicative (Eff es)
forall a. a -> Eff es a
forall a b. Eff es a -> Eff es b -> Eff es a
forall a b. Eff es a -> Eff es b -> Eff es b
forall a b. Eff es (a -> b) -> Eff es a -> Eff es b
forall a b c. (a -> b -> c) -> Eff es a -> Eff es b -> Eff es c
forall (es :: Effects). Functor (Eff es)
forall (es :: Effects) a. a -> Eff es a
forall (es :: Effects) a b. Eff es a -> Eff es b -> Eff es a
forall (es :: Effects) a b. Eff es a -> Eff es b -> Eff es b
forall (es :: Effects) a b. Eff es (a -> b) -> Eff es a -> Eff es b
forall (es :: Effects) a b c.
(a -> b -> c) -> Eff es a -> Eff es b -> Eff es c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (es :: Effects) a. a -> Eff es a
pure :: forall a. a -> Eff es a
$c<*> :: forall (es :: Effects) a b. Eff es (a -> b) -> Eff es a -> Eff es b
<*> :: forall a b. Eff es (a -> b) -> Eff es a -> Eff es b
$cliftA2 :: forall (es :: Effects) a b c.
(a -> b -> c) -> Eff es a -> Eff es b -> Eff es c
liftA2 :: forall a b c. (a -> b -> c) -> Eff es a -> Eff es b -> Eff es c
$c*> :: forall (es :: Effects) a b. Eff es a -> Eff es b -> Eff es b
*> :: forall a b. Eff es a -> Eff es b -> Eff es b
$c<* :: forall (es :: Effects) a b. Eff es a -> Eff es b -> Eff es a
<* :: forall a b. Eff es a -> Eff es b -> Eff es a
Applicative, Applicative (Eff es)
Applicative (Eff es) =>
(forall a b. Eff es a -> (a -> Eff es b) -> Eff es b)
-> (forall a b. Eff es a -> Eff es b -> Eff es b)
-> (forall a. a -> Eff es a)
-> Monad (Eff es)
forall a. a -> Eff es a
forall a b. Eff es a -> Eff es b -> Eff es b
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (es :: Effects). Applicative (Eff es)
forall (es :: Effects) a. a -> Eff es a
forall (es :: Effects) a b. Eff es a -> Eff es b -> Eff es b
forall (es :: Effects) a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (es :: Effects) a b. Eff es a -> (a -> Eff es b) -> Eff es b
>>= :: forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
$c>> :: forall (es :: Effects) a b. Eff es a -> Eff es b -> Eff es b
>> :: forall a b. Eff es a -> Eff es b -> Eff es b
$creturn :: forall (es :: Effects) a. a -> Eff es a
return :: forall a. a -> Eff es a
Monad, Monad (Eff es)
Monad (Eff es) =>
(forall a. (a -> Eff es a) -> Eff es a) -> MonadFix (Eff es)
forall a. (a -> Eff es a) -> Eff es a
forall (es :: Effects). Monad (Eff es)
forall (es :: Effects) a. (a -> Eff es a) -> Eff es a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall (es :: Effects) a. (a -> Eff es a) -> Eff es a
mfix :: forall a. (a -> Eff es a) -> Eff es a
MonadFix) via ReaderT Env IO

type role Eff nominal representational

instance (e <: es) => OneWayCoercible (Eff e) (Eff es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (Eff e) (Eff es)
oneWayCoercibleImpl = OneWayCoercibleD (Eff e) (Eff es)
forall {k} (a :: k) (b :: k). OneWayCoercibleD a b
unsafeOneWayCoercible

instance (e <: es) => OneWayCoercible (Eff e r) (Eff es r) where
  oneWayCoercibleImpl :: OneWayCoercibleD (Eff e r) (Eff es r)
oneWayCoercibleImpl = OneWayCoercibleD (Eff e r) (Eff es r)
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible

-- | Because doing 'IO' operations inside 'Eff' requires a value-level
-- argument we can't give @IO@-related instances to @Eff@ directly.
-- Instead we wrap it in @EffReader@.
newtype EffReader r es a = MkEffReader {forall r (es :: Effects) a. EffReader r es a -> r -> Eff es a
unEffReader :: r -> Eff es a}
  deriving ((forall a b. (a -> b) -> EffReader r es a -> EffReader r es b)
-> (forall a b. a -> EffReader r es b -> EffReader r es a)
-> Functor (EffReader r es)
forall a b. a -> EffReader r es b -> EffReader r es a
forall a b. (a -> b) -> EffReader r es a -> EffReader r es b
forall r (es :: Effects) a b.
a -> EffReader r es b -> EffReader r es a
forall r (es :: Effects) a b.
(a -> b) -> EffReader r es a -> EffReader r es b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r (es :: Effects) a b.
(a -> b) -> EffReader r es a -> EffReader r es b
fmap :: forall a b. (a -> b) -> EffReader r es a -> EffReader r es b
$c<$ :: forall r (es :: Effects) a b.
a -> EffReader r es b -> EffReader r es a
<$ :: forall a b. a -> EffReader r es b -> EffReader r es a
Functor, Functor (EffReader r es)
Functor (EffReader r es) =>
(forall a. a -> EffReader r es a)
-> (forall a b.
    EffReader r es (a -> b) -> EffReader r es a -> EffReader r es b)
-> (forall a b c.
    (a -> b -> c)
    -> EffReader r es a -> EffReader r es b -> EffReader r es c)
-> (forall a b.
    EffReader r es a -> EffReader r es b -> EffReader r es b)
-> (forall a b.
    EffReader r es a -> EffReader r es b -> EffReader r es a)
-> Applicative (EffReader r es)
forall a. a -> EffReader r es a
forall a b.
EffReader r es a -> EffReader r es b -> EffReader r es a
forall a b.
EffReader r es a -> EffReader r es b -> EffReader r es b
forall a b.
EffReader r es (a -> b) -> EffReader r es a -> EffReader r es b
forall a b c.
(a -> b -> c)
-> EffReader r es a -> EffReader r es b -> EffReader r es c
forall r (es :: Effects). Functor (EffReader r es)
forall r (es :: Effects) a. a -> EffReader r es a
forall r (es :: Effects) a b.
EffReader r es a -> EffReader r es b -> EffReader r es a
forall r (es :: Effects) a b.
EffReader r es a -> EffReader r es b -> EffReader r es b
forall r (es :: Effects) a b.
EffReader r es (a -> b) -> EffReader r es a -> EffReader r es b
forall r (es :: Effects) a b c.
(a -> b -> c)
-> EffReader r es a -> EffReader r es b -> EffReader r es c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall r (es :: Effects) a. a -> EffReader r es a
pure :: forall a. a -> EffReader r es a
$c<*> :: forall r (es :: Effects) a b.
EffReader r es (a -> b) -> EffReader r es a -> EffReader r es b
<*> :: forall a b.
EffReader r es (a -> b) -> EffReader r es a -> EffReader r es b
$cliftA2 :: forall r (es :: Effects) a b c.
(a -> b -> c)
-> EffReader r es a -> EffReader r es b -> EffReader r es c
liftA2 :: forall a b c.
(a -> b -> c)
-> EffReader r es a -> EffReader r es b -> EffReader r es c
$c*> :: forall r (es :: Effects) a b.
EffReader r es a -> EffReader r es b -> EffReader r es b
*> :: forall a b.
EffReader r es a -> EffReader r es b -> EffReader r es b
$c<* :: forall r (es :: Effects) a b.
EffReader r es a -> EffReader r es b -> EffReader r es a
<* :: forall a b.
EffReader r es a -> EffReader r es b -> EffReader r es a
Applicative, Applicative (EffReader r es)
Applicative (EffReader r es) =>
(forall a b.
 EffReader r es a -> (a -> EffReader r es b) -> EffReader r es b)
-> (forall a b.
    EffReader r es a -> EffReader r es b -> EffReader r es b)
-> (forall a. a -> EffReader r es a)
-> Monad (EffReader r es)
forall a. a -> EffReader r es a
forall a b.
EffReader r es a -> EffReader r es b -> EffReader r es b
forall a b.
EffReader r es a -> (a -> EffReader r es b) -> EffReader r es b
forall r (es :: Effects). Applicative (EffReader r es)
forall r (es :: Effects) a. a -> EffReader r es a
forall r (es :: Effects) a b.
EffReader r es a -> EffReader r es b -> EffReader r es b
forall r (es :: Effects) a b.
EffReader r es a -> (a -> EffReader r es b) -> EffReader r es b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall r (es :: Effects) a b.
EffReader r es a -> (a -> EffReader r es b) -> EffReader r es b
>>= :: forall a b.
EffReader r es a -> (a -> EffReader r es b) -> EffReader r es b
$c>> :: forall r (es :: Effects) a b.
EffReader r es a -> EffReader r es b -> EffReader r es b
>> :: forall a b.
EffReader r es a -> EffReader r es b -> EffReader r es b
$creturn :: forall r (es :: Effects) a. a -> EffReader r es a
return :: forall a. a -> EffReader r es a
Monad) via (Reader.ReaderT r (Eff es))

instance (e <: es) => MonadIO (EffReader (IOE e) es) where
  liftIO :: forall a. IO a -> EffReader (IOE e) es a
liftIO = (IOE e -> Eff es a) -> EffReader (IOE e) es a
forall r (es :: Effects) a. (r -> Eff es a) -> EffReader r es a
MkEffReader ((IOE e -> Eff es a) -> EffReader (IOE e) es a)
-> (IO a -> IOE e -> Eff es a) -> IO a -> EffReader (IOE e) es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOE e -> IO a -> Eff es a) -> IO a -> IOE e -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOE e -> IO a -> Eff es a
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO

effReader :: (r -> Eff es a) -> EffReader r es a
effReader :: forall r (es :: Effects) a. (r -> Eff es a) -> EffReader r es a
effReader = (r -> Eff es a) -> EffReader r es a
forall r (es :: Effects) a. (r -> Eff es a) -> EffReader r es a
MkEffReader

runEffReader :: r -> EffReader r es a -> Eff es a
runEffReader :: forall r (es :: Effects) a. r -> EffReader r es a -> Eff es a
runEffReader r
r (MkEffReader r -> Eff es a
m) = r -> Eff es a
m r
r

-- | Deprecated.  Use 'withEffToIO_' instead.
withEffToIO ::
  (e2 <: es) =>
  -- | Continuation with the unlifting function in scope.
  ((forall r. (forall e1. IOE e1 -> Eff (e1 :& es) r) -> IO r) -> IO a) ->
  IOE e2 ->
  Eff es a
withEffToIO :: forall (e2 :: Effects) (es :: Effects) a.
(e2 <: es) =>
((forall r.
  (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
 -> IO a)
-> IOE e2 -> Eff es a
withEffToIO (forall r.
 (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
-> IO a
k IOE e2
io = (Env -> IO a) -> Eff es a
forall (es :: Effects) a. (Env -> IO a) -> Eff es a
UnsafeMkEff (\Env
env -> (forall r.
 (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
-> IO a
k (\forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r
f -> Eff (e2 :& es) r -> Env -> IO r
forall (es :: Effects) a. Eff es a -> Env -> IO a
unsafeUnEff (IOE e2 -> Eff (e2 :& es) r
forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r
f IOE e2
io) Env
env))

withEffToIO' ::
  (e2 <: es) =>
  -- | Continuation with the unlifting function in scope.
  IOE e2 ->
  ((forall r. (forall e1. IOE e1 -> Eff (e1 :& es) r) -> IO r) -> IO a) ->
  Eff es a
withEffToIO' :: forall (e2 :: Effects) (es :: Effects) a.
(e2 <: es) =>
IOE e2
-> ((forall r.
     (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
    -> IO a)
-> Eff es a
withEffToIO' IOE e2
io (forall r.
 (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
-> IO a
k = ((forall r.
  (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
 -> IO a)
-> IOE e2 -> Eff es a
forall (e2 :: Effects) (es :: Effects) a.
(e2 <: es) =>
((forall r.
  (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
 -> IO a)
-> IOE e2 -> Eff es a
withEffToIO (forall r.
 (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
-> IO a
k IOE e2
io

-- | This is equivalent to the 'withRunInIO' method of
-- 'MonadUnliftIO', but written in Bluefin-style.
withEffToIO_ ::
  (e <: es) =>
  IOE e ->
  -- | Continuation with the unlifting function in scope.
  ((forall r. Eff es r -> IO r) -> IO a) ->
  Eff es a
withEffToIO_ :: forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO_ IOE e
io (forall r. Eff es r -> IO r) -> IO a
k =
  ((forall r.
  (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
 -> IO a)
-> IOE e -> Eff es a
forall (e2 :: Effects) (es :: Effects) a.
(e2 <: es) =>
((forall r.
  (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
 -> IO a)
-> IOE e2 -> Eff es a
withEffToIO (\forall r.
(forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r
effToIO -> (forall r. Eff es r -> IO r) -> IO a
k (\Eff es r
eff -> (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r
forall r.
(forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r
effToIO (\IOE e1
_ -> Eff es r -> Eff (e1 :& es) r
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl Eff es r
eff))) IOE e
io

-- We can do the old API in terms of withEffToIO_
withEffToIO_' ::
  (e2 <: es) =>
  IOE e2 ->
  -- | Continuation with the unlifting function in scope.
  ((forall r. (forall e1. IOE e1 -> Eff (e1 :& es) r) -> IO r) -> IO a) ->
  Eff es a
withEffToIO_' :: forall (e2 :: Effects) (es :: Effects) a.
(e2 <: es) =>
IOE e2
-> ((forall r.
     (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
    -> IO a)
-> Eff es a
withEffToIO_' IOE e2
io (forall r.
 (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
-> IO a
k =
  IOE e2 -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO_ IOE e2
io (\forall r. Eff es r -> IO r
effToIO -> (forall r.
 (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
-> IO a
k (\forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r
eff -> Eff es r -> IO r
forall r. Eff es r -> IO r
effToIO (In (e2 :& es) es -> Eff (e2 :& es) r -> Eff es r
forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff (In e2 es -> In (e2 :& es) es
forall (e1 :: Effects) (e2 :: Effects).
In e1 e2 -> In (e1 :& e2) e2
subsume2 In e2 es
forall (a :: Effects) (b :: Effects). (a <: b) => In a b
has) (IOE e2 -> Eff (e2 :& es) r
forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r
eff IOE e2
io))))

-- We don't try to do anything sophisticated here.  I haven't thought
-- through all the consequences.

-- | You probably want to use 'withEffToIO_' instead.
instance (e <: es) => MonadUnliftIO (EffReader (IOE e) es) where
  withRunInIO ::
    ((forall a. EffReader (IOE e) es a -> IO a) -> IO b) ->
    EffReader (IOE e) es b
  withRunInIO :: forall b.
((forall a. EffReader (IOE e) es a -> IO a) -> IO b)
-> EffReader (IOE e) es b
withRunInIO (forall a. EffReader (IOE e) es a -> IO a) -> IO b
k =
    (IOE e -> Eff es b) -> EffReader (IOE e) es b
forall r (es :: Effects) a. (r -> Eff es a) -> EffReader r es a
MkEffReader ((IOE e -> Eff es b) -> EffReader (IOE e) es b)
-> (IOE e -> Eff es b) -> EffReader (IOE e) es b
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> do
      IOE e -> ((forall {r}. Eff es r -> IO r) -> IO b) -> Eff es b
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO_ IOE e
io (((forall {r}. Eff es r -> IO r) -> IO b) -> Eff es b)
-> ((forall {r}. Eff es r -> IO r) -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff es r -> IO r
effToIO -> do
        (forall a. EffReader (IOE e) es a -> IO a) -> IO b
k ((forall a. EffReader (IOE e) es a -> IO a) -> IO b)
-> (forall a. EffReader (IOE e) es a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ \(MkEffReader IOE e -> Eff es a
f) -> do
          Eff es a -> IO a
forall {r}. Eff es r -> IO r
effToIO (IOE e -> Eff es a
f IOE e
io)

race ::
  (e2 <: es) =>
  (forall e. IOE e -> Eff (e :& es) a) ->
  (forall e. IOE e -> Eff (e :& es) a) ->
  IOE e2 ->
  Eff es a
race :: forall (e2 :: Effects) (es :: Effects) a.
(e2 <: es) =>
(forall (e :: Effects). IOE e -> Eff (e :& es) a)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) a)
-> IOE e2
-> Eff es a
race forall (e :: Effects). IOE e -> Eff (e :& es) a
x forall (e :: Effects). IOE e -> Eff (e :& es) a
y IOE e2
io = do
  Either a a
r <- IOE e2
-> ((forall {r}.
     (forall {e1 :: Effects}. IOE e1 -> Eff (e1 :& es) r) -> IO r)
    -> IO (Either a a))
-> Eff es (Either a a)
forall (e2 :: Effects) (es :: Effects) a.
(e2 <: es) =>
IOE e2
-> ((forall r.
     (forall (e1 :: Effects). IOE e1 -> Eff (e1 :& es) r) -> IO r)
    -> IO a)
-> Eff es a
withEffToIO' IOE e2
io (((forall {r}.
   (forall {e1 :: Effects}. IOE e1 -> Eff (e1 :& es) r) -> IO r)
  -> IO (Either a a))
 -> Eff es (Either a a))
-> ((forall {r}.
     (forall {e1 :: Effects}. IOE e1 -> Eff (e1 :& es) r) -> IO r)
    -> IO (Either a a))
-> Eff es (Either a a)
forall a b. (a -> b) -> a -> b
$ \forall {r}.
(forall {e1 :: Effects}. IOE e1 -> Eff (e1 :& es) r) -> IO r
toIO ->
    IO a -> IO a -> IO (Either a a)
forall a b. IO a -> IO b -> IO (Either a b)
Async.race ((forall (e :: Effects). IOE e -> Eff (e :& es) a) -> IO a
forall {r}.
(forall {e1 :: Effects}. IOE e1 -> Eff (e1 :& es) r) -> IO r
toIO (Eff (e1 :& es) a -> Eff (e1 :& es) a
forall (es :: Effects) r. Eff es r -> Eff es r
withClonedEnv (Eff (e1 :& es) a -> Eff (e1 :& es) a)
-> (IOE e1 -> Eff (e1 :& es) a) -> IOE e1 -> Eff (e1 :& es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOE e1 -> Eff (e1 :& es) a
forall (e :: Effects). IOE e -> Eff (e :& es) a
x)) ((forall (e :: Effects). IOE e -> Eff (e :& es) a) -> IO a
forall {r}.
(forall {e1 :: Effects}. IOE e1 -> Eff (e1 :& es) r) -> IO r
toIO (Eff (e1 :& es) a -> Eff (e1 :& es) a
forall (es :: Effects) r. Eff es r -> Eff es r
withClonedEnv (Eff (e1 :& es) a -> Eff (e1 :& es) a)
-> (IOE e1 -> Eff (e1 :& es) a) -> IOE e1 -> Eff (e1 :& es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOE e1 -> Eff (e1 :& es) a
forall (e :: Effects). IOE e -> Eff (e :& es) a
y))

  a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Eff es a) -> a -> Eff es a
forall a b. (a -> b) -> a -> b
$ case Either a a
r of
    Left a
a -> a
a
    Right a
a -> a
a

withClonedEnv :: Eff es r -> Eff es r
withClonedEnv :: forall (es :: Effects) r. Eff es r -> Eff es r
withClonedEnv Eff es r
m = (Env -> IO r) -> Eff es r
forall (es :: Effects) a. (Env -> IO a) -> Eff es a
UnsafeMkEff ((Env -> IO r) -> Eff es r) -> (Env -> IO r) -> Eff es r
forall a b. (a -> b) -> a -> b
$ \Env
vault -> do
  Env
vault' <- Env -> IO Env
forall {a}. IORef a -> IO (IORef a)
cloneIORef Env
vault
  case Eff es r
m of UnsafeMkEff Env -> IO r
m' -> Env -> IO r
m' Env
vault'
  where
    cloneIORef :: IORef a -> IO (IORef a)
cloneIORef IORef a
ref = do
      a
orig <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref
      a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
orig

-- | Connect two coroutines.  Their execution is interleaved by
-- exchanging @a@s and @b@s. When the former yields its first @a@ it
-- starts the latter (which is awaiting an @a@).
connectCoroutines ::
  forall es a b r.
  (forall e. Coroutine a b e -> Eff (e :& es) r) ->
  (forall e. a -> Coroutine b a e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
connectCoroutines :: forall (es :: Effects) a b r.
(forall (e :: Effects). Coroutine a b e -> Eff (e :& es) r)
-> (forall (e :: Effects). a -> Coroutine b a e -> Eff (e :& es) r)
-> Eff es r
connectCoroutines forall (e :: Effects). Coroutine a b e -> Eff (e :& es) r
m1 forall (e :: Effects). a -> Coroutine b a e -> Eff (e :& es) r
m2 = (forall (e :: Effects). IOE e -> Eff (e :& es) r) -> Eff es r
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) r) -> Eff es r)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) r) -> Eff es r
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> do
  MVar a
av <- IOE e -> IO (MVar a) -> Eff (e :& es) (MVar a)
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
  MVar b
bv <- IOE e -> IO (MVar b) -> Eff (e :& es) (MVar b)
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io IO (MVar b)
forall a. IO (MVar a)
newEmptyMVar

  let t1 :: forall e. IOE e -> Eff (e :& es) r
      t1 :: forall (e :: Effects). IOE e -> Eff (e :& es) r
t1 IOE e
io' = (forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& (e :& es)) r)
-> (a -> Eff (e :& es) b) -> Eff (e :& es) r
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r)
-> (Request a b e1 -> Eff (e1 :& es) r)
-> Request a b e1
-> Eff (e1 :& (e :& es)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request a b e1 -> Eff (e1 :& es) r
forall (e :: Effects). Coroutine a b e -> Eff (e :& es) r
m1) ((a -> Eff (e :& es) b) -> Eff (e :& es) r)
-> (a -> Eff (e :& es) b) -> Eff (e :& es) r
forall a b. (a -> b) -> a -> b
$ \a
a -> IOE e -> IO b -> Eff (e :& es) b
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io' (IO b -> Eff (e :& es) b) -> IO b -> Eff (e :& es) b
forall a b. (a -> b) -> a -> b
$ do
        MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
av a
a
        MVar b -> IO b
forall a. MVar a -> IO a
takeMVar MVar b
bv

  let t2 :: forall e. IOE e -> Eff (e :& es) r
      t2 :: forall (e :: Effects). IOE e -> Eff (e :& es) r
t2 IOE e
io' = do
        a
ainit <- IOE e -> IO a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io' (MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
av)
        (forall (e1 :: Effects). Request b a e1 -> Eff (e1 :& (e :& es)) r)
-> (b -> Eff (e :& es) a) -> Eff (e :& es) r
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r)
-> (Request b a e1 -> Eff (e1 :& es) r)
-> Request b a e1
-> Eff (e1 :& (e :& es)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Request b a e1 -> Eff (e1 :& es) r
forall (e :: Effects). a -> Coroutine b a e -> Eff (e :& es) r
m2 a
ainit) ((b -> Eff (e :& es) a) -> Eff (e :& es) r)
-> (b -> Eff (e :& es) a) -> Eff (e :& es) r
forall a b. (a -> b) -> a -> b
$ \b
b_ -> IOE e -> IO a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io' (IO a -> Eff (e :& es) a) -> IO a -> Eff (e :& es) a
forall a b. (a -> b) -> a -> b
$ do
          MVar b -> b -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar b
bv b
b_
          MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
av

  (forall (e :: Effects). IOE e -> Eff (e :& (e :& es)) r)
-> (forall (e :: Effects). IOE e -> Eff (e :& (e :& es)) r)
-> IOE e
-> Eff (e :& es) r
forall (e2 :: Effects) (es :: Effects) a.
(e2 <: es) =>
(forall (e :: Effects). IOE e -> Eff (e :& es) a)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) a)
-> IOE e2
-> Eff es a
race (Eff (e :& es) r -> Eff (e :& (e :& es)) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder (Eff (e :& es) r -> Eff (e :& (e :& es)) r)
-> (IOE e -> Eff (e :& es) r) -> IOE e -> Eff (e :& (e :& es)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOE e -> Eff (e :& es) r
forall (e :: Effects). IOE e -> Eff (e :& es) r
t1) (Eff (e :& es) r -> Eff (e :& (e :& es)) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder (Eff (e :& es) r -> Eff (e :& (e :& es)) r)
-> (IOE e -> Eff (e :& es) r) -> IOE e -> Eff (e :& (e :& es)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOE e -> Eff (e :& es) r
forall (e :: Effects). IOE e -> Eff (e :& es) r
t2) IOE e
io

-- | Old name for 'consumeStream'.  @receiveStream@ will be deprecated
-- in a future version.
receiveStream ::
  (forall e. Consume a e -> Eff (e :& es) r) ->
  (forall e. Stream a e -> Eff (e :& es) r) ->
  Eff es r
receiveStream :: forall a (es :: Effects) r.
(forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
receiveStream = (forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
forall a (es :: Effects) r.
(forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
consumeStream

consumeStream ::
  -- | Each 'await' from the @Consume@ ...
  (forall e. Consume a e -> Eff (e :& es) r) ->
  -- | ... receives the value 'yield'ed from the @Stream@
  (forall e. Stream a e -> Eff (e :& es) r) ->
  Eff es r
consumeStream :: forall a (es :: Effects) r.
(forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
consumeStream forall (e :: Effects). Consume a e -> Eff (e :& es) r
r forall (e :: Effects). Stream a e -> Eff (e :& es) r
s = (forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects).
    () -> Coroutine a () e -> Eff (e :& es) r)
-> Eff es r
forall (es :: Effects) a b r.
(forall (e :: Effects). Coroutine a b e -> Eff (e :& es) r)
-> (forall (e :: Effects). a -> Coroutine b a e -> Eff (e :& es) r)
-> Eff es r
connectCoroutines Consume a e -> Eff (e :& es) r
forall (e :: Effects). Consume a e -> Eff (e :& es) r
r (\() -> Coroutine a () e -> Eff (e :& es) r
forall (e :: Effects). Stream a e -> Eff (e :& es) r
s)

-- | Argument-flipped version of 'consumeStream'
streamConsume ::
  forall a (es :: Effects) r.
  (forall (e :: Effects). Stream a e -> Eff (e :& es) r) ->
  (forall (e :: Effects). Consume a e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
streamConsume :: forall a (es :: Effects) r.
(forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> Eff es r
streamConsume forall (e :: Effects). Stream a e -> Eff (e :& es) r
s forall (e :: Effects). Consume a e -> Eff (e :& es) r
c = (forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
forall a (es :: Effects) r.
(forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
consumeStream Consume a e -> Eff (e :& es) r
forall (e :: Effects). Consume a e -> Eff (e :& es) r
c Stream a e -> Eff (e :& es) r
forall (e :: Effects). Stream a e -> Eff (e :& es) r
s

instance (e <: es) => MonadBase IO (EffReader (IOE e) es) where
  liftBase :: forall α. IO α -> EffReader (IOE e) es α
liftBase = IO α -> EffReader (IOE e) es α
forall α. IO α -> EffReader (IOE e) es α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (e <: es) => MonadBaseControl IO (EffReader (IOE e) es) where
  type StM (EffReader (IOE e) es) a = a
  liftBaseWith :: forall a.
(RunInBase (EffReader (IOE e) es) IO -> IO a)
-> EffReader (IOE e) es a
liftBaseWith = ((forall a. EffReader (IOE e) es a -> IO a) -> IO a)
-> EffReader (IOE e) es a
(RunInBase (EffReader (IOE e) es) IO -> IO a)
-> EffReader (IOE e) es a
forall b.
((forall a. EffReader (IOE e) es a -> IO a) -> IO b)
-> EffReader (IOE e) es b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO
  restoreM :: forall a. StM (EffReader (IOE e) es) a -> EffReader (IOE e) es a
restoreM = a -> EffReader (IOE e) es a
StM (EffReader (IOE e) es) a -> EffReader (IOE e) es a
forall a. a -> EffReader (IOE e) es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance (e <: es) => MonadFail (EffReader (Throw String e) es) where
  fail :: forall a. String -> EffReader (Throw String e) es a
fail = (Throw String e -> Eff es a) -> EffReader (Throw String e) es a
forall r (es :: Effects) a. (r -> Eff es a) -> EffReader r es a
MkEffReader ((Throw String e -> Eff es a) -> EffReader (Throw String e) es a)
-> (String -> Throw String e -> Eff es a)
-> String
-> EffReader (Throw String e) es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Throw String e -> String -> Eff es a)
-> String -> Throw String e -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Throw String e -> String -> Eff es a
forall (e :: Effects) (es :: Effects) ex a.
(e <: es) =>
Throw ex e -> ex -> Eff es a
throw

hoistReader ::
  (forall b. m b -> n b) ->
  Reader.ReaderT r m a ->
  Reader.ReaderT r n a
hoistReader :: forall (m :: * -> *) (n :: * -> *) r a.
(forall b. m b -> n b) -> ReaderT r m a -> ReaderT r n a
hoistReader forall b. m b -> n b
f = (r -> n a) -> ReaderT r n a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((r -> n a) -> ReaderT r n a)
-> (ReaderT r m a -> r -> n a) -> ReaderT r m a -> ReaderT r n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ReaderT r m a
m -> m a -> n a
forall b. m b -> n b
f (m a -> n a) -> (r -> m a) -> r -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT ReaderT r m a
m)

-- | Run `MonadIO` operations in 'Eff'.
--
-- @
-- >>> runEff $ \\io -> withMonadIO io $ liftIO $ do
--       putStrLn "Hello world!"
-- Hello, world!
-- @

-- This is not really any better than just running the action in
-- `IO`.
withMonadIO ::
  (e <: es) =>
  IOE e ->
  -- | 'MonadIO' operation
  (forall m. (MonadIO m) => m r) ->
  -- | @MonadIO@ operation run in @Eff@
  Eff es r
withMonadIO :: forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
IOE e -> (forall (m :: * -> *). MonadIO m => m r) -> Eff es r
withMonadIO IOE e
io forall (m :: * -> *). MonadIO m => m r
m = EffReader (IOE e) es r -> IOE e -> Eff es r
forall r (es :: Effects) a. EffReader r es a -> r -> Eff es a
unEffReader EffReader (IOE e) es r
forall (m :: * -> *). MonadIO m => m r
m IOE e
io

-- | Run 'MonadFail' operations in 'Eff'.
--
-- @
-- >>> runPureEff $ try $ \\e ->
--       when (2 > 1) $
--         withMonadFail e (fail "2 was bigger than 1")
-- Left "2 was bigger than 1"
-- @

-- This is not really any better than just running the action in
-- `Either String` and then applying `either (throw f) pure`.
withMonadFail ::
  (e <: es) =>
  -- | @Throw@ to @throw@ on @fail@
  Throw String e ->
  -- | 'MonadFail' operation
  (forall m. (MonadFail m) => m r) ->
  -- | @MonadFail@ operation run in @Eff@
  Eff es r
withMonadFail :: forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Throw String e
-> (forall (m :: * -> *). MonadFail m => m r) -> Eff es r
withMonadFail Throw String e
f forall (m :: * -> *). MonadFail m => m r
m = EffReader (Throw String e) es r -> Throw String e -> Eff es r
forall r (es :: Effects) a. EffReader r es a -> r -> Eff es a
unEffReader EffReader (Throw String e) es r
forall (m :: * -> *). MonadFail m => m r
m Throw String e
f

-- | Run an 'Eff' that doesn't contain any unhandled effects.
runPureEff :: (forall es. Eff es a) -> a
runPureEff :: forall a. (forall (es :: Effects). Eff es a) -> a
runPureEff = (forall (es :: Effects). Eff es a) -> a
forall a. (forall (es :: Effects). Eff es a) -> a
runPureEffPoisonable

-- | Run an 'Eff' that doesn't contain any unhandled effects.  If the
-- evaluation of the result of runPureEffPoisonable is interrupted by
-- an asynchronous exception the thunk can become poisoned and unable
-- to be resumed (subsequent evaluation throws the async exception
-- again).
--
-- See https://github.com/tomjaguarpaw/bluefin/issues/30
runPureEffPoisonable :: (forall es. Eff es a) -> a
runPureEffPoisonable :: forall a. (forall (es :: Effects). Eff es a) -> a
runPureEffPoisonable forall (es :: Effects). Eff es a
e = IO a -> a
forall a. IO a -> a
unsafePerformIO ((forall (e :: Effects). IOE e -> Eff e a) -> IO a
forall a. (forall (e :: Effects). IOE e -> Eff e a) -> IO a
runEff (\IOE e
_ -> Eff e a
forall (es :: Effects). Eff es a
e))

-- | Run an 'Eff' that doesn't contain any unhandled effects. The
-- computation runs in a dedicated worker thread, so an asynchronous
-- exception received by a thread demanding the result does not
-- interrupt the computation itself. (An exception delivered to the
-- worker thread would be rethrown and could poison the thunk, but
-- that cannot happen unless the worker thread's ID is looked up by
-- some out-of-band means -- don't do that!).
--
-- The worker thread continues to work even if the thread forcing it
-- is killed, which may be surprising. If no references to the thunk
-- for the result of runPureEffAsyncSafe remain, the worker thread is
-- killed.
--
-- A proper fix to this issue probably belongs in GHC.
runPureEffAsyncSafe :: (forall es. Eff es a) -> a
runPureEffAsyncSafe :: forall a. (forall (es :: Effects). Eff es a) -> a
runPureEffAsyncSafe forall (es :: Effects). Eff es a
e = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
  MVar (Either SomeException a)
result <- IO (MVar (Either SomeException a))
forall a. IO (MVar a)
newEmptyMVar
  IORef ()
owner <- () -> IO (IORef ())
forall a. a -> IO (IORef a)
newIORef ()
  ThreadId
_ <- IO ThreadId -> IO ThreadId
forall a. IO a -> IO a
Control.Exception.mask_ (IO ThreadId -> IO ThreadId) -> IO ThreadId -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOWithUnmask (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
    ThreadId
tid <- IO ThreadId
myThreadId
    IORef () -> IO () -> IO ()
forall key. key -> IO () -> IO ()
addFinalizer IORef ()
owner (ThreadId -> IO ()
killThread ThreadId
tid)
    Either SomeException a
r <- forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try @Control.Exception.SomeException (IO a -> IO (Either SomeException a))
-> (IO a -> IO a) -> IO a -> IO (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
unmask (IO a -> IO (Either SomeException a))
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ do
      (forall (e :: Effects). IOE e -> Eff e a) -> IO a
forall a. (forall (e :: Effects). IOE e -> Eff e a) -> IO a
runEff (\IOE e
_ -> Eff e a
forall (es :: Effects). Eff es a
e)
    MVar (Either SomeException a) -> Either SomeException a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException a)
result Either SomeException a
r
  Either SomeException a
r <- IORef ()
-> IO (Either SomeException a) -> IO (Either SomeException a)
forall a b. a -> IO b -> IO b
keepAlive IORef ()
owner (MVar (Either SomeException a) -> IO (Either SomeException a)
forall a. MVar a -> IO a
readMVar MVar (Either SomeException a)
result)
  (SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
r

keepAlive :: a -> IO b -> IO b
keepAlive :: forall a b. a -> IO b -> IO b
keepAlive a
a (IO State# RealWorld -> (# State# RealWorld, b #)
action) = (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, b #)) -> IO b)
-> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> a
-> State# RealWorld
-> (State# RealWorld -> (# State# RealWorld, b #))
-> (# State# RealWorld, b #)
forall a d b. a -> State# d -> (State# d -> b) -> b
keepAlive# a
a State# RealWorld
s State# RealWorld -> (# State# RealWorld, b #)
action

-- | Like 'runPureEffAsyncSafe', but starts a fresh worker after an
-- asynchronous exception interrupts a demand for the result.  This
-- means that if the thread forcing the thunk is killed the work done
-- so far is discarded, and restarted from scratch in the next
-- evaluation.
--
-- This should not be used. It exists only as an example of a (worse)
-- alternative approach.  Use 'runPureEffAsyncSafe' instead.
runPureEffAsyncSafeRestarting :: (forall es. Eff es a) -> a
runPureEffAsyncSafeRestarting :: forall a. (forall (es :: Effects). Eff es a) -> a
runPureEffAsyncSafeRestarting forall (es :: Effects). Eff es a
effBody = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Control.Exception.mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    MVar ThreadId
tidVar <- IO (MVar ThreadId)
forall a. IO (MVar a)
newEmptyMVar
    MVar (Either SomeException a)
done <- IO (MVar (Either SomeException a))
forall a. IO (MVar a)
newEmptyMVar

    let body :: IO (Either SomeException a)
body = do
          ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
            Either SomeException a
r <-
              forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try @Control.Exception.SomeException (IO a -> IO (Either SomeException a))
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$
                IO a -> IO a
forall a. IO a -> IO a
restore (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
                  (forall (e :: Effects). IOE e -> Eff e a) -> IO a
forall a. (forall (e :: Effects). IOE e -> Eff e a) -> IO a
runEff (\IOE e
_ -> Eff e a
forall (es :: Effects). Eff es a
effBody)
            MVar (Either SomeException a) -> Either SomeException a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException a)
done Either SomeException a
r
          MVar ThreadId -> ThreadId -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ThreadId
tidVar ThreadId
tid
          MVar (Either SomeException a) -> IO (Either SomeException a)
forall a. MVar a -> IO a
takeMVar MVar (Either SomeException a)
done

    Either SomeException a
r <- (IO (Either SomeException a) -> IO (Either SomeException a))
-> IO (Either SomeException a)
forall a. (a -> a) -> a
fix ((IO (Either SomeException a) -> IO (Either SomeException a))
 -> IO (Either SomeException a))
-> (IO (Either SomeException a) -> IO (Either SomeException a))
-> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ \IO (Either SomeException a)
again -> do
      Either SomeException (Either SomeException a)
attempted <-
        IO (Either SomeException (Either SomeException a))
-> IO (Either SomeException (Either SomeException a))
forall a. IO a -> IO a
restore (IO (Either SomeException (Either SomeException a))
 -> IO (Either SomeException (Either SomeException a)))
-> IO (Either SomeException (Either SomeException a))
-> IO (Either SomeException (Either SomeException a))
forall a b. (a -> b) -> a -> b
$
          forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try @Control.Exception.SomeException IO (Either SomeException a)
body
      case Either SomeException (Either SomeException a)
attempted of
        Left SomeException
ex -> do
          ThreadId
tid <- MVar ThreadId -> IO ThreadId
forall a. MVar a -> IO a
takeMVar MVar ThreadId
tidVar
          ThreadId -> IO ()
killThread ThreadId
tid
          Either SomeException a
_ <- MVar (Either SomeException a) -> IO (Either SomeException a)
forall a. MVar a -> IO a
takeMVar MVar (Either SomeException a)
done
          ThreadId
myself <- IO ThreadId
myThreadId
          ThreadId -> SomeException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
myself SomeException
ex
          IO (Either SomeException a)
again
        Right Either SomeException a
result -> Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
result

    case Either SomeException a
r of
      Left SomeException
l -> SomeException -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO SomeException
l
      Right a
r' -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r'

unsafeCoerceEff :: Eff t r -> Eff t' r
unsafeCoerceEff :: forall (t :: Effects) r (t' :: Effects). Eff t r -> Eff t' r
unsafeCoerceEff = Eff t r -> Eff t' r
forall a b. Coercible a b => a -> b
coerce

weakenEff :: t `In` t' -> Eff t r -> Eff t' r
weakenEff :: forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff (In# (# #)) = Eff t r -> Eff t' r
forall (t :: Effects) r (t' :: Effects). Eff t r -> Eff t' r
unsafeCoerceEff

insertFirst :: Eff b r -> Eff (c1 :& b) r
insertFirst :: forall (b :: Effects) r (c1 :: Effects). Eff b r -> Eff (c1 :& b) r
insertFirst = In b (c1 :& b) -> Eff b r -> Eff (c1 :& b) r
forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff (In b b -> In b (c1 :& b)
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In a (c :& b)
drop (ZW -> In b b
forall (a :: Effects). ZW -> In a a
eq (# #) -> ZW
ZW))

insertSecond :: Eff (c1 :& b) r -> Eff (c1 :& (c2 :& b)) r
insertSecond :: forall (c1 :: Effects) (b :: Effects) r (c2 :: Effects).
Eff (c1 :& b) r -> Eff (c1 :& (c2 :& b)) r
insertSecond = Eff (c1 :& b) r -> Eff (c1 :& (c2 :& b)) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
insertManySecond

insertManySecond :: (b <: c) => Eff (c1 :& b) r -> Eff (c1 :& c) r
insertManySecond :: forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
insertManySecond = In (c1 :& b) (c1 :& c) -> Eff (c1 :& b) r -> Eff (c1 :& c) r
forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff (In c1 c1 -> In b c -> In (c1 :& b) (c1 :& c)
forall (a :: Effects) (b :: Effects) (c :: Effects) (d :: Effects).
In a b -> In c d -> In (a :& c) (b :& d)
bimap In c1 c1
forall (a :: Effects) (b :: Effects). (a <: b) => In a b
has In b c
forall (a :: Effects) (b :: Effects). (a <: b) => In a b
has)

assoc1Eff :: Eff ((a :& b) :& c) r -> Eff (a :& (b :& c)) r
assoc1Eff :: forall (a :: Effects) (b :: Effects) (c :: Effects) r.
Eff ((a :& b) :& c) r -> Eff (a :& (b :& c)) r
assoc1Eff = In ((a :& b) :& c) (a :& (b :& c))
-> Eff ((a :& b) :& c) r -> Eff (a :& (b :& c)) r
forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff (ZW -> In ((a :& b) :& c) (a :& (b :& c))
forall (a :: Effects) (b :: Effects) (c :: Effects).
ZW -> In ((a :& b) :& c) (a :& (b :& c))
assoc1 (# #) -> ZW
ZW)

pushFirst :: Eff a r -> Eff (a :& b) r
pushFirst :: forall (a :: Effects) r (b :: Effects). Eff a r -> Eff (a :& b) r
pushFirst = In a (a :& b) -> Eff a r -> Eff (a :& b) r
forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff (ZW -> In a (a :& b)
forall (a :: Effects) (b :: Effects). ZW -> In a (a :& b)
fstI (# #) -> ZW
ZW)

mergeEff :: Eff (a :& a) r -> Eff a r
mergeEff :: forall (a :: Effects) r. Eff (a :& a) r -> Eff a r
mergeEff = In (a :& a) a -> Eff (a :& a) r -> Eff a r
forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff (ZW -> In (a :& a) a
forall (a :: Effects). ZW -> In (a :& a) a
merge (# #) -> ZW
ZW)

inContext :: (e2 <: e1) => Eff (e1 :& e2) r -> Eff e1 r
inContext :: forall (e2 :: Effects) (e1 :: Effects) r.
(e2 <: e1) =>
Eff (e1 :& e2) r -> Eff e1 r
inContext = In (e1 :& e2) e1 -> Eff (e1 :& e2) r -> Eff e1 r
forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff (In e2 e1 -> In (e1 :& e2) e1
forall (e2 :: Effects) (e1 :: Effects).
In e2 e1 -> In (e1 :& e2) e1
subsume1 In e2 e1
forall (a :: Effects) (b :: Effects). (a <: b) => In a b
has)

-- | Used to define dynamic effects.
makeOp :: Eff (e :& e) r -> Eff e r
makeOp :: forall (a :: Effects) r. Eff (a :& a) r -> Eff a r
makeOp = Eff (e :& e) r -> Eff e r
forall (e2 :: Effects) (e1 :: Effects) r.
(e2 <: e1) =>
Eff (e1 :& e2) r -> Eff e1 r
inContext

-- | Used to define dynamic effects.
useImpl :: (e <: es) => Eff e r -> Eff es r
useImpl :: forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl = In e es -> Eff e r -> Eff es r
forall (t :: Effects) (t' :: Effects) r.
In t t' -> Eff t r -> Eff t' r
weakenEff In e es
forall (a :: Effects) (b :: Effects). (a <: b) => In a b
has

-- | Like 'useImpl'
useImplUnder ::
  (e <: es) =>
  Eff (e1 :& e) r ->
  -- | ͘
  Eff (e1 :& es) r
useImplUnder :: forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder = Eff (e1 :& e) r -> Eff (e1 :& es) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
insertManySecond

-- | Used to define handlers of compound effects.
useImplIn ::
  (e <: es) =>
  (t -> Eff (es :& e) r) ->
  t ->
  -- | ͘
  Eff es r
useImplIn :: forall (e :: Effects) (es :: Effects) t r.
(e <: es) =>
(t -> Eff (es :& e) r) -> t -> Eff es r
useImplIn t -> Eff (es :& e) r
f t
h = Eff (es :& e) r -> Eff es r
forall (e2 :: Effects) (e1 :: Effects) r.
(e2 <: e1) =>
Eff (e1 :& e2) r -> Eff e1 r
inContext (t -> Eff (es :& e) r
f t
h)

-- | Deprecated.  Use 'useImplUnder' instead.
useImplWithin ::
  (e <: es) =>
  (t -> Eff (e1 :& e) r) ->
  t ->
  -- | ͘
  Eff (e1 :& es) r
useImplWithin :: forall (e :: Effects) (es :: Effects) t (e1 :: Effects) r.
(e <: es) =>
(t -> Eff (e1 :& e) r) -> t -> Eff (e1 :& es) r
useImplWithin t -> Eff (e1 :& e) r
k = Eff (e1 :& e) r -> Eff (e1 :& es) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder (Eff (e1 :& e) r -> Eff (e1 :& es) r)
-> (t -> Eff (e1 :& e) r) -> t -> Eff (e1 :& es) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Eff (e1 :& e) r
k

-- | Capability to create strict mutable state capabilities
data StateSource (e :: Effects) = StateSource

type role StateSource nominal

-- | Capability to throw an exception of type @exn@
newtype Throw exn (e :: Effects)
  = MkException (forall a. exn -> Eff e a)
  deriving (HandleD (Throw exn)
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (Throw exn e) (Throw exn es)) =>
HandleD (Throw exn) -> Handle (Throw exn)
forall exn. HandleD (Throw exn)
forall exn (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Throw exn e) (Throw exn es)
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Throw exn e) (Throw exn es)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
$chandleImpl :: forall exn. HandleD (Throw exn)
handleImpl :: HandleD (Throw exn)
Handle) via OneWayCoercibleHandle (Throw exn)

type role Throw representational nominal

instance (e <: es) => OneWayCoercible (Throw ex e) (Throw ex es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (Throw ex e) (Throw ex es)
oneWayCoercibleImpl = OneWayCoercibleD (Throw ex e) (Throw ex es)
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible

-- | A scoped exception capability that can catch within its own scope.
type ThrowCatch :: Type -> Effects -> Type
newtype ThrowCatch ex e
  = MkThrowCatch (ScopedException.Exception ex)
  deriving (HandleD (ThrowCatch ex)
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (ThrowCatch ex e) (ThrowCatch ex es)) =>
HandleD (ThrowCatch ex) -> Handle (ThrowCatch ex)
forall ex. HandleD (ThrowCatch ex)
forall ex (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (ThrowCatch ex e) (ThrowCatch ex es)
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (ThrowCatch ex e) (ThrowCatch ex es)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
$chandleImpl :: forall ex. HandleD (ThrowCatch ex)
handleImpl :: HandleD (ThrowCatch ex)
Handle) via OneWayCoercibleHandle (ThrowCatch ex)

type role ThrowCatch nominal nominal

instance
  (e <: es) =>
  OneWayCoercible (ThrowCatch ex e) (ThrowCatch ex es)
  where
  oneWayCoercibleImpl :: OneWayCoercibleD (ThrowCatch ex e) (ThrowCatch ex es)
oneWayCoercibleImpl = OneWayCoercibleD (ThrowCatch ex e) (ThrowCatch ex es)
forall {k} (a :: k) (b :: k). OneWayCoercibleD a b
unsafeOneWayCoercible

-- | Capability to modify a reference to an @s@
newtype Modify s (e :: Effects) = UnsafeMkState (IORef s)
  deriving (HandleD (Modify s)
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (Modify s e) (Modify s es)) =>
HandleD (Modify s) -> Handle (Modify s)
forall s. HandleD (Modify s)
forall s (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Modify s e) (Modify s es)
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Modify s e) (Modify s es)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
$chandleImpl :: forall s. HandleD (Modify s)
handleImpl :: HandleD (Modify s)
Handle) via OneWayCoercibleHandle (Modify s)

type role Modify representational nominal

instance (e <: es) => OneWayCoercible (Modify s e) (Modify s es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (Modify s e) (Modify s es)
oneWayCoercibleImpl = OneWayCoercibleD (Modify s e) (Modify s es)
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible

-- | Capability to yield a value of type @a@ and then await a value of
-- type @b@ in response.
newtype Request a b (e :: Effects) = MkCoroutine (a -> Eff e b)
  deriving (HandleD (Request a b)
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (Request a b e) (Request a b es)) =>
HandleD (Request a b) -> Handle (Request a b)
forall a b. HandleD (Request a b)
forall a b (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Request a b e) (Request a b es)
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Request a b e) (Request a b es)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
$chandleImpl :: forall a b. HandleD (Request a b)
handleImpl :: HandleD (Request a b)
Handle) via OneWayCoercibleHandle (Request a b)

instance (e <: es) => OneWayCoercible (Request a b e) (Request a b es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (Request a b e) (Request a b es)
oneWayCoercibleImpl = OneWayCoercibleD (Request a b e) (Request a b es)
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible

-- | Capability to yield values of type @a@.  It is implemented as a
-- 'Bluefin.Capability.Request' capability that can yield values of
-- type @a@ and then await values of type @()@.
type Yield a = Request a ()

type Await a = Request () a

-- | Every Bluefin capability should have an instance of class @Handle@.
-- Built-in capabilities, such as 'Throw', 'Modify' and 'IOE', come with
-- @Handle@ instances.
--
-- You should define a @Handle@ instance for each capability that you
-- define yourself.  As
-- an example, an "application" capability with a dynamic effect for
-- database queries, a concrete effect for application state and a
-- concrete effect for a logging effect might look like this:
--
-- @
-- data Application e = MkApplication
--   { queryDatabase :: String -> Int -> Eff e [String],
--     applicationState :: Modify (Int, Bool) e,
--     logger :: Yield String e
--   }
--   deriving (Generic)
--   deriving (Handle) via 'OneWayCoercibleHandle' Application
--
-- instance (e \<: es) => 'OneWayCoercible' (Application e) (Application es) where
--   oneWayCoercibleImpl = 'gOneWayCoercible'
-- @
--
-- In occasional cases, @gOneWayCoercible@ won't work, in which can
-- you can instead use
--
-- @
-- instance (e \<: es) => OneWayCoercible (MyCapability e) (MyCapability es) where
--   oneWayCoercibleImpl = 'oneWayCoercibleTrustMe' $ \\h -> \<mapHandle definition\>
-- @
--
-- Please note the "handle" nomeclature is legacy and will probably
-- change to "capability" in the future.  See "Bluefin.Capability".
class
  (forall e es. (e <: es) => OneWayCoercible (h e) (h es)) =>
  Handle (h :: Effects -> Type)
  where
  handleImpl :: HandleD h

-- | This was previously a method of class 'Handle' using which you
-- could define @Handle@ instances. Now, you should define
-- @handleImpl@ instead.  If you previously had a definition of
-- @mapHandle@, for example like this:
--
-- @
-- instance Handle MyCapability where
--   mapHandle h = \<mapHandle definition\>
-- @
--
-- you should change it to
--
-- @
-- data MyCapability e = ...
--   deriving (Generic)
--   deriving (Handle) via 'OneWayCoercibleHandle' MyCapability
--
-- instance (e \<: es) => 'OneWayCoercible' (MyCapability e) (MyCapability es) where
--   'oneWayCoercibleImpl' = 'gOneWayCoercible'
-- @
--
-- In occasional cases, @gOneWayCoercible@ won't work, in which can
-- you can instead use
--
-- @
-- instance (e \<: es) => OneWayCoercible (MyCapability e) (MyCapability es) where
--   oneWayCoercibleImpl = 'oneWayCoercibleTrustMe' $ \\h -> \<mapHandle definition\>
-- @
mapHandle :: forall h e es. (Handle h, e <: es) => h e -> h es
mapHandle :: forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e <: es) =>
h e -> h es
mapHandle = h e -> h es
forall a b. OneWayCoercible a b => a -> b
unsafeOneWayCoerce

withHandle ::
  forall h r.
  (Handle h) =>
  -- | ͘
  ((forall e es. (e <: es) => OneWayCoercible (h e) (h es)) => r) ->
  r
withHandle :: forall (h :: Effects -> *) r.
Handle h =>
((forall (e :: Effects) (es :: Effects).
  (e <: es) =>
  OneWayCoercible (h e) (h es)) =>
 r)
-> r
withHandle (forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
r
r = r
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
r
r

type HandleDict :: (Effects -> Type) -> Type
data HandleDict h where
  MkHandleDict ::
    (forall e es. (e <: es) => OneWayCoercible (h e) (h es)) =>
    HandleDict h

type role HandleDict nominal

-- The essential properties of HandleD h are
--
-- (defining Handle' h =
--    forall e es. (e <: es) => OneWayCoercible (h e) (h es))
--
-- 1. It can be created by having Handle' h in scope
--
-- 2. Having it can put Handle' h into scope
--
-- 3. There is an instance
--
--      Coercible h1 h2 => Coercible (Handle' h1) (Handle' h2)
--
-- 1 is used by handleOneWayCoercible
--
-- 2 is used by withHandle
--
-- 3 is used by deriving via of OneWayCoercibleHandle
--
-- The only way I have worked out how to satisfy all three properties
-- is to have `HandleD h` not depend on `h`, instead have `Any` in
-- place of where we would use `h`.  That way we can get property 3
-- (which requires cooperation with GHC) and achieve properties 1 and
-- 2 by unsafeCoerce.

-- | The type of the 'handleImpl' method of the 'Handle' class.
-- Create a @HandleD@ using deriving via of 'OneWayCoercibleHandle'.
type HandleD :: (Effects -> Type) -> Type
newtype HandleD h = MkHandleD (HandleDict Any)

handleDictOfHandleD :: HandleD h -> HandleDict h
-- SPJ suggests this might be safe on ghc-devs
--
-- https://mailman.haskell.org/archives/list/ghc-devs@haskell.org/thread/A4AJPPA3WSORHKCMFWAFX26XNQQVYT5R/
handleDictOfHandleD :: forall (h :: Effects -> *). HandleD h -> HandleDict h
handleDictOfHandleD (MkHandleD HandleDict Any
f) = HandleDict Any -> HandleDict h
forall a b. a -> b
unsafeCoerce HandleDict Any
f

handleDictImpl :: (Handle h) => HandleDict h
handleDictImpl :: forall (h :: Effects -> *). Handle h => HandleDict h
handleDictImpl = HandleD h -> HandleDict h
forall (h :: Effects -> *). HandleD h -> HandleDict h
handleDictOfHandleD HandleD h
forall (h :: Effects -> *). Handle h => HandleD h
handleImpl

type role HandleD representational

handleOneWayCoercible ::
  forall h.
  (forall e es. (e <: es) => OneWayCoercible (h e) (h es)) =>
  -- | ͘
  HandleD h
-- SPJ suggests this might be safe on ghc-devs
--
-- https://mailman.haskell.org/archives/list/ghc-devs@haskell.org/thread/A4AJPPA3WSORHKCMFWAFX26XNQQVYT5R/
handleOneWayCoercible :: forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h
handleOneWayCoercible = HandleDict Any -> HandleD h
forall (h :: Effects -> *). HandleDict Any -> HandleD h
MkHandleD (HandleDict h -> HandleDict Any
forall a b. a -> b
unsafeCoerce (forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleDict h
MkHandleDict @h))

instance (Handle h) => Handle (Rec1 h) where
  handleImpl :: HandleD (Rec1 h)
handleImpl = HandleD (Rec1 h)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h
handleOneWayCoercible

instance (Handle h) => Handle (M1 i t h) where
  handleImpl :: HandleD (M1 i t h)
handleImpl = HandleD (M1 i t h)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h
handleOneWayCoercible

instance (Handle h1, Handle h2) => Handle (h1 :*: h2) where
  handleImpl :: HandleD (h1 :*: h2)
handleImpl = HandleD (h1 :*: h2)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h
handleOneWayCoercible

-- | It is not always possible to derive an instance of
-- 'OneWayCoercible'.  In such cases write a definition of
-- 'oneWayCoercibleImpl' using @oneWayCoercibleTrustMe@.  Its argument
-- must be a total function mapping the effect parameter of @h@.
-- Normally you'll write the function by mapping the constitients of
-- @h@ using the functions in this module like 'mapHandle', 'useImpl'
-- and 'useImplUnder'.
--
-- If this function is not total then it's possible you are violating
-- the type system, which could lead to segfaults or worse.  It's not
-- easy to supply a partial function by accident, but be careful!
-- (N.B. it must not be literally @mapHandle@ otherwise you'll have a
-- circular definition!)
oneWayCoercibleTrustMe ::
  (e <: es) =>
  (forall e' es'. (e' <: es') => h e' -> h es') ->
  -- | ͘
  OneWayCoercibleD (h e) (h es)
-- Forcing the argument doesn't do much of a check, but it is
-- something
oneWayCoercibleTrustMe :: forall (e :: Effects) (es :: Effects) (h :: Effects -> *).
(e <: es) =>
(forall (e' :: Effects) (es' :: Effects).
 (e' <: es') =>
 h e' -> h es')
-> OneWayCoercibleD (h e) (h es)
oneWayCoercibleTrustMe !forall (e' :: Effects) (es' :: Effects).
(e' <: es') =>
h e' -> h es'
_ = OneWayCoercibleD (h e) (h es)
forall {k} (a :: k) (b :: k). OneWayCoercibleD a b
unsafeOneWayCoercible

-- { OneWayCoercibleHandle

-- | 'OneWayCoercibleHandle' is used to derive 'Handle' instances
-- using @DerivingVia@.  Make sure you import the constructor, for
-- example using a wildcard import like this
--
-- @
-- import Bluefin.Compound (OneWayCoercibleHandle (..))
-- @
--
-- because if you /only/ import the type like this
--
-- @
-- import Bluefin.Compound (OneWayCoercibleHandle)
-- @
--
-- then @deriving via OneWayCoercibleHandle ...@ will not work. The
-- constructor needs to be in scope.
newtype OneWayCoercibleHandle a es = MkOneWayCoercibleHandle (a es)
  deriving stock ((forall x.
 OneWayCoercibleHandle a es -> Rep (OneWayCoercibleHandle a es) x)
-> (forall x.
    Rep (OneWayCoercibleHandle a es) x -> OneWayCoercibleHandle a es)
-> Generic (OneWayCoercibleHandle a es)
forall x.
Rep (OneWayCoercibleHandle a es) x -> OneWayCoercibleHandle a es
forall x.
OneWayCoercibleHandle a es -> Rep (OneWayCoercibleHandle a es) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (a :: k -> *) (es :: k) x.
Rep (OneWayCoercibleHandle a es) x -> OneWayCoercibleHandle a es
forall k (a :: k -> *) (es :: k) x.
OneWayCoercibleHandle a es -> Rep (OneWayCoercibleHandle a es) x
$cfrom :: forall k (a :: k -> *) (es :: k) x.
OneWayCoercibleHandle a es -> Rep (OneWayCoercibleHandle a es) x
from :: forall x.
OneWayCoercibleHandle a es -> Rep (OneWayCoercibleHandle a es) x
$cto :: forall k (a :: k -> *) (es :: k) x.
Rep (OneWayCoercibleHandle a es) x -> OneWayCoercibleHandle a es
to :: forall x.
Rep (OneWayCoercibleHandle a es) x -> OneWayCoercibleHandle a es
Generic)

instance
  forall h.
  (forall e' es'. (e' <: es') => OneWayCoercible (OneWayCoercibleHandle h e') (OneWayCoercibleHandle h es')) =>
  Handle (OneWayCoercibleHandle h)
  where
  handleImpl :: HandleD (OneWayCoercibleHandle h)
handleImpl = HandleD (OneWayCoercibleHandle h)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h
handleOneWayCoercible

instance
  (OneWayCoercible (h e) (h es)) =>
  OneWayCoercible (OneWayCoercibleHandle h e) (OneWayCoercibleHandle h es)
  where
  oneWayCoercibleImpl :: OneWayCoercibleD
  (OneWayCoercibleHandle h e) (OneWayCoercibleHandle h es)
oneWayCoercibleImpl = OneWayCoercibleD
  (OneWayCoercibleHandle h e) (OneWayCoercibleHandle h es)
forall {k} (h :: k -> *) (e :: k) (es :: k).
GOneWayCoercible (Rep (h e)) (Rep (h es)) =>
OneWayCoercibleD (h e) (h es)
gOneWayCoercible

-- }

-- | For defining 'OneWayCoercible' instances for newtypes. Example:
--
-- @
-- newtype Random g e = Random (Modify g e)
--   deriving (Handle) via OneWayCoercibleHandle (Random g)
--
-- instance (e \<: es) => OneWayCoercible (Random g e) (Random g es) where
--   oneWayCoercibleImpl = oneWayCoercibleNewtypeHandle @(Modify g)
-- @
oneWayCoercibleNewtypeHandle ::
  forall h1 h2 e es.
  (e :> es) =>
  ( Coercible (h2 e) (h1 e),
    OneWayCoercible (h1 e) (h1 es),
    Coercible (h1 es) (h2 es)
  ) =>
  -- | ͘
  OneWayCoercibleD (h2 e) (h2 es)
oneWayCoercibleNewtypeHandle :: forall {k} (h1 :: Effects -> k) (h2 :: Effects -> k) (e :: Effects)
       (es :: Effects).
(e :> es, Coercible (h2 e) (h1 e), OneWayCoercible (h1 e) (h1 es),
 Coercible (h1 es) (h2 es)) =>
OneWayCoercibleD (h2 e) (h2 es)
oneWayCoercibleNewtypeHandle =
  OneWayCoercibleD (h2 e) (h1 e)
-> OneWayCoercibleD (h1 e) (h1 es)
-> OneWayCoercibleD (h1 es) (h2 es)
-> OneWayCoercibleD (h2 e) (h2 es)
forall {k} (t1 :: k) (t2 :: k) (t3 :: k) (t4 :: k).
OneWayCoercibleD t1 t2
-> OneWayCoercibleD t2 t3
-> OneWayCoercibleD t3 t4
-> OneWayCoercibleD t1 t4
trans3D
    (forall (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible @(h2 e) @(h1 e))
    (forall (a :: k) (b :: k).
OneWayCoercible a b =>
OneWayCoercibleD a b
forall {k} (a :: k) (b :: k).
OneWayCoercible a b =>
OneWayCoercibleD a b
oneWayCoercibleImpl @(h1 e) @(h1 es))
    (forall (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible @(h1 es) @(h2 es))

-- | A convenience type whose only purpose is to avoid writing @(# #)@
-- as an argument to functions which are only functions because
-- top-level definitions of unlifted kind are forbidden.
newtype ZW = MkZW (# #)

pattern ZW :: ZW
pattern $mZW :: forall {r}. ZW -> ((# #) -> r) -> ((# #) -> r) -> r
$bZW :: (# #) -> ZW
ZW <- MkZW (# #)
  where
    ZW = (# #) -> ZW
MkZW (# #)

{-# COMPLETE ZW #-}

newtype In (a :: Effects) (b :: Effects) = In# (# #)

unsafeInAxiom :: ZW -> e1 `In` e2
unsafeInAxiom :: forall (e1 :: Effects) (e2 :: Effects). ZW -> In e1 e2
unsafeInAxiom ZW
ZW = (# #) -> In e1 e2
forall (a :: Effects) (b :: Effects). (# #) -> In a b
In# (# #)

merge :: ZW -> (a :& a) `In` a
merge :: forall (a :: Effects). ZW -> In (a :& a) a
merge ZW
ZW = (# #) -> In (a :& a) a
forall (a :: Effects) (b :: Effects). (# #) -> In a b
In# (# #)

eq :: ZW -> a `In` a
eq :: forall (a :: Effects). ZW -> In a a
eq ZW
ZW = ZW -> In a a
forall (e1 :: Effects) (e2 :: Effects). ZW -> In e1 e2
unsafeInAxiom (# #) -> ZW
ZW

fstI :: ZW -> a `In` (a :& b)
fstI :: forall (a :: Effects) (b :: Effects). ZW -> In a (a :& b)
fstI ZW
ZW = ZW -> In a (a :& b)
forall (e1 :: Effects) (e2 :: Effects). ZW -> In e1 e2
unsafeInAxiom (# #) -> ZW
ZW

sndI :: ZW -> a `In` (b :& a)
sndI :: forall (a :: Effects) (b :: Effects). ZW -> In a (b :& a)
sndI ZW
ZW = ZW -> In a (b :& a)
forall (e1 :: Effects) (e2 :: Effects). ZW -> In e1 e2
unsafeInAxiom (# #) -> ZW
ZW

cmp :: a `In` b -> b `In` c -> a `In` c
cmp :: forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In b c -> In a c
cmp (In# (# #)) (In# (# #)) = ZW -> In a c
forall (e1 :: Effects) (e2 :: Effects). ZW -> In e1 e2
unsafeInAxiom (# #) -> ZW
ZW

bimap :: a `In` b -> c `In` d -> (a :& c) `In` (b :& d)
bimap :: forall (a :: Effects) (b :: Effects) (c :: Effects) (d :: Effects).
In a b -> In c d -> In (a :& c) (b :& d)
bimap (In# (# #)) (In# (# #)) = ZW -> In (a :& c) (b :& d)
forall (e1 :: Effects) (e2 :: Effects). ZW -> In e1 e2
unsafeInAxiom (# #) -> ZW
ZW

assoc1 :: ZW -> ((a :& b) :& c) `In` (a :& (b :& c))
assoc1 :: forall (a :: Effects) (b :: Effects) (c :: Effects).
ZW -> In ((a :& b) :& c) (a :& (b :& c))
assoc1 ZW
ZW = ZW -> In ((a :& b) :& c) (a :& (b :& c))
forall (e1 :: Effects) (e2 :: Effects). ZW -> In e1 e2
unsafeInAxiom (# #) -> ZW
ZW

drop :: a `In` b -> a `In` (c :& b)
drop :: forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In a (c :& b)
drop In a b
h = In (c :& a) (c :& b) -> In a (c :& b)
forall (b :: Effects) (a :: Effects) (c :: Effects).
In (b :& a) c -> In a c
w2 (In a b -> In (c :& a) (c :& b)
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In (c :& a) (c :& b)
b In a b
h)

here :: a `In` b -> (a `In` (b :& c))
here :: forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In a (b :& c)
here In a b
h = In (a :& c) (b :& c) -> In a (b :& c)
forall (a :: Effects) (b :: Effects) (c :: Effects).
In (a :& b) c -> In a c
w (In a b -> In (a :& c) (b :& c)
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In (a :& c) (b :& c)
b2 In a b
h)

w :: (a :& b) `In` c -> (a `In` c)
w :: forall (a :: Effects) (b :: Effects) (c :: Effects).
In (a :& b) c -> In a c
w = In a (a :& b) -> In (a :& b) c -> In a c
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In b c -> In a c
cmp (ZW -> In a (a :& b)
forall (a :: Effects) (b :: Effects). ZW -> In a (a :& b)
fstI (# #) -> ZW
ZW)

w2 :: (b :& a) `In` c -> (a `In` c)
w2 :: forall (b :: Effects) (a :: Effects) (c :: Effects).
In (b :& a) c -> In a c
w2 = In a (b :& a) -> In (b :& a) c -> In a c
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In b c -> In a c
cmp (ZW -> In a (b :& a)
forall (a :: Effects) (b :: Effects). ZW -> In a (b :& a)
sndI (# #) -> ZW
ZW)

b2 :: (a `In` b) -> ((a :& c) `In` (b :& c))
b2 :: forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In (a :& c) (b :& c)
b2 In a b
h = In a b -> In c c -> In (a :& c) (b :& c)
forall (a :: Effects) (b :: Effects) (c :: Effects) (d :: Effects).
In a b -> In c d -> In (a :& c) (b :& d)
bimap In a b
h (ZW -> In c c
forall (a :: Effects). ZW -> In a a
eq (# #) -> ZW
ZW)

b :: (a `In` b) -> (c :& a) `In` (c :& b)
b :: forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In (c :& a) (c :& b)
b = In c c -> In a b -> In (c :& a) (c :& b)
forall (a :: Effects) (b :: Effects) (c :: Effects) (d :: Effects).
In a b -> In c d -> In (a :& c) (b :& d)
bimap (ZW -> In c c
forall (a :: Effects). ZW -> In a a
eq (# #) -> ZW
ZW)

subsume1 :: (e2 `In` e1) -> (e1 :& e2) `In` e1
subsume1 :: forall (e2 :: Effects) (e1 :: Effects).
In e2 e1 -> In (e1 :& e2) e1
subsume1 In e2 e1
i = In (e1 :& e2) (e1 :& e1) -> In (e1 :& e1) e1 -> In (e1 :& e2) e1
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In b c -> In a c
cmp (In e1 e1 -> In e2 e1 -> In (e1 :& e2) (e1 :& e1)
forall (a :: Effects) (b :: Effects) (c :: Effects) (d :: Effects).
In a b -> In c d -> In (a :& c) (b :& d)
bimap (ZW -> In e1 e1
forall (a :: Effects). ZW -> In a a
eq (# #) -> ZW
ZW) In e2 e1
i) (ZW -> In (e1 :& e1) e1
forall (a :: Effects). ZW -> In (a :& a) a
merge (# #) -> ZW
ZW)

subsume2 :: (e1 `In` e2) -> (e1 :& e2) `In` e2
subsume2 :: forall (e1 :: Effects) (e2 :: Effects).
In e1 e2 -> In (e1 :& e2) e2
subsume2 In e1 e2
i = In (e1 :& e2) (e2 :& e2) -> In (e2 :& e2) e2 -> In (e1 :& e2) e2
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In b c -> In a c
cmp (In e1 e2 -> In e2 e2 -> In (e1 :& e2) (e2 :& e2)
forall (a :: Effects) (b :: Effects) (c :: Effects) (d :: Effects).
In a b -> In c d -> In (a :& c) (b :& d)
bimap In e1 e2
i (ZW -> In e2 e2
forall (a :: Effects). ZW -> In a a
eq (# #) -> ZW
ZW)) (ZW -> In (e2 :& e2) e2
forall (a :: Effects). ZW -> In (a :& a) a
merge (# #) -> ZW
ZW)

-- | The subset constraint on sets of effect tags
--
-- Please use the type synonym '<:' instead of @:>@.  The former is a
-- better name for this constraint and @:>@ will be renamed @<:@ in a
-- future version.
class (es1 :: Effects) :> (es2 :: Effects)

-- | The subset constraint on sets of effect tags.  @<:@ is a type
-- operator (see the extension @TypeOperators@) so in order to import
-- it you need to use the @ExplicitNamespaces@ extension and the
-- @type@ import qualifier, like this:
--
-- @
-- {-# LANUGAGE ExplicitNamespaces #-}
-- import Bluefin.Eff (type (<:))
-- @
--
-- \"@<:@\" is a synonym for \"':>'\".  \"@<:@\" is a better name for
-- this constraint than \"@:>@\" because it is more evocative of
-- mathematical relations like @<@, @<=@, @⊂@ and @⊆@ which hold when
-- the argument on the left of the operator is "smaller than" the
-- argument on the right.  In the case of @<:@ we have that @e1 <: e2@
-- when the set of effect tags @e1@ is a subset of or equal to @e2@,
-- i.e. "@e1@ is smaller than (or equal to) @e2@".  For example, the
-- following constraints hold (note that ':&' is the union of sets of
-- effect tags):
--
-- * @e <: e@
-- * @e <: (e1 :& ... :& e :& ... :& en)@
type (<:) = (:>)

-- | A set of effects @e@ is a subset of itself
instance e :> e

instanceProof1 :: ZW -> e `In` e
instanceProof1 :: forall (a :: Effects). ZW -> In a a
instanceProof1 ZW
ZW = ZW -> In e e
forall (a :: Effects). ZW -> In a a
eq (# #) -> ZW
ZW

-- | If @e@ is subset of @es@ then @e@ is a subset of a larger set, @x
-- :& es@
instance {-# INCOHERENT #-} (e :> es) => e :> (x :& es)

instanceProof2 :: e `In` es -> e `In` (x :& es)
instanceProof2 :: forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In a (c :& b)
instanceProof2 = In e es -> In e (x :& es)
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In a (c :& b)
drop

-- Do we want this?
-- instance {-# incoherent #-} (e :> es) => (e' :& e) :> (e' :& es)

-- This seems a bit wobbly

-- | @e@ is a subset of a larger set @e :& es@
instance e :> (e :& es)

instanceProof3 :: ZW -> e `In` (e :& es)
instanceProof3 :: forall (a :: Effects) (b :: Effects). ZW -> In a (a :& b)
instanceProof3 ZW
ZW = ZW -> In e (e :& es)
forall (a :: Effects) (b :: Effects). ZW -> In a (a :& b)
fstI (# #) -> ZW
ZW

subset ::
  forall e1 es m.
  (Monad m) =>
  (e1 <: es) =>
  m ()
subset :: forall (e1 :: Effects) (es :: Effects) (m :: * -> *).
(Monad m, e1 <: es) =>
m ()
subset = forall (c :: Constraint) (m :: * -> *). (Monad m, c) => m ()
satisfied @(e1 <: es)

satisfied :: forall c m. (Monad m, c) => m ()
satisfied :: forall (c :: Constraint) (m :: * -> *). (Monad m, c) => m ()
satisfied = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

effTag :: Eff es (Proxy es)
effTag :: forall (es :: Effects). Eff es (Proxy es)
effTag = Proxy es -> Eff es (Proxy es)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Proxy es
forall {k} (t :: k). Proxy t
Proxy

handleTag :: h e -> Eff es (Proxy e)
handleTag :: forall {k} (h :: k -> *) (e :: k) (es :: Effects).
h e -> Eff es (Proxy e)
handleTag h e
_ = Proxy e -> Eff es (Proxy e)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Proxy e
forall {k} (t :: k). Proxy t
Proxy

-- |
-- @
-- >>> runPureEff $ try $ \\e -> do
--       throw e 42
--       pure "No exception thrown"
-- Left 42
-- @
--
-- @
-- >>> runPureEff $ try $ \\e -> do
--       pure "No exception thrown"
-- Right "No exception thrown"
-- @
throw ::
  (e <: es) =>
  Throw ex e ->
  -- | Value to throw
  ex ->
  Eff es a
throw :: forall (e :: Effects) (es :: Effects) ex a.
(e <: es) =>
Throw ex e -> ex -> Eff es a
throw Throw ex e
h = case Throw ex e -> Throw ex es
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e <: es) =>
h e -> h es
mapHandle Throw ex e
h of MkException forall a. ex -> Eff es a
throw_ -> ex -> Eff es a
forall a. ex -> Eff es a
throw_

throwCatchThrow ::
  (e <: es) =>
  ThrowCatch ex e ->
  ex ->
  Eff es a
throwCatchThrow :: forall (e :: Effects) (es :: Effects) ex a.
(e <: es) =>
ThrowCatch ex e -> ex -> Eff es a
throwCatchThrow (MkThrowCatch Exception ex
ex) ex
exn =
  (forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> IOE e -> IO a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io (Exception ex -> ex -> IO a
forall e a. Exception e -> e -> IO a
ScopedException.throw Exception ex
ex ex
exn)

has :: forall a b. (a <: b) => a `In` b
-- This is safe because, as shown by instanceProof1/2/3, the only way
-- to construct `a <: b` is if `a `In` b`.
has :: forall (a :: Effects) (b :: Effects). (a <: b) => In a b
has = ZW -> In a b
forall (e1 :: Effects) (e2 :: Effects). ZW -> In e1 e2
unsafeInAxiom (# #) -> ZW
ZW

data Dict c where
  Dict :: forall c. (c) => Dict c

unsafeCoerceDict :: forall c c'. Dict c -> Dict c'
unsafeCoerceDict :: forall (c :: Constraint) (c' :: Constraint). Dict c -> Dict c'
unsafeCoerceDict = forall a b. a -> b
unsafeCoerce @(Dict c) @(Dict c')

-- Seems like it could be better
have :: forall a b. a `In` b -> Dict (a <: b)
have :: forall (a :: Effects) (b :: Effects). In a b -> Dict (a <: b)
have In a b
_ = forall (c :: Constraint) (c' :: Constraint). Dict c -> Dict c'
unsafeCoerceDict @(a <: (a :& b)) @(a <: b) Dict (a <: (a :& b))
forall (c :: Constraint). c => Dict c
Dict

-- |
-- @
-- >>> runPureEff $ try $ \\e -> do
--       throw e 42
--       pure "No exception thrown"
-- Left 42
-- @
try ::
  forall exn (es :: Effects) a.
  (forall e. Throw exn e -> Eff (e :& es) a) ->
  -- | @Left@ if the exception was thrown, @Right@ otherwise
  Eff es (Either exn a)
try :: forall exn (es :: Effects) a.
(forall (e :: Effects). Throw exn e -> Eff (e :& es) a)
-> Eff es (Either exn a)
try forall (e :: Effects). Throw exn e -> Eff (e :& es) a
f =
  (forall (e :: Effects). ThrowCatch exn e -> Eff (e :& es) a)
-> Eff es (Either exn a)
forall ex (es :: Effects) a.
(forall (e :: Effects). ThrowCatch ex e -> Eff (e :& es) a)
-> Eff es (Either ex a)
throwCatchTry ((forall (e :: Effects). ThrowCatch exn e -> Eff (e :& es) a)
 -> Eff es (Either exn a))
-> (forall (e :: Effects). ThrowCatch exn e -> Eff (e :& es) a)
-> Eff es (Either exn a)
forall a b. (a -> b) -> a -> b
$ \ThrowCatch exn e
ex ->
    Throw exn e -> Eff (e :& es) a
forall (e :: Effects). Throw exn e -> Eff (e :& es) a
f ((forall a. exn -> Eff e a) -> Throw exn e
forall exn (e :: Effects).
(forall a. exn -> Eff e a) -> Throw exn e
MkException (ThrowCatch exn e -> exn -> Eff e a
forall (e :: Effects) (es :: Effects) ex a.
(e <: es) =>
ThrowCatch ex e -> ex -> Eff es a
throwCatchThrow ThrowCatch exn e
ex))

throwCatchTry ::
  (forall e. ThrowCatch ex e -> Eff (e :& es) a) ->
  Eff es (Either ex a)
throwCatchTry :: forall ex (es :: Effects) a.
(forall (e :: Effects). ThrowCatch ex e -> Eff (e :& es) a)
-> Eff es (Either ex a)
throwCatchTry forall (e :: Effects). ThrowCatch ex e -> Eff (e :& es) a
f =
  (forall (e :: Effects). IOE e -> Eff (e :& es) (Either ex a))
-> Eff es (Either ex a)
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) (Either ex a))
 -> Eff es (Either ex a))
-> (forall (e :: Effects). IOE e -> Eff (e :& es) (Either ex a))
-> Eff es (Either ex a)
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> do
    IOE e
-> ((forall {r}. Eff (e :& es) r -> IO r) -> IO (Either ex a))
-> Eff (e :& es) (Either ex a)
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO_ IOE e
io (((forall {r}. Eff (e :& es) r -> IO r) -> IO (Either ex a))
 -> Eff (e :& es) (Either ex a))
-> ((forall {r}. Eff (e :& es) r -> IO r) -> IO (Either ex a))
-> Eff (e :& es) (Either ex a)
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff (e :& es) r -> IO r
effToIO -> do
      (Exception ex -> IO a) -> IO (Either ex a)
forall e a. (Exception e -> IO a) -> IO (Either e a)
ScopedException.try ((Exception ex -> IO a) -> IO (Either ex a))
-> (Exception ex -> IO a) -> IO (Either ex a)
forall a b. (a -> b) -> a -> b
$ \Exception ex
ex -> do
        Eff (e :& es) a -> IO a
forall {r}. Eff (e :& es) r -> IO r
effToIO (ThrowCatch ex e -> Eff (e :& es) a
forall (e :: Effects). ThrowCatch ex e -> Eff (e :& es) a
f (Exception ex -> ThrowCatch ex e
forall ex (e :: Effects). Exception ex -> ThrowCatch ex e
MkThrowCatch Exception ex
ex))

-- |
-- @
-- >>> runPureEff $ handle (pure . show) $ \\e -> do
--       throw e 42
--       pure "No exception thrown"
-- "42"
-- @
handle ::
  forall exn (es :: Effects) a.
  -- | If the exception is thrown, apply this handler
  (exn -> Eff es a) ->
  (forall e. Throw exn e -> Eff (e :& es) a) ->
  Eff es a
handle :: forall exn (es :: Effects) a.
(exn -> Eff es a)
-> (forall (e :: Effects). Throw exn e -> Eff (e :& es) a)
-> Eff es a
handle exn -> Eff es a
h forall (e :: Effects). Throw exn e -> Eff (e :& es) a
f =
  (forall (e :: Effects). Throw exn e -> Eff (e :& es) a)
-> Eff es (Either exn a)
forall exn (es :: Effects) a.
(forall (e :: Effects). Throw exn e -> Eff (e :& es) a)
-> Eff es (Either exn a)
try Throw exn e -> Eff (e :& es) a
forall (e :: Effects). Throw exn e -> Eff (e :& es) a
f Eff es (Either exn a) -> (Either exn a -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left exn
e -> exn -> Eff es a
h exn
e
    Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | 'handle', but with the argument order swapped
catch ::
  forall exn (es :: Effects) a.
  (forall e. Throw exn e -> Eff (e :& es) a) ->
  -- | If the exception is thrown, apply this handler
  (exn -> Eff es a) ->
  Eff es a
catch :: forall exn (es :: Effects) a.
(forall (e :: Effects). Throw exn e -> Eff (e :& es) a)
-> (exn -> Eff es a) -> Eff es a
catch forall (e :: Effects). Throw exn e -> Eff (e :& es) a
f exn -> Eff es a
h = (exn -> Eff es a)
-> (forall (e :: Effects). Throw exn e -> Eff (e :& es) a)
-> Eff es a
forall exn (es :: Effects) a.
(exn -> Eff es a)
-> (forall (e :: Effects). Throw exn e -> Eff (e :& es) a)
-> Eff es a
handle exn -> Eff es a
h Throw exn e -> Eff (e :& es) a
forall (e :: Effects). Throw exn e -> Eff (e :& es) a
f

-- We really do need to have an IOE argument here because, it is not
-- determined which of Ex1 or Ex2 is produced in the following code,
-- due to pure exceptions being imprecise.
--
-- f :: IO (Either Ex1 (Either Ex2 a))
-- f = runEff $ \io -> do
--   try $ \e1 -> do
--     try $ \e2 -> do
--       rethrowIO io e1 $ do
--         rethrowIO io e2 $ doa
--           Control.Exception.throw Ex1) (Control.Exception.throw E2)

-- | Rethrow an exception raised by an 'IO' action as a Bluefin
-- exception.
--
-- @
-- 'runEff' $ \\io -> do
--   r \<- 'try' $ \\ex -> do
--     rethrowIO @'Control.Exception.IOException' io ex $ do
--       effIO io ('Prelude.readFile' "\/tmp\/doesnt-exist")
--
--   'effIO' io $ putStrLn $ case r of
--     Left e -> "Caught IOException:\\n" ++ show e
--     Right contents -> contents
-- @
--
-- @
-- Caught IOException:
-- \/tmp\/doesnt-exist: openFile: does not exist (No such file or directory)
-- @
rethrowIO ::
  forall ex es e1 e2 r.
  (e1 <: es, e2 <: es, Control.Exception.Exception ex) =>
  IOE e1 ->
  Throw ex e2 ->
  Eff es r ->
  -- | ͘
  Eff es r
rethrowIO :: forall ex (es :: Effects) (e1 :: Effects) (e2 :: Effects) r.
(e1 <: es, e2 <: es, Exception ex) =>
IOE e1 -> Throw ex e2 -> Eff es r -> Eff es r
rethrowIO IOE e1
io Throw ex e2
ex Eff es r
body =
  IOE e1 -> ((forall {r}. Eff es r -> IO r) -> IO r) -> Eff es r
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO_ IOE e1
io (((forall {r}. Eff es r -> IO r) -> IO r) -> Eff es r)
-> ((forall {r}. Eff es r -> IO r) -> IO r) -> Eff es r
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff es r -> IO r
effToIO -> do
    IO r -> (ex -> IO r) -> IO r
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch
      (Eff es r -> IO r
forall {r}. Eff es r -> IO r
effToIO Eff es r
body)
      (\ex
e -> Eff es r -> IO r
forall {r}. Eff es r -> IO r
effToIO (forall (e :: Effects) (es :: Effects) ex a.
(e <: es) =>
Throw ex e -> ex -> Eff es a
throw @_ @es Throw ex e2
ex ex
e))

-- | @bracket acquire release body@: @acquire@ a resource, perform the
-- @body@ with it, and @release@ the resource even if @body@ threw an
-- exception.  This is essentially the same as
-- @Control.Exception.'Control.Exception.bracket'@, whose
-- documentation you can inspect for further details.
--
-- @bracket@ has a very general type that does not require @es@ to
-- contain an exception or IO effect. The reason that this is safe is:
--
--    * While @bracket@ does catch exceptions, this is unobservable,
--      since the exception is re-thrown; the cleanup action happens
--      unconditionally; and no part of it gets access to the thrown
--      exception.
--
--    * 'Eff' itself is able to guarantee that any exceptions thrown
--      in the body will be actually thrown before @bracket@
--      exits. This is inherited from the fact that @Eff@ is a wrapper
--      around 'IO'.
--
-- While it is usually the case that the cleanup action will in fact
-- want to use @IO@ effects, this is not universally true, see the
-- @polymorphicBracket@ example for an example.
bracket ::
  -- | Acquire the resource
  Eff es a ->
  -- | Release the resource
  (a -> Eff es ()) ->
  -- | Run the body with resource
  (a -> Eff es b) ->
  Eff es b
bracket :: forall (es :: Effects) a b.
Eff es a -> (a -> Eff es ()) -> (a -> Eff es b) -> Eff es b
bracket Eff es a
before a -> Eff es ()
after a -> Eff es b
body =
  (forall (e :: Effects). IOE e -> Eff (e :& es) b) -> Eff es b
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) b) -> Eff es b)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> do
    IOE e
-> ((forall {r}. Eff (e :& es) r -> IO r) -> IO b)
-> Eff (e :& es) b
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO_ IOE e
io (((forall {r}. Eff (e :& es) r -> IO r) -> IO b)
 -> Eff (e :& es) b)
-> ((forall {r}. Eff (e :& es) r -> IO r) -> IO b)
-> Eff (e :& es) b
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff (e :& es) r -> IO r
effToIO -> do
      IO a -> (a -> IO ()) -> (a -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Control.Exception.bracket
        (Eff (e :& es) a -> IO a
forall {r}. Eff (e :& es) r -> IO r
effToIO (Eff es a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl Eff es a
before))
        (Eff (e :& es) () -> IO ()
forall {r}. Eff (e :& es) r -> IO r
effToIO (Eff (e :& es) () -> IO ())
-> (a -> Eff (e :& es) ()) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es () -> Eff (e :& es) ()
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl (Eff es () -> Eff (e :& es) ())
-> (a -> Eff es ()) -> a -> Eff (e :& es) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Eff es ()
after)
        (Eff (e :& es) b -> IO b
forall {r}. Eff (e :& es) r -> IO r
effToIO (Eff (e :& es) b -> IO b) -> (a -> Eff (e :& es) b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es b -> Eff (e :& es) b
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl (Eff es b -> Eff (e :& es) b)
-> (a -> Eff es b) -> a -> Eff (e :& es) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Eff es b
body)

-- | A simpler variant of 'bracket` for use when you don't need to
-- acquire a resource.
finally ::
  -- | Body
  Eff es b ->
  -- | Final action to run after the body, regardless of whether the
  -- body terminated normally or via exception
  Eff es () ->
  Eff es b
finally :: forall (es :: Effects) b. Eff es b -> Eff es () -> Eff es b
finally Eff es b
body Eff es ()
after =
  (forall (e :: Effects). IOE e -> Eff (e :& es) b) -> Eff es b
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) b) -> Eff es b)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> do
    IOE e
-> ((forall {r}. Eff (e :& es) r -> IO r) -> IO b)
-> Eff (e :& es) b
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO_ IOE e
io (((forall {r}. Eff (e :& es) r -> IO r) -> IO b)
 -> Eff (e :& es) b)
-> ((forall {r}. Eff (e :& es) r -> IO r) -> IO b)
-> Eff (e :& es) b
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff (e :& es) r -> IO r
effToIO -> do
      IO b -> IO () -> IO b
forall a b. IO a -> IO b -> IO a
Control.Exception.finally
        (Eff (e :& es) b -> IO b
forall {r}. Eff (e :& es) r -> IO r
effToIO (Eff es b -> Eff (e :& es) b
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl Eff es b
body))
        (Eff (e :& es) () -> IO ()
forall {r}. Eff (e :& es) r -> IO r
effToIO (Eff es () -> Eff (e :& es) ()
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl Eff es ()
after))

withStateInIO ::
  (e1 <: es, e2 <: es) =>
  IOE e1 ->
  Modify s e2 ->
  (IORef s -> IO r) ->
  Eff es r
withStateInIO :: forall (e1 :: Effects) (es :: Effects) (e2 :: Effects) s r.
(e1 <: es, e2 <: es) =>
IOE e1 -> Modify s e2 -> (IORef s -> IO r) -> Eff es r
withStateInIO IOE e1
io (UnsafeMkState IORef s
r) IORef s -> IO r
k = IOE e1 -> IO r -> Eff es r
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e1
io (IORef s -> IO r
k IORef s
r)

-- |
-- @
-- >>> runPureEff $ runState 10 $ \\st -> do
--       n <- get st
--       pure (2 * n)
-- (20,10)
-- @
get ::
  (e <: es) =>
  Modify s e ->
  -- | The current value of the state
  Eff es s
get :: forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> Eff es s
get Modify s e
st = (forall (e :: Effects). IOE e -> Eff (e :& es) s) -> Eff es s
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) s) -> Eff es s)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) s) -> Eff es s
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> IOE e -> Modify s e -> (IORef s -> IO s) -> Eff (e :& es) s
forall (e1 :: Effects) (es :: Effects) (e2 :: Effects) s r.
(e1 <: es, e2 <: es) =>
IOE e1 -> Modify s e2 -> (IORef s -> IO r) -> Eff es r
withStateInIO IOE e
io Modify s e
st IORef s -> IO s
forall a. IORef a -> IO a
readIORef

-- | Set the value of the state
--
-- @
-- >>> runPureEff $ runState 10 $ \\st -> do
--       put st 30
-- ((), 30)
-- @
put ::
  (e <: es) =>
  Modify s e ->
  -- | The new value of the state.  The new value is forced before
  -- writing it to the state.
  s ->
  Eff es ()
put :: forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> s -> Eff es ()
put Modify s e
st s
s = (forall (e :: Effects). IOE e -> Eff (e :& es) ()) -> Eff es ()
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) ()) -> Eff es ())
-> (forall (e :: Effects). IOE e -> Eff (e :& es) ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> IOE e -> Modify s e -> (IORef s -> IO ()) -> Eff (e :& es) ()
forall (e1 :: Effects) (es :: Effects) (e2 :: Effects) s r.
(e1 <: es, e2 <: es) =>
IOE e1 -> Modify s e2 -> (IORef s -> IO r) -> Eff es r
withStateInIO IOE e
io Modify s e
st ((IORef s -> s -> IO ()) -> s -> IORef s -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (s -> IORef s -> IO ()) -> s -> IORef s -> IO ()
forall a b. (a -> b) -> a -> b
$! s
s)

-- |
-- @
-- >>> runPureEff $ runState 10 $ \\st -> do
--       modify st (* 2)
-- ((), 20)
-- @
modify ::
  (e <: es) =>
  Modify s e ->
  -- | Apply this function to the state.  The new value of the state
  -- is forced before writing it to the state.
  (s -> s) ->
  Eff es ()
modify :: forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> (s -> s) -> Eff es ()
modify Modify s e
state s -> s
f = do
  s
s <- Modify s e -> Eff es s
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> Eff es s
get Modify s e
state
  Modify s e -> s -> Eff es ()
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> s -> Eff es ()
put Modify s e
state (s -> s
f s
s)

-- |
-- @
-- 'runPureEff' $ 'withStateSource' $ \\source -> do
--   n <- 'newState' source 5
--   total <- newState source 0
--
--   'withJumpTo' $ \\done -> forever $ do
--     n' <- 'Bluefin.Capability.Modify.get' n
--     'Bluefin.Capability.Modify.modify' total (+ n')
--     when (n' == 0) $ 'Bluefin.Capability.JumpTo.jumpTo' done
--     modify n (subtract 1)
--
--   get total
-- 15
-- @
withStateSource ::
  (forall e. StateSource e -> Eff (e :& es) a) ->
  -- | ͘
  Eff es a
withStateSource :: forall (es :: Effects) a.
(forall (e :: Effects). StateSource e -> Eff (e :& es) a)
-> Eff es a
withStateSource forall (e :: Effects). StateSource e -> Eff (e :& es) a
f = (StateSource es -> Eff (es :& es) a) -> StateSource es -> Eff es a
forall (e :: Effects) (es :: Effects) t r.
(e <: es) =>
(t -> Eff (es :& e) r) -> t -> Eff es r
useImplIn StateSource es -> Eff (es :& es) a
forall (e :: Effects). StateSource e -> Eff (e :& es) a
f StateSource es
forall (e :: Effects). StateSource e
StateSource

-- |
-- @
-- runPureEff $ 'withStateSource' $ \\source -> do
--   n <- 'newState' source 5
--   total <- newState source 0
--
--   'Bluefin.Capability.JumpTo.withJumpTo' $ \\done -> forever $ do
--     n' <- 'Bluefin.Capability.Modify.get' n
--     'Bluefin.Capability.Modify.modify' total (+ n')
--     when (n' == 0) $ 'Bluefin.Capability.JumpTo.jumpTo' done
--     modify n (subtract 1)
--
--   get total
-- 15
-- @
newState ::
  (e <: es) =>
  StateSource e ->
  -- | The initial value for the state capability
  s ->
  -- | A new state capability
  Eff es (Modify s e)
newState :: forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
StateSource e -> s -> Eff es (Modify s e)
newState StateSource e
StateSource s
s = (forall (e :: Effects). IOE e -> Eff (e :& es) (Modify s e))
-> Eff es (Modify s e)
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) (Modify s e))
 -> Eff es (Modify s e))
-> (forall (e :: Effects). IOE e -> Eff (e :& es) (Modify s e))
-> Eff es (Modify s e)
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> do
  (IORef s -> Modify s e)
-> Eff (e :& es) (IORef s) -> Eff (e :& es) (Modify s e)
forall a b. (a -> b) -> Eff (e :& es) a -> Eff (e :& es) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef s -> Modify s e
forall s (e :: Effects). IORef s -> Modify s e
UnsafeMkState (IOE e -> IO (IORef s) -> Eff (e :& es) (IORef s)
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io (s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
s))

-- |
-- @
-- >>> runPureEff $ runState 10 $ \\st -> do
--       n <- get st
--       pure (2 * n)
-- (20,10)
-- @
runState ::
  -- | Initial state
  s ->
  -- | Stateful computation
  (forall e. Modify s e -> Eff (e :& es) a) ->
  -- | Result and final state
  Eff es (a, s)
runState :: forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es (a, s)
runState s
s forall (e :: Effects). Modify s e -> Eff (e :& es) a
f = do
  (forall (e :: Effects). StateSource e -> Eff (e :& es) (a, s))
-> Eff es (a, s)
forall (es :: Effects) a.
(forall (e :: Effects). StateSource e -> Eff (e :& es) a)
-> Eff es a
withStateSource ((forall (e :: Effects). StateSource e -> Eff (e :& es) (a, s))
 -> Eff es (a, s))
-> (forall (e :: Effects). StateSource e -> Eff (e :& es) (a, s))
-> Eff es (a, s)
forall a b. (a -> b) -> a -> b
$ \StateSource e
source -> do
    Modify s e
state <- StateSource e -> s -> Eff (e :& es) (Modify s e)
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
StateSource e -> s -> Eff es (Modify s e)
newState StateSource e
source s
s
    a
a <- Modify s e -> Eff (e :& es) a
forall (e :: Effects). Modify s e -> Eff (e :& es) a
f Modify s e
state
    s
s' <- Modify s e -> Eff (e :& es) s
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> Eff es s
get Modify s e
state
    (a, s) -> Eff (e :& es) (a, s)
forall a. a -> Eff (e :& es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, s
s')

yieldCoroutine ::
  (e1 <: es) =>
  Coroutine a b e1 ->
  -- | ͘
  a ->
  Eff es b
yieldCoroutine :: forall (e1 :: Effects) (es :: Effects) a b.
(e1 <: es) =>
Coroutine a b e1 -> a -> Eff es b
yieldCoroutine (MkCoroutine a -> Eff e1 b
f) = Eff e1 b -> Eff es b
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl (Eff e1 b -> Eff es b) -> (a -> Eff e1 b) -> a -> Eff es b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Eff e1 b
f

-- |
--
-- Yield an element to the stream.
--
-- @
-- >>> runPureEff $ yieldToList $ \\y -> do
--       yield y 1
--       yield y 2
--       yield y 100
-- ([1,2,100], ())
-- @
yield ::
  (e1 <: es) =>
  Yield a e1 ->
  -- | Yield this value from the stream
  a ->
  Eff es ()
yield :: forall (e1 :: Effects) (es :: Effects) a.
(e1 <: es) =>
Yield a e1 -> a -> Eff es ()
yield = Coroutine a () e1 -> a -> Eff es ()
forall (e1 :: Effects) (es :: Effects) a b.
(e1 <: es) =>
Coroutine a b e1 -> a -> Eff es b
yieldCoroutine

handleCoroutine ::
  (a -> Eff es b) ->
  (z -> Eff es r) ->
  (forall e1. Coroutine a b e1 -> Eff (e1 :& es) z) ->
  Eff es r
handleCoroutine :: forall a (es :: Effects) b z r.
(a -> Eff es b)
-> (z -> Eff es r)
-> (forall (e1 :: Effects). Coroutine a b e1 -> Eff (e1 :& es) z)
-> Eff es r
handleCoroutine a -> Eff es b
update z -> Eff es r
finish forall (e1 :: Effects). Coroutine a b e1 -> Eff (e1 :& es) z
f = do
  z
z <- (forall (e1 :: Effects). Coroutine a b e1 -> Eff (e1 :& es) z)
-> (a -> Eff es b) -> Eff es z
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach Coroutine a b e1 -> Eff (e1 :& es) z
forall (e1 :: Effects). Coroutine a b e1 -> Eff (e1 :& es) z
f a -> Eff es b
update
  z -> Eff es r
finish z
z

-- |
--
-- Apply an effectful function to each element yielded to the stream.
--
-- @
-- >>> 'runPureEff' $ 'yieldToList' $ \\y -> do
--       'forEach' ('inFoldable' [0 .. 3]) $ \\i -> do
--         'yield' y i
--         yield y (i * 10)
-- ([0, 0, 1, 10, 2, 20, 3, 30], ())
-- @
forEach ::
  (forall e1. Request a b e1 -> Eff (e1 :& es) r) ->
  -- | Apply this effectful function for each element of the coroutine
  (a -> Eff es b) ->
  Eff es r
forEach :: forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r
f a -> Eff es b
h = (Request a b es -> Eff (es :& es) r) -> Request a b es -> Eff es r
forall (e :: Effects) (es :: Effects) t r.
(e <: es) =>
(t -> Eff (es :& e) r) -> t -> Eff es r
useImplIn Request a b es -> Eff (es :& es) r
forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r
f ((a -> Eff es b) -> Request a b es
forall a b (e :: Effects). (a -> Eff e b) -> Request a b e
MkCoroutine a -> Eff es b
h)

-- |
--
-- Ignore all elements yielded to the stream.
--
-- @
-- >>> runPureEff $ ignoreStream $ \\y -> do
--      for_ [0 .. 4] $ \\i -> do
--        yield y i
--        yield y (i * 10)
--
--      pure 42
-- 42
-- @
ignoreStream ::
  (forall e1. Stream a e1 -> Eff (e1 :& es) r) ->
  -- | ͘
  Eff es r
ignoreStream :: forall a (es :: Effects) r.
(forall (e1 :: Effects). Stream a e1 -> Eff (e1 :& es) r)
-> Eff es r
ignoreStream forall (e1 :: Effects). Stream a e1 -> Eff (e1 :& es) r
k = (forall (e1 :: Effects). Stream a e1 -> Eff (e1 :& es) r)
-> (a -> Eff es ()) -> Eff es r
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach Stream a e1 -> Eff (e1 :& es) r
forall (e1 :: Effects). Stream a e1 -> Eff (e1 :& es) r
k (\a
_ -> () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- |
-- @
-- >>> runPureEff $ yieldToList $ inFoldable [1, 2, 100]
-- ([1, 2, 100], ())
-- @
inFoldable ::
  (Foldable t, e1 <: es) =>
  -- | Yield all these values from the stream
  t a ->
  Yield a e1 ->
  Eff es ()
inFoldable :: forall (t :: * -> *) (e1 :: Effects) (es :: Effects) a.
(Foldable t, e1 <: es) =>
t a -> Yield a e1 -> Eff es ()
inFoldable t a
t = t a -> (a -> Eff es ()) -> Eff es ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ t a
t ((a -> Eff es ()) -> Eff es ())
-> (Yield a e1 -> a -> Eff es ()) -> Yield a e1 -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yield a e1 -> a -> Eff es ()
forall (e1 :: Effects) (es :: Effects) a.
(e1 <: es) =>
Yield a e1 -> a -> Eff es ()
yield

-- | Pair each element in the stream with an increasing index,
-- starting from 0.
--
-- @
-- >>> runPureEff $ yieldToList $ enumerate (inFoldable [\"A\", \"B\", \"C\"])
-- ([(0, \"A\"), (1, \"B\"), (2, \"C\")], ())
-- @
enumerate ::
  (e2 <: es) =>
  -- | ͘
  (forall e1. Yield a e1 -> Eff (e1 :& es) r) ->
  Yield (Int, a) e2 ->
  Eff es r
enumerate :: forall (e2 :: Effects) (es :: Effects) a r.
(e2 <: es) =>
(forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Yield (Int, a) e2 -> Eff es r
enumerate forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r
s = Int
-> (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Yield (Int, a) e2
-> Eff es r
forall (e2 :: Effects) (es :: Effects) a r.
(e2 <: es) =>
Int
-> (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Yield (Int, a) e2
-> Eff es r
enumerateFrom Int
0 Yield a e1 -> Eff (e1 :& es) r
forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r
s

-- | Pair each element in the stream with an increasing index,
-- starting from an inital value.
--
-- @
-- >>> runPureEff $ yieldToList $ enumerateFrom 1 (inFoldable [\"A\", \"B\", \"C\"])
-- ([(1, \"A\"), (2, \"B\"), (3, \"C\")], ())
-- @
enumerateFrom ::
  (e2 <: es) =>
  -- | Initial value
  Int ->
  (forall e1. Yield a e1 -> Eff (e1 :& es) r) ->
  Yield (Int, a) e2 ->
  Eff es r
enumerateFrom :: forall (e2 :: Effects) (es :: Effects) a r.
(e2 <: es) =>
Int
-> (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Yield (Int, a) e2
-> Eff es r
enumerateFrom Int
n forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r
ss Yield (Int, a) e2
st =
  Int
-> (forall {e :: Effects}. Modify Int e -> Eff (e :& es) r)
-> Eff es r
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es a
evalState Int
n ((forall {e :: Effects}. Modify Int e -> Eff (e :& es) r)
 -> Eff es r)
-> (forall {e :: Effects}. Modify Int e -> Eff (e :& es) r)
-> Eff es r
forall a b. (a -> b) -> a -> b
$ \Modify Int e
i -> (forall (e1 :: Effects).
 Request a () e1 -> Eff (e1 :& (e :& es)) r)
-> (a -> Eff (e :& es) ()) -> Eff (e :& es) r
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r)
-> (Request a () e1 -> Eff (e1 :& es) r)
-> Request a () e1
-> Eff (e1 :& (e :& es)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request a () e1 -> Eff (e1 :& es) r
forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r
ss) ((a -> Eff (e :& es) ()) -> Eff (e :& es) r)
-> (a -> Eff (e :& es) ()) -> Eff (e :& es) r
forall a b. (a -> b) -> a -> b
$ \a
s -> do
    Int
ii <- Modify Int e -> Eff (e :& es) Int
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> Eff es s
get Modify Int e
i
    Yield (Int, a) e2 -> (Int, a) -> Eff (e :& es) ()
forall (e1 :: Effects) (es :: Effects) a.
(e1 <: es) =>
Yield a e1 -> a -> Eff es ()
yield Yield (Int, a) e2
st (Int
ii, a
s)
    Modify Int e -> Int -> Eff (e :& es) ()
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> s -> Eff es ()
put Modify Int e
i (Int
ii Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | A version of 'forEach' specialized to @Consume@.  Every time the
-- @Consume@ is used to 'await' a @b@, feed it the one created by the
-- handler.
consumeEach ::
  -- | Body
  ( forall e.
    Consume b e ->
    Eff (e :& es) r
  ) ->
  -- | Value to send to each @await@ in the body.
  Eff es b ->
  Eff es r
consumeEach :: forall b (es :: Effects) r.
(forall (e :: Effects). Consume b e -> Eff (e :& es) r)
-> Eff es b -> Eff es r
consumeEach forall (e :: Effects). Consume b e -> Eff (e :& es) r
k Eff es b
e = (forall (e :: Effects). Consume b e -> Eff (e :& es) r)
-> (() -> Eff es b) -> Eff es r
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach Consume b e1 -> Eff (e1 :& es) r
forall (e :: Effects). Consume b e -> Eff (e :& es) r
k (\() -> Eff es b
e)

await :: (e <: es) => Await a e -> Eff es a
await :: forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
Await a e -> Eff es a
await Await a e
r = Await a e -> () -> Eff es a
forall (e1 :: Effects) (es :: Effects) a b.
(e1 <: es) =>
Coroutine a b e1 -> a -> Eff es b
yieldCoroutine Await a e
r ()

type ReturnEarly = Throw

-- | Run an 'Eff' action with the ability to return early to this
-- point.  In the language of exceptions, 'withEarlyReturn' installs
-- an exception handler for an exception of type @r@.
--
-- @
-- >>> runPureEff $ withEarlyReturn $ \\e -> do
--       for_ [1 .. 10] $ \\i -> do
--         when (i >= 5) $
--           returnEarly e ("Returned early with " ++ show i)
--       pure "End of loop"
-- "Returned early with 5"
-- @
withEarlyReturn ::
  (forall e. EarlyReturn r e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
withEarlyReturn :: forall r (es :: Effects).
(forall (e :: Effects). EarlyReturn r e -> Eff (e :& es) r)
-> Eff es r
withEarlyReturn = (r -> Eff es r)
-> (forall (e :: Effects). EarlyReturn r e -> Eff (e :& es) r)
-> Eff es r
forall exn (es :: Effects) a.
(exn -> Eff es a)
-> (forall (e :: Effects). Throw exn e -> Eff (e :& es) a)
-> Eff es a
handle r -> Eff es r
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- |
-- @
-- >>> runPureEff $ withEarlyReturn $ \\e -> do
--       for_ [1 .. 10] $ \\i -> do
--         when (i >= 5) $
--           returnEarly e ("Returned early with " ++ show i)
--       pure "End of loop"
-- "Returned early with 5"
-- @
returnEarly ::
  (e <: es) =>
  ReturnEarly r e ->
  -- | Return early to the handler, with this value.
  r ->
  Eff es a
returnEarly :: forall (e :: Effects) (es :: Effects) ex a.
(e <: es) =>
Throw ex e -> ex -> Eff es a
returnEarly = Throw r e -> r -> Eff es a
forall (e :: Effects) (es :: Effects) ex a.
(e <: es) =>
Throw ex e -> ex -> Eff es a
throw

-- |
-- @
-- >>> runPureEff $ evalState 10 $ \\st -> do
--       n <- get st
--       pure (2 * n)
-- 20
-- @
evalState ::
  -- | Initial state
  s ->
  -- | Stateful computation
  (forall e. Modify s e -> Eff (e :& es) a) ->
  -- | Result
  Eff es a
evalState :: forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es a
evalState s
s forall (e :: Effects). Modify s e -> Eff (e :& es) a
f = ((a, s) -> a) -> Eff es (a, s) -> Eff es a
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> a
forall a b. (a, b) -> a
fst (s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es (a, s)
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es (a, s)
runState s
s Modify s e -> Eff (e :& es) a
forall (e :: Effects). Modify s e -> Eff (e :& es) a
f)

-- |
-- @
-- >>> runPureEff $ withState 10 $ \\st -> do
--       n <- get st
--       pure (\s -> (2 * n, s))
-- (20,10)
-- @
withState ::
  -- | Initial state
  s ->
  -- | Stateful computation
  (forall e. Modify s e -> Eff (e :& es) (s -> a)) ->
  -- | Result
  Eff es a
withState :: forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) (s -> a))
-> Eff es a
withState s
s forall (e :: Effects). Modify s e -> Eff (e :& es) (s -> a)
f = do
  (s -> a
g, s
s') <- s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) (s -> a))
-> Eff es (s -> a, s)
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es (a, s)
runState s
s Modify s e -> Eff (e :& es) (s -> a)
forall (e :: Effects). Modify s e -> Eff (e :& es) (s -> a)
f
  a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> a
g s
s')

data Compound e1 e2 ss where
  Compound ::
    Proxy# s1 ->
    Proxy# s2 ->
    e1 s1 ->
    e2 s2 ->
    Compound e1 e2 (s1 :& s2)

compound ::
  h1 e1 ->
  -- | ͘
  h2 e2 ->
  Compound h1 h2 (e1 :& e2)
compound :: forall (h1 :: Effects -> *) (e1 :: Effects) (h2 :: Effects -> *)
       (e2 :: Effects).
h1 e1 -> h2 e2 -> Compound h1 h2 (e1 :& e2)
compound = Proxy# e1
-> Proxy# e2 -> h1 e1 -> h2 e2 -> Compound h1 h2 (e1 :& e2)
forall (s1 :: Effects) (s2 :: Effects) (e1 :: Effects -> *)
       (e2 :: Effects -> *).
Proxy# s1
-> Proxy# s2 -> e1 s1 -> e2 s2 -> Compound e1 e2 (s1 :& s2)
Compound Proxy# e1
forall {k} (a :: k). Proxy# a
proxy# Proxy# e2
forall {k} (a :: k). Proxy# a
proxy#

inComp :: forall a b c r. (a <: b) => (b <: c) => ((a <: c) => r) -> r
inComp :: forall (a :: Effects) (b :: Effects) (c :: Effects) r.
(a <: b, b <: c) =>
((a <: c) => r) -> r
inComp (a <: c) => r
k = case In a c -> Dict (a <: c)
forall (a :: Effects) (b :: Effects). In a b -> Dict (a <: b)
have (In a b -> In b c -> In a c
forall (a :: Effects) (b :: Effects) (c :: Effects).
In a b -> In b c -> In a c
cmp (forall (a :: Effects) (b :: Effects). (a <: b) => In a b
has @a @b) (forall (a :: Effects) (b :: Effects). (a <: b) => In a b
has @b @c)) of Dict (a <: c)
Dict -> r
(a <: c) => r
k

withCompound ::
  forall h1 h2 e es r.
  (e <: es) =>
  Compound h1 h2 e ->
  -- | ͘
  (forall e1 e2. (e1 <: es, e2 <: es) => h1 e1 -> h2 e2 -> Eff es r) ->
  Eff es r
withCompound :: forall (h1 :: Effects -> *) (h2 :: Effects -> *) (e :: Effects)
       (es :: Effects) r.
(e <: es) =>
Compound h1 h2 e
-> (forall (e1 :: Effects) (e2 :: Effects).
    (e1 <: es, e2 <: es) =>
    h1 e1 -> h2 e2 -> Eff es r)
-> Eff es r
withCompound Compound h1 h2 e
c forall (e1 :: Effects) (e2 :: Effects).
(e1 <: es, e2 <: es) =>
h1 e1 -> h2 e2 -> Eff es r
f =
  case Compound h1 h2 e
c of
    Compound (Proxy# s1
_ :: Proxy# st) (Proxy# s2
_ :: Proxy# st') h1 s1
h h2 s2
i ->
      forall (a :: Effects) (b :: Effects) (c :: Effects) r.
(a <: b, b <: c) =>
((a <: c) => r) -> r
inComp @st @e @es (forall (a :: Effects) (b :: Effects) (c :: Effects) r.
(a <: b, b <: c) =>
((a <: c) => r) -> r
inComp @st' @e @es (h1 s1 -> h2 s2 -> Eff es r
forall (e1 :: Effects) (e2 :: Effects).
(e1 <: es, e2 <: es) =>
h1 e1 -> h2 e2 -> Eff es r
f h1 s1
h h2 s2
i))

withC1 ::
  forall e1 e2 ss es r.
  (ss <: es) =>
  Compound e1 e2 ss ->
  (forall st. (st <: es) => e1 st -> Eff es r) ->
  Eff es r
withC1 :: forall (e1 :: Effects -> *) (e2 :: Effects -> *) (ss :: Effects)
       (es :: Effects) r.
(ss <: es) =>
Compound e1 e2 ss
-> (forall (st :: Effects). (st <: es) => e1 st -> Eff es r)
-> Eff es r
withC1 Compound e1 e2 ss
c forall (st :: Effects). (st <: es) => e1 st -> Eff es r
f = Compound e1 e2 ss
-> (forall (e1 :: Effects) (e2 :: Effects).
    (e1 <: es, e2 <: es) =>
    e1 e1 -> e2 e2 -> Eff es r)
-> Eff es r
forall (h1 :: Effects -> *) (h2 :: Effects -> *) (e :: Effects)
       (es :: Effects) r.
(e <: es) =>
Compound h1 h2 e
-> (forall (e1 :: Effects) (e2 :: Effects).
    (e1 <: es, e2 <: es) =>
    h1 e1 -> h2 e2 -> Eff es r)
-> Eff es r
withCompound Compound e1 e2 ss
c (\e1 e1
h e2 e2
_ -> e1 e1 -> Eff es r
forall (st :: Effects). (st <: es) => e1 st -> Eff es r
f e1 e1
h)

withC2 ::
  forall e1 e2 ss es r.
  (ss <: es) =>
  Compound e1 e2 ss ->
  (forall st. (st <: es) => e2 st -> Eff es r) ->
  Eff es r
withC2 :: forall (e1 :: Effects -> *) (e2 :: Effects -> *) (ss :: Effects)
       (es :: Effects) r.
(ss <: es) =>
Compound e1 e2 ss
-> (forall (st :: Effects). (st <: es) => e2 st -> Eff es r)
-> Eff es r
withC2 Compound e1 e2 ss
c forall (st :: Effects). (st <: es) => e2 st -> Eff es r
f = Compound e1 e2 ss
-> (forall (e1 :: Effects) (e2 :: Effects).
    (e1 <: es, e2 <: es) =>
    e1 e1 -> e2 e2 -> Eff es r)
-> Eff es r
forall (h1 :: Effects -> *) (h2 :: Effects -> *) (e :: Effects)
       (es :: Effects) r.
(e <: es) =>
Compound h1 h2 e
-> (forall (e1 :: Effects) (e2 :: Effects).
    (e1 <: es, e2 <: es) =>
    h1 e1 -> h2 e2 -> Eff es r)
-> Eff es r
withCompound Compound e1 e2 ss
c (\e1 e1
_ e2 e2
i -> e2 e2 -> Eff es r
forall (st :: Effects). (st <: es) => e2 st -> Eff es r
f e2 e2
i)

putC :: forall ss es e. (ss <: es) => Compound e (Modify Int) ss -> Int -> Eff es ()
putC :: forall (ss :: Effects) (es :: Effects) (e :: Effects -> *).
(ss <: es) =>
Compound e (Modify Int) ss -> Int -> Eff es ()
putC Compound e (Modify Int) ss
c Int
i = Compound e (Modify Int) ss
-> (forall (st :: Effects).
    (st <: es) =>
    Modify Int st -> Eff es ())
-> Eff es ()
forall (e1 :: Effects -> *) (e2 :: Effects -> *) (ss :: Effects)
       (es :: Effects) r.
(ss <: es) =>
Compound e1 e2 ss
-> (forall (st :: Effects). (st <: es) => e2 st -> Eff es r)
-> Eff es r
withC2 Compound e (Modify Int) ss
c (\Modify Int st
h -> Modify Int st -> Int -> Eff es ()
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> s -> Eff es ()
put Modify Int st
h Int
i)

getC :: forall ss es e. (ss <: es) => Compound e (Modify Int) ss -> Eff es Int
getC :: forall (ss :: Effects) (es :: Effects) (e :: Effects -> *).
(ss <: es) =>
Compound e (Modify Int) ss -> Eff es Int
getC Compound e (Modify Int) ss
c = Compound e (Modify Int) ss
-> (forall (st :: Effects).
    (st <: es) =>
    Modify Int st -> Eff es Int)
-> Eff es Int
forall (e1 :: Effects -> *) (e2 :: Effects -> *) (ss :: Effects)
       (es :: Effects) r.
(ss <: es) =>
Compound e1 e2 ss
-> (forall (st :: Effects). (st <: es) => e2 st -> Eff es r)
-> Eff es r
withC2 Compound e (Modify Int) ss
c (\Modify Int st
h -> Modify Int st -> Eff es Int
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> Eff es s
get Modify Int st
h)

-- TODO: Make this (s1 <: es, s2 <: es), like withC
runCompound ::
  e1 s1 ->
  -- | ͘
  e2 s2 ->
  (forall es'. Compound e1 e2 es' -> Eff (es' :& es) r) ->
  Eff (s1 :& (s2 :& es)) r
runCompound :: forall (e1 :: Effects -> *) (s1 :: Effects) (e2 :: Effects -> *)
       (s2 :: Effects) (es :: Effects) r.
e1 s1
-> e2 s2
-> (forall (es' :: Effects).
    Compound e1 e2 es' -> Eff (es' :& es) r)
-> Eff (s1 :& (s2 :& es)) r
runCompound e1 s1
e1 e2 s2
e2 forall (es' :: Effects). Compound e1 e2 es' -> Eff (es' :& es) r
k = Eff ((s1 :& s2) :& es) r -> Eff (s1 :& (s2 :& es)) r
forall (a :: Effects) (b :: Effects) (c :: Effects) r.
Eff ((a :& b) :& c) r -> Eff (a :& (b :& c)) r
assoc1Eff (Compound e1 e2 (s1 :& s2) -> Eff ((s1 :& s2) :& es) r
forall (es' :: Effects). Compound e1 e2 es' -> Eff (es' :& es) r
k (e1 s1 -> e2 s2 -> Compound e1 e2 (s1 :& s2)
forall (h1 :: Effects -> *) (e1 :: Effects) (h2 :: Effects -> *)
       (e2 :: Effects).
h1 e1 -> h2 e2 -> Compound h1 h2 (e1 :& e2)
compound e1 s1
e1 e2 s2
e2))

-- |
--
-- Gather all yielded elements into a list.
--
-- @
-- >>> runPureEff $ yieldToList $ \\y -> do
--       yield y 1
--       yield y 2
--       yield y 100
-- ([1,2,100], ())
-- @
yieldToList ::
  (forall e1. Yield a e1 -> Eff (e1 :& es) r) ->
  -- | Yielded elements and final result
  Eff es ([a], r)
yieldToList :: forall a (es :: Effects) r.
(forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Eff es ([a], r)
yieldToList forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r
f = do
  ([a]
as, r
r) <- (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Eff es ([a], r)
forall a (es :: Effects) r.
(forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Eff es ([a], r)
yieldToReverseList Yield a e -> Eff (e :& es) r
forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r
f
  ([a], r) -> Eff es ([a], r)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
as, r
r)

-- | Gather all yielded elements into a list, purely.  Can be used
-- when only when there are no other capabilities in scope, besides
-- the 'Yield'.
yieldToPureList :: (forall e. Yield a e -> Eff e r) -> ([a], r)
yieldToPureList :: forall a r.
(forall (e :: Effects). Yield a e -> Eff e r) -> ([a], r)
yieldToPureList forall (e :: Effects). Yield a e -> Eff e r
f = (forall (es :: Effects). Eff es ([a], r)) -> ([a], r)
forall a. (forall (es :: Effects). Eff es a) -> a
runPureEff ((forall (es :: Effects). Eff es ([a], r)) -> ([a], r))
-> (forall (es :: Effects). Eff es ([a], r)) -> ([a], r)
forall a b. (a -> b) -> a -> b
$ (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Eff es ([a], r)
forall a (es :: Effects) r.
(forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Eff es ([a], r)
yieldToList ((forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
 -> Eff es ([a], r))
-> (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Eff es ([a], r)
forall a b. (a -> b) -> a -> b
$ \Yield a e1
y -> Eff e1 r -> Eff (e1 :& es) r
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Eff e r -> Eff es r
useImpl (Yield a e1 -> Eff e1 r
forall (e :: Effects). Yield a e -> Eff e r
f Yield a e1
y)

-- |
-- @
-- >>> runPureEff $ withYieldToList $ \\y -> do
--   yield y 1
--   yield y 2
--   yield y 100
--   pure length
-- 3
-- @
withYieldToList ::
  -- | Yield computation
  (forall e. Yield a e -> Eff (e :& es) ([a] -> r)) ->
  -- | Result
  Eff es r
withYieldToList :: forall a (es :: Effects) r.
(forall (e :: Effects). Yield a e -> Eff (e :& es) ([a] -> r))
-> Eff es r
withYieldToList forall (e :: Effects). Yield a e -> Eff (e :& es) ([a] -> r)
f = do
  ([a]
l, [a] -> r
g) <- (forall (e :: Effects). Yield a e -> Eff (e :& es) ([a] -> r))
-> Eff es ([a], [a] -> r)
forall a (es :: Effects) r.
(forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Eff es ([a], r)
yieldToList Yield a e1 -> Eff (e1 :& es) ([a] -> r)
forall (e :: Effects). Yield a e -> Eff (e :& es) ([a] -> r)
f
  r -> Eff es r
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> r
g [a]
l)

-- | This is more efficient than 'yieldToList' because it gathers the
-- elements into a stack in reverse order. @yieldToList@ then reverses
-- that stack.
--
-- @
-- >>> runPureEff $ yieldToReverseList $ \\y -> do
--       yield y 1
--       yield y 2
--       yield y 100
-- ([100,2,1], ())
-- @
yieldToReverseList ::
  (forall e. Yield a e -> Eff (e :& es) r) ->
  -- | Yielded elements in reverse order, and final result
  Eff es ([a], r)
yieldToReverseList :: forall a (es :: Effects) r.
(forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Eff es ([a], r)
yieldToReverseList forall (e :: Effects). Yield a e -> Eff (e :& es) r
f = do
  [a]
-> (forall {e :: Effects}. Modify [a] e -> Eff (e :& es) ([a], r))
-> Eff es ([a], r)
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es a
evalState [] ((forall {e :: Effects}. Modify [a] e -> Eff (e :& es) ([a], r))
 -> Eff es ([a], r))
-> (forall {e :: Effects}. Modify [a] e -> Eff (e :& es) ([a], r))
-> Eff es ([a], r)
forall a b. (a -> b) -> a -> b
$ \(Modify [a] e
s :: Modify lo st) -> do
    r
r <- (forall (e1 :: Effects).
 Request a () e1 -> Eff (e1 :& (e :& es)) r)
-> (a -> Eff (e :& es) ()) -> Eff (e :& es) r
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r)
-> (Request a () e1 -> Eff (e1 :& es) r)
-> Request a () e1
-> Eff (e1 :& (e :& es)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request a () e1 -> Eff (e1 :& es) r
forall (e :: Effects). Yield a e -> Eff (e :& es) r
f) ((a -> Eff (e :& es) ()) -> Eff (e :& es) r)
-> (a -> Eff (e :& es) ()) -> Eff (e :& es) r
forall a b. (a -> b) -> a -> b
$ \a
i ->
      Modify [a] e -> ([a] -> [a]) -> Eff (e :& es) ()
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> (s -> s) -> Eff es ()
modify Modify [a] e
s (a
i :)
    [a]
as <- Modify [a] e -> Eff (e :& es) [a]
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> Eff es s
get Modify [a] e
s
    ([a], r) -> Eff (e :& es) ([a], r)
forall a. a -> Eff (e :& es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
as, r
r)

mapMaybe ::
  (e2 <: es) =>
  -- | Yield from the output stream all of the elemnts of the input
  -- stream for which this function returns @Just@
  (a -> Maybe b) ->
  -- | Input stream
  (forall e1. Yield a e1 -> Eff (e1 :& es) r) ->
  Yield b e2 ->
  Eff es r
mapMaybe :: forall (e2 :: Effects) (es :: Effects) a b r.
(e2 <: es) =>
(a -> Maybe b)
-> (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Yield b e2
-> Eff es r
mapMaybe a -> Maybe b
f forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r
s Yield b e2
y = (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> (a -> Eff es ()) -> Eff es r
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach Yield a e1 -> Eff (e1 :& es) r
forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r
s ((a -> Eff es ()) -> Eff es r) -> (a -> Eff es ()) -> Eff es r
forall a b. (a -> b) -> a -> b
$ \a
a -> do
  case a -> Maybe b
f a
a of
    Maybe b
Nothing -> () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just b
b_ -> Yield b e2 -> b -> Eff es ()
forall (e1 :: Effects) (es :: Effects) a.
(e1 <: es) =>
Yield a e1 -> a -> Eff es ()
yield Yield b e2
y b
b_

-- | Remove 'Nothing' elements from a stream.
catMaybes ::
  (e2 <: es) =>
  -- | Input stream
  (forall e1. Yield (Maybe a) e1 -> Eff (e1 :& es) r) ->
  Yield a e2 ->
  Eff es r
catMaybes :: forall (e2 :: Effects) (es :: Effects) a r.
(e2 <: es) =>
(forall (e1 :: Effects). Yield (Maybe a) e1 -> Eff (e1 :& es) r)
-> Yield a e2 -> Eff es r
catMaybes forall (e1 :: Effects). Yield (Maybe a) e1 -> Eff (e1 :& es) r
s Yield a e2
y = (Maybe a -> Maybe a)
-> (forall (e1 :: Effects). Yield (Maybe a) e1 -> Eff (e1 :& es) r)
-> Yield a e2
-> Eff es r
forall (e2 :: Effects) (es :: Effects) a b r.
(e2 <: es) =>
(a -> Maybe b)
-> (forall (e1 :: Effects). Yield a e1 -> Eff (e1 :& es) r)
-> Yield b e2
-> Eff es r
mapMaybe Maybe a -> Maybe a
forall a. a -> a
id Yield (Maybe a) e1 -> Eff (e1 :& es) r
forall (e1 :: Effects). Yield (Maybe a) e1 -> Eff (e1 :& es) r
s Yield a e2
y

-- |
-- @
-- runPureEff $ yieldToList $ \yOut -> do
--   consumeStream
--     (\\c -> takeConsume 6 c yOut)
--     (\\yIn -> cycleToStream [1..3] yIn)
-- ([1,2,3,1,2,3],())
-- @
cycleToStream ::
  (Foldable f, e1 <: es) =>
  f a ->
  Yield a e1 ->
  -- | ͘
  Eff es ()
cycleToStream :: forall (t :: * -> *) (e1 :: Effects) (es :: Effects) a.
(Foldable t, e1 <: es) =>
t a -> Yield a e1 -> Eff es ()
cycleToStream f a
f Yield a e1
y = do
  Eff es () -> Eff es ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (f a -> Yield a e1 -> Eff es ()
forall (t :: * -> *) (e1 :: Effects) (es :: Effects) a.
(Foldable t, e1 <: es) =>
t a -> Yield a e1 -> Eff es ()
inFoldable f a
f Yield a e1
y)

-- |
-- @
-- runPureEff $ yieldToList $ \yOut -> do
--   consumeStream
--     (\\c -> takeConsume 4 c yOut)
--     (\\yIn -> inFoldable [1..10] yIn)
-- ([1,2,3,4],())
-- @
takeConsume ::
  (e1 <: es, e2 <: es) =>
  Int ->
  Consume a e1 ->
  Stream a e2 ->
  -- | ͘
  Eff es ()
takeConsume :: forall (e1 :: Effects) (es :: Effects) (e2 :: Effects) a.
(e1 <: es, e2 <: es) =>
Int -> Consume a e1 -> Stream a e2 -> Eff es ()
takeConsume Int
count Consume a e1
source Stream a e2
sink = Int -> Eff es ()
loop Int
count
  where
    loop :: Int -> Eff es ()
loop Int
c | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    loop Int
c = do
      Consume a e1 -> Eff es a
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
Await a e -> Eff es a
await Consume a e1
source Eff es a -> (a -> Eff es ()) -> Eff es ()
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream a e2 -> a -> Eff es ()
forall (e1 :: Effects) (es :: Effects) a.
(e1 <: es) =>
Yield a e1 -> a -> Eff es ()
yield Stream a e2
sink
      Int -> Eff es ()
loop (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

type JumpTo = ReturnEarly ()

-- |
-- @
-- runPureEff $ 'withStateSource' $ \\source -> do
--   n <- 'newState' source 5
--   total <- newState source 0
--
--   'Bluefin.Capability.JumpTo.withJumpTo' $ \\done -> forever $ do
--     n' <- 'Bluefin.Capability.Modify.get' n
--     'Bluefin.Capability.Modify.modify' total (+ n')
--     when (n' == 0) $ 'Bluefin.Capability.JumpTo.jumpTo' done
--     modify n (subtract 1)
--
--   get total
-- 15
-- @
withJump ::
  (forall e. Jump e -> Eff (e :& es) ()) ->
  -- | ͘
  Eff es ()
withJump :: forall (es :: Effects).
(forall (e :: Effects). Jump e -> Eff (e :& es) ()) -> Eff es ()
withJump = (forall (e :: Effects). EarlyReturn () e -> Eff (e :& es) ())
-> Eff es ()
forall r (es :: Effects).
(forall (e :: Effects). EarlyReturn r e -> Eff (e :& es) r)
-> Eff es r
withEarlyReturn

-- |
-- @
-- runPureEff $ 'withStateSource' $ \\source -> do
--   n <- 'newState' source 5
--   total <- newState source 0
--
--   'Bluefin.Capability.JumpTo.withJumpTo' $ \\done -> forever $ do
--     n' <- 'Bluefin.Capability.Modify.get' n
--     'Bluefin.Capability.Modify.modify' total (+ n')
--     when (n' == 0) $ 'Bluefin.Capability.JumpTo.jumpTo' done
--     modify n (subtract 1)
--
--   get total
-- 15
-- @
jumpTo ::
  (e <: es) =>
  JumpTo e ->
  -- | ͘
  Eff es a
jumpTo :: forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
JumpTo e -> Eff es a
jumpTo JumpTo e
tag = JumpTo e -> () -> Eff es a
forall (e :: Effects) (es :: Effects) ex a.
(e <: es) =>
Throw ex e -> ex -> Eff es a
throw JumpTo e
tag ()

unwrap :: (e <: es) => JumpTo e -> Maybe a -> Eff es a
unwrap :: forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
JumpTo e -> Maybe a -> Eff es a
unwrap JumpTo e
j = \case
  Maybe a
Nothing -> JumpTo e -> Eff es a
forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
JumpTo e -> Eff es a
jumpTo JumpTo e
j
  Just a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Capability to run 'IO' operations
data IOE (e :: Effects) = MkIOE
  deriving (HandleD IOE
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (IOE e) (IOE es)) =>
HandleD IOE -> Handle IOE
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (IOE e) (IOE es)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
$chandleImpl :: HandleD IOE
handleImpl :: HandleD IOE
Handle) via OneWayCoercibleHandle IOE

type role IOE nominal

instance (e <: es) => OneWayCoercible (IOE e) (IOE es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (IOE e) (IOE es)
oneWayCoercibleImpl = OneWayCoercibleD (IOE e) (IOE es)
forall {k} (a :: k) (b :: k). OneWayCoercibleD a b
unsafeOneWayCoercible

-- | Run an 'IO' operation in 'Eff'
--
-- @
-- >>> runEff $ \\io -> do
--       effIO io (putStrLn "Hello world!")
-- Hello, world!
-- @
effIO ::
  (e <: es) =>
  IOE e ->
  IO a ->
  -- | ͘
  Eff es a
effIO :: forall (e :: Effects) (es :: Effects) a.
(e <: es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
MkIOE = (Env -> IO a) -> Eff es a
forall (es :: Effects) a. (Env -> IO a) -> Eff es a
UnsafeMkEff ((Env -> IO a) -> Eff es a)
-> (IO a -> Env -> IO a) -> IO a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Env -> IO a
forall a b. a -> b -> a
const

-- | Run an 'Eff' whose only unhandled effect is 'IO'.
--
-- @
-- >>> runEff $ \\io -> do
--       effIO io (putStrLn "Hello world!")
-- Hello, world!
-- @
runEff ::
  (forall e. IOE e -> Eff e a) ->
  -- | ͘
  IO a
runEff :: forall a. (forall (e :: Effects). IOE e -> Eff e a) -> IO a
runEff forall (e :: Effects). IOE e -> Eff e a
eff = (forall (e :: Effects). IOE e -> Eff e a) -> IO a
forall a. (forall (e :: Effects). IOE e -> Eff e a) -> IO a
runEff_ IOE e -> Eff e a
forall (e :: Effects). IOE e -> Eff e a
eff

-- | Run an 'Eff' whose only unhandled effect is 'IO'.
--
-- @
-- >>> runEff_ $ \\io -> do
--       effIO io (putStrLn "Hello world!")
-- Hello, world!
-- @
--
-- Use 'runEff' instead.  @runEff_@ will be deprecated in a future
-- version.
runEff_ ::
  (forall e. IOE e -> Eff e a) ->
  -- | ͘
  IO a
runEff_ :: forall a. (forall (e :: Effects). IOE e -> Eff e a) -> IO a
runEff_ forall (e :: Effects). IOE e -> Eff e a
eff = do
  Env
emptyEnv <- Vault -> IO Env
forall a. a -> IO (IORef a)
newIORef Vault
Vault.empty
  Eff Any a -> Env -> IO a
forall (es :: Effects) a. Eff es a -> Env -> IO a
unsafeUnEff (IOE Any -> Eff Any a
forall (e :: Effects). IOE e -> Eff e a
eff IOE Any
forall (e :: Effects). IOE e
MkIOE) Env
emptyEnv

unsafeProvideIO ::
  (forall e. IOE e -> Eff (e :& es) a) ->
  -- | ͘
  Eff es a
unsafeProvideIO :: forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO forall (e :: Effects). IOE e -> Eff (e :& es) a
eff = (IOE es -> Eff (es :& es) a) -> IOE es -> Eff es a
forall (e :: Effects) (es :: Effects) t r.
(e <: es) =>
(t -> Eff (es :& e) r) -> t -> Eff es r
useImplIn IOE es -> Eff (es :& es) a
forall (e :: Effects). IOE e -> Eff (e :& es) a
eff IOE es
forall (e :: Effects). IOE e
MkIOE

newtype Tell w e = Tell (Yield w e)
  deriving (HandleD (Tell w)
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (Tell w e) (Tell w es)) =>
HandleD (Tell w) -> Handle (Tell w)
forall w. HandleD (Tell w)
forall w (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Tell w e) (Tell w es)
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Tell w e) (Tell w es)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
$chandleImpl :: forall w. HandleD (Tell w)
handleImpl :: HandleD (Tell w)
Handle) via OneWayCoercibleHandle (Tell w)

instance (e <: es) => OneWayCoercible (Tell w e) (Tell w es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (Tell w e) (Tell w es)
oneWayCoercibleImpl = OneWayCoercibleD (Tell w e) (Tell w es)
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible

-- |
-- @
-- >>> 'Data.Monoid.getAny' $ snd $ runPureEff $ runWriter $ \\w -> do
--       -- Non-empty list (the tell event does happen)
--       for_ [1 .. 10] $ \\_ -> tell w ('Data.Monoid.Any' True)
-- True
-- @
runWriter ::
  (Monoid w) =>
  -- | ͘
  (forall e. Writer w e -> Eff (e :& es) r) ->
  Eff es (r, w)
runWriter :: forall w (es :: Effects) r.
Monoid w =>
(forall (e :: Effects). Writer w e -> Eff (e :& es) r)
-> Eff es (r, w)
runWriter forall (e :: Effects). Writer w e -> Eff (e :& es) r
f = w
-> (forall {e :: Effects}. Modify w e -> Eff (e :& es) r)
-> Eff es (r, w)
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es (a, s)
runState w
forall a. Monoid a => a
mempty ((forall {e :: Effects}. Modify w e -> Eff (e :& es) r)
 -> Eff es (r, w))
-> (forall {e :: Effects}. Modify w e -> Eff (e :& es) r)
-> Eff es (r, w)
forall a b. (a -> b) -> a -> b
$ \Modify w e
st -> do
  (forall (e1 :: Effects).
 Request w () e1 -> Eff (e1 :& (e :& es)) r)
-> (w -> Eff (e :& es) ()) -> Eff (e :& es) r
forall a b (es :: Effects) r.
(forall (e1 :: Effects). Request a b e1 -> Eff (e1 :& es) r)
-> (a -> Eff es b) -> Eff es r
forEach (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r
forall (e :: Effects) (es :: Effects) (e1 :: Effects) r.
(e <: es) =>
Eff (e1 :& e) r -> Eff (e1 :& es) r
useImplUnder (Eff (e1 :& es) r -> Eff (e1 :& (e :& es)) r)
-> (Request w () e1 -> Eff (e1 :& es) r)
-> Request w () e1
-> Eff (e1 :& (e :& es)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer w e1 -> Eff (e1 :& es) r
forall (e :: Effects). Writer w e -> Eff (e :& es) r
f (Writer w e1 -> Eff (e1 :& es) r)
-> (Request w () e1 -> Writer w e1)
-> Request w () e1
-> Eff (e1 :& es) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request w () e1 -> Writer w e1
forall w (e :: Effects). Yield w e -> Tell w e
Tell) ((w -> Eff (e :& es) ()) -> Eff (e :& es) r)
-> (w -> Eff (e :& es) ()) -> Eff (e :& es) r
forall a b. (a -> b) -> a -> b
$ \w
ww -> do
    Modify w e -> (w -> w) -> Eff (e :& es) ()
forall (e :: Effects) (es :: Effects) s.
(e <: es) =>
Modify s e -> (s -> s) -> Eff es ()
modify Modify w e
st (w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
ww)

-- |
-- @
-- >>> 'Data.Monoid.getAny' $ runPureEff $ execWriter $ \\w -> do
--       -- Non-empty list (the tell event does happen)
--       for_ [1 .. 10] $ \\_ -> tell w ('Data.Monoid.Any' True)
-- True
-- @
--
-- @
-- >>> 'Data.Monoid.getAny' $ runPureEff $ execWriter $ \\w -> do
--       -- Empty list (the tell event does not happen)
--       for_ [] $ \\_ -> tell w ('Data.Monoid.Any' True)
-- False
-- @
execWriter ::
  (Monoid w) =>
  -- | ͘
  (forall e. Writer w e -> Eff (e :& es) r) ->
  Eff es w
execWriter :: forall w (es :: Effects) r.
Monoid w =>
(forall (e :: Effects). Writer w e -> Eff (e :& es) r) -> Eff es w
execWriter forall (e :: Effects). Writer w e -> Eff (e :& es) r
f = ((r, w) -> w) -> Eff es (r, w) -> Eff es w
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (r, w) -> w
forall a b. (a, b) -> b
snd ((forall (e :: Effects). Writer w e -> Eff (e :& es) r)
-> Eff es (r, w)
forall w (es :: Effects) r.
Monoid w =>
(forall (e :: Effects). Writer w e -> Eff (e :& es) r)
-> Eff es (r, w)
runWriter Tell w e -> Eff ('Union e es) r
forall (e :: Effects). Writer w e -> Eff (e :& es) r
f)

-- |
-- @
-- >>> 'Data.Monoid.getAny' $ runPureEff $ execWriter $ \\w -> do
--       -- Non-empty list (the tell event does happen)
--       for_ [1 .. 10] $ \\_ -> tell w ('Data.Monoid.Any' True)
-- True
-- @
tell ::
  (e <: es) =>
  Tell w e ->
  -- | ͘
  w ->
  Eff es ()
tell :: forall (e :: Effects) (es :: Effects) w.
(e <: es) =>
Tell w e -> w -> Eff es ()
tell (Tell Yield w e
y) = Yield w e -> w -> Eff es ()
forall (e1 :: Effects) (es :: Effects) a.
(e1 <: es) =>
Yield a e1 -> a -> Eff es ()
yield Yield w e
y

type Ask :: Type -> Effects -> Type
newtype Ask r e = MkReader (Vault.Key r)
  deriving (HandleD (Ask r)
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (Ask r e) (Ask r es)) =>
HandleD (Ask r) -> Handle (Ask r)
forall r. HandleD (Ask r)
forall r (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Ask r e) (Ask r es)
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (Ask r e) (Ask r es)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
$chandleImpl :: forall r. HandleD (Ask r)
handleImpl :: HandleD (Ask r)
Handle) via OneWayCoercibleHandle (Ask r)

instance (e <: es) => OneWayCoercible (Ask r e) (Ask r es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (Ask r e) (Ask r es)
oneWayCoercibleImpl = OneWayCoercibleD (Ask r e) (Ask r es)
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible

type role Ask representational nominal

runReader ::
  -- | Initial value for @Reader@.
  r ->
  (forall e. Reader r e -> Eff (e :& es) a) ->
  Eff es a
runReader :: forall r (es :: Effects) a.
r
-> (forall (e :: Effects). Reader r e -> Eff (e :& es) a)
-> Eff es a
runReader r
r forall (e :: Effects). Reader r e -> Eff (e :& es) a
f = do
  Eff es (Key r)
-> (Key r -> Eff es ()) -> (Key r -> Eff es a) -> Eff es a
forall (es :: Effects) a b.
Eff es a -> (a -> Eff es ()) -> (a -> Eff es b) -> Eff es b
bracket
    ( (Env -> IO (Key r)) -> Eff es (Key r)
forall (es :: Effects) a. (Env -> IO a) -> Eff es a
UnsafeMkEff ((Env -> IO (Key r)) -> Eff es (Key r))
-> (Env -> IO (Key r)) -> Eff es (Key r)
forall a b. (a -> b) -> a -> b
$ \Env
vault -> do
        Key r
k <- IO (Key r)
forall a. IO (Key a)
Vault.newKey
        Env -> (Vault -> Vault) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' Env
vault (\Vault
v -> Key r -> r -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key r
k r
r Vault
v)
        Key r -> IO (Key r)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Key r
k
    )
    (\Key r
k -> (Env -> IO ()) -> Eff es ()
forall (es :: Effects) a. (Env -> IO a) -> Eff es a
UnsafeMkEff ((Env -> IO ()) -> Eff es ()) -> (Env -> IO ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \Env
vault -> Env -> (Vault -> Vault) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' Env
vault (Key r -> Vault -> Vault
forall a. Key a -> Vault -> Vault
Vault.delete Key r
k))
    (\Key r
k -> Eff (es :& es) a -> Eff es a
forall (a :: Effects) r. Eff (a :& a) r -> Eff a r
makeOp (Reader r es -> Eff (es :& es) a
forall (e :: Effects). Reader r e -> Eff (e :& es) a
f (Key r -> Reader r es
forall r (e :: Effects). Key r -> Ask r e
MkReader Key r
k)))

-- | Read the value.  Note that @ask@ has the property that these two
-- operations are always equivalent:
--
-- @
-- do
--   r1 <- ask re
--   r2 <- ask re
--   pure (r1, r2)
-- @
--
-- @
-- do
--   r <- ask re
--   pure (r, r)
-- @
ask ::
  (e <: es) =>
  -- | ͘
  Ask r e ->
  Eff es r
ask :: forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Ask r e -> Eff es r
ask (MkReader Key r
k) = (Env -> IO r) -> Eff es r
forall (es :: Effects) a. (Env -> IO a) -> Eff es a
UnsafeMkEff ((Env -> IO r) -> Eff es r) -> (Env -> IO r) -> Eff es r
forall a b. (a -> b) -> a -> b
$ \Env
vault -> do
  Vault
v <- Env -> IO Vault
forall a. IORef a -> IO a
readIORef Env
vault
  case Key r -> Vault -> Maybe r
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key r
k Vault
v of
    Maybe r
Nothing -> String -> IO r
forall a. HasCallStack => String -> a
error String
msg
    Just r
ref -> r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
ref
  where
    msg :: String
msg =
      [String] -> String
unlines
        [ String
"ask called on out of scope reference",
          [String] -> String
unwords
            [ String
"If you haven't subverted Bluefin's type system",
              String
"then this is a Bluefin bug.",
              String
"Please report it at",
              String
"https://github.com/tomjaguarpaw/bluefin/issues/new"
            ]
        ]

-- | Read the value modified by a function
asks ::
  (e <: es) =>
  Ask r e ->
  -- | Read the value modified by this function
  (r -> a) ->
  Eff es a
asks :: forall (e :: Effects) (es :: Effects) r a.
(e <: es) =>
Ask r e -> (r -> a) -> Eff es a
asks Ask r e
r r -> a
f = (r -> a) -> Eff es r -> Eff es a
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> a
f (Ask r e -> Eff es r
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Ask r e -> Eff es r
ask Ask r e
r)

-- | Locally override the value in the @Ask@. It will be restored
-- when the @local@ block ends.
local ::
  (e1 <: es) =>
  Ask r e1 ->
  -- | In the body, the reader value is modified by this function.
  (r -> r) ->
  -- | Body
  Eff es a ->
  Eff es a
local :: forall (e1 :: Effects) (es :: Effects) r a.
(e1 <: es) =>
Ask r e1 -> (r -> r) -> Eff es a -> Eff es a
local (MkReader Key r
key) r -> r
f Eff es a
k = (Env -> IO a) -> Eff es a
forall (es :: Effects) a. (Env -> IO a) -> Eff es a
UnsafeMkEff ((Env -> IO a) -> Eff es a) -> (Env -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \env :: Env
env@Env
vault -> do
  Vault
orig <- Env -> IO Vault
forall a. IORef a -> IO a
readIORef Env
vault
  IO () -> (() -> IO ()) -> (() -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Control.Exception.bracket
    (Env -> Vault -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef Env
vault ((r -> r) -> Key r -> Vault -> Vault
forall a. (a -> a) -> Key a -> Vault -> Vault
Vault.adjust r -> r
f Key r
key Vault
orig))
    (\() -> Env -> Vault -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef Env
vault Vault
orig)
    (\() -> case Eff es a
k of UnsafeMkEff Env -> IO a
m -> Env -> IO a
m Env
env)

newtype AskCapability h e = UnsafeMkHandleReader (Ask (h e) e)
  deriving (HandleD (AskCapability h)
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (AskCapability h e) (AskCapability h es)) =>
HandleD (AskCapability h) -> Handle (AskCapability h)
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (AskCapability h e) (AskCapability h es)
forall (h :: Effects -> *). HandleD (AskCapability h)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (AskCapability h e) (AskCapability h es)
$chandleImpl :: forall (h :: Effects -> *). HandleD (AskCapability h)
handleImpl :: HandleD (AskCapability h)
Handle) via OneWayCoercibleHandle (AskCapability h)

-- In general this is really tremendously unsafe because we could take
-- an `HandleReader h e`, map it to `HandleReader h es`, write an `h
-- es` to it and then use the original handle to use the `h es` at
-- type `h e`.  We must be very careful to only ever write to the
-- mapped handle in such a way that we can only use the new value at
-- the correct effect tag.  That is, we should only ever write to the
-- handle via `localHandle`.
mapHandleReader ::
  forall h e es.
  (Handle h, e <: es) =>
  HandleReader h e ->
  -- | ͘
  HandleReader h es
mapHandleReader :: forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e <: es) =>
HandleReader h e -> HandleReader h es
mapHandleReader = case Coercion (h e) (h es)
coerceH of Coercion (h e) (h es)
Coercion -> HandleReader h e -> HandleReader h es
forall a b. Coercible a b => a -> b
coerce
  where
    oneWayCoerceH :: OneWayCoercion (h e) (h es)
    oneWayCoerceH :: OneWayCoercion (h e) (h es)
oneWayCoerceH = OneWayCoercion (h e) (h es)
forall {k} (a :: k) (b :: k).
OneWayCoercible a b =>
OneWayCoercion a b
oneWayCoercion

    coerceH :: Coercion (h e) (h es)
    coerceH :: Coercion (h e) (h es)
coerceH = OneWayCoercion (h e) (h es) -> Coercion (h e) (h es)
forall {k} (a :: k) (b :: k). OneWayCoercion a b -> Coercion a b
unsafeCoercionOfOneWayCoercion OneWayCoercion (h e) (h es)
oneWayCoerceH

localHandle ::
  (e <: es, Handle h) =>
  HandleReader h e ->
  (h es -> h es) ->
  Eff es r ->
  -- | ͘
  Eff es r
localHandle :: forall (e :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e <: es, Handle h) =>
HandleReader h e -> (h es -> h es) -> Eff es r -> Eff es r
localHandle HandleReader h e
hh h es -> h es
f Eff es r
k = do
  let UnsafeMkHandleReader Ask (h es) es
st = HandleReader h e -> AskCapability h es
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e <: es) =>
h e -> h es
mapHandle HandleReader h e
hh
  Ask (h es) es -> (h es -> h es) -> Eff es r -> Eff es r
forall (e1 :: Effects) (es :: Effects) r a.
(e1 <: es) =>
Ask r e1 -> (r -> r) -> Eff es a -> Eff es a
local Ask (h es) es
st h es -> h es
f Eff es r
k

askHandle ::
  (e <: es, Handle h) =>
  HandleReader h e ->
  -- | ͘
  Eff es (h es)
askHandle :: forall (e :: Effects) (es :: Effects) (h :: Effects -> *).
(e <: es, Handle h) =>
HandleReader h e -> Eff es (h es)
askHandle HandleReader h e
hh = let UnsafeMkHandleReader Ask (h es) es
st = HandleReader h e -> AskCapability h es
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e <: es) =>
h e -> h es
mapHandle HandleReader h e
hh in Ask (h es) es -> Eff es (h es)
forall (e :: Effects) (es :: Effects) r.
(e <: es) =>
Ask r e -> Eff es r
ask Ask (h es) es
st

asksHandle ::
  (e1 <: es, Handle h) =>
  HandleReader h e1 ->
  (forall e. h e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
asksHandle :: forall (e1 :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e1 <: es, Handle h) =>
HandleReader h e1
-> (forall (e :: Effects). h e -> Eff (e :& es) r) -> Eff es r
asksHandle HandleReader h e1
hh forall (e :: Effects). h e -> Eff (e :& es) r
k = do
  h es
h <- HandleReader h e1 -> Eff es (h es)
forall (e :: Effects) (es :: Effects) (h :: Effects -> *).
(e <: es, Handle h) =>
HandleReader h e -> Eff es (h es)
askHandle HandleReader h e1
hh
  Eff (es :& es) r -> Eff es r
forall (a :: Effects) r. Eff (a :& a) r -> Eff a r
makeOp (h es -> Eff (es :& es) r
forall (e :: Effects). h e -> Eff (e :& es) r
k h es
h)

runHandleReader ::
  (e1 <: es, Handle h) =>
  h e1 ->
  (forall e. HandleReader h e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
runHandleReader :: forall (e1 :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e1 <: es, Handle h) =>
h e1
-> (forall (e :: Effects). HandleReader h e -> Eff (e :& es) r)
-> Eff es r
runHandleReader h e1
h forall (e :: Effects). HandleReader h e -> Eff (e :& es) r
k = do
  h es
-> (forall {e :: Effects}. Reader (h es) e -> Eff (e :& es) r)
-> Eff es r
forall r (es :: Effects) a.
r
-> (forall (e :: Effects). Reader r e -> Eff (e :& es) a)
-> Eff es a
runReader (h e1 -> h es
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e <: es) =>
h e -> h es
mapHandle h e1
h) ((forall {e :: Effects}. Reader (h es) e -> Eff (e :& es) r)
 -> Eff es r)
-> (forall {e :: Effects}. Reader (h es) e -> Eff (e :& es) r)
-> Eff es r
forall a b. (a -> b) -> a -> b
$ \(Reader (h es) e
st :: Ask (h es) e) -> do
    let oneWayCoerceH :: OneWayCoercion (h es) (h (e :& es))
        oneWayCoerceH :: OneWayCoercion (h es) (h (e :& es))
oneWayCoerceH = OneWayCoercion (h es) (h (e :& es))
forall {k} (a :: k) (b :: k).
OneWayCoercible a b =>
OneWayCoercion a b
oneWayCoercion

    let coerceH :: Coercion (h es) (h (e :& es))
        coerceH :: Coercion (h es) (h (e :& es))
coerceH = OneWayCoercion (h es) (h (e :& es))
-> Coercion (h es) (h (e :& es))
forall {k} (a :: k) (b :: k). OneWayCoercion a b -> Coercion a b
unsafeCoercionOfOneWayCoercion OneWayCoercion (h es) (h (e :& es))
oneWayCoerceH

    let mapS :: Ask (h es) e' -> Ask (h (e :& es)) e'
        mapS :: forall (e' :: Effects). Ask (h es) e' -> Ask (h (e :& es)) e'
mapS = case Coercion (h es) (h (e :& es))
coerceH of Coercion (h es) (h (e :& es))
Coercion -> Ask (h es) e' -> Ask (h (e :& es)) e'
forall a b. Coercible a b => a -> b
coerce

    let h' :: HandleReader h (e :& es)
        h' :: HandleReader h (e :& es)
h' = case Coercion (h es) (h (e :& es))
coerceH of
          Coercion (h es) (h (e :& es))
Coercion ->
            Ask (h (e :& es)) (e :& es) -> HandleReader h (e :& es)
forall (h :: Effects -> *) (e :: Effects).
Ask (h e) e -> AskCapability h e
UnsafeMkHandleReader (Ask (h es) (e :& es) -> Ask (h (e :& es)) (e :& es)
forall (e' :: Effects). Ask (h es) e' -> Ask (h (e :& es)) e'
mapS (Reader (h es) e -> Ask (h es) (e :& es)
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e <: es) =>
h e -> h es
mapHandle Reader (h es) e
st))

    (HandleReader h (e :& es) -> Eff ((e :& es) :& es) r)
-> HandleReader h (e :& es) -> Eff (e :& es) r
forall (e :: Effects) (es :: Effects) t r.
(e <: es) =>
(t -> Eff (es :& e) r) -> t -> Eff es r
useImplIn HandleReader h (e :& es) -> Eff ((e :& es) :& es) r
forall (e :: Effects). HandleReader h e -> Eff (e :& es) r
k HandleReader h (e :& es)
h'

instance (e <: es) => OneWayCoercible (AskCapability h e) (AskCapability h es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (AskCapability h e) (AskCapability h es)
oneWayCoercibleImpl = OneWayCoercibleD (AskCapability h e) (AskCapability h es)
forall {k} (a :: k) (b :: k). OneWayCoercibleD a b
unsafeOneWayCoercible

newtype ConstEffect r (e :: Effects) = MkConstEffect r
  deriving (HandleD (ConstEffect r)
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (ConstEffect r e) (ConstEffect r es)) =>
HandleD (ConstEffect r) -> Handle (ConstEffect r)
forall r. HandleD (ConstEffect r)
forall r (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (ConstEffect r e) (ConstEffect r es)
forall (e :: Effects) (es :: Effects).
(e <: es) =>
OneWayCoercible (ConstEffect r e) (ConstEffect r es)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e <: es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h -> Handle h
$chandleImpl :: forall r. HandleD (ConstEffect r)
handleImpl :: HandleD (ConstEffect r)
Handle) via OneWayCoercibleHandle (ConstEffect r)

instance (e <: es) => OneWayCoercible (ConstEffect r e) (ConstEffect r es) where
  oneWayCoercibleImpl :: OneWayCoercibleD (ConstEffect r e) (ConstEffect r es)
oneWayCoercibleImpl = OneWayCoercibleD (ConstEffect r e) (ConstEffect r es)
forall {k} (a :: k) (b :: k). Coercible a b => OneWayCoercibleD a b
oneWayCoercible

runConstEffect ::
  r ->
  (forall e. ConstEffect r e -> Eff (e :& es) a) ->
  -- | ͘
  Eff es a
runConstEffect :: forall r (es :: Effects) a.
r
-> (forall (e :: Effects). ConstEffect r e -> Eff (e :& es) a)
-> Eff es a
runConstEffect r
r forall (e :: Effects). ConstEffect r e -> Eff (e :& es) a
k = (ConstEffect r es -> Eff (es :& es) a)
-> ConstEffect r es -> Eff es a
forall (e :: Effects) (es :: Effects) t r.
(e <: es) =>
(t -> Eff (es :& e) r) -> t -> Eff es r
useImplIn ConstEffect r es -> Eff (es :& es) a
forall (e :: Effects). ConstEffect r e -> Eff (e :& es) a
k (r -> ConstEffect r es
forall r (e :: Effects). r -> ConstEffect r e
MkConstEffect r
r)

-- Capbility synonyms

type Reader = Ask

type HandleReader = AskCapability

-- | Capability to await values of type @a@
type Consume a = Await a

type Jump = JumpTo

-- | Capability to yield a value of type @a@ and then await a value of
-- type @b@ in response.
type Coroutine = Request

type EarlyReturn r = ReturnEarly r

-- | Capability to modify a reference to an @s@
type State = Modify

type Writer = Tell

-- | Capability to throw an exception of type @exn@
type Exception = Throw

-- | Capability to yield values of type @a@.  It is implemented as a
-- 'Bluefin.Capability.Request' capability that can yield values of
-- type @a@ and then await values of type @()@.
type Stream a = Yield a

runAsk ::
  -- | Initial value for @Ask@.
  r ->
  (forall e. Ask r e -> Eff (e :& es) a) ->
  Eff es a
runAsk :: forall r (es :: Effects) a.
r
-> (forall (e :: Effects). Reader r e -> Eff (e :& es) a)
-> Eff es a
runAsk = r
-> (forall (e :: Effects). Reader r e -> Eff (e :& es) a)
-> Eff es a
forall r (es :: Effects) a.
r
-> (forall (e :: Effects). Reader r e -> Eff (e :& es) a)
-> Eff es a
runReader

-- | Interleave the execution of two Bluefin operations by sending
-- their requests to each other.  @a@s are sent from the first to the
-- second which responds by returning @b@s.  The first runs until it
-- yields its first @a@ it starts the second (which is awaiting an
-- @a@).
connectRequests ::
  forall es a b r.
  (forall e. Request a b e -> Eff (e :& es) r) ->
  (forall e. a -> Request b a e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
connectRequests :: forall (es :: Effects) a b r.
(forall (e :: Effects). Coroutine a b e -> Eff (e :& es) r)
-> (forall (e :: Effects). a -> Coroutine b a e -> Eff (e :& es) r)
-> Eff es r
connectRequests = (forall (e :: Effects). Coroutine a b e -> Eff (e :& es) r)
-> (forall (e :: Effects). a -> Coroutine b a e -> Eff (e :& es) r)
-> Eff es r
forall (es :: Effects) a b r.
(forall (e :: Effects). Coroutine a b e -> Eff (e :& es) r)
-> (forall (e :: Effects). a -> Coroutine b a e -> Eff (e :& es) r)
-> Eff es r
connectCoroutines

request ::
  (e1 <: es) =>
  Request a b e1 ->
  -- | ͘
  a ->
  Eff es b
request :: forall (e1 :: Effects) (es :: Effects) a b.
(e1 <: es) =>
Coroutine a b e1 -> a -> Eff es b
request = Coroutine a b e1 -> a -> Eff es b
forall (e1 :: Effects) (es :: Effects) a b.
(e1 <: es) =>
Coroutine a b e1 -> a -> Eff es b
yieldCoroutine

-- | 'awaitYield' is 'Bluefin.Capability.Request.connectRequests'
-- specialized to @Await@ and @Yield@, which is the most common case.
awaitYield ::
  -- | Starts running first. Each 'await' from the @Await@ ...
  (forall e. Await a e -> Eff (e :& es) r) ->
  -- | ... receives the value 'yield'ed from the @Yield@
  (forall e. Yield a e -> Eff (e :& es) r) ->
  Eff es r
awaitYield :: forall a (es :: Effects) r.
(forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
awaitYield = (forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
forall a (es :: Effects) r.
(forall (e :: Effects). Consume a e -> Eff (e :& es) r)
-> (forall (e :: Effects). Stream a e -> Eff (e :& es) r)
-> Eff es r
consumeStream

-- | A version of 'forEach' specialized to @Await@.  Every time the
-- @Await@ is used to 'await' a @b@, feed it the one created by the
-- handler.
eachAwait ::
  -- | Body
  (forall e. Await b e -> Eff (e :& es) r) ->
  -- | Value to send to each @await@ in the body.
  Eff es b ->
  Eff es r
eachAwait :: forall b (es :: Effects) r.
(forall (e :: Effects). Consume b e -> Eff (e :& es) r)
-> Eff es b -> Eff es r
eachAwait = (forall (e :: Effects). Consume b e -> Eff (e :& es) r)
-> Eff es b -> Eff es r
forall b (es :: Effects) r.
(forall (e :: Effects). Consume b e -> Eff (e :& es) r)
-> Eff es b -> Eff es r
consumeEach

-- |
-- @
-- runPureEff $ yieldToList $ \yOut -> do
--   awaitYield
--     (\\c -> takeAwait 4 c yOut)
--     (\\yIn -> inFoldable [1..10] yIn)
-- ([1,2,3,4],())
-- @
takeAwait ::
  (e1 <: es, e2 <: es) =>
  Int ->
  Await a e1 ->
  Yield a e2 ->
  -- | ͘
  Eff es ()
takeAwait :: forall (e1 :: Effects) (es :: Effects) (e2 :: Effects) a.
(e1 <: es, e2 <: es) =>
Int -> Consume a e1 -> Stream a e2 -> Eff es ()
takeAwait = Int -> Consume a e1 -> Stream a e2 -> Eff es ()
forall (e1 :: Effects) (es :: Effects) (e2 :: Effects) a.
(e1 <: es, e2 <: es) =>
Int -> Consume a e1 -> Stream a e2 -> Eff es ()
takeConsume

-- |
--
-- Ignore all yielded elements.
--
-- @
-- >>> runPureEff $ ignoreYield $ \\y -> do
--      for_ [0 .. 4] $ \\i -> do
--        yield y i
--        yield y (i * 10)
--
--      pure 42
-- 42
-- @
ignoreYield ::
  (forall e1. Yield a e1 -> Eff (e1 :& es) r) ->
  -- | ͘
  Eff es r
ignoreYield :: forall a (es :: Effects) r.
(forall (e1 :: Effects). Stream a e1 -> Eff (e1 :& es) r)
-> Eff es r
ignoreYield = (forall (e1 :: Effects). Stream a e1 -> Eff (e1 :& es) r)
-> Eff es r
forall a (es :: Effects) r.
(forall (e1 :: Effects). Stream a e1 -> Eff (e1 :& es) r)
-> Eff es r
ignoreStream

-- |
-- @
-- runPureEff $ yieldToList $ \yOut -> do
--   consumeStream
--     (\\c -> takeAwait 6 c yOut)
--     (\\yIn -> cycleToYield [1..3] yIn)
-- ([1,2,3,1,2,3],())
-- @
cycleToYield ::
  (Foldable f, e1 <: es) =>
  f a ->
  Yield a e1 ->
  -- | ͘
  Eff es ()
cycleToYield :: forall (t :: * -> *) (e1 :: Effects) (es :: Effects) a.
(Foldable t, e1 <: es) =>
t a -> Yield a e1 -> Eff es ()
cycleToYield = f a -> Yield a e1 -> Eff es ()
forall (t :: * -> *) (e1 :: Effects) (es :: Effects) a.
(Foldable t, e1 <: es) =>
t a -> Yield a e1 -> Eff es ()
cycleToStream

-- | Run an 'Eff' action with the ability to return early to this
-- point.  In the language of exceptions, @withReturnEarly@ installs
-- an exception handler for an exception of type @r@.
--
-- @
-- >>> runPureEff $ withReturnEarly $ \\e -> do
--       for_ [1 .. 10] $ \\i -> do
--         when (i >= 5) $
--           returnEarly e ("Returned early with " ++ show i)
--       pure "End of loop"
-- "Returned early with 5"
-- @
withReturnEarly ::
  (forall e. ReturnEarly r e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
withReturnEarly :: forall r (es :: Effects).
(forall (e :: Effects). EarlyReturn r e -> Eff (e :& es) r)
-> Eff es r
withReturnEarly = (forall (e :: Effects). EarlyReturn r e -> Eff (e :& es) r)
-> Eff es r
forall r (es :: Effects).
(forall (e :: Effects). EarlyReturn r e -> Eff (e :& es) r)
-> Eff es r
withEarlyReturn

-- |
-- @
-- >>> runPureEff $ evalModify 10 $ \\st -> do
--       n <- get st
--       pure (2 * n)
-- 20
-- @
evalModify ::
  -- | Initial value of modifyable state
  s ->
  -- | Stateful computation
  (forall e. Modify s e -> Eff (e :& es) a) ->
  -- | Result
  Eff es a
evalModify :: forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es a
evalModify = s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es a
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es a
evalState

-- |
-- @
-- >>> runPureEff $ withModify 10 $ \\st -> do
--       n <- get st
--       pure (\s -> (2 * n, s))
-- (20,10)
-- @
withModify ::
  -- | Initial value of modifyable state
  s ->
  -- | Stateful computation
  (forall e. Modify s e -> Eff (e :& es) (s -> a)) ->
  -- | Result
  Eff es a
withModify :: forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) (s -> a))
-> Eff es a
withModify = s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) (s -> a))
-> Eff es a
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) (s -> a))
-> Eff es a
withState

-- |
-- @
-- >>> runPureEff $ runModify 10 $ \\st -> do
--       n <- get st
--       pure (2 * n)
-- (20,10)
-- @
runModify ::
  -- | Initial value of modifyable state
  s ->
  -- | Stateful computation
  (forall e. Modify s e -> Eff (e :& es) a) ->
  -- | Result and final state
  Eff es (a, s)
runModify :: forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es (a, s)
runModify = s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es (a, s)
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). Modify s e -> Eff (e :& es) a)
-> Eff es (a, s)
runState

-- |
-- @
-- >>> 'Data.Monoid.getAny' $ snd $ runPureEff $ runTell $ \\w -> do
--       -- Non-empty list (the tell event does happen)
--       for_ [1 .. 10] $ \\_ -> tell w ('Data.Monoid.Any' True)
-- True
-- @
runTell ::
  (Monoid w) =>
  -- | ͘
  (forall e. Tell w e -> Eff (e :& es) r) ->
  Eff es (r, w)
runTell :: forall w (es :: Effects) r.
Monoid w =>
(forall (e :: Effects). Writer w e -> Eff (e :& es) r)
-> Eff es (r, w)
runTell = (forall (e :: Effects). Writer w e -> Eff (e :& es) r)
-> Eff es (r, w)
forall w (es :: Effects) r.
Monoid w =>
(forall (e :: Effects). Writer w e -> Eff (e :& es) r)
-> Eff es (r, w)
runWriter

-- |
-- @
-- >>> 'Data.Monoid.getAny' $ runPureEff $ execTell $ \\w -> do
--       -- Non-empty list (the tell event does happen)
--       for_ [1 .. 10] $ \\_ -> tell w ('Data.Monoid.Any' True)
-- True
-- @
--
-- @
-- >>> 'Data.Monoid.getAny' $ runPureEff $ execTell $ \\w -> do
--       -- Empty list (the tell event does not happen)
--       for_ [] $ \\_ -> tell w ('Data.Monoid.Any' True)
-- False
-- @
execTell ::
  (Monoid w) =>
  -- | ͘
  (forall e. Tell w e -> Eff (e :& es) r) ->
  Eff es w
execTell :: forall w (es :: Effects) r.
Monoid w =>
(forall (e :: Effects). Writer w e -> Eff (e :& es) r) -> Eff es w
execTell = (forall (e :: Effects). Writer w e -> Eff (e :& es) r) -> Eff es w
forall w (es :: Effects) r.
Monoid w =>
(forall (e :: Effects). Writer w e -> Eff (e :& es) r) -> Eff es w
execWriter

runAskCapability ::
  (e1 <: es, Handle h) =>
  h e1 ->
  (forall e. AskCapability h e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
runAskCapability :: forall (e1 :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e1 <: es, Handle h) =>
h e1
-> (forall (e :: Effects). HandleReader h e -> Eff (e :& es) r)
-> Eff es r
runAskCapability = h e1
-> (forall (e :: Effects). HandleReader h e -> Eff (e :& es) r)
-> Eff es r
forall (e1 :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e1 <: es, Handle h) =>
h e1
-> (forall (e :: Effects). HandleReader h e -> Eff (e :& es) r)
-> Eff es r
runHandleReader

-- | Do not use @askCapability@.  It is unsafe and will be removed in
-- a future version.  Use 'asksCapability' instead.
askCapability ::
  (e <: es, Handle h) =>
  AskCapability h e ->
  -- | ͘
  Eff es (h es)
askCapability :: forall (e :: Effects) (es :: Effects) (h :: Effects -> *).
(e <: es, Handle h) =>
HandleReader h e -> Eff es (h es)
askCapability = HandleReader h e -> Eff es (h es)
forall (e :: Effects) (es :: Effects) (h :: Effects -> *).
(e <: es, Handle h) =>
HandleReader h e -> Eff es (h es)
askHandle

asksCapability ::
  (e1 <: es, Handle h) =>
  AskCapability h e1 ->
  (forall e. h e -> Eff (e :& es) r) ->
  -- | ͘
  Eff es r
asksCapability :: forall (e1 :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e1 <: es, Handle h) =>
HandleReader h e1
-> (forall (e :: Effects). h e -> Eff (e :& es) r) -> Eff es r
asksCapability = HandleReader h e1
-> (forall (e :: Effects). h e -> Eff (e :& es) r) -> Eff es r
forall (e1 :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e1 <: es, Handle h) =>
HandleReader h e1
-> (forall (e :: Effects). h e -> Eff (e :& es) r) -> Eff es r
asksHandle

localCapability ::
  (e <: es, Handle h) =>
  AskCapability h e ->
  (h es -> h es) ->
  Eff es r ->
  -- | ͘
  Eff es r
localCapability :: forall (e :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e <: es, Handle h) =>
HandleReader h e -> (h es -> h es) -> Eff es r -> Eff es r
localCapability = HandleReader h e -> (h es -> h es) -> Eff es r -> Eff es r
forall (e :: Effects) (es :: Effects) (h :: Effects -> *) r.
(e <: es, Handle h) =>
HandleReader h e -> (h es -> h es) -> Eff es r -> Eff es r
localHandle

-- |
-- @
-- runPureEff $ 'withStateSource' $ \\source -> do
--   n <- 'newState' source 5
--   total <- newState source 0
--
--   'Bluefin.Capability.JumpTo.withJumpTo' $ \\done -> forever $ do
--     n' <- 'Bluefin.Capability.Modify.get' n
--     'Bluefin.Capability.Modify.modify' total (+ n')
--     when (n' == 0) $ 'Bluefin.Capability.JumpTo.jumpTo' done
--     modify n (subtract 1)
--
--   get total
-- 15
-- @
withJumpTo ::
  (forall e. JumpTo e -> Eff (e :& es) ()) ->
  -- | ͘
  Eff es ()
withJumpTo :: forall (es :: Effects).
(forall (e :: Effects). Jump e -> Eff (e :& es) ()) -> Eff es ()
withJumpTo = (forall (e :: Effects). EarlyReturn () e -> Eff (e :& es) ())
-> Eff es ()
forall r (es :: Effects).
(forall (e :: Effects). EarlyReturn r e -> Eff (e :& es) r)
-> Eff es r
withEarlyReturn