{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
-- | The 'Eff' monad.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Effectful.Internal.Monad
  ( -- * Monad
    Eff(..)
  , runEff
  , impureEff
  , impureEff_

  -- * IO
  , IOE
  , runIOE

  -- * Helpers
  , runEffect
  , evalEffect
  , execEffect
  , getEffect
  , putEffect
  , stateEffect
  , localEffect
  , listenEffect
  , readerEffectM
  , stateEffectM
  ) where

import Control.Concurrent (myThreadId)
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Control
import GHC.Magic (oneShot)

import Effectful.Internal.Env
import Effectful.Internal.Has

type role Eff nominal representational

newtype Eff (es :: [Effect]) a = Eff { Eff es a -> Env es -> IO a
unEff :: Env es -> IO a }

runEff :: Eff '[] a -> IO a
runEff :: Eff '[] a -> IO a
runEff (Eff Env '[] -> IO a
m) = Env '[] -> IO a
m (Env '[] -> IO a) -> IO (Env '[]) -> IO a
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
Monad m =>
(a -> m b) -> m a -> m b
=<< IO (Env '[])
emptyEnv

impureEff :: (Env es -> IO a) -> Eff es a
impureEff :: (Env es -> IO a) -> Eff es a
impureEff Env es -> IO a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
Eff ((Env es -> IO a) -> Env es -> IO a
oneShot Env es -> IO a
m)

impureEff_ :: IO a -> Eff es a
impureEff_ :: IO a -> Eff es a
impureEff_ IO a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
_ -> IO a
m

----------------------------------------
-- Base

instance Functor (Eff es) where
  fmap :: (a -> b) -> Eff es a -> Eff es b
fmap a -> b
f (Eff Env es -> IO a
m) = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> a -> b
f (a -> b) -> IO a -> IO b
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Functor f =>
(a -> b) -> f a -> f b
<$> Env es -> IO a
m Env es
es

instance Applicative (Eff es) where
  pure :: a -> Eff es a
pure = IO a -> Eff es a
forall (a :: Effect) (es :: [Effect]). IO a -> Eff es a
impureEff_ (IO a -> Eff es a) -> (a -> IO a) -> a -> Eff es a
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure
  Eff Env es -> IO (a -> b)
mf <*> :: Eff es (a -> b) -> Eff es a -> Eff es b
<*> Eff Env es -> IO a
mx = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> IO (a -> b)
mf Env es
es IO (a -> b) -> IO a -> IO b
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Applicative f =>
f (a -> b) -> f a -> f b
<*> Env es -> IO a
mx Env es
es

instance Monad (Eff es) where
  Eff Env es -> IO a
m >>= :: Eff es a -> (a -> Eff es b) -> Eff es b
>>= a -> Eff es b
k = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> do
    a
a <- Env es -> IO a
m Env es
es
    Eff es b -> Env es -> IO b
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff (a -> Eff es b
k a
a) Env es
es

----------------------------------------
-- Exception

instance MonadThrow (Eff es) where
  throwM :: e -> Eff es a
throwM e
e = IO a -> Eff es a
forall (a :: Effect) (es :: [Effect]). IO a -> Eff es a
impureEff_ (IO a -> Eff es a) -> IO a -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ e -> IO a
forall (m :: Effect -> Effect) (e :: Effect) (a :: Effect).
(MonadThrow m, Exception e) =>
e -> m a
throwM e
e

instance MonadCatch (Eff es) where
  catch :: Eff es a -> (e -> Eff es a) -> Eff es a
catch (Eff Env es -> IO a
m) e -> Eff es a
handler = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> do
    Int
size <- Env es -> IO Int
forall (es :: [Effect]). Env es -> IO Int
sizeEnv Env es
es
    Env es -> IO a
m Env es
es IO a -> (e -> IO a) -> IO a
forall (m :: Effect -> Effect) (e :: Effect) (a :: Effect).
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> do
      Int -> Env es -> IO ()
forall (es :: [Effect]). HasCallStack => Int -> Env es -> IO ()
checkSizeEnv Int
size Env es
es
      Eff es a -> Env es -> IO a
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff (e -> Eff es a
handler e
e) Env es
es

instance MonadMask (Eff es) where
  mask :: ((forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b)
-> Eff es b
mask (forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b
k = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> ((forall (a :: Effect). IO a -> IO a) -> IO b) -> IO b
forall (m :: Effect -> Effect) (b :: Effect).
MonadMask m =>
((forall (a :: Effect). m a -> m a) -> m b) -> m b
mask (((forall (a :: Effect). IO a -> IO a) -> IO b) -> IO b)
-> ((forall (a :: Effect). IO a -> IO a) -> IO b) -> IO b
forall (a :: Effect) b. (a -> b) -> a -> b
$ \forall (a :: Effect). IO a -> IO a
restore ->
    Eff es b -> Env es -> IO b
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff ((forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b
k ((forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b)
-> (forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b
forall (a :: Effect) b. (a -> b) -> a -> b
$ (\IO a -> IO a
f (Eff Env es -> IO a
m) -> (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ IO a -> IO a
f (IO a -> IO a) -> (Env es -> IO a) -> Env es -> IO a
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. Env es -> IO a
m) IO a -> IO a
forall (a :: Effect). IO a -> IO a
restore) Env es
es

  uninterruptibleMask :: ((forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b)
-> Eff es b
uninterruptibleMask (forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b
k = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> ((forall (a :: Effect). IO a -> IO a) -> IO b) -> IO b
forall (m :: Effect -> Effect) (b :: Effect).
MonadMask m =>
((forall (a :: Effect). m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall (a :: Effect). IO a -> IO a) -> IO b) -> IO b)
-> ((forall (a :: Effect). IO a -> IO a) -> IO b) -> IO b
forall (a :: Effect) b. (a -> b) -> a -> b
$ \forall (a :: Effect). IO a -> IO a
restore ->
    Eff es b -> Env es -> IO b
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff ((forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b
k ((forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b)
-> (forall (a :: Effect). Eff es a -> Eff es a) -> Eff es b
forall (a :: Effect) b. (a -> b) -> a -> b
$ (\IO a -> IO a
f (Eff Env es -> IO a
m) -> (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ IO a -> IO a
f (IO a -> IO a) -> (Env es -> IO a) -> Env es -> IO a
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. Env es -> IO a
m) IO a -> IO a
forall (a :: Effect). IO a -> IO a
restore) Env es
es

  generalBracket :: Eff es a
-> (a -> ExitCase b -> Eff es c)
-> (a -> Eff es b)
-> Eff es (b, c)
generalBracket Eff es a
acquire a -> ExitCase b -> Eff es c
release a -> Eff es b
use = (Env es -> IO (b, c)) -> Eff es (b, c)
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO (b, c)) -> Eff es (b, c))
-> (Env es -> IO (b, c)) -> Eff es (b, c)
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> ((forall (a :: Effect). IO a -> IO a) -> IO (b, c)) -> IO (b, c)
forall (m :: Effect -> Effect) (b :: Effect).
MonadMask m =>
((forall (a :: Effect). m a -> m a) -> m b) -> m b
mask (((forall (a :: Effect). IO a -> IO a) -> IO (b, c)) -> IO (b, c))
-> ((forall (a :: Effect). IO a -> IO a) -> IO (b, c)) -> IO (b, c)
forall (a :: Effect) b. (a -> b) -> a -> b
$ \forall (a :: Effect). IO a -> IO a
restore -> do
    Int
size <- Env es -> IO Int
forall (es :: [Effect]). Env es -> IO Int
sizeEnv Env es
es
    a
resource <- Eff es a -> Env es -> IO a
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff Eff es a
acquire Env es
es
    b
b <- IO b -> IO b
forall (a :: Effect). IO a -> IO a
restore (Eff es b -> Env es -> IO b
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff (a -> Eff es b
use a
resource) Env es
es) IO b -> (SomeException -> IO b) -> IO b
forall (m :: Effect -> Effect) (e :: Effect) (a :: Effect).
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e -> do
      Int -> Env es -> IO ()
forall (es :: [Effect]). HasCallStack => Int -> Env es -> IO ()
checkSizeEnv Int
size Env es
es
      c
_ <- Eff es c -> Env es -> IO c
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff (a -> ExitCase b -> Eff es c
release a
resource (ExitCase b -> Eff es c) -> ExitCase b -> Eff es c
forall (a :: Effect) b. (a -> b) -> a -> b
$ SomeException -> ExitCase b
forall (a :: Effect). SomeException -> ExitCase a
ExitCaseException SomeException
e) Env es
es
      SomeException -> IO b
forall (m :: Effect -> Effect) (e :: Effect) (a :: Effect).
(MonadThrow m, Exception e) =>
e -> m a
throwM SomeException
e
    Int -> Env es -> IO ()
forall (es :: [Effect]). HasCallStack => Int -> Env es -> IO ()
checkSizeEnv Int
size Env es
es
    c
c <- Eff es c -> Env es -> IO c
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff (a -> ExitCase b -> Eff es c
release a
resource (ExitCase b -> Eff es c) -> ExitCase b -> Eff es c
forall (a :: Effect) b. (a -> b) -> a -> b
$ b -> ExitCase b
forall (a :: Effect). a -> ExitCase a
ExitCaseSuccess b
b) Env es
es
    (b, c) -> IO (b, c)
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure (b
b, c
c)

----------------------------------------
-- IO

data IOE = IOE

runIOE :: Eff '[IOE] a -> Eff '[] a
runIOE :: Eff '[IOE] a -> Eff '[] a
runIOE = IOE -> Eff '[IOE] a -> Eff '[] a
forall (e :: Effect) (es :: [Effect]) (a :: Effect).
e -> Eff (e : es) a -> Eff es a
evalEffect IOE
IOE

instance IOE :> es => MonadIO (Eff es) where
  liftIO :: IO a -> Eff es a
liftIO = IO a -> Eff es a
forall (a :: Effect) (es :: [Effect]). IO a -> Eff es a
impureEff_

instance IOE :> es => MonadBase IO (Eff es) where
  liftBase :: IO α -> Eff es α
liftBase = IO α -> Eff es α
forall (a :: Effect) (es :: [Effect]). IO a -> Eff es a
impureEff_

instance IOE :> es => MonadBaseControl IO (Eff es) where
  type StM (Eff es) a = a
  liftBaseWith :: (RunInBase (Eff es) IO -> IO a) -> Eff es a
liftBaseWith = (RunInBase (Eff es) IO -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect).
((forall (r :: Effect). Eff es r -> IO r) -> IO a) -> Eff es a
runInIO
  restoreM :: StM (Eff es) a -> Eff es a
restoreM = StM (Eff es) a -> Eff es a
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure

instance IOE :> es => MonadUnliftIO (Eff es) where
  withRunInIO :: ((forall (a :: Effect). Eff es a -> IO a) -> IO b) -> Eff es b
withRunInIO = ((forall (a :: Effect). Eff es a -> IO a) -> IO b) -> Eff es b
forall (es :: [Effect]) (a :: Effect).
((forall (r :: Effect). Eff es r -> IO r) -> IO a) -> Eff es a
runInIO

-- | Run 'Eff' computations in 'IO'.
runInIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
runInIO :: ((forall (r :: Effect). Eff es r -> IO r) -> IO a) -> Eff es a
runInIO (forall (r :: Effect). Eff es r -> IO r) -> IO a
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> do
  ThreadId
tid0 <- IO ThreadId
myThreadId
  (forall (r :: Effect). Eff es r -> IO r) -> IO a
f ((forall (r :: Effect). Eff es r -> IO r) -> IO a)
-> (forall (r :: Effect). Eff es r -> IO r) -> IO a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \(Eff Env es -> IO r
m) -> do
    ThreadId
tid <- IO ThreadId
myThreadId
    -- If the lifting function is called from a different thread, we need to
    -- clone the environment, otherwise multiple threads will attempt to modify
    -- it in different ways and things will break horribly.
    if ThreadId
tid0 ThreadId -> ThreadId -> Bool
forall (a :: Effect). Eq a => a -> a -> Bool
== ThreadId
tid
      then Env es -> IO r
m Env es
es
      else Env es -> IO r
m (Env es -> IO r) -> IO (Env es) -> IO r
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
Monad m =>
(a -> m b) -> m a -> m b
=<< Env es -> IO (Env es)
forall (es :: [Effect]). Env es -> IO (Env es)
cloneEnv Env es
es

----------------------------------------
-- Helpers

runEffect :: e -> Eff (e : es) a -> Eff es (a, e)
runEffect :: e -> Eff (e : es) a -> Eff es (a, e)
runEffect e
e0 (Eff Env (e : es) -> IO a
m) = (Env es -> IO (a, e)) -> Eff es (a, e)
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO (a, e)) -> Eff es (a, e))
-> (Env es -> IO (a, e)) -> Eff es (a, e)
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es0 -> do
  Int
size <- Env es -> IO Int
forall (es :: [Effect]). Env es -> IO Int
sizeEnv Env es
es0
  IO (Env (e : es))
-> (Env (e : es) -> IO (Env Any))
-> (Env (e : es) -> IO (a, e))
-> IO (a, e)
forall (m :: Effect -> Effect) (a :: Effect) (c :: Effect)
       (b :: Effect).
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (e -> Env es -> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
e -> Env es -> IO (Env (e : es))
unsafeConsEnv e
e0 Env es
es0)
          (Int -> Env (e : es) -> IO (Env Any)
forall (es :: [Effect]) (es0 :: [Effect]).
HasCallStack =>
Int -> Env es -> IO (Env es0)
unsafeTrimEnv Int
size)
          (\Env (e : es)
es -> (,) (a -> e -> (a, e)) -> IO a -> IO (e -> (a, e))
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Functor f =>
(a -> b) -> f a -> f b
<$> Env (e : es) -> IO a
m Env (e : es)
es IO (e -> (a, e)) -> IO e -> IO (a, e)
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Applicative f =>
f (a -> b) -> f a -> f b
<*> Env (e : es) -> IO e
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO e
getEnv Env (e : es)
es)

evalEffect :: e -> Eff (e : es) a -> Eff es a
evalEffect :: e -> Eff (e : es) a -> Eff es a
evalEffect e
e (Eff Env (e : es) -> IO a
m) = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es0 -> do
  Int
size <- Env es -> IO Int
forall (es :: [Effect]). Env es -> IO Int
sizeEnv Env es
es0
  IO (Env (e : es))
-> (Env (e : es) -> IO (Env Any)) -> (Env (e : es) -> IO a) -> IO a
forall (m :: Effect -> Effect) (a :: Effect) (c :: Effect)
       (b :: Effect).
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (e -> Env es -> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
e -> Env es -> IO (Env (e : es))
unsafeConsEnv e
e Env es
es0)
          (Int -> Env (e : es) -> IO (Env Any)
forall (es :: [Effect]) (es0 :: [Effect]).
HasCallStack =>
Int -> Env es -> IO (Env es0)
unsafeTrimEnv Int
size)
          (\Env (e : es)
es -> Env (e : es) -> IO a
m Env (e : es)
es)

execEffect :: e -> Eff (e : es) a -> Eff es e
execEffect :: e -> Eff (e : es) a -> Eff es e
execEffect e
e0 (Eff Env (e : es) -> IO a
m) = (Env es -> IO e) -> Eff es e
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO e) -> Eff es e) -> (Env es -> IO e) -> Eff es e
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es0 -> do
  Int
size <- Env es -> IO Int
forall (es :: [Effect]). Env es -> IO Int
sizeEnv Env es
es0
  IO (Env (e : es))
-> (Env (e : es) -> IO (Env Any)) -> (Env (e : es) -> IO e) -> IO e
forall (m :: Effect -> Effect) (a :: Effect) (c :: Effect)
       (b :: Effect).
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (e -> Env es -> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
e -> Env es -> IO (Env (e : es))
unsafeConsEnv e
e0 Env es
es0)
          (Int -> Env (e : es) -> IO (Env Any)
forall (es :: [Effect]) (es0 :: [Effect]).
HasCallStack =>
Int -> Env es -> IO (Env es0)
unsafeTrimEnv Int
size)
          (\Env (e : es)
es -> Env (e : es) -> IO a
m Env (e : es)
es IO a -> IO e -> IO e
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Applicative f =>
f a -> f b -> f b
*> Env (e : es) -> IO e
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO e
getEnv Env (e : es)
es)

getEffect :: e :> es => Eff es e
getEffect :: Eff es e
getEffect = (Env es -> IO e) -> Eff es e
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO e) -> Eff es e) -> (Env es -> IO e) -> Eff es e
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> IO e
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO e
getEnv Env es
es

putEffect :: e :> es => e -> Eff es ()
putEffect :: e -> Eff es ()
putEffect e
e = (Env es -> IO ()) -> Eff es ()
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO ()) -> Eff es ()) -> (Env es -> IO ()) -> Eff es ()
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> e -> Env es -> IO ()
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
e -> Env es -> IO ()
unsafePutEnv e
e Env es
es

stateEffect :: e :> es => (e -> (a, e)) -> Eff es a
stateEffect :: (e -> (a, e)) -> Eff es a
stateEffect e -> (a, e)
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> (e -> (a, e)) -> Env es -> IO a
forall (e :: Effect) (es :: [Effect]) (a :: Effect).
(HasCallStack, e :> es) =>
(e -> (a, e)) -> Env es -> IO a
unsafeStateEnv e -> (a, e)
f Env es
es

localEffect :: e :> es => (e -> e) -> Eff es a -> Eff es a
localEffect :: (e -> e) -> Eff es a -> Eff es a
localEffect e -> e
f (Eff Env es -> IO a
m) = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> do
  IO e -> (e -> IO ()) -> (e -> IO a) -> IO a
forall (m :: Effect -> Effect) (a :: Effect) (c :: Effect)
       (b :: Effect).
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket ((e -> (e, e)) -> Env es -> IO e
forall (e :: Effect) (es :: [Effect]) (a :: Effect).
(HasCallStack, e :> es) =>
(e -> (a, e)) -> Env es -> IO a
unsafeStateEnv (\e
e -> (e
e, e -> e
f e
e)) Env es
es)
          (\e
e -> e -> Env es -> IO ()
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
e -> Env es -> IO ()
unsafePutEnv e
e Env es
es)
          (\e
_ -> Env es -> IO a
m Env es
es)

listenEffect :: (e :> es, Monoid e) => Eff es a -> Eff es (a, e)
listenEffect :: Eff es a -> Eff es (a, e)
listenEffect (Eff Env es -> IO a
m) = (Env es -> IO (a, e)) -> Eff es (a, e)
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO (a, e)) -> Eff es (a, e))
-> (Env es -> IO (a, e)) -> Eff es (a, e)
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> ((forall (a :: Effect). IO a -> IO a) -> IO (a, e)) -> IO (a, e)
forall (m :: Effect -> Effect) (b :: Effect).
MonadMask m =>
((forall (a :: Effect). m a -> m a) -> m b) -> m b
mask (((forall (a :: Effect). IO a -> IO a) -> IO (a, e)) -> IO (a, e))
-> ((forall (a :: Effect). IO a -> IO a) -> IO (a, e)) -> IO (a, e)
forall (a :: Effect) b. (a -> b) -> a -> b
$ \forall (a :: Effect). IO a -> IO a
restore -> do
  e
