polysemy-research/polysemy
1
1
Fork 0
mirror of https://github.com/polysemy-research/polysemy.git synced 2024-11-29 22:52:37 +03:00
Code Issues Projects Releases Wiki Activity

Rename Lift to Embed (#161)

Browse Source 
* Move Polysemy.Internal.Lift to Polysemy.Lift.Type

* Add Polysemy.Lift module and runLift interpreter

* Add a Sandy reminder

* Add explicit foralls and split type signature

* Fix import spacing, for there is no "qualified"

* Implement runIO in terms of runLift

* Rename Lift -> Embed

* Replace sendM with embed

* Add a Sandy todo for embed version

* Rename runEmbed and related runEmbedded (from IO)

* runEmbedded -> runEmbeddedInIO
* runEmbed -> runEmbedded

* Update cabal
This commit is contained in:
Georgi Lyubenov 2019-07-11 18:02:26 +03:00 committed by Sandy Maguire
parent 9bfb486769
commit 48b6768ad4
22 changed files with 136 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
README.md
View File

@ -91,10 +91,10 @@ data Teletype m a where
makeSem ''Teletype
runTeletypeIO :: Member (Lift IO) r => Sem (Teletype ': r) a -> Sem r a
runTeletypeIO :: Member (Embed IO) r => Sem (Teletype ': r) a -> Sem r a
runTeletypeIO = interpret $ \case
ReadTTY -> sendM getLine
WriteTTY msg -> sendM $ putStrLn msg
ReadTTY -> embed getLine
WriteTTY msg -> embed $ putStrLn msg
runTeletypePure :: [String] -> Sem (Teletype ': r) a -> Sem r ([String], a)
runTeletypePure i
@ -121,7 +121,7 @@ pureOutput :: [String] -> [String]
pureOutput = fst . run . echoPure
-- Now let's do things
echoIO :: Sem '[Lift IO] ()
echoIO :: Sem '[Embed IO] ()
echoIO = runTeletypeIO echo
-- echo forever

2
bench/Poly.hs
View File

@ -36,7 +36,7 @@ prog
:: Sem '[ State Bool
, Error Bool
, Resource
, Lift IO
, Embed IO
] Bool
prog = catch @Bool (throw True) (pure . not)

6
polysemy-plugin/test/ExampleSpec.hs
View File

@ -16,10 +16,10 @@ data Teletype m a where
makeSem ''Teletype
runTeletypeIO :: Member (Lift IO) r => Sem (Teletype ': r) a -> Sem r a
runTeletypeIO :: Member (Embed IO) r => Sem (Teletype ': r) a -> Sem r a
runTeletypeIO = interpret $ \case
ReadTTY -> sendM getLine
WriteTTY msg -> sendM $ putStrLn msg
ReadTTY -> embed getLine
WriteTTY msg -> embed $ putStrLn msg
data CustomException = ThisException | ThatException deriving Show

8
polysemy-plugin/test/LegitimateTypeErrorSpec.hs
View File

@ -6,8 +6,8 @@ import Polysemy
import Test.Hspec
import Test.ShouldNotTypecheck
wrongLift :: Member (Lift IO) r => Sem r ()
wrongLift = sendM putStrLn
wrongEmbed :: Member (Embed IO) r => Sem r ()
wrongEmbed = embed putStrLn
wrongReturn :: Sem (e ': r) () -> Sem r ()
wrongReturn = reinterpret undefined
@ -17,8 +17,8 @@ wrongReturn = reinterpret undefined
spec :: Spec
spec = do
describe "Legitimate type errors" $ do
it "should be caused by `sendM`ing an unsaturated function" $
shouldNotTypecheck wrongLift
it "should be caused by `embed`ing an unsaturated function" $
shouldNotTypecheck wrongEmbed
it "should be caused by giving a bad type to reinterpret" $
shouldNotTypecheck wrongReturn

6
polysemy-plugin/test/PluginSpec.hs
View File

@ -46,8 +46,8 @@ errState = do
err
lifted :: Monad m => Member (Lift m) r => Sem r ()
lifted = sendM $ pure ()
lifted :: Monad m => Member (Embed m) r => Sem r ()
lifted = embed $ pure ()
newtype MyString = MyString String
@ -136,7 +136,7 @@ spec = do
output $ replicate 2 5
describe "Lift effect" $ do
describe "Embed effect" $ do
it "should interpret against IO" $ do
res <- runM lifted
res `shouldBe` ()

5
polysemy.cabal
View File

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: e22afd49cd8b82cdc69be962d872539c65eedc43a2978aa7a0652b40dd7db105
-- hash: 7e0e9242c36e377756ae6ef007d19a16cdaf3f244855b0bfc97e267f4df143ea
name: polysemy
version: 0.7.0.0
@ -41,6 +41,8 @@ library
exposed-modules:
Polysemy
Polysemy.Async
Polysemy.Embed
Polysemy.Embed.Type
Polysemy.Error
Polysemy.Fixpoint
Polysemy.Input
@ -51,7 +53,6 @@ library
Polysemy.Internal.Fixpoint
Polysemy.Internal.Forklift
Polysemy.Internal.Kind
Polysemy.Internal.Lift
Polysemy.Internal.NonDet
Polysemy.Internal.Tactics
Polysemy.Internal.TH.Common

4
src/Polysemy.hs
View File

@ -10,8 +10,8 @@ module Polysemy
, runM
-- * Interoperating With Other Monads
, Lift (..)
, sendM
, Embed (..)
, embed
-- * Lifting
, raise

12
src/Polysemy/Async.hs
View File

@ -41,7 +41,7 @@ makeSem ''Async
--
-- @since 0.5.0.0
runAsync
:: LastMember (Lift IO) r
:: LastMember (Embed IO) r
=> Sem (Async ': r) a
-> Sem r a
runAsync m = withLowerToIO $ \lower _ -> lower $
@ -50,10 +50,10 @@ runAsync m = withLowerToIO $ \lower _ -> lower $
Async a -> do
ma <- runT a
ins <- getInspectorT
fa <- sendM $ A.async $ lower $ runAsync ma
fa <- embed $ A.async $ lower $ runAsync ma
pureT $ fmap (inspect ins) fa
Await a -> pureT =<< sendM (A.wait a)
Await a -> pureT =<< embed (A.wait a)
) m
{-# INLINE runAsync #-}
@ -64,7 +64,7 @@ runAsync m = withLowerToIO $ \lower _ -> lower $
--
-- @since 0.5.0.0
runAsyncInIO
:: Member (Lift IO) r
:: Member (Embed IO) r
=> (forall x. Sem r x -> IO x)
-- ^ Strategy for lowering a 'Sem' action down to 'IO'. This is likely
-- some combination of 'runM' and other interpreters composed via '.@'.
@ -75,10 +75,10 @@ runAsyncInIO lower m = interpretH
Async a -> do
ma <- runT a
ins <- getInspectorT
fa <- sendM $ A.async $ lower $ runAsyncInIO lower ma
fa <- embed $ A.async $ lower $ runAsyncInIO lower ma
pureT $ fmap (inspect ins) fa
Await a -> pureT =<< sendM (A.wait a)
Await a -> pureT =<< embed (A.wait a)
) m
{-# INLINE runAsyncInIO #-}

29
src/Polysemy/Embed.hs Normal file
View File

@ -0,0 +1,29 @@
{-# LANGUAGE TemplateHaskell #-}
module Polysemy.Embed
( -- * Effect
Embed (..)
-- * Actions
, embed
-- * Interpretations
, runEmbedded
) where
import Polysemy
import Polysemy.Embed.Type (Embed (..))
------------------------------------------------------------------------------
-- | Given a natural transform from @m1@ to @m2@
-- run a @Embed m1@ effect by transforming it into a @Embed m2@ effect.
--
-- TODO(sandy): @since
runEmbedded
:: forall m1 m2 r a
. Member (Embed m2) r
=> (forall x. m1 x -> m2 x)
-> Sem (Embed m1 ': r) a
-> Sem r a
runEmbedded f = interpret $ embed . f . unEmbed
{-# INLINE runEmbedded #-}

18
src/Polysemy/Internal/Lift.hs → src/Polysemy/Embed/Type.hs
View File

@ -2,7 +2,10 @@
{-# OPTIONS_HADDOCK not-home #-}
module Polysemy.Internal.Lift where
module Polysemy.Embed.Type
( -- * Effect
Embed (..)
) where
import Data.Kind
@ -10,23 +13,22 @@ import Data.Kind
------------------------------------------------------------------------------
-- | An effect which allows a regular 'Monad' @m@ into the 'Polysemy.Sem'
-- ecosystem. Monadic actions in @m@ can be lifted into 'Polysemy.Sem' via
-- 'Polysemy.sendM'.
-- 'Polysemy.embed'.
--
-- For example, you can use this effect to lift 'IO' actions directly into
-- 'Polysemy.Sem':
--
-- @
-- 'Polysemy.sendM' (putStrLn "hello") :: 'Polysemy.Member' ('Polysemy.Lift' IO) r => 'Polysemy.Sem' r ()
-- 'Polysemy.embed' (putStrLn "hello") :: 'Polysemy.Member' ('Polysemy.Embed' IO) r => 'Polysemy.Sem' r ()
-- @
--
-- That being said, you lose out on a significant amount of the benefits of
-- 'Polysemy.Sem' by using 'Polysemy.sendM' directly in application code; doing
-- 'Polysemy.Sem' by using 'Polysemy.embed' directly in application code; doing
-- so will tie your application code directly to the underlying monad, and
-- prevent you from interpreting it differently. For best results, only use
-- 'Lift' in your effect interpreters.
-- 'Embed' in your effect interpreters.
--
-- Consider using 'Polysemy.Trace.trace' and 'Polysemy.Trace.runTraceIO' as
-- a substitute for using 'putStrLn' directly.
newtype Lift m (z :: Type -> Type) a where
Lift :: { unLift :: m a } -> Lift m z a
newtype Embed m (z :: Type -> Type) a where
Embed :: { unEmbed :: m a } -> Embed m z a

16
src/Polysemy/Error.hs
View File

@ -51,18 +51,18 @@ fromEither (Right a) = pure a
------------------------------------------------------------------------------
-- | A combinator doing 'sendM' and 'fromEither' at the same time. Useful for
-- | A combinator doing 'embed' and 'fromEither' at the same time. Useful for
-- interoperating with 'IO'.
--
-- @since 0.5.1.0
fromEitherM
:: forall e m r a
. ( Member (Error e) r
, Member (Lift m) r
, Member (Embed m) r
)
=> m (Either e a)
-> Sem r a
fromEitherM = fromEither <=< sendM
fromEitherM = fromEither <=< embed
------------------------------------------------------------------------------
@ -135,7 +135,7 @@ instance (Typeable e) => X.Exception (WrappedExc e)
-- significantly faster than 'runError', at the cost of being less flexible.
runErrorInIO
:: ( Typeable e
, Member (Lift IO) r
, Member (Embed IO) r
)
=> (∀ x. Sem r x -> IO x)
-- ^ Strategy for lowering a 'Sem' action down to 'IO'. This is
@ -144,7 +144,7 @@ runErrorInIO
-> Sem (Error e ': r) a
-> Sem r (Either e a)
runErrorInIO lower
= sendM
= embed
. fmap (first unwrapExc)
. X.try
. (lower .@ runErrorAsExc)
@ -154,19 +154,19 @@ runErrorInIO lower
-- TODO(sandy): Can we use the new withLowerToIO machinery for this?
runErrorAsExc
:: forall e r a. ( Typeable e
, Member (Lift IO) r
, Member (Embed IO) r
)
=> (∀ x. Sem r x -> IO x)
-> Sem (Error e ': r) a
-> Sem r a
runErrorAsExc lower = interpretH $ \case
Throw e -> sendM $ X.throwIO $ WrappedExc e
Throw e -> embed $ X.throwIO $ WrappedExc e
Catch try handle -> do
is <- getInitialStateT
t <- runT try
h <- bindT handle
let runIt = lower . runErrorAsExc lower
sendM $ X.catch (runIt t) $ \(se :: WrappedExc e) ->
embed $ X.catch (runIt t) $ \(se :: WrappedExc e) ->
runIt $ h $ unwrapExc se <$ is
{-# INLINE runErrorAsExc #-}

4
src/Polysemy/Fixpoint.hs
View File

@ -29,7 +29,7 @@ runFixpoint lower = interpretH $ \case
-- | Run a 'Fixpoint' effect in terms of an underlying 'MonadFix' instance.
runFixpointM
:: ( MonadFix m
, Member (Lift m) r
, Member (Embed m) r
)
=> (∀ x. Sem r x -> m x)
-> Sem (Fixpoint ': r) a
@ -37,5 +37,5 @@ runFixpointM
runFixpointM lower = interpretH $ \case
Fixpoint mf -> do
c <- bindT mf
sendM $ mfix $ lower . runFixpointM lower . c
embed $ mfix $ lower . runFixpointM lower . c

25
src/Polysemy/IO.hs
View File

@ -3,11 +3,12 @@
module Polysemy.IO
( -- * Interpretations
runIO
, runEmbedded
, runEmbeddedInIO
) where
import Control.Monad.IO.Class
import Polysemy
import Polysemy.Embed
import Polysemy.Internal
import Polysemy.Internal.Union
@ -37,37 +38,37 @@ import Polysemy.Internal.Union
runIO
:: forall m r a
. ( MonadIO m
, Member (Lift m) r
, Member (Embed m) r
)
=> Sem (Lift IO ': r) a
=> Sem (Embed IO ': r) a
-> Sem r a
runIO = interpret $ sendM . liftIO @m . unLift
runIO = runEmbedded $ liftIO @m
{-# INLINE runIO #-}
------------------------------------------------------------------------------
-- | Given some @'MonadIO' m@, interpret all @'Lift' m@ actions in that monad
-- | Given some @'MonadIO' m@, interpret all @'Embed' m@ actions in that monad
-- at once. This is useful for interpreting effects like databases, which use
-- their own monad for describing actions.
--
-- This function creates a thread, and so should be compiled with @-threaded@.
--
-- @since 0.6.0.0
runEmbedded
-- TODO(sandy): @since
runEmbeddedInIO
:: ( MonadIO m
, LastMember (Lift IO) r
, LastMember (Embed IO) r
)
=> (forall x. m x -> IO x) -- ^ The means of running this monad.
-> Sem (Lift m ': r) a
-> Sem (Embed m ': r) a
-> Sem r a
runEmbedded run_m (Sem m) = withLowerToIO $ \lower _ ->
runEmbeddedInIO run_m (Sem m) = withLowerToIO $ \lower _ ->
run_m $ m $ \u ->
case decomp u of
Left x -> liftIO
. lower
. liftSem
$ hoist (runEmbedded run_m) x
$ hoist (runEmbeddedInIO run_m) x
Right (Weaving (Lift wd) s _ y _) ->
Right (Weaving (Embed wd) s _ y _) ->
fmap y $ fmap (<$ s) wd

32
src/Polysemy/Internal.hs
View File

@ -11,14 +11,14 @@ module Polysemy.Internal
, Member
, Members
, send
, sendM
, embed
, run
, runM
, raise
, raiseUnder
, raiseUnder2
, raiseUnder3
, Lift (..)
, Embed (..)
, usingSem
, liftSem
, hoistSem
@ -34,7 +34,7 @@ import Control.Monad.IO.Class
import Data.Functor.Identity
import Data.Kind
import Polysemy.Internal.Fixpoint
import Polysemy.Internal.Lift
import Polysemy.Embed.Type
import Polysemy.Internal.NonDet
import Polysemy.Internal.PluginLookup
import Polysemy.Internal.Union
@ -57,8 +57,8 @@ import Polysemy.Internal.Union
-- 'Polysemy.Error.runError' to 'Polysemy.Error.runErrorInIO'.
--
-- The effect stack @r@ can contain arbitrary other monads inside of it. These
-- monads are lifted into effects via the 'Lift' effect. Monadic values can be
-- lifted into a 'Sem' via 'sendM'.
-- monads are lifted into effects via the 'Embed' effect. Monadic values can be
-- lifted into a 'Sem' via 'embed'.
--
-- A 'Sem' can be interpreted as a pure value (via 'run') or as any
-- traditional 'Monad' (via 'runM'). Each effect @E@ comes equipped with some
@ -73,7 +73,7 @@ import Polysemy.Internal.Union
-- monomorphic representation of the @r@ parameter.
--
-- After all of your effects are handled, you'll be left with either
-- a @'Sem' '[] a@ or a @'Sem' '[ 'Lift' m ] a@ value, which can be
-- a @'Sem' '[] a@ or a @'Sem' '[ 'Embed' m ] a@ value, which can be
-- consumed respectively by 'run' and 'runM'.
--
-- ==== Examples
@ -231,8 +231,8 @@ instance (Member NonDet r) => MonadFail (Sem r) where
-- | This instance will only lift 'IO' actions. If you want to lift into some
-- other 'MonadIO' type, use this instance, and handle it via the
-- 'Polysemy.IO.runIO' interpretation.
instance (Member (Lift IO) r) => MonadIO (Sem r) where
liftIO = sendM
instance (Member (Embed IO) r) => MonadIO (Sem r) where
liftIO = embed
{-# INLINE liftIO #-}
instance Member Fixpoint r => MonadFix (Sem r) where
@ -300,7 +300,7 @@ raiseUnder3 = hoistSem $ hoist raiseUnder3 . weakenUnder3
------------------------------------------------------------------------------
-- | Lift an effect into a 'Sem'. This is used primarily via
-- | Embed an effect into a 'Sem'. This is used primarily via
-- 'Polysemy.makeSem' to implement smart constructors.
send :: Member e r => e (Sem r) a -> Sem r a
send = liftSem . inj
@ -308,10 +308,12 @@ send = liftSem . inj
------------------------------------------------------------------------------
-- | Lift a monadic action @m@ into 'Sem'.
sendM :: Member (Lift m) r => m a -> Sem r a
sendM = send . Lift
{-# INLINE sendM #-}
-- | Embed a monadic action @m@ in 'Sem'.
--
-- TODO(sandy): @since
embed :: Member (Embed m) r => m a -> Sem r a
embed = send . Embed
{-# INLINE embed #-}
------------------------------------------------------------------------------
@ -324,11 +326,11 @@ run (Sem m) = runIdentity $ m absurdU
------------------------------------------------------------------------------
-- | Lower a 'Sem' containing only a single lifted 'Monad' into that
-- monad.
runM :: Monad m => Sem '[Lift m] a -> m a
runM :: Monad m => Sem '[Embed m] a -> m a
runM (Sem m) = m $ \z ->
case extract z of
Weaving e s _ f _ -> do
a <- unLift e
a <- unEmbed e
pure $ f $ a <$ s
{-# INLINE runM #-}

22
src/Polysemy/Internal/Forklift.hs
View File

@ -19,7 +19,7 @@ import Polysemy.Internal.Union
--
-- @since 0.5.0.0
data Forklift r = forall a. Forklift
{ responseMVar :: MVar (Sem '[Lift IO] a)
{ responseMVar :: MVar (Sem '[Embed IO] a)
, request :: Union r (Sem r) a
}
@ -30,13 +30,13 @@ data Forklift r = forall a. Forklift
--
-- @since 0.5.0.0
runViaForklift
:: LastMember (Lift IO) r
:: LastMember (Embed IO) r
=> InChan (Forklift r)
-> Sem r a
-> Sem '[Lift IO] a
-> Sem '[Embed IO] a
runViaForklift chan (Sem m) = Sem $ \k -> m $ \u -> do
case decompLast u of
Left x -> usingSem k $ join $ sendM $ do
Left x -> usingSem k $ join $ embed $ do
mvar <- newEmptyMVar
writeChan chan $ Forklift mvar x
takeMVar mvar
@ -53,29 +53,29 @@ runViaForklift chan (Sem m) = Sem $ \k -> m $ \u -> do
--
-- @since 0.5.0.0
withLowerToIO
:: LastMember (Lift IO) r
:: LastMember (Embed IO) r
=> ((forall x. Sem r x -> IO x) -> IO () -> IO a)
-- ^ A lambda that takes the lowering function, and a finalizing 'IO'
-- action to mark a the forked thread as being complete. The finalizing
-- action need not be called.
-> Sem r a
withLowerToIO action = do
(inchan, outchan) <- sendM newChan
signal <- sendM newEmptyMVar
(inchan, outchan) <- embed newChan
signal <- embed newEmptyMVar
res <- sendM $ A.async $ do
res <- embed $ A.async $ do
a <- action (runM . runViaForklift inchan)
(putMVar signal ())
putMVar signal ()
pure a
let me = do
raced <- sendM $ A.race (takeMVar signal) $ readChan outchan
raced <- embed $ A.race (takeMVar signal) $ readChan outchan
case raced of
Left () -> sendM $ A.wait res
Left () -> embed $ A.wait res
Right (Forklift mvar req) -> do
resp <- liftSem req
sendM $ putMVar mvar $ pure resp
embed $ putMVar mvar $ pure resp
me_b
{-# INLINE me #-}

8
src/Polysemy/Resource.hs
View File

@ -81,7 +81,7 @@ onException act end = bracketOnError (pure ()) (const end) (const act)
-- @since 0.4.0.0
runResourceInIO
:: ∀ r a
. Member (Lift IO) r
. Member (Embed IO) r
=> (∀ x. Sem r x -> IO x)
-- ^ Strategy for lowering a 'Sem' action down to 'IO'. This is likely
-- some combination of 'runM' and other interpreters composed via '.@'.
@ -96,7 +96,7 @@ runResourceInIO finish = interpretH $ \case
let run_it :: Sem (Resource ': r) x -> IO x
run_it = finish .@ runResourceInIO
sendM $ X.bracket (run_it a) (run_it . d) (run_it . u)
embed $ X.bracket (run_it a) (run_it . d) (run_it . u)
BracketOnError alloc dealloc use -> do
a <- runT alloc
@ -106,7 +106,7 @@ runResourceInIO finish = interpretH $ \case
let run_it :: Sem (Resource ': r) x -> IO x
run_it = finish .@ runResourceInIO
sendM $ X.bracketOnError (run_it a) (run_it . d) (run_it . u)
embed $ X.bracketOnError (run_it a) (run_it . d) (run_it . u)
{-# INLINE runResourceInIO #-}
@ -168,7 +168,7 @@ runResource = interpretH $ \case
-- @since 0.5.0.0
runResourceBase
:: forall r a
. LastMember (Lift IO) r
. LastMember (Embed IO) r
=> Sem (Resource ': r) a
-> Sem r a
runResourceBase = interpretH $ \case

6
src/Polysemy/State.hs
View File

@ -79,13 +79,13 @@ runLazyState = lazilyStateful $ \case
-- @since 0.1.2.0
runStateInIORef
:: forall s r a
. Member (Lift IO) r
. Member (Embed IO) r
=> IORef s
-> Sem (State s ': r) a
-> Sem r a
runStateInIORef ref = interpret $ \case
Get -> sendM $ readIORef ref
Put s -> sendM $ writeIORef ref s
Get -> embed $ readIORef ref
Put s -> embed $ writeIORef ref s
{-# INLINE runStateInIORef #-}

6
src/Polysemy/Trace.hs
View File

@ -31,15 +31,15 @@ makeSem ''Trace
------------------------------------------------------------------------------
-- | Run a 'Trace' effect by printing the messages to stdout.
runTraceIO :: Member (Lift IO) r => Sem (Trace ': r) a -> Sem r a
runTraceIO :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a
runTraceIO = interpret $ \case
Trace m -> sendM $ putStrLn m
Trace m -> embed $ putStrLn m
{-# INLINE runTraceIO #-}
------------------------------------------------------------------------------
-- | Run a 'Trace' effect by ignoring all of its messages.
runIgnoringTrace :: Member (Lift IO) r => Sem (Trace ': r) a -> Sem r a
runIgnoringTrace :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a
runIgnoringTrace = interpret $ \case
Trace _ -> pure ()
{-# INLINE runIgnoringTrace #-}

6
test/AsyncSpec.hs
View File

@ -27,14 +27,14 @@ spec = describe "async" $ do
message 1 v
put $ reverse v
sendM $ threadDelay 1e5
embed $ threadDelay 1e5
get >>= message 1
sendM $ threadDelay 1e5
embed $ threadDelay 1e5
get @String
void $ async $ do
sendM $ threadDelay 5e4
embed $ threadDelay 5e4
get >>= message 2
put "pong"

2
test/BracketSpec.hs
View File

@ -19,7 +19,7 @@ runTest = run
. runError @()
runTest2
:: Sem '[Error (), Resource, State [Char], Trace, Lift IO] a
:: Sem '[Error (), Resource, State [Char], Trace, Embed IO] a
-> IO ([String], ([Char], Either () a))
runTest2 = runM
. runTraceAsList

6
test/InspectorSpec.hs
View File

@ -25,7 +25,7 @@ spec = parallel $ describe "Inspector" $ do
void . (runM .@ runCallback ref)
. runState False
$ do
sendM $ pretendPrint ref "hello world"
embed $ pretendPrint ref "hello world"
callback $ show <$> get @Bool
modify not
callback $ show <$> get @Bool
@ -47,7 +47,7 @@ spec = parallel $ describe "Inspector" $ do
runCallback
:: Member (Lift IO) r
:: Member (Embed IO) r
=> IORef [String]
-> (forall x. Sem r x -> IO x)
-> Sem (Callback ': r) a
@ -56,7 +56,7 @@ runCallback ref lower = interpretH $ \case
Callback cb -> do
cb' <- runT cb
ins <- getInspectorT
sendM $ doCB ref $ do
embed $ doCB ref $ do
v <- lower .@ runCallback ref $ cb'
pure $ maybe ":(" id $ inspect ins v
getInitialStateT

6
test/TypeErrors.hs
View File

@ -89,9 +89,9 @@ tooFewArgumentsReinterpret = ()
-- in runM foo'''
-- :}
-- ...
-- ... Unhandled effect 'Lift IO'
-- ... Unhandled effect 'Embed IO'
-- ...
-- ... Expected type: Sem '[Lift m] (Bool, ())
-- ... Expected type: Sem '[Embed m] (Bool, ())
-- ... Actual type: Sem '[] (Bool, ())
-- ...
runningTooManyEffects = ()
@ -142,7 +142,7 @@ missingFmap'PLUGIN = ()
--------------------------------------------------------------------------------
-- |
-- >>> :{
-- foo :: Sem '[State Int, Lift IO] ()
-- foo :: Sem '[State Int, Embed IO] ()
-- foo = output ()
-- :}
-- ...