polysemy-plugin 0.2.0.1 → 0.2.0.2

raw patch · 7 files changed

+59/−15 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• polysemy-plugin.cabal +3/−2
• src/Polysemy/Plugin/Fundep.hs +4/−4
• src/Polysemy/Plugin/InlineRecursiveCalls.hs +0/−1
• test/InlineRecursiveCallsSpec.hs +9/−8
• test/PluginSpec.hs +8/−0
• test/VDQSpec.hs +30/−0

@@ -1,5 +1,10 @@ # Changelog for polysemy-plugin +## 0.2.0.2 (2019-06-09)++- Fixed a bug where the plugin wouldn't attempt to unify effects recursively+- Updated the test suite to test against `polysemy-0.3`+ ## 0.2.0.1 (2019-05-28)  - Fixed a bug where the plugin would get confused in the context of legitimate

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 140d529a7cdddca38bcea9f27672cebd7742b7668b1be602c699a624cbb253aa+-- hash: 833a0e985a778fbc94a5830306c89c74928839bc5d967121db306b2744cfe1a5  name:           polysemy-plugin-version:        0.2.0.1+version:        0.2.0.2 synopsis:       Disambiguate obvious uses of effects. description:    Please see the README on GitHub at <https://github.com/isovector/polysemy/tree/master/polysemy-plugin#readme> category:       Polysemy@@ -56,6 +56,7 @@       InlineRecursiveCallsSpec       LegitimateTypeErrorSpec       PluginSpec+      VDQSpec       Paths_polysemy_plugin   hs-source-dirs:       test

@@ -89,14 +89,14 @@       (g, gs) = splitAppTys given    in (&& eqType w g) . flip all (zip ws gs) $ \(wt, gt) ->      or [ isTyVarTy wt-        , eqType gt wt+        , eqType wt gt+        , canUnify wt gt         ]  - mkWanted :: Bool -> CtLoc -> Type -> Type -> TcPluginM (Maybe Ct)-mkWanted mustUnify loc wanted given =-  if (not mustUnify || canUnify wanted given)+mkWanted must_unify loc wanted given =+  if (not must_unify || canUnify wanted given)      then do        (ev, _) <- unsafeTcPluginTcM $ runTcSDeriveds $ newWantedEq loc Nominal wanted given        pure $ Just $ CNonCanonical ev

@@ -14,7 +14,6 @@ import HscTypes import IdInfo import Name-import SrcLoc import UniqSupply import Unique import Var

@@ -18,10 +18,7 @@ spec :: Spec spec = describe "inlining recursive calls" $ do   it "should explicitly break recursion" $ do-    -- TODO(sandy): This should use (===) instead of (==-), but can't due to-    -- a bug in inspection-testing. See:-    -- https://github.com/nomeata/inspection-testing/pull/19-    shouldSucceed $(inspectTest $ 'recursive ==- 'mutual)+    shouldSucceed $(inspectTest $ 'recursive === 'mutual)   isSuccess :: Result -> Bool@@ -44,9 +41,11 @@     case decomp u of         Left x -> S.StateT $ \s' ->           k . fmap swap-            . weave (s', ()) (uncurry $ recursive f)+            . weave (s', ())+                    (uncurry $ recursive f)+                    (Just . snd)             $ x-        Right (Yo e z _ y) ->+        Right (Yo e z _ y _) ->           fmap (y . (<$ z)) $ S.mapStateT (usingSem k) $ f e  @@ -61,9 +60,11 @@     case decomp u of         Left x -> S.StateT $ \s' ->           k . fmap swap-            . weave (s', ()) (uncurry $ mutual2 f)+            . weave (s', ())+                    (uncurry $ mutual2 f)+                    (Just . snd)             $ x-        Right (Yo e z _ y) ->+        Right (Yo e z _ y _) ->           fmap (y . (<$ z)) $ S.mapStateT (usingSem k) $ f e {-# INLINE mutual #-} 

@@ -10,6 +10,7 @@ import Polysemy import Polysemy.Error import Polysemy.State+import Polysemy.Output import Test.Hspec  @@ -115,6 +116,13 @@       flipShouldBe (Right @String (10 :: Int, True))  . run $ runError $ runState 0 errState     it "should interpret against Bool/Float" $ do       flipShouldBe (Right @Bool (10 :: Float, True))  . run $ runError $ runState 0 errState++  describe "Output effect" $ do+    it "should unify recursively" $ do+      -- TODO(sandy): This should unify even without the type app. Bug #95+      flipShouldBe 11 . sum @[] . fst . run . runFoldMapOutput id $ do+        output [1]+        output $ replicate 2 5     describe "Lift effect" $ do

@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}++module VDQSpec where++import Polysemy+import Polysemy.Error+import Polysemy.Input+import Polysemy.Output+import Polysemy.Resource+import Test.Hspec++data Select a = Select a++data DBAction whichDb m a where+  DoSelect :: Select a -> DBAction whichDb m (Maybe a)++makeSem ''DBAction++runDBAction :: Sem (DBAction which ': r) a -> Sem r a+runDBAction = interpret $ \case+  DoSelect (Select a) -> pure $ Just a++spec :: Spec+spec = describe "example" $ do+  it "should compile!" $ do+    let z = run . runDBAction $ doSelect $ Select True+    z `shouldBe` Just True+