mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-09-11 02:25:43 +03:00
Simple variants of runT and bindT (#393)
* Simple variants of runT and bindT * Fix accidental removal of INLINE on reinterpretH * Rename bindTH and runTH to -Simple instead. Improve docs on these. * Update changelog and add @since TODOs
This commit is contained in:
parent
175ccc840b
commit
478c86e080
@ -2,7 +2,8 @@
|
||||
|
||||
|
||||
## Unreleased changes
|
||||
* Added `InterpretersFor` as a shorthand for interpreters consuming multiple effects
|
||||
- Added `InterpretersFor` as a shorthand for interpreters consuming multiple effects
|
||||
- Added `runTSimple` and `bindTSimple`, which are simplified variants of `runT` and `bindT`
|
||||
|
||||
## 1.4.0.0 (2020-10-31)
|
||||
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 2.0
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 5b7f95eb8e97177f60ae7387f50e8594297ee64259fcac3310f3cc83edef6531
|
||||
-- hash: 9d61a6c298262f3e765c48ccc01f30cd9c328104777970c3529931c4d5c4ca22
|
||||
|
||||
name: polysemy
|
||||
version: 1.4.0.0
|
||||
@ -143,6 +143,7 @@ test-suite polysemy-test
|
||||
KnownRowSpec
|
||||
LawsSpec
|
||||
OutputSpec
|
||||
TacticsSpec
|
||||
ThEffectSpec
|
||||
TypeErrors
|
||||
ViewSpec
|
||||
|
@ -137,6 +137,8 @@ module Polysemy
|
||||
, WithTactics
|
||||
, getInitialStateT
|
||||
, pureT
|
||||
, runTSimple
|
||||
, bindTSimple
|
||||
, runT
|
||||
, bindT
|
||||
, getInspectorT
|
||||
|
@ -80,12 +80,11 @@ interpretH
|
||||
-- already in 'Sem'.
|
||||
-> Sem (e ': r) a
|
||||
-> Sem r a
|
||||
interpretH f (Sem m) = m $ \u ->
|
||||
interpretH f (Sem m) = Sem $ \k -> m $ \u ->
|
||||
case decomp u of
|
||||
Left x -> liftSem $ hoist (interpretH f) x
|
||||
Left x -> k $ hoist (interpretH f) x
|
||||
Right (Weaving e s d y v) -> do
|
||||
a <- runTactics s d v $ f e
|
||||
pure $ y a
|
||||
fmap y $ usingSem k $ runTactics s d v (interpretH f . d) $ f e
|
||||
{-# INLINE interpretH #-}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
@ -166,12 +165,13 @@ reinterpretH
|
||||
-- ^ A natural transformation from the handled effect to the new effect.
|
||||
-> Sem (e1 ': r) a
|
||||
-> Sem (e2 ': r) a
|
||||
reinterpretH f (Sem m) = Sem $ \k -> m $ \u ->
|
||||
reinterpretH f sem = Sem $ \k -> runSem sem $ \u ->
|
||||
case decompCoerce u of
|
||||
Left x -> k $ hoist (reinterpretH f) $ x
|
||||
Right (Weaving e s d y v) -> do
|
||||
a <- usingSem k $ runTactics s (raiseUnder . d) v $ f e
|
||||
pure $ y a
|
||||
fmap y $ usingSem k
|
||||
$ runTactics s (raiseUnder . d) v (reinterpretH f . d)
|
||||
$ f e
|
||||
{-# INLINE[3] reinterpretH #-}
|
||||
-- TODO(sandy): Make this fuse in with 'stateful' directly.
|
||||
|
||||
@ -208,8 +208,9 @@ reinterpret2H f (Sem m) = Sem $ \k -> m $ \u ->
|
||||
case decompCoerce u of
|
||||
Left x -> k $ weaken $ hoist (reinterpret2H f) $ x
|
||||
Right (Weaving e s d y v) -> do
|
||||
a <- usingSem k $ runTactics s (raiseUnder2 . d) v $ f e
|
||||
pure $ y a
|
||||
fmap y $ usingSem k
|
||||
$ runTactics s (raiseUnder2 . d) v (reinterpret2H f . d)
|
||||
$ f e
|
||||
{-# INLINE[3] reinterpret2H #-}
|
||||
|
||||
|
||||
@ -241,9 +242,10 @@ reinterpret3H
|
||||
reinterpret3H f (Sem m) = Sem $ \k -> m $ \u ->
|
||||
case decompCoerce u of
|
||||
Left x -> k . weaken . weaken . hoist (reinterpret3H f) $ x
|
||||
Right (Weaving e s d y v) -> do
|
||||
a <- usingSem k $ runTactics s (raiseUnder3 . d) v $ f e
|
||||
pure $ y a
|
||||
Right (Weaving e s d y v) ->
|
||||
fmap y $ usingSem k
|
||||
$ runTactics s (raiseUnder3 . d) v (reinterpret3H f . d)
|
||||
$ f e
|
||||
{-# INLINE[3] reinterpret3H #-}
|
||||
|
||||
|
||||
@ -342,7 +344,9 @@ interceptUsingH
|
||||
interceptUsingH pr f (Sem m) = Sem $ \k -> m $ \u ->
|
||||
case prjUsing pr u of
|
||||
Just (Weaving e s d y v) ->
|
||||
usingSem k $ y <$> runTactics s (raise . d) v (f e)
|
||||
fmap y $ usingSem k
|
||||
$ runTactics s (raise . d) v (interceptUsingH pr f . d)
|
||||
$ f e
|
||||
Nothing -> k $ hoist (interceptUsingH pr f) u
|
||||
{-# INLINE interceptUsingH #-}
|
||||
|
||||
|
@ -8,7 +8,9 @@ module Polysemy.Internal.Tactics
|
||||
, getInspectorT
|
||||
, Inspector (..)
|
||||
, runT
|
||||
, runTSimple
|
||||
, bindT
|
||||
, bindTSimple
|
||||
, pureT
|
||||
, liftT
|
||||
, runTactics
|
||||
@ -77,9 +79,10 @@ type Tactical e m r x = ∀ f. Functor f
|
||||
type WithTactics e f m r = Tactics f m (e ': r) ': r
|
||||
|
||||
data Tactics f n r m a where
|
||||
GetInitialState :: Tactics f n r m (f ())
|
||||
HoistInterpretation :: (a -> n b) -> Tactics f n r m (f a -> Sem r (f b))
|
||||
GetInspector :: Tactics f n r m (Inspector f)
|
||||
GetInitialState :: Tactics f n r m (f ())
|
||||
HoistInterpretation :: (a -> n b) -> Tactics f n r m (f a -> Sem r (f b))
|
||||
HoistInterpretationH :: (a -> n b) -> f a -> Tactics f n r m (f b)
|
||||
GetInspector :: Tactics f n r m (Inspector f)
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
@ -146,6 +149,26 @@ runT na = do
|
||||
pure $ na' istate
|
||||
{-# INLINE runT #-}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Run a monadic action in a 'Tactical' environment. The stateful environment
|
||||
-- used will be the same one that the effect is initally run in.
|
||||
-- Use 'bindTSimple' if you'd prefer to explicitly manage your stateful
|
||||
-- environment.
|
||||
--
|
||||
-- This is a less flexible but significantly simpler variant of 'runT'.
|
||||
-- Instead of returning a 'Sem' action corresponding to the provided action,
|
||||
-- 'runTSimple' runs the action immediately.
|
||||
--
|
||||
-- @since TODO
|
||||
runTSimple :: m a
|
||||
-- ^ The monadic action to lift. This is usually a parameter in your
|
||||
-- effect.
|
||||
-> Tactical e m r a
|
||||
runTSimple na = do
|
||||
istate <- getInitialStateT
|
||||
bindTSimple (const na) istate
|
||||
{-# INLINE runTSimple #-}
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Lift a kleisli action into the stateful environment. You can use
|
||||
@ -163,6 +186,30 @@ bindT
|
||||
bindT f = send $ HoistInterpretation f
|
||||
{-# INLINE bindT #-}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Lift a kleisli action into the stateful environment.
|
||||
-- You can use 'bindTSimple' to execute an effect parameter of the form
|
||||
-- @a -> m b@ by providing the result of a `runTSimple` or another
|
||||
-- `bindTSimple`.
|
||||
--
|
||||
-- This is a less flexible but significantly simpler variant of 'bindT'.
|
||||
-- Instead of returning a 'Sem' kleisli action corresponding to the
|
||||
-- provided kleisli action, 'bindTSimple' runs the kleisli action immediately.
|
||||
--
|
||||
-- @since TODO
|
||||
bindTSimple
|
||||
:: forall m f r e a b
|
||||
. (a -> m b)
|
||||
-- ^ The monadic continuation to lift. This is usually a parameter in
|
||||
-- your effect.
|
||||
--
|
||||
-- Continuations executed via 'bindTSimple' will run in the same
|
||||
-- environment which produced the @a@.
|
||||
-> f a
|
||||
-> Sem (WithTactics e f m r) (f b)
|
||||
bindTSimple f s = send @(Tactics _ _ (e ': r)) $ HoistInterpretationH f s
|
||||
{-# INLINE bindTSimple #-}
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Internal function to create first-order interpreter combinators out of
|
||||
@ -185,15 +232,18 @@ runTactics
|
||||
=> f ()
|
||||
-> (∀ x. f (m x) -> Sem r2 (f x))
|
||||
-> (∀ x. f x -> Maybe x)
|
||||
-> (∀ x. f (m x) -> Sem r (f x))
|
||||
-> Sem (Tactics f m r2 ': r) a
|
||||
-> Sem r a
|
||||
runTactics s d v (Sem m) = m $ \u ->
|
||||
runTactics s d v d' (Sem m) = Sem $ \k -> m $ \u ->
|
||||
case decomp u of
|
||||
Left x -> liftSem $ hoist (runTactics s d v) x
|
||||
Left x -> k $ hoist (runTactics s d v d') x
|
||||
Right (Weaving GetInitialState s' _ y _) ->
|
||||
pure $ y $ s <$ s'
|
||||
Right (Weaving (HoistInterpretation na) s' _ y _) -> do
|
||||
pure $ y $ (d . fmap na) <$ s'
|
||||
Right (Weaving (HoistInterpretationH na fa) s' _ y _) -> do
|
||||
(y . (<$ s')) <$> runSem (d' (fmap na fa)) k
|
||||
Right (Weaving GetInspector s' _ y _) -> do
|
||||
pure $ y $ Inspector v <$ s'
|
||||
{-# INLINE runTactics #-}
|
||||
|
22
test/TacticsSpec.hs
Normal file
22
test/TacticsSpec.hs
Normal file
@ -0,0 +1,22 @@
|
||||
module TacticsSpec where
|
||||
|
||||
import Polysemy
|
||||
import Polysemy.Internal (send)
|
||||
import Test.Hspec
|
||||
|
||||
data TestE :: Effect where
|
||||
TestE :: m a -> (a -> m b) -> TestE m b
|
||||
|
||||
interpretTestE :: InterpreterFor TestE r
|
||||
interpretTestE =
|
||||
interpretH $ \case
|
||||
TestE ma f -> do
|
||||
a <- runTSimple ma
|
||||
bindTSimple f a
|
||||
|
||||
spec :: Spec
|
||||
spec = parallel $ describe "runTH and bindTH" $ do
|
||||
it "should act as expected" $ do
|
||||
r <- runM (interpretTestE (send (TestE (pure 5) (pure . (9 +)))))
|
||||
print r
|
||||
(14 :: Int) `shouldBe` r
|
Loading…
Reference in New Issue
Block a user