cleff-plugin (empty) → 0.1.0.0

raw patch · 8 files changed

+587/−0 lines, 8 filesdep +basedep +cleffdep +cleff-plugin

Dependencies added: base, cleff, cleff-plugin, containers, ghc, ghc-tcplugins-extra

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• README.md +48/−0
• cleff-plugin.cabal +107/−0
• src/Cleff/Plugin.hs +21/−0
• src/Cleff/Plugin/Internal.hs +244/−0
• test/CleffSpec.hs +117/−0
• test/Main.hs +15/−0

@@ -0,0 +1,5 @@+# Changelog for `cleff-plugin`++## 0.1.0.0 (2022-03-13)++- Initial release

@@ -0,0 +1,30 @@+Copyright Xy Ren (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Xy Ren nor the names of other contributors+      may be used to endorse or promote products derived from this+      software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,48 @@+# `cleff-plugin`++This GHC typechecking plugin disambiguates obvious usages of effects for the extensible effect framework `cleff`.++## Usage++This plugin works with GHC 8.6 through 9.2 and `cleff >= 0.1 && < 0.4`. To use the plugin:++1. Add this plugin as your package's dependency.+    - If you use `stack`, then you also need to add these lines your `stack.yaml`:+      ```yaml+      extra-deps:+      - cleff-plugin-0.1.0.0+      ```+2. Enable the plugin by adding the following GHC option to your project file:+    ```+    ghc-options: -fplugin=Cleff.Plugin+    ```++## What it does++When using `cleff`, the following code would not compile:++```haskell+action :: '[State Int, State String] :>> es => Eff es ()+action = do+  x <- get+  put (x + 1)+-- • Could not deduce (Cleff.Internal.Rec.Elem (State s0) es)+--     arising from a use of ‘get’+```++This is because GHC is unable to determine which `State` effect we're trying to operate on, although the only viable choice is `State Int`. We had to write:++```haskell+action :: '[State Int, State String] :>> es => Eff es ()+action = do+  x <- get @Int+  put (x + 1)+```++This is quite unwieldy. This plugin tells GHC extra information so code like this can typecheck without requiring manually annotating which effect to use.++## References++This plugin's design is largely inspired by [`polysemy-plugin`](https://hackage.haskell.org/package/polysemy-plugin), which is in turn based on [`simple-effects`](https://hackage.haskell.org/package/simple-effects).++Refer to [`docs/plugin-spec.md`](https://github.com/re-xyr/cleff/tree/master/docs/plugin-spec.md) for details on the disambiguation algorithm this typecheck plugin uses.

@@ -0,0 +1,107 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           cleff-plugin+version:        0.1.0.0+synopsis:       Automatic disambiguation for extensible effects+description:    Please see the README on GitHub at <https://github.com/re-xyr/cleff/tree/master/cleff-plugin#readme>+category:       Control, Effect, Language+homepage:       https://github.com/re-xyr/cleff#readme+bug-reports:    https://github.com/re-xyr/cleff/issues+author:         Xy Ren+maintainer:     xy.r@outlook.com+copyright:      2022 Xy Ren+license:        BSD3+license-file:   LICENSE+build-type:     Simple+tested-with:+    GHC == 8.6.5+  , GHC == 8.8.4+  , GHC == 8.10.7+  , GHC == 9.0.2+extra-source-files:+    CHANGELOG.md+    README.md++source-repository head+  type: git+  location: https://github.com/re-xyr/cleff++library+  exposed-modules:+      Cleff.Plugin+      Cleff.Plugin.Internal+  other-modules:+      Paths_cleff_plugin+  hs-source-dirs:+      src+  default-extensions:+      BangPatterns+      BlockArguments+      DerivingStrategies+      EmptyCase+      FlexibleContexts+      FlexibleInstances+      LambdaCase+      NoStarIsType+      PolyKinds+      ScopedTypeVariables+      TupleSections+      UnicodeSyntax+  ghc-options: -Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wno-unticked-promoted-constructors -Wpartial-fields -Wunused-type-patterns -Wmissing-export-lists+  build-depends:+      base >=4.12 && <4.17+    , cleff >=0.1 && <0.4+    , containers >=0.5 && <0.7+    , ghc >=8.6 && <9.3+    , ghc-tcplugins-extra >=0.3 && <0.5+  if impl(ghc >= 8.8)+    ghc-options: -Wmissing-deriving-strategies+  default-language: Haskell2010++test-suite cleff-plugin-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      CleffSpec+      Paths_cleff_plugin+  hs-source-dirs:+      test+  default-extensions:+      BangPatterns+      BlockArguments+      DerivingStrategies+      EmptyCase+      FlexibleContexts+      FlexibleInstances+      LambdaCase+      NoStarIsType+      PolyKinds+      ScopedTypeVariables+      TupleSections+      UnicodeSyntax+      DataKinds+      FunctionalDependencies+      TemplateHaskell+      GADTs+      GeneralizedNewtypeDeriving+      KindSignatures+      RankNTypes+      TypeApplications+      TypeFamilies+      TypeOperators+      UndecidableInstances+  ghc-options: -Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wno-unticked-promoted-constructors -Wpartial-fields -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.12 && <4.17+    , cleff+    , cleff-plugin+    , containers >=0.5 && <0.7+    , ghc >=8.6 && <9.3+    , ghc-tcplugins-extra >=0.3 && <0.5+  if impl(ghc >= 8.8)+    ghc-options: -Wmissing-deriving-strategies+  default-language: Haskell2010

@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}+-- | Copyright: (c) 2022 Xy Ren+-- License: BSD3+-- Maintainer: xy.r@outlook.com+-- Stability: experimental+-- Portability: non-portable (GHC only)+module Cleff.Plugin (plugin) where++import           Cleff.Plugin.Internal (Plugin, makePlugin)++-- | The GHC typechecker plugin that disambiguates trivial uses of @cleff@ effects. Refer to the README for more info.+plugin :: Plugin+#if MIN_VERSION_cleff(0, 3, 2)+plugin = makePlugin [("cleff", "Cleff.Internal.Rec", ":>")]+#elif MIN_VERSION_cleff(0, 3, 1)+plugin = makePlugin [("cleff", "Cleff.Internal.Rec", "Elem")]+#elif MIN_VERSION_cleff(0, 2, 0)+plugin = makePlugin [("rec-smallarray", "Data.Rec.SmallArray", "Elem")]+#else+plugin = makePlugin [("cleff", "Data.Rec", "Elem")]+#endif

