Merge pull request #195 from github/upgrade-to-fused-effects-0.5

Upgrade to fused-effects v0.5.

semantic-core/semantic-core.cabal

@@ -40,7 +40,7 @@ library
                      , containers                  ^>= 0.6
                      , directory                   ^>= 1.3
                      , filepath                    ^>= 1.4
-                     , fused-effects               ^>= 0.4
+                     , fused-effects               ^>= 0.5
                      , haskeline                   ^>= 0.7.5
                      , parsers                     ^>= 0.12.10
                      , prettyprinter               ^>= 1.2.1

semantic-core/src/Analysis/Eval.hs

@@ -11,7 +11,6 @@ module Analysis.Eval
 , Analysis(..)
 ) where
 
-import Control.Effect
 import Control.Effect.Fail
 import Control.Effect.Reader
 import Control.Monad ((>=>))

semantic-core/src/Control/Effect/Readline.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RankNTypes, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RankNTypes, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 
 module Control.Effect.Readline
 ( Readline (..)
@@ -11,7 +11,6 @@ module Control.Effect.Readline
 , ReadlineC (..)
 , runReadline
 , runReadlineWithHistory
-, TransC (..)
 , ControlIOC (..)
 , runControlIO
 ) where
@@ -19,38 +18,33 @@ module Control.Effect.Readline
 import Prelude hiding (print)
 
 import Control.Effect.Carrier
+import Control.Effect.Lift
 import Control.Effect.Reader
-import Control.Effect.Sum
-import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
-import Data.Coerce
 import Data.Int
 import Data.String
 import Data.Text.Prettyprint.Doc
 import Data.Text.Prettyprint.Doc.Render.Text
+import GHC.Generics (Generic1)
 import System.Console.Haskeline hiding (Handler, handle)
 import System.Directory
 import System.FilePath
 
 data Readline (m :: * -> *) k
-  = Prompt String (Maybe String -> k)
+  = Prompt String (Maybe String -> m k)
-  | forall a . Print (Doc a) k
+  | Print AnyDoc (m k)
-  | AskLine (Line -> k)
+  | AskLine (Line -> m k)
+  deriving stock (Functor, Generic1)
+  deriving anyclass (Effect, HFunctor)
 
-deriving instance Functor (Readline m)
+newtype AnyDoc = AnyDoc { unAnyDoc :: forall a . Doc a }
-
-instance HFunctor Readline where
-  hmap _ = coerce
-
-instance Effect Readline where
-  handle state handler = coerce . fmap (handler . (<$ state))
 
 prompt :: (IsString str, Member Readline sig, Carrier sig m) => String -> m (Maybe str)
 prompt p = fmap fromString <$> send (Prompt p pure)
 
 print :: (Pretty a, Carrier sig m, Member Readline sig) => a -> m ()
-print s = send (Print (pretty s) (pure ()))
+print s = send (Print (AnyDoc (pretty s)) (pure ()))
 
 println :: (Pretty a, Carrier sig m, Member Readline sig) => a -> m ()
 println s = print s >> print @String "\n"
@@ -63,19 +57,19 @@ newtype Line = Line Int64
 increment :: Line -> Line
 increment (Line n) = Line (n + 1)
 
-newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (TransC InputT m) a }
+newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (LiftC (InputT m)) a }
-  deriving (Applicative, Functor, Monad, MonadIO)
+  deriving newtype (Applicative, Functor, Monad, MonadIO)
 
 runReadline :: MonadException m => Prefs -> Settings m -> ReadlineC m a -> m a
-runReadline prefs settings = runInputTWithPrefs prefs settings . runTransC . runReader (Line 0) . runReadlineC
+runReadline prefs settings = runInputTWithPrefs prefs settings . runM . runReader (Line 0) . runReadlineC
 
-instance (Carrier sig m, Effect sig, MonadException m, MonadIO m) => Carrier (Readline :+: sig) (ReadlineC m) where
+instance (MonadException m, MonadIO m) => Carrier (Readline :+: Lift (InputT m)) (ReadlineC m) where
   eff (L (Prompt prompt k)) = ReadlineC $ do
-    str <- lift (TransC (getInputLine (cyan <> prompt <> plain)))
+    str <- lift (lift (getInputLine (cyan <> prompt <> plain)))
     local increment (runReadlineC (k str))
     where cyan = "\ESC[1;36m\STX"
           plain = "\ESC[0m\STX"
-  eff (L (Print text k)) = liftIO (putDoc text) *> k
+  eff (L (Print text k)) = liftIO (putDoc (unAnyDoc text)) *> k
   eff (L (AskLine k)) = ReadlineC ask >>= k
   eff (R other) = ReadlineC (eff (R (handleCoercible other)))
 
@@ -93,19 +87,12 @@ runReadlineWithHistory block = do
 
   runReadline prefs settings block
 
--- | Promote a monad transformer into an effect.
-newtype TransC t (m :: * -> *) a = TransC { runTransC :: t m a }
-  deriving (Applicative, Functor, Monad, MonadIO, MonadTrans)
-
-instance (Carrier sig m, Effect sig, Monad (t m), MonadTrans t) => Carrier sig (TransC t m) where
-  eff = TransC . join . lift . eff . handle (pure ()) (pure . (runTransC =<<))
-
 runControlIO :: (forall x . m x -> IO x) -> ControlIOC m a -> m a
 runControlIO handler = runReader (Handler handler) . runControlIOC
 
 -- | This exists to work around the 'MonadException' constraint that haskeline entails.
 newtype ControlIOC m a = ControlIOC { runControlIOC :: ReaderC (Handler m) m a }
-  deriving (Applicative, Functor, Monad, MonadIO)
+  deriving newtype (Applicative, Functor, Monad, MonadIO)
 
 newtype Handler m = Handler (forall x . m x -> IO x)
 

semantic-core/src/Data/Core/Pretty.hs

@@ -8,7 +8,6 @@ module Data.Core.Pretty
   , prettyCore
   ) where
 
-import           Control.Effect
 import           Control.Effect.Reader
 import           Data.Core
 import           Data.File

semantic-core/src/Data/Loc.hs

@@ -15,7 +15,6 @@ import Control.Effect.Carrier
 import Control.Effect.Error
 import Control.Effect.Fail
 import Control.Effect.Reader
-import Control.Effect.Sum
 import Data.Text (Text, pack)
 import Data.Text.Prettyprint.Doc (Pretty (..))
 import GHC.Stack

semantic-core/src/Data/Name.hs

@@ -16,11 +16,9 @@ module Data.Name
 ) where
 
 import           Control.Applicative
-import           Control.Effect
 import           Control.Effect.Carrier
 import           Control.Effect.Reader
 import           Control.Effect.State
-import           Control.Effect.Sum
 import           Control.Monad.Fail
 import           Control.Monad.IO.Class
 import qualified Data.Char as Char
@@ -99,14 +97,14 @@ namespace s m = send (Namespace s m pure)
 
 
 data Naming m k
