effectful-plugin 2.1.0.0 → 2.2.0.0
raw patch · 4 files changed
+109/−43 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +12/−0
- effectful-plugin.cabal +7/−24
- src/Effectful/Plugin.hs +57/−19
- tests/PluginTests.hs +33/−0
CHANGELOG.md view
@@ -1,3 +1,15 @@+# effectful-plugin-2.2.0.0 (2026-08-24)+* Fix a compiler panic when a constraint headed by a type variable or a+ quantified constraint is considered during candidate filtering.+* Consider effects from the context as candidates for wanteds with (partially)+ concrete effect rows instead of silently favouring effects from the row.+ Genuinely ambiguous cases are now reported as such by GHC, while cases+ disambiguated by other constraints resolve to the effect that fits. The+ plugin also no longer commits to the sole candidate when it doesn't satisfy+ the remaining constraints, which results in better error messages.+* Make sure that givens are produced only from effect rows headed by the+ promoted list constructor.+ # effectful-plugin-2.1.0.0 (2026-04-02) * Drop support for GHC < 9.6. * Consider built-in instances when filtering candidates.
effectful-plugin.cabal view
@@ -1,7 +1,7 @@-cabal-version: 3.0+cabal-version: 3.8 build-type: Simple name: effectful-plugin-version: 2.1.0.0+version: 2.2.0.0 license: BSD-3-Clause license-file: LICENSE category: Control@@ -11,7 +11,7 @@ description: Instruct GHC to do a better job with disambiguation of effects.- .+ See the README for more information. extra-source-files: CHANGELOG.md@@ -35,38 +35,21 @@ common language ghc-options: -Wall -Wcompat- -Wmissing-deriving-strategies+ -Werror=missing-deriving-strategies -Werror=prepositive-qualified-module - default-language: Haskell2010+ default-language: GHC2021 - default-extensions: BangPatterns- ConstraintKinds- DataKinds- DeriveFunctor- DeriveGeneric+ default-extensions: DataKinds+ DeepSubsumption DerivingStrategies DuplicateRecordFields- FlexibleContexts- FlexibleInstances- GADTs- GeneralizedNewtypeDeriving- ImportQualifiedPost LambdaCase- MultiParamTypeClasses NoFieldSelectors NoStarIsType OverloadedRecordDot- PolyKinds- RankNTypes- RecordWildCards RoleAnnotations- ScopedTypeVariables- StandaloneDeriving- TupleSections- TypeApplications TypeFamilies- TypeOperators UndecidableInstances library
src/Effectful/Plugin.hs view
@@ -8,6 +8,7 @@ import Data.IORef import Data.Maybe import Data.Set qualified as S+import GHC.Builtin.Types import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.TyCo.Rep@@ -102,7 +103,12 @@ { tcPluginInit = initPlugin , tcPluginRewrite = \_ -> emptyUFM , tcPluginSolve = disambiguateEffects- , tcPluginStop = pluginStopHook+#if __GLASGOW_HASKELL__ >= 1001+ , tcPluginPostTc = \_ -> pure ()+ , tcPluginShutdown = pluginShutdownHook+#else+ , tcPluginStop = tcPluginIO . pluginShutdownHook+#endif } , pluginRecompile = purePlugin }@@ -112,7 +118,10 @@ clsMod <- lookupModule $ mkModuleName "Effectful.Internal.Effect" elemClass <- tcLookupClass =<< lookupOrig clsMod (mkTcOcc ":>") totalTime <- tcPluginIO $ newIORef 0- pure PluginData{..}+ pure PluginData+ { elemClass = elemClass+ , totalTime = totalTime+ } where lookupModule :: ModuleName -> TcPluginM Module lookupModule modName = do@@ -141,11 +150,8 @@ case findCandidates wanted effGivens of Left given -> printSingle "Already solved by" given Right [] -> printLn "No candidates"- Right [(given, _)] -> do- printSingle "Single candidate found" given- emitEqConstraint solutions wanted given Right candidates -> do- printList "Multiple candidates found" $ map fst candidates+ printList "Candidates found" $ map fst candidates filterCandidates dflags None candidates >>= \case None -> printLn "No candidates left" Single given -> do@@ -202,8 +208,20 @@ then do printLn "Solvable from local context" allWantedsSolvable rest- else case tcSplitTyConApp wanted of- (con, args) -> case tyConClass_maybe con of+ -- The predicate might not be a type constructor application,+ -- e.g. when it's headed by a type variable or it's a quantified+ -- constraint, so the total variant of the split needs to be used+ -- to avoid compiler panics.+ --+ -- The two veto branches below are deliberately conservative,+ -- because these cases are hard to hit in real-world code and+ -- treating them properly is a lot of work, so the juice is not+ -- worth the squeeze.+ else case tcSplitTyConApp_maybe wanted of+ Nothing -> do+ printLn "Not a type constructor application"+ pure False+ Just (con, args) -> case tyConClass_maybe con of Nothing -> do printLn "Not a class constraint" pure False@@ -328,12 +346,13 @@ [] -> acc fullEs : rest -> let extractGivens :: Type -> [EffGiven]- extractGivens es = case splitAppTys es of- (_colon, [_kind, eff, esTail]) -> EffGiven- { effCon = fst $ splitAppTys eff- , eff = eff- , es = fullEs- } : extractGivens esTail+ extractGivens es = case tcSplitTyConApp_maybe es of+ Just (con, [_kind, eff, esTail])+ | con == promotedConsDataCon -> EffGiven+ { effCon = fst $ splitAppTys eff+ , eff = eff+ , es = fullEs+ } : extractGivens esTail _ -> [] in loop (extractGivens fullEs ++ acc) rest @@ -371,6 +390,15 @@ -- | Find givens unifiable with a wanted and give them back along with -- appropriate substitutions. --+-- A given @e :> es@ is a candidate for a wanted @e' :> ws@ not only when its+-- effect row is equal to @ws@, but also when it's a suffix of @ws@, since then+-- it solves the wanted via the @e :> es => e :> (x : es)@ instance just as+-- well. This way effects from the context compete with effects from a+-- (partially) concrete row instead of the latter silently winning.+--+-- Candidates with equal effect types represent the same solution (the emitted+-- equality constraint would be identical), so only the first one is kept.+-- -- Returns Left if the wanted is already solved by one of the givens. findCandidates :: EffWanted -> [EffGiven] -> Either EffGiven [(EffGiven, Subst)] findCandidates wanted = loop []@@ -378,14 +406,24 @@ loop acc = \case [] -> Right acc given : rest ->- if wanted.effCon `eqType` given.effCon && wanted.es `eqType` given.es+ if wanted.effCon `eqType` given.effCon && given.es `isRowSuffixOf` wanted.es then case tcUnifyTyNoSkolems wanted.eff given.eff of Just subst | isEmptySubst subst -> Left given+ | any (eqType given.eff . (.eff) . fst) acc -> loop acc rest | otherwise -> loop ((given, subst) : acc) rest Nothing -> loop acc rest else loop acc rest + -- Check whether the first effect row is a syntactic suffix of the second.+ isRowSuffixOf :: Type -> Type -> Bool+ isRowSuffixOf gs ws+ | gs `eqType` ws = True+ | otherwise = case tcSplitTyConApp_maybe ws of+ Just (con, [_kind, _eff, wsTail])+ | con == promotedConsDataCon -> gs `isRowSuffixOf` wsTail+ _ -> False+ nubType :: [Type] -> [Type] nubType = coerce . S.toList . S.fromList @OrdType . coerce @@ -411,8 +449,8 @@ modifyIORef' pd.totalTime (+ (t2 - t1)) pure a -pluginStopHook :: PluginData -> TcPluginM ()-pluginStopHook pd = tcPluginIO $ do+pluginShutdownHook :: PluginData -> IO ()+pluginShutdownHook pd = do time <- readIORef pd.totalTime putStrLn $ "Execution time of effectful-plugin (seconds): " ++ show time @@ -421,8 +459,8 @@ timed :: PluginData -> TcPluginM a -> TcPluginM a timed _ action = action -pluginStopHook :: PluginData -> TcPluginM ()-pluginStopHook _ = pure ()+pluginShutdownHook :: PluginData -> IO ()+pluginShutdownHook _ = pure () #endif
tests/PluginTests.hs view
@@ -8,6 +8,7 @@ {-# OPTIONS_GHC -Wno-unused-foralls #-} module Main where +import Data.Kind import Data.String import Data.Typeable import Unsafe.Coerce@@ -165,3 +166,35 @@ runDBAction :: Eff (DBAction which : es) a -> Eff es a runDBAction = interpret_ $ \case DoSelect (Select a) -> pure $ Just a++-- An effect from the context competes with a concrete effect at the head of+-- the row, so disambiguation needs to go through fit-checking instead of+-- silently picking the head.+uniquelyIntOrString :: State String :> es => Eff es ()+uniquelyIntOrString = evalState (0 :: Int) $ ordPut 10 >> put ""++-- An effect from the context that's identical to a concrete effect in the row+-- is the same solution, not an ambiguity.+sameEffectTwice :: State Int :> es => Eff es ()+sameEffectTwice = evalState (0 :: Int) $ put 10++-- Wanteds whose rows share a suffix containing the same concrete effect yield+-- one solution, not an ambiguity.+sharedRowSuffix :: Eff (State Int : es) ()+sharedRowSuffix = do+ _ <- runErrorNoCallStack @() $ put 10+ put 20++-- Disambiguation in the presence of a constraint headed by a type variable+-- must not panic the compiler when checking whether candidates fit, since the+-- constraint is not a type constructor application.+needC :: forall (c :: Type -> Constraint) a es. c a => a -> Eff es ()+needC _ = pure ()++constraintPoly+ :: forall (c :: Type -> Constraint) es+ . (c Int, State Int :> es, State String :> es)+ => Eff es ()+constraintPoly = do+ s <- get+ needC @c s