mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-09-11 02:25:43 +03:00
* polysemy-plugin: Reject ununifiable effect candidates early * Bump version, update changelog, expand tests
63 lines
1.4 KiB
Haskell
63 lines
1.4 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
|
|
|
|
module MultipleVarsSpec where
|
|
|
|
import Polysemy
|
|
import Polysemy.State
|
|
|
|
import Test.Hspec
|
|
|
|
data TaggedState k s m a where
|
|
TaggedGet :: forall k s m. TaggedState k s m s
|
|
TaggedPut :: forall k s m. s -> TaggedState k s m ()
|
|
|
|
makeSem ''TaggedState
|
|
|
|
runTaggedState :: forall k s r a
|
|
. s
|
|
-> Sem (TaggedState k s ': r) a
|
|
-> Sem r (s, a)
|
|
runTaggedState s =
|
|
(runState s .)
|
|
$ reinterpret
|
|
$ \case
|
|
TaggedGet -> get
|
|
TaggedPut s -> put s
|
|
|
|
test :: Members '[
|
|
TaggedState Char Int
|
|
, TaggedState Bool Int
|
|
] r
|
|
=> Sem r ()
|
|
test = do
|
|
taggedPut @Bool 10
|
|
taggedPut @Char (-10)
|
|
|
|
spec :: Spec
|
|
spec = describe "Using multiple, but ununifiable instances\
|
|
\ of the same effect" $ do
|
|
it "should get disambiguated and compile, \
|
|
\and actions should target the right effects." $ do
|
|
let
|
|
res1 =
|
|
run
|
|
. runTaggedState @Char 0
|
|
. runTaggedState @Bool 7
|
|
$ test
|
|
res2 =
|
|
run
|
|
. runTaggedState @Bool 0
|
|
. runTaggedState @Char 7
|
|
$ test
|
|
res3 =
|
|
run
|
|
. runTaggedState @Bool 0
|
|
. runTaggedState @Char 7
|
|
$ do
|
|
taggedPut @Bool 10
|
|
taggedPut @Char (-10)
|
|
res1 `shouldBe` (-10, (10, ()))
|
|
res2 `shouldBe` (10, (-10, ()))
|
|
res3 `shouldBe` (10, (-10, ()))
|