-  = Gensym Text (Gensym -> k)
+  = Gensym Text (Gensym -> m k)
-  | forall a . Namespace Text (m a) (a -> k)
+  | forall a . Namespace Text (m a) (a -> m k)
 
-deriving instance Functor (Naming m)
+deriving instance Functor m => Functor (Naming m)
 
 instance HFunctor Naming where
-  hmap _ (Gensym    s   k) = Gensym    s       k
+  hmap f (Gensym    s   k) = Gensym    s       (f . k)
-  hmap f (Namespace s m k) = Namespace s (f m) k
+  hmap f (Namespace s m k) = Namespace s (f m) (f . k)
 
 instance Effect Naming where
   handle state handler (Gensym    s   k) = Gensym    s                        (handler . (<$ state) . k)

semantic.cabal

@@ -55,8 +55,8 @@ common dependencies
                      , fastsum ^>= 0.1.1.0
                      , filepath ^>= 1.4.2.1
                      , free ^>= 5.1
-                     , fused-effects ^>= 0.4.0.0
+                     , fused-effects ^>= 0.5.0.0
-                     , fused-effects-exceptions ^>= 0.1.1.0
+                     , fused-effects-exceptions ^>= 0.2.0.0
                      , hashable ^>= 1.2.7.0
                      , tree-sitter ^>= 0.1.0.0
                      , mtl ^>= 2.2.2

src/Analysis/Abstract/Graph.hs

@@ -19,7 +19,6 @@ module Analysis.Abstract.Graph
 import           Algebra.Graph.Export.Dot hiding (vertexName)
 import           Control.Abstract hiding (Function(..))
 import           Control.Effect.Carrier
-import           Control.Effect.Sum
 import           Data.Abstract.BaseError
 import           Data.Abstract.Declarations
 import           Data.Abstract.Module (Module (moduleInfo), ModuleInfo (..))
@@ -150,20 +149,20 @@ graphingModuleInfo recur m = do
     _             -> pure ()
 
 eavesdrop :: Evaluator term address value (EavesdropC address value m) a
-          -> (forall x . Modules address value m (m x) -> Evaluator term address value m ())
+          -> (forall x . Modules address value m x -> Evaluator term address value m ())
           -> Evaluator term address value m a
 eavesdrop m f = raiseHandler (runEavesdropC (runEvaluator . f)) m
 
-newtype EavesdropC address value m a = EavesdropC ((forall x . Modules address value m (m x) -> m ()) -> m a)
+newtype EavesdropC address value m a = EavesdropC ((forall x . Modules address value m x -> m ()) -> m a)
-  deriving (Alternative, Applicative, Functor, Monad) via (ReaderC (forall x . Modules address value m (m x) -> m ()) m)
+  deriving (Alternative, Applicative, Functor, Monad) via (ReaderC (forall x . Modules address value m x -> m ()) m)
 
-runEavesdropC :: (forall x . Modules address value m (m x) -> m ()) -> EavesdropC address value m a -> m a
+runEavesdropC :: (forall x . Modules address value m x -> m ()) -> EavesdropC address value m a -> m a
 runEavesdropC f (EavesdropC m) = m f
 
 instance (Carrier sig m, Member (Modules address value) sig, Applicative m) => Carrier sig (EavesdropC address value m) where
   eff op