e0 <- (e -> (e, e)) -> Env es -> IO e
forall (e :: Effect) (es :: [Effect]) (a :: Effect).
(HasCallStack, e :> es) =>
(e -> (a, e)) -> Env es -> IO a
unsafeStateEnv (\e
e -> (e
e, e
forall (a :: Effect). Monoid a => a
mempty)) Env es
es
  -- If an exception is thrown, restore e0 and keep parts of e1.
  a
a <- IO a -> IO a
forall (a :: Effect). IO a -> IO a
restore (Env es -> IO a
m Env es
es) IO a -> IO () -> IO a
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
MonadCatch m =>
m a -> m b -> m a
`onException` (e -> e) -> Env es -> IO ()
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
(e -> e) -> Env es -> IO ()
unsafeModifyEnv (\e
e -> e
e0 e -> e -> e
forall (a :: Effect). Monoid a => a -> a -> a
`mappend` e
e) Env es
es
  e
e1 <- (e -> (e, e)) -> Env es -> IO e
forall (e :: Effect) (es :: [Effect]) (a :: Effect).
(HasCallStack, e :> es) =>
(e -> (a, e)) -> Env es -> IO a
unsafeStateEnv (\e
e -> (e
e, e
e0 e -> e -> e
forall (a :: Effect). Monoid a => a -> a -> a
`mappend` e
e)) Env es
es
  (a, e) -> IO (a, e)
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure (a
a, e
e1)