@@ -0,0 +1,244 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Redundant if" #-}+-- | Copyright: (c) 2022 Xy Ren+-- License: BSD3+-- Maintainer: xy.r@outlook.com+-- Stability: unstable+-- Portability: non-portable (GHC only)+module Cleff.Plugin.Internal (Plugin, Names, makePlugin) where++import           Data.Function           (on)+import           Data.IORef              (IORef, modifyIORef, newIORef, readIORef)+import           Data.Maybe              (isNothing, mapMaybe)+import           Data.Set                (Set)+import qualified Data.Set                as Set+import           Data.Traversable        (for)+import           GHC.TcPluginM.Extra     (lookupModule, lookupName)++#if __GLASGOW_HASKELL__ >= 900+import           GHC.Core.Class          (Class)+import           GHC.Core.InstEnv        (InstEnvs, lookupInstEnv)+import           GHC.Core.Unify          (tcUnifyTy)+import           GHC.Plugins             (Outputable (ppr), Plugin (pluginRecompile, tcPlugin), PredType,+                                          Role (Nominal), TCvSubst, Type, defaultPlugin, eqType, fsLit, mkModuleName,+                                          mkTcOcc, nonDetCmpType, purePlugin, showSDocUnsafe, splitAppTys, substTys,+                                          tyConClass_maybe)+import           GHC.Tc.Plugin           (tcLookupClass, tcPluginIO)+import           GHC.Tc.Solver.Monad     (newWantedEq, runTcSDeriveds)+import           GHC.Tc.Types            (TcM, TcPlugin (TcPlugin, tcPluginInit, tcPluginSolve, tcPluginStop),+                                          TcPluginM, TcPluginResult (TcPluginOk), unsafeTcPluginTcM)+import           GHC.Tc.Types.Constraint (Ct (CDictCan, CNonCanonical), CtEvidence (CtWanted), CtLoc, ctPred)+import           GHC.Tc.Utils.Env        (tcGetInstEnvs)+import           GHC.Tc.Utils.TcType     (tcSplitTyConApp)++#else+import           Class                   (Class)+#if __GLASGOW_HASKELL__ >= 810+import           Constraint              (Ct (CDictCan, CNonCanonical), CtEvidence (CtWanted), CtLoc, ctPred)+#endif+import           GhcPlugins              (Outputable (ppr), Plugin (pluginRecompile, tcPlugin), PredType,+                                          Role (Nominal), TCvSubst, Type, defaultPlugin, eqType, fsLit, mkModuleName,+                                          mkTcOcc, nonDetCmpType, purePlugin, showSDocUnsafe, splitAppTys, substTys,+                                          tyConClass_maybe)+import           InstEnv                 (InstEnvs, lookupInstEnv)+import           TcEnv                   (tcGetInstEnvs)+import           TcPluginM               (tcLookupClass, tcPluginIO)+import           TcRnTypes+import           TcSMonad                (newWantedEq, runTcSDeriveds)+import           TcType                  (tcSplitTyConApp)+import           Unify                   (tcUnifyTy)+#endif++-- | A list of unique, unambiguous Haskell names in the format of @(packageName, moduleName, identifier)@.+type Names = [(String, String, String)]++-- | Make a @polysemy-plugin@-style effect disambiguation plugin that applies to all the "element-of" typeclasses+-- passed in. Each of the names passed in should have type @k -> [k] -> 'Data.Kind.Type'@ where @k@ can be either+-- polymorphic or monomorphic.+--+-- Some examples include:+--+-- @+-- (\"cleff\", \"Cleff.Internal.Rec\", \":>\")+-- (\"polysemy\", \"Polysemy.Internal.Union\", \"Member\")+-- (\"effectful\", \"Effectful.Internal.Effect\", \":>\")+-- @+--+-- You can see the source code for notes on the implementation of the plugin.+makePlugin :: Names -> Plugin+makePlugin names = defaultPlugin+  { tcPlugin = const (Just $ fakedep names)+  , pluginRecompile = purePlugin+  }++fakedep :: Names -> TcPlugin+fakedep names = TcPlugin+  { tcPluginInit = initFakedep names+  , tcPluginSolve = solveFakedepForAllElemClasses+  , tcPluginStop = const $ pure ()+  }++liftTc :: TcM a -> TcPluginM a+liftTc = unsafeTcPluginTcM++liftIo :: IO a -> TcPluginM a+liftIo = tcPluginIO+type VisitedSet = Set (OrdType, OrdType)++initFakedep :: Names -> TcPluginM ([Class], IORef VisitedSet)+initFakedep names = do+  classes <- for names \(packageName, elemModuleName, elemClassName) -> do+    recMod <- lookupModule (mkModuleName elemModuleName) $ fsLit packageName+    nm <- lookupName recMod $ mkTcOcc elemClassName+    tcLookupClass nm+  visited <- liftIo $ newIORef Set.empty+  pure (classes, visited)++data FakedepGiven = FakedepGiven+  { givenEffHead :: Type+  , givenEff     :: Type+  , givenEs      :: Type+  }++instance Show FakedepGiven where+  show (FakedepGiven _ e es) = "(Elem " <> showSDocUnsafe (ppr e) <> " " <> showSDocUnsafe (ppr es) <> ")"++data FakedepWanted = FakedepWanted FakedepGiven CtLoc++instance Show FakedepWanted where+  show (FakedepWanted given _) = show given++newtype OrdType = OrdType { unOrdType :: Type }++instance Eq OrdType where+  (==) = eqType `on` unOrdType++instance Ord OrdType where+  compare = nonDetCmpType `on` unOrdType++solveFakedepForAllElemClasses :: ([Class], IORef VisitedSet) -> [Ct] -> [Ct] -> [Ct] -> TcPluginM TcPluginResult+solveFakedepForAllElemClasses (elemClasses, visitedRef) givens _ wanteds = do+  solns <- concat <$> for elemClasses \elemCls -> solveFakedep (elemCls, visitedRef) givens wanteds+  pure $ TcPluginOk [] solns++solveFakedep :: (Class, IORef VisitedSet) -> [Ct] -> [Ct] -> TcPluginM [Ct]+solveFakedep _ _ [] = pure []+solveFakedep (elemCls, visitedRef) allGivens allWanteds = do+  -- We're given two lists of constraints here:+  -- - 'allGivens' are constraints already in our context,+  -- - 'allWanteds' are constraints that need to be solved.+  -- In the following notes, the words "give/given" and "want/wanted" all refer to this specific technical concept:+  -- given constraints are those that we can use, and wanted constraints are those that we need to solve.+  let+    -- The only type of constraint we're interested in solving are 'Elem e es' constraints. Therefore, we extract these+    -- constraints out of the 'allGivens' and 'allWanted's.+    givens = mapMaybe relevantGiven allGivens+    wanteds = mapMaybe relevantWanted allWanteds+    -- 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++  -- traceM $ "Givens: " <> show (showSDocUnsafe . ppr <$> allGivens)+  -- traceM $ "Wanteds: " <> show (showSDocUnsafe . ppr <$> allWanteds)++  -- For each 'Elem e es' we /want/ to solve (the "goal"), we need to eventually correspond it to another unique+  -- /given/ 'Elem e es' that will make the program typecheck (the "solution").+  globals <- liftTc tcGetInstEnvs -- Get the global instances environment for later use+  let solns = mapMaybe (solve globals allGivenTypes extraWanteds givens) wanteds++  -- Now we need to tell GHC the solutions. The way we do this is to generate a new equality constraint, like+  -- 'Elem (State e) es ~ Elem (State Int) es', so that GHC's constraint solver will know that 'e' must be 'Int'.+  eqns <- for solns \(FakedepWanted (FakedepGiven _ goalEff _) loc, FakedepGiven _ solnEff _)  -> do+    (eqn, _) <- liftTc $ runTcSDeriveds $ newWantedEq loc Nominal goalEff solnEff+    pure (CNonCanonical eqn, (OrdType goalEff, OrdType solnEff))++  -- For any solution we've generated, we need to be careful not to generate it again, or we might end up generating+  -- infinitely many solutions. So, we record any already generated solution in a set.+  visitedSolnPairs <- liftIo $ readIORef visitedRef+  let solnEqns = fst <$> flip filter eqns \(_, pair) -> Set.notMember pair visitedSolnPairs+  liftIo $ modifyIORef visitedRef (Set.union $ Set.fromList $ snd <$> eqns)++  -- traceM $ "Emitting: " <> showSDocUnsafe (ppr solnEqns)+  pure solnEqns -- Finally we tell GHC the solutions.++  where++    -- Determine if there is a unique solution to a goal from a set of candidates.+    solve :: InstEnvs -> [PredType] -> [PredType] -> [FakedepGiven] -> FakedepWanted -> Maybe (FakedepWanted, FakedepGiven)+    solve globals allGivenTypes extraWanteds givens goal@(FakedepWanted (FakedepGiven _ _ goalEs) _) =+      let+        -- Apart from 'Elem' constraints in the context, the effects already hardwired into the effect stack type,+        -- like those in 'A : B : C : es', also need to be considered. So here we extract that for them to be considered+        -- simultaneously with regular 'Elem' constraints.+        cands = extractExtraGivens goalEs goalEs <> givens+        -- The first criteria is that the candidate constraint must /unify/ with the goal. This means that the type+        -- variables in the goal can be instantiated in a way so that the goal becomes equal to the candidate.+        -- For example, the candidates 'Elem (State Int) es' and 'Elem (State String) es' both unify with the goal+        -- 'Elem (State s) es'.+        unifiableCands = mapMaybe (unifiableWith goal) cands+      in case unifiableCands of+        -- If there's already only one unique solution, commit to it; in the worst case where it doesn't actually match,+        -- we get a cleaner error message like "Unable to match (State String) to (State Int)" instead of a type+        -- ambiguity error.+        [(soln, _)] -> Just (goal, soln)+        _ ->+          -- Otherwise, the second criteria comes in: the candidate must satisfy all other constraints we /want/ to solve.+          -- For example, when we want to solve '(Elem (State a) es, Num a)`, the candidate 'Elem (State Int) es' will do+          -- the job, because it satisfied 'Num a'; however 'Elem (State String) es' will be excluded.+          let satisfiableCands = filter (satisfiable globals allGivenTypes extraWanteds) unifiableCands+          -- Finally, if there is a unique candidate remaining, we use it as the solution; otherwise we don't solve anything.+          in case satisfiableCands of+            [(soln, _)] -> Just (goal, soln)+            _           -> Nothing++    -- Extract the heads of a type like 'A : B : C : es' into 'FakedepGiven's.+    extractExtraGivens :: Type -> Type -> [FakedepGiven]+    extractExtraGivens fullEs es = case splitAppTys es of+      (_colon, [_kind, e, es']) ->+        let (dtHead, _tyArgs) = splitAppTys e+        in FakedepGiven dtHead e fullEs : extractExtraGivens fullEs es'+      _ -> []++    -- Determine whether a given constraint is of form 'Elem e es'.+    relevantGiven :: Ct -> Maybe FakedepGiven+    relevantGiven (CDictCan _ cls [_kind, eff, es] _) -- Polymorphic case+      | cls == elemCls = Just $ FakedepGiven (fst $ splitAppTys eff) eff es+    relevantGiven (CDictCan _ cls [eff, es] _) -- Monomorphic case+      | cls == elemCls = Just $ FakedepGiven (fst $ splitAppTys eff) eff es+    relevantGiven _ = Nothing++    -- Determine whether a wanted constraint is of form 'Elem e es'.+    relevantWanted :: Ct -> Maybe FakedepWanted+    relevantWanted (CDictCan (CtWanted _ _ _ loc) cls [_kind, eff, es] _) -- Polymorphic case+      | cls == elemCls = Just $ FakedepWanted (FakedepGiven (fst $ splitAppTys eff) eff es) loc+    relevantWanted (CDictCan (CtWanted _ _ _ loc) cls [eff, es] _) -- Monomorphic case+      | cls == elemCls = Just $ FakedepWanted (FakedepGiven (fst $ splitAppTys eff) eff es) loc+    relevantWanted _ = Nothing++    -- Determine whether a constraint is /not/ of form 'Elem e es'.+    irrelevant :: Ct -> Bool+    irrelevant = isNothing . relevantGiven++    -- 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.+    unifiableWith :: FakedepWanted -> FakedepGiven -> Maybe (FakedepGiven, TCvSubst)+    unifiableWith (FakedepWanted goal _) cand =+      -- First, the 'es' type must be equal, and the datatype head of the effect must be equal too.+      if givenEs goal `eqType` givenEs cand && givenEffHead goal `eqType` givenEffHead cand+        then (cand, ) <$> tcUnifyTy (givenEff goal) (givenEff cand) -- Then the effect type must unify.+        else Nothing++    -- Check whether a candidate can satisfy all tthe wanted constraints.+    satisfiable :: InstEnvs -> [PredType] -> [PredType] -> (FakedepGiven, TCvSubst) -> Bool+    satisfiable globals givens wanteds (_, subst) =+      let+        wantedsInst = substTys subst wanteds -- The wanteds after unification.+        givensInst = Set.fromList $ OrdType <$> substTys subst givens -- The local given context after unification.+      in flip all wantedsInst \want ->+        if Set.member (OrdType want) givensInst then True -- Can we find this constraint in our local context?+        else let (con, args) = tcSplitTyConApp want+        in case tyConClass_maybe con of -- If not, lookup the global environment.+          Nothing  -> False+          Just cls -> let (res, _, _) = lookupInstEnv False globals cls args in not $ null res

