fused-effects 0.3.1.0 → 0.4.0.0

raw patch · 15 files changed

+129/−142 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• examples/Teletype.hs +4/−12
• fused-effects.cabal +2/−1
• src/Control/Effect.hs +0/−4
• src/Control/Effect/Carrier.hs +26/−40
• src/Control/Effect/Fail.hs +4/−13
• src/Control/Effect/Interpose.hs +51/−0
• src/Control/Effect/Lift.hs +4/−12
• src/Control/Effect/NonDet.hs +2/−11
• src/Control/Effect/Resumable.hs +5/−11
• src/Control/Effect/State/Internal.hs +7/−11
• src/Control/Effect/State/Lazy.hs +3/−0
• src/Control/Effect/State/Strict.hs +4/−1
• src/Control/Effect/Sum.hs +0/−12
• src/Control/Effect/Trace.hs +6/−14

@@ -1,3 +1,14 @@+# v0.4.0.0++## Backwards-incompatible changes++- Removes APIs deprecated in 0.3.0.0, including `Eff`, `interpret`, `ret`, and the `handle*` family of helper functions.++## Other changes++- Adds the ability to derive default instances of `HFunctor` and `Effect` for first-order effects, using the `-XDeriveAnyClass` extension.+- Adds a generic `Interpose` effect that enables arbitrary "eavesdropping" on other effects.+ # 0.3.1.0  - Improved speed of `Reader`, `State`, `Writer`, and `Pure` effects by defining and inlining auxiliary `Applicative` methods.

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}  module Teletype where @@ -28,15 +28,7 @@ data Teletype (m :: * -> *) k   = Read (String -> k)   | Write String k-  deriving (Functor)--instance HFunctor Teletype where-  hmap _ = coerce-  {-# INLINE hmap #-}--instance Effect Teletype where-  handle state handler (Read    k) = Read (handler . (<$ state) . k)-  handle state handler (Write s k) = Write s (handler (k <$ state))+  deriving (Functor, HFunctor, Effect)  read :: (Member Teletype sig, Carrier sig m) => m String read = send (Read pure)@@ -49,7 +41,7 @@ runTeletypeIO = runTeletypeIOC  newtype TeletypeIOC m a = TeletypeIOC { runTeletypeIOC :: m a }-  deriving (Applicative, Functor, Monad, MonadIO)+  deriving newtype (Applicative, Functor, Monad, MonadIO)  instance (MonadIO m, Carrier sig m) => Carrier (Teletype :+: sig) (TeletypeIOC m) where   eff (L (Read    k)) = liftIO getLine      >>= k@@ -61,7 +53,7 @@ runTeletypeRet i = runWriter . runState i . runTeletypeRetC  newtype TeletypeRetC m a = TeletypeRetC { runTeletypeRetC :: StateC [String] (WriterC [String] m) a }-  deriving (Applicative, Functor, Monad)+  deriving newtype (Applicative, Functor, Monad)  instance (Carrier sig m, Effect sig) => Carrier (Teletype :+: sig) (TeletypeRetC m) where   eff (L (Read    k)) = do

@@ -1,5 +1,5 @@ name:                fused-effects-version:             0.3.1.0+version:             0.4.0.0 synopsis:            A fast, flexible, fused effect system. description:         A fast, flexible, fused effect system, à la Effect Handlers in Scope, Monad Transformers and Modular Algebraic Effects: What Binds Them Together, and Fusion for Free—Efficient Algebraic Effect Handlers. homepage:            https://github.com/fused-effects/fused-effects@@ -27,6 +27,7 @@                      , Control.Effect.Error                      , Control.Effect.Fail                      , Control.Effect.Fresh+                     , Control.Effect.Interpose                      , Control.Effect.Interpret                      , Control.Effect.Lift                      , Control.Effect.NonDet

@@ -1,6 +1,5 @@ module Control.Effect ( module X-, Eff ) where  import Control.Effect.Carrier   as X (Carrier, Effect)@@ -20,6 +19,3 @@ import Control.Effect.Sum       as X ((:+:), Member, send) import Control.Effect.Trace     as X (Trace, TraceByPrintingC, TraceByIgnoringC, TraceByReturningC) import Control.Effect.Writer    as X (Writer, WriterC)--type Eff m = m-{-# DEPRECATED Eff "Carriers are now monads; use @m@ instead of @Eff m@." #-}

@@ -5,14 +5,8 @@ , Carrier(..) , handlePure , handleCoercible-, handleReader-, handleState-, handleEither-, handleTraversable-, interpret ) where -import Control.Monad (join) import Data.Coerce  class HFunctor h where@@ -25,13 +19,30 @@   {-# INLINE fmap' #-}    -- | Higher-order functor map of a natural transformation over higher-order positions within the effect.+  -- A definition for 'hmap' over first-order effects can be derived automatically.   hmap :: (forall x . m x -> n x) -> (h m a -> h n a) +  default hmap :: Coercible (h m a) (h n a)+               => (forall x . m x -> n x)+               -> (h m a -> h n a)+  hmap _ = coerce+  {-# INLINE hmap #-} + -- | The class of effect types, which must: -- --   1. Be functorial in their last two arguments, and --   2. Support threading effects in higher-order positions through using the carrier’s suspended state.+--+-- All first-order effects (those without recursive occurrences of @m@) admit a default definition+-- of 'handle'. The @-XDeriveAnyClass@ extension allows derivation of both 'HFunctor' and 'Effect':+--+-- @+--   data State s (m :: * -> *) k+--     = Get (s -> k)+--     | Put s k+--       deriving (Functor, HFunctor, Effect)+-- @ class HFunctor sig => Effect sig where   -- | Handle any effects in a signature by threading the carrier’s state all the way through to the continuation.   handle :: Functor f@@ -40,18 +51,21 @@          -> sig m (m a)          -> sig n (n (f a)) +  default handle :: (Functor f, Coercible (sig m (n (f a))) (sig n (n (f a))))+                 => f ()+                 -> (forall x . f (m x) -> n (f x))+                 -> sig m (m a)+                 -> sig n (n (f a))+  handle state handler = coerce . fmap' (handler . (<$ state))+  {-# INLINE handle #-} ++ -- | The class of carriers (results) for algebras (effect handlers) over signatures (effects), whose actions are given by the 'eff' method. class (HFunctor sig, Monad m) => Carrier sig m | m -> sig where   -- | Construct a value in the carrier for an effect signature (typically a sum of a handled effect and any remaining effects).   eff :: sig m (m a) -> m a -  -- | Construct a value in the carrier for an effect signature (typically a sum of a handled effect and any remaining effects).-  ret :: a -> m a-  ret = pure--{-# DEPRECATED ret "Use 'pure' instead; 'ret' is a historical alias and will be removed in future versions" #-}- -- | Apply a handler specified as a natural transformation to both higher-order and continuation positions within an 'HFunctor'. handlePure :: HFunctor sig => (forall x . f x -> g x) -> sig f (f a) -> sig g (g a) handlePure handler = hmap handler . fmap' handler@@ -63,31 +77,3 @@ handleCoercible :: (HFunctor sig, Coercible f g) => sig f (f a) -> sig g (g a) handleCoercible = handlePure coerce {-# INLINE handleCoercible #-}--{-# DEPRECATED handleReader, handleState, handleEither, handleTraversable-  "Compose carrier types from other carriers and define 'eff' with handleCoercible instead" #-}---- | Thread a @Reader@-like carrier through an 'HFunctor'.-handleReader :: HFunctor sig => r -> (forall x . f x -> r -> g x) -> sig f (f a) -> sig g (g a)-handleReader r run = handlePure (flip run r)-{-# INLINE handleReader #-}---- | Thread a @State@-like carrier through an 'Effect'.-handleState :: Effect sig => s -> (forall x . f x -> s -> g (s, x)) -> sig f (f a) -> sig g (g (s, a))-handleState s run = handle (s, ()) (uncurry (flip run))-{-# INLINE handleState #-}---- | Thread a carrier producing 'Either's through an 'Effect'.-handleEither :: (Carrier sig g, Effect sig) => (forall x . f x -> g (Either e x)) -> sig f (f a) -> sig g (g (Either e a))-handleEither run = handle (Right ()) (either (pure . Left) run)-{-# INLINE handleEither #-}---- | Thread a carrier producing values in a 'Traversable' 'Monad' (e.g. '[]') through an 'Effect'.-handleTraversable :: (Effect sig, Applicative g, Monad m, Traversable m) => (forall x . f x -> g (m x)) -> sig f (f a) -> sig g (g (m a))-handleTraversable run = handle (pure ()) (fmap join . traverse run)-{-# INLINE handleTraversable #-}---- | A backwards-compatibility shim, equivalent to 'id'.-interpret :: carrier a -> carrier a-interpret = id-{-# DEPRECATED interpret "Not necessary with monadic carriers; remove or replace with 'id'." #-}

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DerivingStrategies, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} module Control.Effect.Fail ( Fail(..) , MonadFail(..)@@ -14,20 +14,11 @@ import Control.Monad.Fail import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Data.Coerce import Prelude hiding (fail)  newtype Fail (m :: * -> *) k = Fail String-  deriving (Functor)--instance HFunctor Fail where-  hmap _ = coerce-  {-# INLINE hmap #-}--instance Effect Fail where-  handle _ _ = coerce-  {-# INLINE handle #-}-+  deriving stock Functor+  deriving anyclass (HFunctor, Effect)  -- | Run a 'Fail' effect, returning failure messages in 'Left' and successful computations’ results in 'Right'. --@@ -36,7 +27,7 @@ runFail = runError . runFailC  newtype FailC m a = FailC { runFailC :: ErrorC String m a }-  deriving (Alternative, Applicative, Functor, Monad, MonadIO, MonadPlus, MonadTrans)+  deriving newtype (Alternative, Applicative, Functor, Monad, MonadIO, MonadPlus, MonadTrans)  instance (Carrier sig m, Effect sig) => MonadFail (FailC m) where   fail s = FailC (throwError s)

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveFunctor, ExplicitForAll, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}++{- |+This module provides an 'InterposeC' carrier capable of "eavesdropping" on requests+made to other carriers. This is a useful capability for dynamism in deeply-nested+effect stacks, but can lead to complicated control flow. Be careful.+-}+module Control.Effect.Interpose+  ( InterposeC (..)+  , runInterpose+  ) where++import Control.Effect.Carrier+import Control.Effect.Reader+import Control.Effect.Sum+import Control.Monad.Trans.Class++-- | 'runInterpose' takes a handler for a given effect (such as 'State' or 'Reader')+-- and runs that handler whenever an effect of that type is encountered. Within a+-- handler you can use all the capabilities of the underlying monad stack, including+-- the intercepted effect, and you can pass the effect on to the original handler+-- using 'send'.+--+--   prop> run . evalState @Int a . runInterpose @(State Int) (\op -> modify @Int (+b) *> send op) $ modify @Int (+b) == a + b + b+--+runInterpose :: (forall x . eff m (m x) -> m x) -> InterposeC eff m a -> m a+runInterpose handler = runReader (Handler handler) . runInterposeC++newtype InterposeC eff m a = InterposeC { runInterposeC :: ReaderC (Handler eff m) m a }+  deriving (Applicative, Functor, Monad)++instance MonadTrans (InterposeC eff) where+  lift = InterposeC . lift++newtype Handler eff m = Handler (forall x . eff m (m x) -> m x)++runHandler :: HFunctor eff => Handler eff m -> eff (ReaderC (Handler eff m) m) (ReaderC (Handler eff m) m a) -> m a+runHandler h@(Handler handler) = handler . handlePure (runReader h)++instance (HFunctor eff, Carrier sig m, Member eff sig) => Carrier sig (InterposeC eff m) where+  eff (op :: sig (InterposeC eff m) (InterposeC eff m a))+    | Just (op' :: eff (InterposeC eff m) (InterposeC eff m a)) <- prj op = do+      handler <- InterposeC ask+      lift (runHandler handler (handleCoercible op'))+    | otherwise = InterposeC (ReaderC (\ handler -> eff (handlePure (runReader handler . runInterposeC) op)))++-- $setup+-- >>> :seti -XFlexibleContexts+-- >>> import Test.QuickCheck+-- >>> import Control.Effect.Pure+-- >>> import Control.Effect.State

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses #-}+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses #-} module Control.Effect.Lift ( Lift(..) , sendM@@ -14,18 +14,10 @@ import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Control.Monad.Trans.Class-import Data.Coerce  newtype Lift sig (m :: * -> *) k = Lift { unLift :: sig k }-  deriving (Functor)--instance Functor sig => HFunctor (Lift sig) where-  hmap _ = coerce-  {-# INLINE hmap #-}--instance Functor sig => Effect (Lift sig) where-  handle state handler (Lift op) = Lift (fmap (handler . (<$ state)) op)-+  deriving stock Functor+  deriving anyclass (HFunctor, Effect)  -- | Extract a 'Lift'ed 'Monad'ic action from an effectful computation. runM :: LiftC m a -> m a@@ -38,7 +30,7 @@ sendM = send . Lift . fmap pure  newtype LiftC m a = LiftC { runLiftC :: m a }-  deriving (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus)+  deriving newtype (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus)  instance MonadTrans LiftC where   lift = LiftC

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-} module Control.Effect.NonDet ( NonDet(..) , Alternative(..)@@ -13,21 +13,12 @@ import Control.Monad.Fail import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Data.Coerce import Prelude hiding (fail)  data NonDet (m :: * -> *) k   = Empty   | Choose (Bool -> k)-  deriving (Functor)--instance HFunctor NonDet where-  hmap _ = coerce-  {-# INLINE hmap #-}--instance Effect NonDet where-  handle _     _       Empty      = Empty-  handle state handler (Choose k) = Choose (handler . (<$ state) . k)+  deriving (Functor, HFunctor, Effect)   -- | Run a 'NonDet' effect, collecting all branches’ results into an 'Alternative' functor.

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DerivingStrategies, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-} module Control.Effect.Resumable ( Resumable(..) , throwResumable@@ -19,7 +19,6 @@ import Control.Monad.Fail import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Data.Coerce import Data.Functor.Classes  -- | Errors which can be resumed with values of some existentially-quantified type.@@ -27,13 +26,8 @@   = forall a . Resumable (err a) (a -> k)  deriving instance Functor (Resumable err m)--instance HFunctor (Resumable err) where-  hmap _ = coerce-  {-# INLINE hmap #-}--instance Effect (Resumable err) where-  handle state handler (Resumable err k) = Resumable err (handler . (<$ state) . k)+deriving instance HFunctor (Resumable err)+deriving instance Effect (Resumable err)  -- | Throw an error which can be resumed with a value of its result type. --@@ -88,7 +82,7 @@ runResumable = runError . runResumableC  newtype ResumableC err m a = ResumableC { runResumableC :: ErrorC (SomeError err) m a }-  deriving (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus, MonadTrans)+  deriving newtype (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus, MonadTrans)  instance (Carrier sig m, Effect sig) => Carrier (Resumable err :+: sig) (ResumableC err m) where   eff (L (Resumable err _)) = ResumableC (throwError (SomeError err))@@ -110,7 +104,7 @@ runResumableWith with = runReader (Handler with) . runResumableWithC  newtype ResumableWithC err m a = ResumableWithC { runResumableWithC :: ReaderC (Handler err m) m a }-  deriving (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus)+  deriving newtype (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus)  instance MonadTrans (ResumableWithC err) where   lift = ResumableWithC . lift

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, ExplicitForAll, FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, ExplicitForAll, FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} module Control.Effect.State.Internal ( State(..) , get@@ -10,33 +10,26 @@  import Control.Effect.Carrier import Control.Effect.Sum-import Data.Coerce import Prelude hiding (fail)  data State s (m :: * -> *) k   = Get (s -> k)   | Put s k-  deriving (Functor)--instance HFunctor (State s) where-  hmap _ = coerce-  {-# INLINE hmap #-}--instance Effect (State s) where-  handle state handler (Get k)   = Get   (handler . (<$ state) . k)-  handle state handler (Put s k) = Put s (handler . (<$ state) $ k)+  deriving (Functor, HFunctor, Effect)  -- | Get the current state value. -- --   prop> snd (run (runState a get)) == a get :: (Member (State s) sig, Carrier sig m) => m s get = send (Get pure)+{-# INLINEABLE get #-}  -- | Project a function out of the current state value. -- --   prop> snd (run (runState a (gets (applyFun f)))) == applyFun f a gets :: (Member (State s) sig, Carrier sig m) => (s -> a) -> m a gets f = send (Get (pure . f))+{-# INLINEABLE gets #-}  -- | Replace the state value with a new value. --@@ -45,6 +38,7 @@ --   prop> snd (run (runState a (put b *> get))) == b put :: (Member (State s) sig, Carrier sig m) => s -> m () put s = send (Put s (pure ()))+{-# INLINEABLE put #-}  -- | Replace the state value with the result of applying a function to the current state value. --   This is strict in the new state.@@ -54,11 +48,13 @@ modify f = do   a <- get   put $! f a+{-# INLINEABLE modify #-}  -- | Replace the state value with the result of applying a function to the current state value. --   This is lazy in the new state; injudicious use of this function may lead to space leaks. modifyLazy :: (Member (State s) sig, Carrier sig m) => (s -> s) -> m () modifyLazy f = get >>= put . f+{-# INLINEABLE modifyLazy #-}  -- $setup -- >>> :seti -XFlexibleContexts

@@ -79,18 +79,21 @@ --   prop> take 5 . snd . run $ runState () (traverse pure [1..]) == [1,2,3,4,5] runState :: s -> StateC s m a -> m (s, a) runState s c = runStateC c s+{-# INLINE[3] runState #-}  -- | Run a lazy 'State' effect, yielding the result value and discarding the final state. -- --   prop> run (evalState a (pure b)) == b evalState :: forall s m a . Functor m => s -> StateC s m a -> m a evalState s = fmap snd . runState s+{-# INLINE[3] evalState #-}  -- | Run a lazy 'State' effect, yielding the final state and discarding the return value. -- --   prop> run (execState a (pure b)) == a execState :: forall s m a . Functor m => s -> StateC s m a -> m s execState s = fmap fst . runState s+{-# INLINE[3] execState #-}  -- $setup -- >>> :seti -XFlexibleContexts

@@ -26,19 +26,22 @@ -- --   prop> run (runState a (pure b)) == (a, b) runState :: s -> StateC s m a -> m (s, a)-runState = flip runStateC+runState s x = runStateC x s+{-# INLINE[3] runState #-}  -- | Run a 'State' effect, yielding the result value and discarding the final state. -- --   prop> run (evalState a (pure b)) == b evalState :: forall s m a . Functor m => s -> StateC s m a -> m a evalState s = fmap snd . runState s+{-# INLINE[3] evalState #-}  -- | Run a 'State' effect, yielding the final state and discarding the return value. -- --   prop> run (execState a (pure b)) == a execState :: forall s m a . Functor m => s -> StateC s m a -> m s execState s = fmap fst . runState s+{-# INLINE[3] execState #-}   newtype StateC s m a = StateC { runStateC :: s -> m (s, a) }

@@ -1,7 +1,6 @@ {-# LANGUAGE DeriveFunctor, FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeOperators #-} module Control.Effect.Sum ( (:+:)(..)-, handleSum , Member(..) , send ) where@@ -25,17 +24,6 @@ instance (Effect l, Effect r) => Effect (l :+: r) where   handle state handler (L l) = L (handle state handler l)   handle state handler (R r) = R (handle state handler r)---- | Lift algebras for either side of a sum into a single algebra on sums.------   Note that the order of the functions is the opposite of members of the sum. This is more convenient for defining effect handlers as lambdas (especially using @-XLambdaCase@) on the right, enabling better error messaging when using typed holes than would be the case with a binding in a where clause.-{-# DEPRECATED handleSum "Carriers are now monads, so handleSum is obsolete: define handlers with do-notation and pattern-matching on L and R" #-}-handleSum :: (          sig2  m a -> b)-          -> ( sig1           m a -> b)-          -> ((sig1 :+: sig2) m a -> b)-handleSum alg1 _    (R op) = alg1 op-handleSum _    alg2 (L op) = alg2 op-{-# INLINE handleSum #-}  class Member (sub :: (* -> *) -> (* -> *)) sup where   inj :: sub m a -> sup m a

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} module Control.Effect.Trace ( Trace(..) , trace@@ -19,21 +19,13 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class import Data.Bifunctor (first)-import Data.Coerce import System.IO  data Trace (m :: * -> *) k = Trace   { traceMessage :: String   , traceCont    :: k-  }-  deriving (Functor)--instance HFunctor Trace where-  hmap _ = coerce-  {-# INLINE hmap #-}--instance Effect Trace where-  handle state handler (Trace s k) = Trace s (handler (k <$ state))+  } deriving stock Functor+    deriving anyclass (HFunctor, Effect)  -- | Append a message to the trace log. trace :: (Member Trace sig, Carrier sig m) => String -> m ()@@ -45,7 +37,7 @@ runTraceByPrinting = runTraceByPrintingC  newtype TraceByPrintingC m a = TraceByPrintingC { runTraceByPrintingC :: m a }-  deriving (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus)+  deriving newtype (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus)  instance MonadTrans TraceByPrintingC where   lift = TraceByPrintingC@@ -64,7 +56,7 @@ runTraceByIgnoring = runTraceByIgnoringC  newtype TraceByIgnoringC m a = TraceByIgnoringC { runTraceByIgnoringC :: m a }-  deriving (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus)+  deriving newtype (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus)  instance MonadTrans TraceByIgnoringC where   lift = TraceByIgnoringC@@ -83,7 +75,7 @@ runTraceByReturning = fmap (first reverse) . runState [] . runTraceByReturningC  newtype TraceByReturningC m a = TraceByReturningC { runTraceByReturningC :: StateC [String] m a }-  deriving (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus, MonadTrans)+  deriving newtype (Alternative, Applicative, Functor, Monad, MonadFail, MonadIO, MonadPlus, MonadTrans)  instance (Carrier sig m, Effect sig) => Carrier (Trace :+: sig) (TraceByReturningC m) where   eff (L (Trace m k)) = TraceByReturningC (modify (m :)) *> k