mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-11-29 22:52:37 +03:00
a4868bddd4
* Union rewrite * Exports, tests, and renamed KnownEffectRow * Got rid of artifacts accidently introduced * More documentation. tryMembership seperate from KnownRow * 'expose' combinator * Applied review suggestions, add Membership module * Fixed a replace-all goof * Scrap expose/Using in favor of interceptUsing/H * Fixed Haddock failure
36 lines
1.1 KiB
Haskell
36 lines
1.1 KiB
Haskell
module KnownRowSpec where
|
|
|
|
import Polysemy
|
|
import Polysemy.Error
|
|
import Polysemy.State
|
|
import Polysemy.Internal
|
|
import Polysemy.Internal.Union
|
|
|
|
import Test.Hspec
|
|
|
|
-- | A variant of 'runState' that uses 'stateToIO' if @r@ contains @Embed IO@.
|
|
-- (Can also be extended to check for @Final IO@)
|
|
runState' :: forall s r a. KnownRow r => s -> Sem (State s ': r) a -> Sem r (s, a)
|
|
runState' s sem = case tryMembership @(Embed IO) of
|
|
Just proof -> subsumeUsing proof (stateToIO s (raiseUnder sem))
|
|
_ -> runState s sem
|
|
|
|
|
|
test :: (Member (Error ()) r, KnownRow r)
|
|
=> Sem r String
|
|
test = fmap fst $ runState' "" $ do
|
|
put "local state"
|
|
_ <- (put "global state" >> throw ()) `catch` \() -> return ()
|
|
return ()
|
|
|
|
spec :: Spec
|
|
spec = parallel $ describe "tryMembership" $ do
|
|
it "should return a valid proof when the targeted \
|
|
\ effect is part of the row" $ do
|
|
res <- runM . runError @() $ test
|
|
res `shouldBe` Right "global state"
|
|
it "should not return a valid proof when the targeted \
|
|
\ effect is not part of the row" $ do
|
|
let res = run . runError @() $ test
|
|
res `shouldBe` Right "local state"
|