mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-12-03 13:05:09 +03:00
c0cf61ea1f
* Properly track skolems for plugin unification * Cleanup imports * Add test * Stuff can now reference different packages * Tools for looking up instances * Add extra evidence * Solve AmbiguousSpec :) * Check givens for extra evidence * Use StateT to cache instance lookups * Remove numClass from Stuff * Documentation * Fix AmbiguousSpec * Don't need deriving strategies anymore * GHC9 imports * Polymorphic and MTPC tests
76 lines
2.1 KiB
Haskell
76 lines
2.1 KiB
Haskell
{-# LANGUAGE AllowAmbiguousTypes #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
{-# OPTIONS_GHC -fdefer-type-errors #-}
|
|
{-# OPTIONS_GHC -fno-warn-deferred-type-errors #-}
|
|
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
|
|
|
|
module AmbiguousSpec where
|
|
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Data.Functor.Identity
|
|
import Data.Monoid
|
|
import Polysemy
|
|
import Polysemy.Embed (runEmbedded)
|
|
import Polysemy.State
|
|
import Test.Hspec
|
|
import Test.ShouldNotTypecheck
|
|
|
|
class MPTC a b where
|
|
mptc :: a -> b
|
|
|
|
instance MPTC Bool Int where
|
|
mptc _ = 1000
|
|
|
|
|
|
uniquelyInt :: Members '[State Int , State String] r => Sem r ()
|
|
uniquelyInt = put 10
|
|
|
|
uniquelyA :: forall a b r. (Num a, Members '[State a, State b] r) => Sem r ()
|
|
uniquelyA = put 10
|
|
|
|
uniquelyString :: Members '[State Int , State String] r => Sem r ()
|
|
uniquelyString = put mempty
|
|
|
|
uniquelyB :: (MPTC Bool b, Members '[State String, State b] r) => Sem r ()
|
|
uniquelyB = put $ mptc False
|
|
|
|
uniquelyIO :: Members '[Embed IO, Embed Identity] r => Sem r ()
|
|
uniquelyIO = embed $ liftIO $ pure ()
|
|
|
|
ambiguous1 :: Members '[State (Sum Int), State String] r => Sem r ()
|
|
ambiguous1 = put mempty
|
|
|
|
ambiguous2 :: (Num String, Members '[State Int, State String] r) => Sem r ()
|
|
ambiguous2 = put 10
|
|
|
|
|
|
spec :: Spec
|
|
spec = describe "example" $ do
|
|
it "should run uniquelyInt" $ do
|
|
let z = run . runState 0 . runState "hello" $ uniquelyInt
|
|
z `shouldBe` (10, ("hello", ()))
|
|
|
|
it "should run uniquelyA" $ do
|
|
let z = run . runState 0 . runState "hello" $ uniquelyA @Int @String
|
|
z `shouldBe` (10, ("hello", ()))
|
|
|
|
it "should run uniquelyB" $ do
|
|
let z = run . runState 0 . runState "hello" $ uniquelyB @Int
|
|
z `shouldBe` (1000, ("hello", ()))
|
|
|
|
it "should run uniquelyString" $ do
|
|
let z = run . runState 0 . runState "hello" $ uniquelyString
|
|
z `shouldBe` (0, ("", ()))
|
|
|
|
it "should run uniquelyIO" $ do
|
|
z <- runM . runEmbedded @Identity (pure . runIdentity) $ uniquelyIO
|
|
z `shouldBe` ()
|
|
|
|
it "should not typecheck ambiguous1" $ do
|
|
shouldNotTypecheck ambiguous1
|
|
|
|
it "should not typecheck ambiguous2" $ do
|
|
shouldNotTypecheck ambiguous2
|
|
|