readerEffectM :: e :> es => (e -> Eff es a) -> Eff es a
readerEffectM :: (e -> Eff es a) -> Eff es a
readerEffectM e -> Eff es a
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> IO e
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO e
getEnv Env es
es IO e -> (e -> IO a) -> IO a
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
Monad m =>
m a -> (a -> m b) -> m b
>>= \e
e -> Eff es a -> Env es -> IO a
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff (e -> Eff es a
f e
e) Env es
es

stateEffectM :: e :> es => (e -> Eff es (a, e)) -> Eff es a
stateEffectM :: (e -> Eff es (a, e)) -> Eff es a
stateEffectM e -> Eff es (a, e)
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) (a :: Effect). (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall (a :: Effect) b. (a -> b) -> a -> b
$ \Env es
es -> do
  (a
a, e
e) <- (\e
e -> Eff es (a, e) -> Env es -> IO (a, e)
forall (es :: [Effect]) (a :: Effect). Eff es a -> Env es -> IO a
unEff (e -> Eff es (a, e)
f e
e) Env es
es) (e -> IO (a, e)) -> IO e -> IO (a, e)
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
Monad m =>
(a -> m b) -> m a -> m b
=<< Env es -> IO e
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO e
getEnv Env es
es
  e -> Env es -> IO ()
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
e -> Env es -> IO ()
unsafePutEnv e
e Env es
es
  a -> IO a
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure a
a