effectful-plugin 1.1.0.3 → 1.1.0.4
raw patch · 5 files changed
+45/−9 lines, 5 filesdep ~ghcPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghc
API changes (from Hackage documentation)
Files
- CHANGELOG.md +3/−0
- effectful-plugin.cabal +7/−2
- src-legacy/Effectful/Plugin.hs +10/−2
- src/Effectful/Plugin.hs +21/−1
- tests/PluginTests.hs +4/−4
CHANGELOG.md view
@@ -1,3 +1,6 @@+# effectful-plugin-1.1.0.4 (2024-10-08)+* Fix inference in presence of implicit parameters.+ # effectful-plugin-1.1.0.3 (2024-06-07) * Drop support for GHC 8.8.
effectful-plugin.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 build-type: Simple name: effectful-plugin-version: 1.1.0.3+version: 1.1.0.4 license: BSD-3-Clause license-file: LICENSE category: Control@@ -25,7 +25,10 @@ location: https://github.com/haskell-effectful/effectful.git common language- ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors+ ghc-options: -Wall+ -Wcompat+ -Wno-unticked-promoted-constructors+ -Wmissing-deriving-strategies -Werror=prepositive-qualified-module default-language: Haskell2010@@ -35,6 +38,7 @@ DataKinds DeriveFunctor DeriveGeneric+ DerivingStrategies FlexibleContexts FlexibleInstances GADTs@@ -43,6 +47,7 @@ LambdaCase MultiParamTypeClasses NoStarIsType+ PolyKinds RankNTypes RecordWildCards RoleAnnotations
src-legacy/Effectful/Plugin.hs view
@@ -13,6 +13,7 @@ #if __GLASGOW_HASKELL__ >= 900 import GHC.Core.Class (Class) import GHC.Core.InstEnv (InstEnvs, lookupInstEnv)+import GHC.Core.Predicate (isIPClass) import GHC.Core.Unify (tcUnifyTy) import GHC.Plugins ( Outputable (ppr), Plugin (pluginRecompile, tcPlugin), PredType@@ -46,6 +47,7 @@ , tyConClass_maybe ) import InstEnv (InstEnvs, lookupInstEnv)+import Predicate (isIPClass) import TcEnv (tcGetInstEnvs) import TcPluginM (tcLookupClass, tcPluginIO) import TcRnTypes@@ -145,7 +147,7 @@ -- We store a list of the types of all given constraints, which will be useful later. allGivenTypes = ctPred <$> allGivens -- We also store a list of wanted constraints that are /not/ 'Elem e es' for later use.- extraWanteds = ctPred <$> filter irrelevant allWanteds+ extraWanteds = ctPred <$> filter (\w -> irrelevant w && not (isIP w)) allWanteds -- traceM $ "Givens: " <> show (showSDocUnsafe . ppr <$> allGivens) -- traceM $ "Wanteds: " <> show (showSDocUnsafe . ppr <$> allWanteds)@@ -224,9 +226,15 @@ | cls == elemCls = Just $ FakedepWanted (FakedepGiven (fst $ splitAppTys eff) eff es) loc relevantWanted _ = Nothing + -- Check if a constraint in an implicit parameter.+ isIP :: Ct -> Bool+ isIP = \case+ CDictCan _ cls _ _ -> isIPClass cls+ _ -> False+ -- Determine whether a constraint is /not/ of form 'Elem e es'. irrelevant :: Ct -> Bool- irrelevant = isNothing . relevantGiven+ irrelevant = isNothing . relevantWanted -- Given a wanted constraint and a given constraint, unify them and give back a substitution that can be applied -- to the wanted to make it equal to the given.
src/Effectful/Plugin.hs view
@@ -11,6 +11,7 @@ import GHC.Core.Class (Class) import GHC.Core.InstEnv (InstEnvs, lookupInstEnv)+import GHC.Core.Predicate (isIPClass) import GHC.Core.TyCo.Rep (PredType, Type) import GHC.Core.TyCo.Subst import GHC.Core.TyCon (tyConClass_maybe)@@ -31,13 +32,18 @@ import GHC.Tc.Types.Constraint ( Ct (..) , CtEvidence (..)+#if __GLASGOW_HASKELL__ < 912 , CtLoc+#endif #if __GLASGOW_HASKELL__ >= 908 , DictCt (..) #endif , ctPred , emptyRewriterSet )+#if __GLASGOW_HASKELL__ >= 912+import GHC.Tc.Types.CtLoc (CtLoc)+#endif import GHC.Tc.Types.Evidence (EvBindsVar, Role (..)) import GHC.Tc.Utils.Env (tcGetInstEnvs) import GHC.Tc.Utils.TcType (tcSplitTyConApp, eqType, nonDetCmpType)@@ -167,7 +173,11 @@ -- constraints. Therefore, we extract these constraints out of the -- 'allGivens' and 'allWanted's. effGivens = mapMaybe maybeEffGiven allGivens- (otherWantedTys, effWanteds) = partitionEithers $ map splitWanteds allWanteds+ (otherWantedTys, effWanteds) = partitionEithers+ . map splitWanteds+ -- Get rid of implicit parameters, they're weird.+ . filter (not . isIP)+ $ allWanteds -- We store a list of the types of all given constraints, which will be -- useful later.@@ -240,6 +250,16 @@ } else Nothing _ -> Nothing++ -- Check if a constraint in an implicit parameter.+ isIP :: Ct -> Bool+ isIP = \case+#if __GLASGOW_HASKELL__ < 908+ CDictCan { cc_class = cls } -> isIPClass cls+#else+ CDictCan DictCt { di_cls = cls } -> isIPClass cls+#endif+ _ -> False -- Determine whether a wanted constraint is of form 'e :> es'. splitWanteds :: Ct -> Either PredType EffWanted
tests/PluginTests.hs view
@@ -63,7 +63,7 @@ err :: Error e :> es => Eff es Bool err = catchError- (throwError (error ""))+ (throwError_ (error "")) (\_ _ -> pure True) errState :: (Num s, Error e :> es, State s :> es) => Eff es Bool@@ -72,7 +72,7 @@ err newtype MyString = MyString String- deriving (IsString, Eq, Show)+ deriving newtype (IsString, Eq, Show) data Janky = forall s. Janky (forall _i. Eff '[State s] ()) @@ -96,7 +96,7 @@ type instance DispatchOf (TaggedState k s) = Dynamic runTaggedState :: s -> Eff (TaggedState k s : es) a -> Eff es (a, s)-runTaggedState s = reinterpret (runState s) $ \_ -> \case+runTaggedState s = reinterpret_ (runState s) $ \case TaggedGet -> get TaggedPut s' -> put s' @@ -112,5 +112,5 @@ type instance DispatchOf (DBAction whichDb) = Dynamic runDBAction :: Eff (DBAction which : es) a -> Eff es a-runDBAction = interpret $ \_ -> \case+runDBAction = interpret_ $ \case DoSelect (Select a) -> pure $ Just a