effectful-plugin 2.0.0.1 → 2.1.0.0
raw patch · 4 files changed
+57/−31 lines, 4 filesdep ~basedep ~ghcPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, ghc
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- effectful-plugin.cabal +6/−9
- src/Effectful/Plugin.hs +32/−22
- tests/PluginTests.hs +15/−0
CHANGELOG.md view
@@ -1,3 +1,7 @@+# effectful-plugin-2.1.0.0 (2026-04-02)+* Drop support for GHC < 9.6.+* Consider built-in instances when filtering candidates.+ # effectful-plugin-2.0.0.1 (2025-08-30) * Small optimization of checking suitable effects for unification. * Add `timing` flag for tracking execution time of the plugin.
effectful-plugin.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 build-type: Simple name: effectful-plugin-version: 2.0.0.1+version: 2.1.0.0 license: BSD-3-Clause license-file: LICENSE category: Control@@ -17,7 +17,7 @@ extra-source-files: CHANGELOG.md README.md -tested-with: GHC == { 9.4.8, 9.6.7, 9.8.4, 9.10.2, 9.12.2, 9.14.1 }+tested-with: GHC == { 9.6.7, 9.8.4, 9.10.3, 9.12.4, 9.14.1 } bug-reports: https://github.com/haskell-effectful/effectful/issues source-repository head@@ -35,7 +35,6 @@ common language ghc-options: -Wall -Wcompat- -Wno-unticked-promoted-constructors -Wmissing-deriving-strategies -Werror=prepositive-qualified-module @@ -55,7 +54,9 @@ ImportQualifiedPost LambdaCase MultiParamTypeClasses+ NoFieldSelectors NoStarIsType+ OverloadedRecordDot PolyKinds RankNTypes RecordWildCards@@ -68,10 +69,6 @@ TypeOperators UndecidableInstances - if impl(ghc >= 9.4)- default-extensions: NoFieldSelectors- , OverloadedRecordDot- library import: language @@ -81,9 +78,9 @@ if flag(verbose) cpp-options: -DVERBOSE - build-depends: base >= 4.16 && < 5+ build-depends: base >= 4.18 && < 5 , containers >= 0.5- , ghc >= 9.4 && < 9.15+ , ghc >= 9.6 && < 9.15 hs-source-dirs: src
src/Effectful/Plugin.hs view
@@ -9,7 +9,6 @@ import Data.Maybe import Data.Set qualified as S import GHC.Core.Class-import GHC.Core.InstEnv import GHC.Core.Predicate import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Subst@@ -18,6 +17,7 @@ import GHC.Core.Unify import GHC.Driver.Env import GHC.Driver.Plugins+import GHC.Tc.Instance.Class import GHC.Tc.Plugin import GHC.Tc.Types import GHC.Tc.Types.Constraint@@ -31,25 +31,24 @@ import GHC.Unit.Module import GHC.Utils.Outputable qualified as O +#if __GLASGOW_HASKELL__ >= 908+import GHC.Driver.DynFlags (DynFlags)+#else+import GHC.Driver.Session (DynFlags)+#endif+ #if __GLASGOW_HASKELL__ <= 912-import GHC.Driver.Config.Finder+import GHC.Driver.Config.Finder (initFinderOpts) #endif #if __GLASGOW_HASKELL__ >= 912-import GHC.Tc.Types.CtLoc+import GHC.Tc.Types.CtLoc (CtLoc) #endif #ifdef TIMING import GHC.Clock #endif -#if __GLASGOW_HASKELL__ <= 904-type Subst = TCvSubst--isEmptySubst :: Subst -> Bool-isEmptySubst = isEmptyTCvSubst-#endif- data EffGiven = EffGiven { effCon :: Type , eff :: Type@@ -135,7 +134,7 @@ printList "Wanteds" allWanteds printList "EffWanteds" effWanteds printList "OtherWanteds" otherWanteds- instEnvs <- getInstEnvs+ dflags <- hsc_dflags <$> getTopEnv solutions <- tcPluginIO $ newIORef [] forM_ effWanteds $ \wanted -> do printSingle "Wanted" wanted@@ -147,7 +146,7 @@ emitEqConstraint solutions wanted given Right candidates -> do printList "Multiple candidates found" $ map fst candidates- filterCandidates instEnvs None candidates >>= \case+ filterCandidates dflags None candidates >>= \case None -> printLn "No candidates left" Single given -> do printSingle "Single candidate left" given@@ -170,11 +169,11 @@ $ allWanteds filterCandidates- :: InstEnvs+ :: DynFlags -> Candidates -> [(EffGiven, Subst)] -> TcPluginM Candidates- filterCandidates instEnvs acc = \case+ filterCandidates dflags acc = \case [] -> pure acc (given, subst) : rest -> do printSingle "Candidate" given@@ -187,12 +186,12 @@ True -> do printLn "Candidate fits" case acc of- None -> filterCandidates instEnvs (Single given) rest+ None -> filterCandidates dflags (Single given) rest Single _ -> pure Multiple Multiple -> error "unreachable" False -> do printLn "Candidate doesn't fit, skipping"- filterCandidates instEnvs acc rest+ filterCandidates dflags acc rest where allWantedsSolvable :: [Type] -> TcPluginM Bool allWantedsSolvable = \case@@ -208,16 +207,27 @@ Nothing -> do printLn "Not a class constraint" pure False- Just cls -> case lookupInstEnv False instEnvs cls args of- ([], _, _) -> do- printLn "No matching instances found"- pure False- _ -> do- printLn "Found matching instances"+ Just cls -> findMatchingInstances dflags cls args >>= \case+ OneInst { cir_what = inst } -> do+ printSingle "Single matching instance" inst allWantedsSolvable rest+ NoInstance -> do+ printLn "No matching instances"+ pure False+ NotSure -> do+ printLn "Multiple matching instances"+ pure False ---------------------------------------- -- Standalone helpers++findMatchingInstances :: DynFlags -> Class -> [Type] -> TcPluginM ClsInstResult+findMatchingInstances dflags cls args =+#if __GLASGOW_HASKELL__ <= 912+ unsafeTcPluginTcM $ matchGlobalInst dflags False cls args+#else+ unsafeTcPluginTcM $ matchGlobalInst dflags False cls args Nothing+#endif findPluginModuleCompat :: HscEnv -> ModuleName -> TcPluginM FindResult findPluginModuleCompat hsc_env mod_name = do
tests/PluginTests.hs view
@@ -9,6 +9,7 @@ module Main where import Data.String+import Data.Typeable import Unsafe.Coerce import Effectful@@ -23,6 +24,20 @@ ---------------------------------------- -- Tests++data X1 = X1 { x1 :: Int }+data X2 = X2 { x2 :: X1 }++x1x2 :: (State X1 :> es, State X2 :> es) => Eff es ()+x1x2 = do+ _ <- gets (.x1)+ _ <- gets (.x2.x1)+ pure ()++typeable :: (State X1 :> es, State x :> es) => Eff es ()+typeable = do+ _ <- gets typeOf+ pure () data Function i o :: Effect where Call :: i -> Function i o m o