@@ -0,0 +1,117 @@+-- Tests copied from `polysemy-plugin` (https://github.com/polysemy-research/polysemy/tree/master/polysemy-plugin/test)+-- (c) 2019 Sandy Maguire, licensed under BSD-3-Clause+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# OPTIONS_GHC -Wno-unused-foralls -fplugin=Cleff.Plugin #-}+module CleffSpec where++import           Cleff+import           Cleff.Error+import           Cleff.State+import           Data.String   (IsString)+import           Unsafe.Coerce (unsafeCoerce)++class MPTC a b where+  mptc :: a -> b++instance MPTC Bool Int where+  mptc _ = 1000++uniquelyInt :: '[State Int, State String] :>> r => Eff r ()+uniquelyInt = put 10++uniquelyA :: (Num a, '[State a, State b] :>> r) => Eff r ()+uniquelyA = put 10++uniquelyString :: '[State Int, State String] :>> r => Eff r ()+uniquelyString = put mempty++uniquelyB :: (MPTC Bool b, '[State String, State b] :>> r) => Eff r ()+uniquelyB = put $ mptc False++uniquelyState' :: '[Error (), State ()] :>> r => Eff r ()+uniquelyState' = pure ()++idState :: State s :> r => Eff r ()+idState = do+  s <- get+  put s++intState :: State Int :> r => Eff r ()+intState = put 10++numState :: Num a => State a :> r => Eff r ()+numState = put 10++strState :: State String :> r => Eff r ()+strState = put "Hello"++oStrState :: IsString a => State a :> r => Eff r ()+oStrState = put "hello"++err :: Error e :> r => Eff r Bool+err =+  catchError+    (throwError (error ""))+    (\_ -> pure True)++errState :: Num s => '[Error e, State s] :>> r => Eff r Bool+errState = do+  numState+  err++newtype MyString = MyString String+  deriving newtype (IsString, Eq, Show)++data Janky = forall s. Janky (forall _i. Eff '[State s] ())++jankyState :: Janky+jankyState = Janky $ put True -- The plugin disambiguates effects for concrete rows too++unsafeUnjank :: Janky -> Eff '[State Bool] ()+unsafeUnjank (Janky m) = unsafeCoerce m++data MoreJanky = forall y. MoreJanky (MPTC Bool y => Eff '[State (Bool, y), State (Char, y)] ())++mptcGet :: MPTC x Bool => x+mptcGet = undefined++moreJankyState :: MoreJanky+moreJankyState = MoreJanky $ put (mptcGet, True)++data TaggedState k s m a where+  TaggedGet :: forall k s m. TaggedState k s m s+  TaggedPut :: forall k s m. s -> TaggedState k s m ()++makeEffect ''TaggedState -- The plugin also disambiguates TH functions generated by 'makeEffect'++runTaggedState :: forall k s r a+                . s+               -> Eff (TaggedState k s : r) a+               -> Eff r (a, s)+runTaggedState s =+    (runState s .)+  $ reinterpret+  $ \case+    TaggedGet    -> get+    TaggedPut s' -> put s'++test :: '[+          TaggedState Char Int+        , TaggedState Bool Int+        ] :>> r+     => Eff r ()+test = do+  taggedPut @Bool 10+  taggedPut @Char (-10)++newtype Select a = Select a++data DBAction whichDb m a where+  DoSelect :: Select a -> DBAction whichDb m (Maybe a)++makeEffect ''DBAction++runDBAction :: Eff (DBAction which ': r) a -> Eff r a+runDBAction = interpret $ \case+  DoSelect (Select a) -> pure $ Just a

@@ -0,0 +1,15 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+module Main where++#ifdef CLEFF_PLUGIN_cleff+import qualified CleffSpec+#endif+#ifdef CLEFF_PLUGIN_effectful+import qualified EffectfulSpec+#endif++main :: IO ()+main = putStrLn "It compiles!"