Fix #68

polysemy-plugin/polysemy-plugin.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 85478fdf6818cbb2b849d4dd68a9f8dbee303d4a7ac2005945ac34ac5eb9dd33
+-- hash: 60270a84ef68a45a07fa377765f20552f6dd4f2750806dffcb31e44deec63db0
 
 name:           polysemy-plugin
 version:        0.2.0.0
@@ -54,6 +54,7 @@ test-suite polysemy-plugin-test
       BadSpec
       ExampleSpec
       InlineRecursiveCallsSpec
+      LegitimateTypeErrorSpec
       PluginSpec
       Paths_polysemy_plugin
   hs-source-dirs:

polysemy-plugin/src/Polysemy/Plugin/Fundep.hs

@@ -88,9 +88,10 @@ canUnify wanted given =
   let (w, ws) = splitAppTys wanted
       (g, gs) = splitAppTys given
    in (&& eqType w g) . flip all (zip ws gs) $ \(wt, gt) ->
-        if isTyVarTy gt
-           then isTyVarTy wt
-           else True
+     or [ isTyVarTy wt
+        , eqType gt wt
+        ]
+
 
 
 mkWanted :: Bool -> CtLoc -> Type -> Type -> TcPluginM (Maybe Ct)

polysemy-plugin/test/LegitimateTypeErrorSpec.hs

@@ -0,0 +1,25 @@
+{-# OPTIONS_GHC -fdefer-type-errors -fno-warn-deferred-type-errors #-}
+
+module LegitimateTypeErrorSpec where
+
+import Polysemy
+import Test.Hspec
+import Test.ShouldNotTypecheck
+
+wrongLift :: Member (Lift IO) r => Sem r ()
+wrongLift = sendM putStrLn
+
+wrongReturn :: Sem (e ': r) () -> Sem r ()
+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 giving a bad type to reinterpret" $
+        shouldNotTypecheck wrongReturn
+