-    | Just eff <- prj op = EavesdropC (\ handler -> let eff' = handlePure (runEavesdropC handler) eff in handler eff' *> send eff')
+    | Just eff <- prj op = EavesdropC (\ handler -> let eff' = hmap (runEavesdropC handler) eff in handler eff' *> send eff')
-    | otherwise          = EavesdropC (\ handler -> eff (handlePure (runEavesdropC handler) op))
+    | otherwise          = EavesdropC (\ handler -> eff (hmap (runEavesdropC handler) op))
 
 -- | Add an edge from the current package to the passed vertex.
 packageInclusion :: ( Member (Reader PackageInfo) sig

src/Control/Abstract/Context.hs

@@ -12,7 +12,6 @@ module Control.Abstract.Context
 , withCurrentCallStack
 ) where
 
-import Control.Effect
 import Control.Effect.Reader
 import Control.Effect.State
 import Data.Abstract.Module

src/Control/Abstract/Evaluator.hs

@@ -17,7 +17,6 @@ module Control.Abstract.Evaluator
   , module X
   ) where
 
-import Control.Effect as X
 import Control.Effect.Carrier
 import Control.Effect.Error as X
 import Control.Effect.Fresh as X

src/Control/Abstract/Heap.hs

@@ -418,9 +418,9 @@ reachable roots heap = go mempty roots
 -- Effects
 
 data Deref value (m :: * -> *) k
-  = DerefCell        (Set value) (Maybe value -> k)
+  = DerefCell        (Set value) (Maybe value -> m k)
-  | AssignCell value (Set value) (Set value   -> k)
+  | AssignCell value (Set value) (Set value   -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 runDeref :: Evaluator term address value (DerefC address value m) a

src/Control/Abstract/Modules.hs

@@ -21,7 +21,6 @@ module Control.Abstract.Modules
 
 import Control.Abstract.Evaluator
 import Control.Effect.Carrier
-import Control.Effect.Sum
 import Data.Abstract.BaseError
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
@@ -60,17 +59,17 @@ load path = sendModules (Load path pure)
 
 
 data Modules address value (m :: * -> *) k
-  = Load    ModulePath (ModuleResult address value -> k)
+  = Load    ModulePath (ModuleResult address value -> m k)
-  | Lookup  ModulePath (Maybe (ModuleResult address value) -> k)
+  | Lookup  ModulePath (Maybe (ModuleResult address value) -> m k)
-  | Resolve [FilePath] (Maybe ModulePath -> k)
+  | Resolve [FilePath] (Maybe ModulePath -> m k)
-  | List    FilePath   ([ModulePath] -> k)
+  | List    FilePath   ([ModulePath] -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 
 sendModules :: ( Member (Modules address value) sig
                , Carrier sig m)
-            => Modules address value (Evaluator term address value m) (Evaluator term address value m return)
+            => Modules address value (Evaluator term address value m) return
             -> Evaluator term address value m return
 sendModules = send
 

src/Control/Abstract/PythonPackage.hs

@@ -4,7 +4,6 @@ module Control.Abstract.PythonPackage
 
 import           Control.Abstract as Abstract
 import           Control.Effect.Carrier
-import           Control.Effect.Sum
 import           Data.Abstract.Name (name)
 import           Data.Abstract.Path (stripQuotes)
 import           Data.Abstract.Value.Concrete (Value (..))

src/Control/Abstract/ScopeGraph.hs

@@ -379,8 +379,8 @@ alloc :: (Member (Allocator address) sig, Carrier sig m) => Name -> Evaluator te
 alloc = send . flip Alloc pure
 
 data Allocator address (m :: * -> *) k
-  = Alloc Name (address -> k)
+  = Alloc Name (address -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 runAllocator :: Evaluator term address value (AllocatorC address m) a

src/Control/Abstract/Value.hs

@@ -48,7 +48,11 @@ module Control.Abstract.Value
 , ObjectC(..)
 , runObject
 , runNumeric
+, runNumericFunction
+, runNumeric2Function
 , castToInteger
+, runBitwiseFunction
+, runBitwise2Function
 , liftBitwise
 , liftBitwise2
 , unsignedRShift
@@ -118,18 +122,18 @@ builtIn address = sendFunction . flip (BuiltIn address) pure
 call :: (Member (Function term address value) sig, Carrier sig m) => value -> [value] -> Evaluator term address value m value
 call fn args = sendFunction (Call fn args pure)
 
-sendFunction :: (Member (Function term address value) sig, Carrier sig m) => Function term address value (Evaluator term address value m) (Evaluator term address value m a) -> Evaluator term address value m a
+sendFunction :: (Member (Function term address value) sig, Carrier sig m) => Function term address value (Evaluator term address value m) a -> Evaluator term address value m a
 sendFunction = send
 
 bindThis :: (Member (Function term address value) sig, Carrier sig m) => value -> value -> Evaluator term address value m value
 bindThis this that = sendFunction (Bind this that pure)
 
 data Function term address value (m :: * -> *) k
-  = Function Name [Name] term address (value -> k) -- ^ A function is parameterized by its name, parameter names, body, parent scope, and returns a ValueRef.
+  = Function Name [Name] term address (value -> m k) -- ^ A function is parameterized by its name, parameter names, body, parent scope, and returns a ValueRef.
-  | BuiltIn address BuiltIn (value -> k)           -- ^ A built-in is parameterized by its parent scope, BuiltIn type, and returns a value.
+  | BuiltIn address BuiltIn (value -> m k)           -- ^ A built-in is parameterized by its parent scope, BuiltIn type, and returns a value.
-  | Call value [value] (value -> k)                -- ^ A Call takes a set of values as parameters and returns a ValueRef.
+  | Call value [value] (value -> m k)                -- ^ A Call takes a set of values as parameters and returns a ValueRef.
-  | Bind value value (value -> k)
+  | Bind value value (value -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 
@@ -154,9 +158,9 @@ ifthenelse :: (Member (Boolean value) sig, Carrier sig m) => value -> m a -> m a
 ifthenelse v t e = asBool v >>= \ c -> if c then t else e
 
 data Boolean value (m :: * -> *) k
-  = Boolean Bool (value -> k)
+  = Boolean Bool (value -> m k)
-  | AsBool value (Bool -> k)
+  | AsBool value (Bool -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 runBoolean :: Evaluator term address value (BooleanC value m) a
@@ -204,11 +208,11 @@ forLoop :: ( Carrier sig m
 forLoop initial cond step body = initial *> while cond (withLexicalScopeAndFrame body *> step)
 
 data While value m k
-  = While (m value) (m value) (value -> k)
+  = While (m value) (m value) (value -> m k)
-  deriving (Functor)
+  deriving stock (Functor, Generic1)
 
 instance HFunctor (While value) where
-  hmap f (While cond body k) = While (f cond) (f body) k
+  hmap f (While cond body k) = While (f cond) (f body) (f . k)
 
 runWhile :: Evaluator term address value (WhileC value m) a
          -> Evaluator term address value m a
@@ -223,15 +227,9 @@ unit :: (Carrier sig m, Member (Unit value) sig) => Evaluator term address value
 unit = send (Unit pure)
 
 newtype Unit value (m :: * -> *) k
-  = Unit (value -> k)
+  = Unit (value -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
-
+  deriving anyclass (HFunctor, Effect)
-instance HFunctor (Unit value) where
-  hmap _ = coerce
-  {-# INLINE hmap #-}
-
-instance Effect (Unit value) where
-  handle state handler (Unit k) = Unit (handler . (<$ state) . k)
 
 runUnit :: Evaluator term address value (UnitC value m) a
         -> Evaluator term address value m a
@@ -250,9 +248,9 @@ asString :: (Member (String value) sig, Carrier sig m) => value -> m Text
 asString v = send (AsString v pure)
 
 data String value (m :: * -> *) k
-  = String Text (value -> k)
+  = String Text (value -> m k)
-  | AsString value (Text -> k)
+  | AsString value (Text -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 newtype StringC value m a = StringC { runStringC :: m a }
@@ -281,7 +279,7 @@ liftNumeric  :: (Member (Numeric value) sig, Carrier sig m)
              => (forall a . Num a => a -> a)
              -> value
              -> m value
-liftNumeric t v = send (LiftNumeric t v pure)
+liftNumeric t v = send (LiftNumeric (NumericFunction t) v pure)
 
 -- | Lift a pair of binary operators to a function on 'value's.
 --   You usually pass the same operator as both arguments, except in the cases where
@@ -292,15 +290,25 @@ liftNumeric2 :: (Member (Numeric value) sig, Carrier sig m)
              -> value
              -> value
              -> m value
-liftNumeric2 t v1 v2 = send (LiftNumeric2 t v1 v2 pure)
+liftNumeric2 t v1 v2 = send (LiftNumeric2 (Numeric2Function t) v1 v2 pure)
+
+data NumericFunction = NumericFunction (forall a . Num a => a -> a)
+
+runNumericFunction :: Num a => NumericFunction -> a -> a
+runNumericFunction (NumericFunction f) a = f a
+
+data Numeric2Function = Numeric2Function (forall a b. Number a -> Number b -> SomeNumber)
+
+runNumeric2Function :: Numeric2Function -> Number a -> Number b -> SomeNumber
+runNumeric2Function (Numeric2Function f) a b = f a b
 
 data Numeric value (m :: * -> *) k
-  = Integer Integer (value -> k)
+  = Integer Integer (value -> m k)
-  | Float Scientific (value -> k)
+  | Float Scientific (value -> m k)
-  | Rational Rational (value -> k)
+  | Rational Rational (value -> m k)
-  | LiftNumeric (forall a . Num a => a -> a) value (value -> k)
+  | LiftNumeric NumericFunction value (value -> m k)
-  | LiftNumeric2 (forall a b. Number a -> Number b -> SomeNumber) value value (value -> k)
+  | LiftNumeric2 Numeric2Function value value (value -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 newtype NumericC value m a = NumericC { runNumericC :: m a }
@@ -321,7 +329,7 @@ liftBitwise :: (Member (Bitwise value) sig, Carrier sig m)
             => (forall a . Bits a => a -> a)
             -> value
             -> m value
-liftBitwise t v = send (LiftBitwise t v pure)
+liftBitwise t v = send (LiftBitwise (BitwiseFunction t) v pure)
 
 -- | Lift a binary bitwise operator to values. The Integral constraint is
 --   necessary to satisfy implementation details of Haskell left/right shift,
@@ -331,7 +339,7 @@ liftBitwise2 :: (Member (Bitwise value) sig, Carrier sig m)
              -> value
              -> value
              -> m value
-liftBitwise2 t v1 v2 = send (LiftBitwise2 t v1 v2 pure)
+liftBitwise2 t v1 v2 = send (LiftBitwise2 (Bitwise2Function t) v1 v2 pure)
 
 unsignedRShift :: (Member (Bitwise value) sig, Carrier sig m)
                => value
@@ -339,12 +347,22 @@ unsignedRShift :: (Member (Bitwise value) sig, Carrier sig m)
                -> m value
 unsignedRShift v1 v2 = send (UnsignedRShift v1 v2 pure)
 
+data BitwiseFunction = BitwiseFunction (forall a . Bits a => a -> a)
+
+runBitwiseFunction :: Bits a => BitwiseFunction -> a -> a
+runBitwiseFunction (BitwiseFunction f) a = f a
+
+data Bitwise2Function = Bitwise2Function (forall a . (Integral a, Bits a) => a -> a -> a)
+
+runBitwise2Function :: (Integral a, Bits a) => Bitwise2Function -> a -> a -> a
+runBitwise2Function (Bitwise2Function f) a b = f a b
+
 data Bitwise value (m :: * -> *) k
-  = CastToInteger value (value -> k)
+  = CastToInteger value (value -> m k)
-  | LiftBitwise (forall a . Bits a => a -> a) value (value -> k)
+  | LiftBitwise BitwiseFunction value (value -> m k)
-  | LiftBitwise2 (forall a . (Integral a, Bits a) => a -> a -> a) value value (value -> k)
+  | LiftBitwise2 Bitwise2Function value value (value -> m k)
-  | UnsignedRShift value value (value -> k)
+  | UnsignedRShift value value (value -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 runBitwise :: Evaluator term address value (BitwiseC value m) a
@@ -368,11 +386,11 @@ scopedEnvironment value = send (ScopedEnvironment value pure)
 klass :: (Member (Object address value) sig, Carrier sig m) => Declaration -> address -> m value
 klass d a = send (Klass d a pure)
 
-data Object address value (m :: * -> *) k
+data Object address value m k
-  = Object address (value -> k)
+  = Object address (value -> m k)
-  | ScopedEnvironment value (Maybe address -> k)
+  | ScopedEnvironment value (Maybe address -> m k)
-  | Klass Declaration address (value -> k)
+  | Klass Declaration address (value -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 newtype ObjectC address value m a = ObjectC { runObjectC :: m a }
@@ -391,9 +409,9 @@ asArray :: (Member (Array value) sig, Carrier sig m) => value -> m [value]
 asArray v = send (AsArray v pure)
 
 data Array value (m :: * -> *) k
-  = Array [value] (value -> k)
+  = Array [value] (value -> m k)
-  | AsArray value ([value] -> k)
+  | AsArray value ([value] -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 newtype ArrayC value m a = ArrayC { runArrayC :: m a }
@@ -413,9 +431,9 @@ kvPair :: (Member (Hash value) sig, Carrier sig m) => value -> value -> m value
 kvPair v1 v2 = send (KvPair v1 v2 pure)
 
 data Hash value (m :: * -> *) k
-  = Hash [(value, value)] (value -> k)
+  = Hash [(value, value)] (value -> m k)
-  | KvPair value value (value -> k)
+  | KvPair value value (value -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 newtype HashC value m a = HashC { runHashC :: m a }

src/Control/Effect/Interpose.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
 module Control.Effect.Interpose
 ( Interpose(..)
 , interpose
@@ -10,15 +10,14 @@ module Control.Effect.Interpose
 import Control.Applicative
 import Control.Effect.Carrier
 import Control.Effect.Reader
-import Control.Effect.Sum
 
-data Interpose eff m k
+data Interpose (eff :: (* -> *) -> * -> *) m k
-  = forall a . Interpose (m a) (forall n x . eff n (n x) -> m x) (a -> k)
+  = forall a . Interpose (m a) (forall n x . eff n x -> m x) (a -> m k)
 
-deriving instance Functor (Interpose eff m)
+deriving instance Functor m => Functor (Interpose eff m)
 
 instance HFunctor (Interpose eff) where
-  hmap f (Interpose m h k) = Interpose (f m) (f . h) k
+  hmap f (Interpose m h k) = Interpose (f m) (f . h) (f . k)
 
 -- | Respond to requests for some specific effect with a handler.
 --
@@ -27,7 +26,7 @@ instance HFunctor (Interpose eff) where
 --   Note that since 'Interpose' lacks an 'Effect' instance, only “pure” effects, i.e. effects which can be handled inside other effects using 'hmap' alone, can be run within the 'runInterpose' scope. This includes @Reader@, but not e.g. @State@ or @Error@.
 interpose :: (Member (Interpose eff) sig, Carrier sig m)
           => m a
-          -> (forall n x . eff n (n x) -> m x)
+          -> (forall n x . eff n x -> m x)
           -> m a
 interpose m f = send (Interpose m f pure)
 
@@ -36,14 +35,15 @@ interpose m f = send (Interpose m f pure)
 runInterpose :: InterposeC eff m a -> m a
 runInterpose = runReader Nothing . runInterposeC
 
-newtype InterposeC eff m a = InterposeC { runInterposeC :: ReaderC (Maybe (Listener eff (InterposeC eff m))) m a }
+newtype InterposeC (eff :: (* -> *) -> * -> *) m a = InterposeC
-  deriving (Alternative, Applicative, Functor, Monad)
+  { runInterposeC :: ReaderC (Maybe (Listener eff (InterposeC eff m))) m a
+  } deriving (Alternative, Applicative, Functor, Monad)
 
-newtype Listener eff m = Listener (forall n x . eff n (n x) -> m x)
+newtype Listener (eff :: (* -> *) -> * -> *) m = Listener (forall n x . eff n x -> m x)
 
--- TODO: Document the implementation of this, as it is extremely subtle.
+-- Normally we can't just extract the existentials out of the Listener type. In this case,
-
+-- we can constrain the foralled 'n' variable to be 'Interpose', which lets it by the typechecker.
-runListener :: Listener eff (InterposeC eff m) -> eff (InterposeC eff m) (InterposeC eff m a) -> InterposeC eff m a
+runListener :: Listener eff (InterposeC eff m) -> eff (InterposeC eff m) a -> InterposeC eff m a
 runListener (Listener listen) = listen
 
 instance (Carrier sig m, Member eff sig) => Carrier (Interpose eff :+: sig) (InterposeC eff m) where

src/Control/Effect/REPL.hs

@@ -10,17 +10,15 @@ module Control.Effect.REPL
 
 import Prologue
 
-import Control.Effect
 import Control.Effect.Carrier
-import Control.Effect.Sum
 import Control.Effect.Reader
 import System.Console.Haskeline
 import qualified Data.Text as T
 
 data REPL (m :: * -> *) k
-  = Prompt Text (Maybe Text -> k)
+  = Prompt Text (Maybe Text -> m k)
-  | Output Text k
+  | Output Text (m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 prompt :: (Member REPL sig, Carrier sig m) => Text -> m (Maybe Text)

src/Data/Abstract/Address/Hole.hs

@@ -6,7 +6,6 @@ module Data.Abstract.Address.Hole
 
 import Control.Abstract
 import Control.Effect.Carrier
-import Control.Effect.Sum
 import Prologue
 
 data Hole context a = Partial context | Total a

src/Data/Abstract/Address/Monovariant.hs

@@ -5,7 +5,6 @@ module Data.Abstract.Address.Monovariant
 
 import Control.Abstract
 import Control.Effect.Carrier
-import Control.Effect.Sum
 import Data.Abstract.Name
 import qualified Data.Set as Set
 import Prologue

src/Data/Abstract/Address/Precise.hs

@@ -6,7 +6,6 @@ module Data.Abstract.Address.Precise
 import Control.Abstract
 import Control.Abstract.ScopeGraph (AllocatorC(..))
 import Control.Effect.Carrier
-import Control.Effect.Sum
 import qualified Data.Set as Set
 import Prologue
 

src/Data/Abstract/Name.hs

@@ -9,7 +9,6 @@ module Data.Abstract.Name
 , __self
 ) where
 
-import           Control.Effect
 import           Control.Effect.Fresh
 import           Data.Aeson
 import qualified Data.Char as Char

src/Data/Abstract/Value/Abstract.hs

@@ -8,7 +8,6 @@ module Data.Abstract.Value.Abstract
 
 import Control.Abstract as Abstract
 import Control.Effect.Carrier
-import Control.Effect.Sum
 import Data.Abstract.BaseError
 import Data.Abstract.Evaluatable
 import qualified Data.Map.Strict as Map

src/Data/Abstract/Value/Concrete.hs

@@ -12,7 +12,6 @@ import qualified Control.Abstract as Abstract
 import Control.Abstract hiding (Boolean(..), Function(..), Numeric(..), Object(..), Array(..), Hash(..), String(..), Unit(..), While(..))
 import Control.Effect.Carrier
 import Control.Effect.Interpose
-import Control.Effect.Sum
 import Data.Abstract.BaseError
 import Data.Abstract.Evaluatable (UnspecializedError(..), EvalError(..), Declarations)
 import Data.Abstract.FreeVariables
@@ -226,20 +225,20 @@ instance ( Member (Reader ModuleInfo) sig
     Abstract.Float    t k -> k (Float (Number.Decimal t))
     Abstract.Rational t k -> k (Rational (Number.Ratio t))
     Abstract.LiftNumeric f arg k -> k =<< case arg of
-      Integer (Number.Integer i) -> pure $ Integer (Number.Integer (f i))
+      Integer (Number.Integer i) -> pure $ Integer (Number.Integer (runNumericFunction f i))
-      Float (Number.Decimal d)   -> pure $ Float (Number.Decimal (f d))
+      Float (Number.Decimal d)   -> pure $ Float (Number.Decimal (runNumericFunction f d))
-      Rational (Number.Ratio r)  -> pure $ Rational (Number.Ratio (f r))
+      Rational (Number.Ratio r)  -> pure $ Rational (Number.Ratio (runNumericFunction f r))
       other                      -> throwBaseError (NumericError other)
     Abstract.LiftNumeric2 f left right k -> k =<< case (left, right) of
-      (Integer  i, Integer j)  -> attemptUnsafeArithmetic (f i j) & specialize
+      (Integer  i, Integer j)  -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
-      (Integer  i, Rational j) -> attemptUnsafeArithmetic (f i j) & specialize
+      (Integer  i, Rational j) -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
-      (Integer  i, Float j)    -> attemptUnsafeArithmetic (f i j) & specialize
+      (Integer  i, Float j)    -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
-      (Rational i, Integer j)  -> attemptUnsafeArithmetic (f i j) & specialize
+      (Rational i, Integer j)  -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
-      (Rational i, Rational j) -> attemptUnsafeArithmetic (f i j) & specialize
+      (Rational i, Rational j) -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
-      (Rational i, Float j)    -> attemptUnsafeArithmetic (f i j) & specialize
+      (Rational i, Float j)    -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
-      (Float    i, Integer j)  -> attemptUnsafeArithmetic (f i j) & specialize
+      (Float    i, Integer j)  -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
-      (Float    i, Rational j) -> attemptUnsafeArithmetic (f i j) & specialize
+      (Float    i, Rational j) -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
-      (Float    i, Float j)    -> attemptUnsafeArithmetic (f i j) & specialize
+      (Float    i, Float j)    -> attemptUnsafeArithmetic (runNumeric2Function f i j) & specialize
       _                        -> throwBaseError (Numeric2Error left right)
 
 -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor
@@ -268,9 +267,9 @@ instance ( Member (Reader ModuleInfo) sig
     CastToInteger (Integer (Number.Integer i)) k -> k (Integer (Number.Integer i))
     CastToInteger (Float (Number.Decimal i)) k -> k (Integer (Number.Integer (coefficient (normalize i))))
     CastToInteger i k -> throwBaseError (NumericError i) >>= k
-    LiftBitwise operator (Integer (Number.Integer i)) k -> k . Integer . Number.Integer . operator $ i
+    LiftBitwise operator (Integer (Number.Integer i)) k -> k . Integer . Number.Integer . runBitwiseFunction operator $ i
     LiftBitwise _ other k -> throwBaseError (BitwiseError other) >>= k
-    LiftBitwise2 operator (Integer (Number.Integer i)) (Integer (Number.Integer j)) k -> k . Integer . Number.Integer $ operator i j
+    LiftBitwise2 operator (Integer (Number.Integer i)) (Integer (Number.Integer j)) k -> k . Integer . Number.Integer $ runBitwise2Function operator i j
     LiftBitwise2 _ left right k -> throwBaseError (Bitwise2Error left right) >>= k
     UnsignedRShift (Integer (Number.Integer i)) (Integer (Number.Integer j)) k | i >= 0 -> k . Integer . Number.Integer $ ourShift (fromIntegral i) (fromIntegral j)
     UnsignedRShift left right k -> throwBaseError (Bitwise2Error left right) >>= k

src/Data/Abstract/Value/Type.hs

@@ -15,7 +15,6 @@ import Control.Abstract.ScopeGraph
 import qualified Control.Abstract as Abstract
 import Control.Abstract hiding (Boolean(..), Function(..), Numeric(..), Object(..), Array(..), Hash(..), String(..), Unit(..), While(..))
 import Control.Effect.Carrier
-import Control.Effect.Sum
 import Data.Abstract.BaseError
 import Data.Semigroup.Foldable (foldMap1)
 import qualified Data.Map as Map

src/Data/Blob.hs

@@ -26,7 +26,6 @@ module Data.Blob
 
 import Prologue
 
-import           Control.Effect
 import           Control.Effect.Error
 import           Data.Aeson
 import qualified Data.ByteString.Lazy as BL

src/Data/Graph.hs

@@ -20,7 +20,6 @@ import qualified Algebra.Graph.AdjacencyMap as A
 import           Algebra.Graph.Class (connect, overlay, vertex)
 import qualified Algebra.Graph.Class as Class
 import qualified Algebra.Graph.ToGraph as Class
-import           Control.Effect
 import           Control.Effect.State
 import           Data.Aeson
 import qualified Data.Set as Set

src/Data/Project.hs

@@ -13,7 +13,6 @@ module Data.Project
 import Prelude hiding (readFile)
 import Prologue
 
-import           Control.Effect
 import           Control.Effect.Error
 import           Data.Blob
 import           Data.Blob.IO

src/Diffing/Algorithm.hs

@@ -14,8 +14,8 @@ module Diffing.Algorithm
   , algorithmForTerms
   ) where
 
-import Control.Effect hiding ((:+:))
+import Control.Effect.Carrier hiding ((:+:))
-import Control.Effect.Carrier
+import Control.Effect.NonDet
 import qualified Data.Diff as Diff
 import Data.Sum
 import Data.Term
@@ -25,20 +25,21 @@ import Prologue
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
 data Diff term1 term2 diff (m :: * -> *) k
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  = Diff term1 term2 (diff -> k)
+  = Diff term1 term2 (diff -> m k)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  | Linear term1 term2 (diff -> k)
+  | Linear term1 term2 (diff -> m k)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  | RWS [term1] [term2] ([diff] -> k)
+  | RWS [term1] [term2] ([diff] -> m k)
   -- | Delete a term.
-  | Delete term1 (diff -> k)
+  | Delete term1 (diff -> m k)
   -- | Insert a term.
-  | Insert term2 (diff -> k)
+  | Insert term2 (diff -> m k)
   -- | Replace one term with another.
-  | Replace term1 term2 (diff -> k)
+  | Replace term1 term2 (diff -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
+
 newtype Algorithm term1 term2 diff m a = Algorithm { runAlgorithm :: m a }
   deriving newtype (Applicative, Alternative, Functor, Monad)
 
@@ -83,7 +84,7 @@ byInserting a2 = sendDiff (Insert a2 pure)
 byReplacing :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> term2 -> Algorithm term1 term2 diff m diff
 byReplacing a1 a2 = send (Replace a1 a2 pure)
 
-sendDiff :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => Diff term1 term2 diff m (m a) -> Algorithm term1 term2 diff m a
+sendDiff :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => Diff term1 term2 diff m a -> Algorithm term1 term2 diff m a
 sendDiff = Algorithm . send
 
 

src/Diffing/Interpreter.hs

@@ -5,11 +5,9 @@ module Diffing.Interpreter
 , stripDiff
 ) where
 
-import Control.Effect
 import Control.Effect.Carrier
 import Control.Effect.Cull
 import Control.Effect.NonDet
-import Control.Effect.Sum
 import qualified Data.Diff as Diff
 import Data.Term
 import Diffing.Algorithm

src/Language/JSON/PrettyPrint.hs

@@ -8,7 +8,6 @@ module Language.JSON.PrettyPrint
 
 import Prologue
 
-import           Control.Effect
 import           Control.Effect.Error
 import           Streaming
 import qualified Streaming.Prelude as Streaming

src/Language/Python/PrettyPrint.hs

@@ -2,7 +2,6 @@
 
 module Language.Python.PrettyPrint ( printingPython ) where
 
-import Control.Effect
 import Control.Effect.Error
 import Streaming
 import qualified Streaming.Prelude as Streaming

src/Language/Ruby/PrettyPrint.hs

@@ -2,9 +2,7 @@
 
 module Language.Ruby.PrettyPrint ( printingRuby ) where
 
-import Control.Effect
 import Control.Effect.Error
-import Control.Monad.Trans (lift)
 import Streaming
 import qualified Streaming.Prelude as Streaming
 

src/Parsing/TreeSitter.hs

@@ -7,7 +7,6 @@ module Parsing.TreeSitter
 import Prologue hiding (bracket)
 
 import qualified Control.Exception as Exc (bracket)
-import           Control.Effect
 import           Control.Effect.Resource
 import           Control.Effect.Trace
 import           Data.ByteString.Unsafe (unsafeUseAsCStringLen)

src/Rendering/Graph.hs

@@ -8,8 +8,8 @@ module Rendering.Graph
 
 import Algebra.Graph.Export.Dot
 import Analysis.ConstructorName
-import Control.Effect
 import Control.Effect.Fresh
+import Control.Effect.Pure
 import Control.Effect.Reader
 import Control.Effect.State
 import Data.Diff

src/Reprinting/Translate.hs

@@ -5,8 +5,8 @@ module Reprinting.Translate
   , TranslatorC
   ) where
 
-import           Control.Effect
 import           Control.Effect.Error
+import           Control.Effect.Pure
 import           Control.Effect.State
 import           Control.Monad
 import           Streaming

src/Semantic/AST.hs

@@ -12,7 +12,6 @@ import Prologue
 import Data.ByteString.Builder
 import Data.List (intersperse)
 
-import           Control.Effect
 import           Control.Effect.Error
 import           Data.AST
 import           Data.Blob

src/Semantic/Analysis.hs

@@ -11,6 +11,7 @@ import qualified Data.Map.Strict as Map
 
 import Control.Abstract as Abstract
 import Control.Abstract.ScopeGraph (runAllocator)
+import Control.Effect.Carrier
 import Control.Effect.Interpose
 import Data.Abstract.Evaluatable
 import Data.Abstract.Module

src/Semantic/Api/Diffs.hs

@@ -13,7 +13,6 @@ module Semantic.Api.Diffs
 
 import           Analysis.ConstructorName (ConstructorName)
 import           Analysis.TOCSummary (HasDeclaration)
-import           Control.Effect
 import           Control.Effect.Error
 import           Control.Exception
 import           Control.Lens

src/Semantic/Api/Symbols.hs

@@ -7,7 +7,6 @@ module Semantic.Api.Symbols
 
 import Prelude hiding (span)
 
-import           Control.Effect
 import           Control.Effect.Error
 import           Control.Exception
 import           Control.Lens

src/Semantic/Api/Terms.hs

@@ -15,7 +15,6 @@ module Semantic.Api.Terms
 
 
 import           Analysis.ConstructorName (ConstructorName)
-import           Control.Effect
 import           Control.Effect.Error
 import           Control.Lens
 import           Control.Monad

src/Semantic/Distribute.hs

@@ -10,10 +10,8 @@ module Semantic.Distribute
 ) where
 
 import qualified Control.Concurrent.Async as Async
-import           Control.Effect
 import           Control.Effect.Carrier
 import           Control.Effect.Reader
-import           Control.Effect.Sum
 import           Control.Monad.IO.Unlift
 import           Control.Parallel.Strategies
 import           Prologue
@@ -39,12 +37,12 @@ distributeFoldMap toTask inputs = fmap fold (distribute (fmap toTask inputs))
 
 -- | Distribute effects run tasks concurrently.
 data Distribute m k
-  = forall a . Distribute (m a) (a -> k)
+  = forall a . Distribute (m a) (a -> m k)
 
-deriving instance Functor (Distribute m)
+deriving instance Functor m => Functor (Distribute m)
 
 instance HFunctor Distribute where
-  hmap f (Distribute m k) = Distribute (f m) k
+  hmap f (Distribute m k) = Distribute (f m) (f . k)
 
 instance Effect Distribute where
   handle state handler (Distribute task k) = Distribute (handler (task <$ state)) (handler . fmap k)

src/Semantic/Graph.hs

@@ -34,6 +34,7 @@ import           Analysis.Abstract.Collecting
 import           Analysis.Abstract.Graph as Graph
 import           Control.Abstract hiding (String)
 import           Control.Abstract.PythonPackage as PythonPackage
+import           Control.Effect.Carrier
 import           Data.Abstract.Address.Hole as Hole
 import           Data.Abstract.Address.Monovariant as Monovariant
 import           Data.Abstract.Address.Precise as Precise

src/Semantic/REPL.hs

@@ -9,9 +9,9 @@ import Control.Abstract.ScopeGraph (runScopeError)
 import Control.Abstract.Heap (runHeapError)
 import Control.Effect.Carrier
 import Control.Effect.Catch
-import Control.Effect.Resource
+import Control.Effect.Lift
-import Control.Effect.Sum
 import Control.Effect.REPL
+import Control.Effect.Resource
 import Data.Abstract.Address.Precise as Precise
 import Data.Abstract.Evaluatable hiding (string)
 import Data.Abstract.Module
@@ -60,8 +60,8 @@ repl proxy parser paths =
   withOptions debugOptions $ \config logger statter ->
     runM
     . withDistribute
-    . withCatch
+    . runCatch
-    . withResource
+    . runResource
     . withTimeout
     . runError @SomeException
     . runTelemetryIgnoringStat (logOptionsFromConfig config)

src/Semantic/Resolution.hs

@@ -7,9 +7,7 @@ module Semantic.Resolution
   , ResolutionC(..)
   ) where
 
-import           Control.Effect
 import           Control.Effect.Carrier
-import           Control.Effect.Sum
 import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
 import           Data.Blob
@@ -18,6 +16,7 @@ import qualified Data.Map as Map
 import           Data.Source
 import           Data.Language
 import           Prologue
+import           GHC.Generics (Generic1)
 import           Semantic.Task.Files
 import           System.FilePath.Posix
 
@@ -44,9 +43,9 @@ resolutionMap Project{..} = case projectLanguage of
   _          -> send (NoResolution pure)
 
 data Resolution (m :: * -> *) k
-  = NodeJSResolution FilePath Text [FilePath] (Map FilePath FilePath -> k)
+  = NodeJSResolution FilePath Text [FilePath] (Map FilePath FilePath -> m k)
-  | NoResolution                              (Map FilePath FilePath -> k)
+  | NoResolution                              (Map FilePath FilePath -> m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 runResolution :: ResolutionC m a -> m a

src/Semantic/Task.hs

@@ -22,7 +22,6 @@ module Semantic.Task
 , time'
 -- * High-level flow
 , parse
-, analyze
 , decorate
 , diff
 , render
@@ -58,20 +57,17 @@ module Semantic.Task
 import           Analysis.Decorator (decoratorWithAlgebra)
 import qualified Assigning.Assignment as Assignment
 import qualified Assigning.Assignment.Deterministic as Deterministic
-import qualified Control.Abstract as Analysis
-import           Control.Effect
 import           Control.Effect.Carrier
 import           Control.Effect.Catch
 import           Control.Effect.Error
+import           Control.Effect.Lift
 import           Control.Effect.Reader
 import           Control.Effect.Resource
-import           Control.Effect.Sum
 import           Control.Effect.Trace
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Data.Blob
 import           Data.ByteString.Builder
-import           Data.Coerce
 import           Data.Diff
 import qualified Data.Error as Error
 import qualified Data.Flag as Flag
@@ -119,13 +115,6 @@ parse :: (Member Task sig, Carrier sig m)
       -> m term
 parse parser blob = send (Parse parser blob pure)
 
--- | A task running some 'Analysis.Evaluator' to completion.
-analyze :: (Member Task sig, Carrier sig m)
-        => (Analysis.Evaluator term address value m a -> result)
-        -> Analysis.Evaluator term address value m a
-        -> m result
-analyze interpret analysis = send (Analyze interpret analysis pure)
-
 -- | A task which decorates a 'Term' with values computed using the supplied 'RAlgebra' function.
 decorate :: (Functor f, Member Task sig, Carrier sig m)
          => RAlgebra (TermF f Location) (Term f Location) field
@@ -169,8 +158,8 @@ runTask taskSession@TaskSession{..} task = do
         run
           = runM
           . withDistribute
-          . withCatch
+          . runCatch
-          . withResource
+          . runResource
           . withTimeout
           . runError
           . runTelemetry logger statter
@@ -208,21 +197,23 @@ instance (Member Telemetry sig, Carrier sig m) => Carrier (Trace :+: sig) (Trace
 
 -- | An effect describing high-level tasks to be performed.
 data Task (m :: * -> *) k
-  = forall term . Parse (Parser term) Blob (term -> k)
+  = forall term . Parse (Parser term) Blob (term -> m k)
-  | forall term address value m a result . Analyze (Analysis.Evaluator term address value m a -> result) (Analysis.Evaluator term address value m a) (result -> k)
+  | forall f field . Functor f => Decorate (RAlgebra (TermF f Location) (Term f Location) field) (Term f Location) (Term f field -> m k)
-  | forall f field . Functor f => Decorate (RAlgebra (TermF f Location) (Term f Location) field) (Term f Location) (Term f field -> k)
+  | forall syntax ann . (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => Diff (These (Term syntax ann) (Term syntax ann)) (Diff syntax ann ann -> m k)
-  | forall syntax ann . (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => Diff (These (Term syntax ann) (Term syntax ann)) (Diff syntax ann ann -> k)
+  | forall input output . Render (Renderer input output) input (output -> m k)
-  | forall input output . Render (Renderer input output) input (output -> k)
+  | forall input . Serialize (Format input) input (Builder -> m k)
-  | forall input . Serialize (Format input) input (Builder -> k)
 
-deriving instance Functor (Task m)
+deriving instance Functor m => Functor (Task m)
 
 instance HFunctor Task where
-  hmap _ = coerce
+  hmap f (Parse parser blob k) = Parse parser blob (f . k)
+  hmap f (Decorate decorator term k) = Decorate decorator term (f . k)
+  hmap f (Semantic.Task.Diff terms k) = Semantic.Task.Diff terms (f . k)
+  hmap f (Render renderer input k) = Render renderer input (f . k)
+  hmap f (Serialize format input k) = Serialize format input (f . k)
 
 instance Effect Task where
   handle state handler (Parse parser blob k) = Parse parser blob (handler . (<$ state) . k)
-  handle state handler (Analyze run analysis k) = Analyze run analysis (handler . (<$ state) . k)
   handle state handler (Decorate decorator term k) = Decorate decorator term (handler . (<$ state) . k)
   handle state handler (Semantic.Task.Diff terms k) = Semantic.Task.Diff terms (handler . (<$ state) . k)
   handle state handler (Render renderer input k) = Render renderer input (handler . (<$ state) . k)
@@ -239,7 +230,6 @@ instance (Member (Error SomeException) sig, Member (Lift IO) sig, Member (Reader
   eff (R other) = TaskC . eff . handleCoercible $ other
   eff (L op) = case op of
     Parse parser blob k -> runParser blob parser >>= k
-    Analyze interpret analysis k -> k . interpret $ analysis
     Decorate algebra term k -> k (decoratorWithAlgebra algebra term)
     Semantic.Task.Diff terms k -> k (diffTermPair terms)
     Render renderer input k -> k (renderer input)

src/Semantic/Task/Files.hs

@@ -17,11 +17,9 @@ module Semantic.Task.Files
   , Excludes(..)
   ) where
 
-import           Control.Effect
 import           Control.Effect.Carrier
 import           Control.Effect.Catch
 import           Control.Effect.Error
-import           Control.Effect.Sum
 import           Data.Blob
 import           Data.Blob.IO
 import qualified Data.ByteString.Builder as B
@@ -50,14 +48,24 @@ data Excludes
 
 -- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
 data Files (m :: * -> *) k
-  = forall a . Read (Source a)                                (a -> k)
+  = forall a . Read (Source a)                                     (a -> m k)
-  | ReadProject (Maybe FilePath) FilePath Language [FilePath] (Project -> k)
+  | ReadProject (Maybe FilePath) FilePath Language [FilePath] (Project -> m k)
-  | FindFiles FilePath [String] [FilePath]                    ([FilePath] -> k)
+  | FindFiles FilePath [String] [FilePath]                    ([FilePath] -> m k)
-  | Write Destination B.Builder                               k
+  | Write Destination B.Builder                               (m k)
 
-deriving instance Functor (Files m)
+deriving instance Functor m => Functor (Files m)
-instance HFunctor Files
+
-instance Effect Files
+instance HFunctor Files where
+  hmap f (Read s k) = Read s (f . k)
+  hmap f (ReadProject mp p l ps k) = ReadProject mp p l ps (f . k)
+  hmap f (FindFiles p s ps k) = FindFiles p s ps (f . k)
+  hmap f (Write d b k) = Write d b (f k)
+
+instance Effect Files where
+  handle state handler (Read s k) = Read s (handler . (<$ state) . k)
+  handle state handler (ReadProject mp p l ps k) = ReadProject mp p l ps (handler . (<$ state) . k)
+  handle state handler (FindFiles p s ps k) = FindFiles p s ps (handler . (<$ state) . k)
+  handle state handler (Write d b k) = Write d b (handler . (<$ state) $ k)
 
 -- | Run a 'Files' effect in 'IO'
 runFiles :: FilesC m a -> m a

src/Semantic/Telemetry.hs

@@ -49,14 +49,13 @@ module Semantic.Telemetry
 , IgnoreTelemetryC(..)
 ) where
 
-import           Control.Effect
 import           Control.Effect.Carrier
 import           Control.Effect.Reader
-import           Control.Effect.Sum
 import           Control.Exception
 import           Control.Monad.IO.Class
 import qualified Data.Time.Clock.POSIX as Time (getCurrentTime)
 import qualified Data.Time.LocalTime as LocalTime
+import           GHC.Generics (Generic1)
 import           Semantic.Telemetry.AsyncQueue
 import           Semantic.Telemetry.Error
 import           Semantic.Telemetry.Log
@@ -137,9 +136,9 @@ time' = withTiming'
 
 -- | Statting and logging effects.
 data Telemetry (m :: * -> *) k
-  = WriteStat Stat k
+  = WriteStat Stat (m k)
-  | WriteLog Level String [(String, String)] k
+  | WriteLog Level String [(String, String)] (m k)
-  deriving stock Functor
+  deriving stock (Functor, Generic1)
   deriving anyclass (HFunctor, Effect)
 
 -- | Run a 'Telemetry' effect by expecting a 'Reader' of 'Queue's to write stats and logs to.

src/Semantic/Timeout.hs

@@ -8,10 +8,8 @@ module Semantic.Timeout
 , Duration(..)
 ) where
 
-import           Control.Effect
 import           Control.Effect.Carrier
 import           Control.Effect.Reader
-import           Control.Effect.Sum
 import           Control.Monad.IO.Class
 import           Control.Monad.IO.Unlift
 import           Data.Duration
@@ -26,12 +24,12 @@ timeout n = send . flip (Timeout n) pure
 -- | 'Timeout' effects run other effects, aborting them if they exceed the
 -- specified duration.
 data Timeout m k
-  = forall a . Timeout Duration (m a) (Maybe a -> k)
+  = forall a . Timeout Duration (m a) (Maybe a -> m k)
 
-deriving instance Functor (Timeout m)
+deriving instance Functor m => Functor (Timeout m)
 
 instance HFunctor Timeout where
-  hmap f (Timeout n task k) = Timeout n (f task) k
+  hmap f (Timeout n task k) = Timeout n (f task) (f . k)
 
 instance Effect Timeout where
   handle state handler (Timeout n task k) = Timeout n (handler (task <$ state)) (handler . maybe (k Nothing <$ state) (fmap (k . Just)))

src/Semantic/Util.hs

@@ -19,6 +19,7 @@ import Prelude hiding (readFile)
 import           Control.Abstract
 import           Control.Abstract.Heap (runHeapError)
 import           Control.Abstract.ScopeGraph (runScopeError)
+import           Control.Effect.Lift
 import           Control.Effect.Trace (runTraceByPrinting)
 import           Control.Exception (displayException)
 import           Data.Abstract.Address.Precise as Precise

src/Tags/Tagging.hs

@@ -8,8 +8,7 @@ where
 import Prelude hiding (fail, filter, log)
 import Prologue hiding (Element, hash)
 
-import           Control.Effect as Eff
+import           Control.Effect.State as Eff
-import           Control.Effect.State
 import           Data.Text as T hiding (empty)
 import           Streaming
 import qualified Streaming.Prelude as Streaming

test/Control/Abstract/Evaluator/Spec.hs

@@ -6,6 +6,7 @@ module Control.Abstract.Evaluator.Spec
 
 import           Control.Abstract as Abstract
 import qualified Control.Abstract.Heap as Heap
+import           Control.Effect.Lift
 import           Data.Abstract.Address.Precise as Precise
 import           Data.Abstract.BaseError
 import           Data.Abstract.Evaluatable

test/SpecHelpers.hs

@@ -23,6 +23,7 @@ import Control.Abstract
 import Data.Abstract.ScopeGraph (EdgeLabel(..))
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import qualified Data.Abstract.Heap as Heap
+import Control.Effect.Lift
 import Control.Effect.Trace as X (runTraceByIgnoring, runTraceByReturning)
 import Control.Monad ((>=>))
 import Data.Traversable as X (for)