dep-t-advice 0.4.7.0 → 0.5.0.0

raw patch · 13 files changed

+1163/−305 lines, 13 filesdep +unliftio-coredep ~dep-tPVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio-core

Dependency ranges changed: dep-t

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README.md +15/−4
• benchmark/benchmarks.hs +1/−3
• dep-t-advice.cabal +27/−7
• lib/Control/Monad/Dep/Advice.hs +87/−159
• lib/Control/Monad/Dep/Advice/Basic.hs +5/−92
• lib/Control/Monad/Dep/SimpleAdvice.hs +495/−0
• lib/Control/Monad/Dep/SimpleAdvice/Basic.hs +141/−0
• lib/Control/Monad/Dep/SimpleAdvice/Internal.hs +126/−0
• test/doctests.hs +4/−2
• test/simple-advice-tests.hs +178/−0
• test/tests-has-conversion.hs +16/−18
• test/tests.hs +58/−20

@@ -1,5 +1,15 @@ # Revision history for dep-t-advice
 
+## 0.5.0.0 
+
+* The Advice type has changed to get rid of the existential type.
+  This breaks the 'makeAdvice' function.   
+* Added 'Control.Monad.Dep.SimpleAdvice' and 'Control.Monad.Dep.SimpleAdvice.Basic'.
+* Moved some "basic" advices.
+* Removed distributeDepT.
+* 'adviseRecord' now receives a 'NonEmpty' path-in-record, ordered innermost-first.
+* More flexible type for doLocally.
+
 ## 0.4.7.0 
 
 * Added 'distributeDepT' and 'component'.

@@ -118,6 +118,21 @@ works on functions that end on a `DepT` action. Also, advice might depend on
 the full gamut of functionality stored in the environment.
 
+## What about `Control.Monad.Dep.SimpleAdvice`?
+
+`Advice`s form `Control.Monad.Dep.Advice` work with the `DepT` monad, but
+that's a bit too specialized. What if I want to use plain `IO` as the monad
+which parameterizes my record-of-functions?
+
+`Control.Monad.Dep.SimpleAdvice` provides a version of the `Advice` type that
+works with records-of-functions parameterized with `IO` or other concrete
+monads. 
+
+This simpler `Advice` can be useful when performing dependency injection
+through [`fixEnv`](https://hackage.haskell.org/package/dep-t-0.4.6.0/docs/Control-Monad-Dep-Env.html#g:9).
+
+There are conversion functions between the two versions of `Advice`.
+
 ## Historical aside
 
 According to Wikipedia, the term "advice" in the sense of aspect-oriented
@@ -166,10 +181,6 @@ 
 - [Using the “constraints” package to make a wrapped function less
   polymorphic](https://stackoverflow.com/questions/65800809/using-the-constraints-package-to-make-a-wrapped-function-less-polymorphic)
-
-- [Dependency Injection Principles, Practices, and
-  Patterns](https://www.goodreads.com/book/show/44416307-dependency-injection-principles-practices-and-patterns)
-  This is a good book on the general princples of DI. 
 
 - [variadic-function](https://hackage.haskell.org/package/variadic-function) a
   Hackage library which also deals with functions of any number of elements.

@@ -34,9 +34,7 @@ --     )
 
 mempty' :: forall ca e m r. Monad m => Advice ca e m r
-mempty' = makeAdvice @()
-  (\args -> pure (pure args))
-  (\() -> id)
+mempty' = makeAdvice (\args -> pure (id, args))
 
 summy :: Monad m => Int -> Int -> Int -> Int -> DepT NilEnv m (Sum Int)
 summy a1 a2 a3 a4 = pure $ Sum a1 <> Sum a2 <> Sum a3 <> Sum a4

@@ -1,13 +1,19 @@ cabal-version:       3.0
 
 name:                dep-t-advice
-version:             0.4.7.0
-synopsis:            Giving good advice to functions in a DepT environment.
-description:         Companion to the dep-t package. Easily add behaviour to functions living in a DepT environment, 
-                     whatever the number of arguments they might have.
+version:             0.5.0.0
+synopsis:            Giving good advice to functions in a record-of-functions.
+description:         
+                     Companion to the dep-t package. Easily add behaviour to
+                     functions living in a record-of-functions, whatever the
+                     number of arguments they might have.
                      
                      In other words: something like the "advices" of
                      aspect-oriented programming.
+
+                     Two flavors of advice are provided: one for environments
+                     parameterized by the DepT monad, and a simpler version for
+                     environments parameterized by IO and other monads.
 -- bug-reports:
 license:             BSD-3-Clause
 license-file:        LICENSE
@@ -24,7 +30,9 @@   build-depends:       base >=4.10.0.0 && < 5,
                        sop-core ^>= 0.5.0.0,
                        transformers ^>= 0.5.0.0,
-                       dep-t ^>= 0.4.6.0,
+                       dep-t ^>= 0.5.0.0,
+                       mtl ^>= 2.2,
+                       unliftio-core ^>= 0.2.0.0,
   default-language:    Haskell2010
 
 common common-tests
@@ -32,8 +40,8 @@   build-depends:       
                        dep-t-advice, 
                        rank2classes       ^>= 1.4.1,
-                       transformers       ^>= 0.5.0.0,
-                       mtl                ^>= 2.2,
+                       -- transformers       ^>= 0.5.0.0,
+                       -- mtl                ^>= 2.2,
                        template-haskell,
                        text,
 
@@ -48,6 +56,10 @@   import: common
   exposed-modules:     Control.Monad.Dep.Advice
                        Control.Monad.Dep.Advice.Basic
+                       Control.Monad.Dep.SimpleAdvice
+                       Control.Monad.Dep.SimpleAdvice.Basic
+  other-modules:       Control.Monad.Dep.SimpleAdvice.Internal    
+                        
   hs-source-dirs:      lib 
 
 test-suite tests
@@ -61,6 +73,14 @@   main-is:             weird-advice-tests.hs
   build-depends:       
                        barbies            ^>= 2.0.2.0
+
+test-suite simple-advice-tests
+  import:              common-tasty
+  type:                exitcode-stdio-1.0
+  main-is:             simple-advice-tests.hs
+  build-depends:       
+                       barbies            ^>= 2.0.2.0
+
 
 test-suite tests-has-conversion
   import:              common-tasty

@@ -17,12 +17,13 @@ {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE BlockArguments #-}
 
 -- |
---    This package provides the 'Advice' datatype, along for functions for creating,
+--    This module provides the 'Advice' datatype, along for functions for creating,
 --    manipulating, composing and applying values of that type.
 --
---    'Advice's represent generic transformations on 'DepT'-effectful functions of
+--    'Advice's are type-preserving transformations on 'DepT'-effectful functions of
 --    any number of arguments.
 --
 -- >>> :{
@@ -36,32 +37,32 @@ --
 -- They work for @DepT@-actions of zero arguments:
 --
--- >>> advise (printArgs stdout "foo0") foo0 `runDepT` NilEnv
+-- >>> advise (fromSimple \_ -> printArgs stdout "foo0") foo0 `runDepT` NilEnv
 -- foo0:
 -- <BLANKLINE>
 -- Sum {getSum = 5}
 --
 -- And for functions of one or more arguments, provided they end on a @DepT@-action:
 --
--- >>> advise (printArgs stdout "foo1") foo1 False `runDepT` NilEnv
+-- >>> advise (fromSimple \_ -> printArgs stdout "foo1") foo1 False `runDepT` NilEnv
 -- foo1: False
 -- <BLANKLINE>
 -- Sum {getSum = 5}
 --
--- >>> advise (printArgs stdout "foo2") foo2 'd' False `runDepT` NilEnv
+-- >>> advise (fromSimple \_ -> printArgs stdout "foo2") foo2 'd' False `runDepT` NilEnv
 -- foo2: 'd' False
 -- <BLANKLINE>
 -- Sum {getSum = 5}
 --
 -- 'Advice's can also tweak the result value of functions:
 --
--- >>> advise (returnMempty @Top) foo2 'd' False `runDepT` NilEnv
+-- >>> advise (fromSimple \_ -> returnMempty @Top) foo2 'd' False `runDepT` NilEnv
 -- Sum {getSum = 0}
 --
 -- And they can be combined using @Advice@'s 'Monoid' instance before being
 -- applied:
 --
--- >>> advise (printArgs stdout "foo2" <> returnMempty) foo2 'd' False `runDepT` NilEnv
+-- >>> advise (fromSimple \_ -> printArgs stdout "foo2" <> returnMempty) foo2 'd' False `runDepT` NilEnv
 -- foo2: 'd' False
 -- <BLANKLINE>
 -- Sum {getSum = 0}
@@ -102,9 +103,13 @@     adviseRecord,
     deceiveRecord,
     -- * Plugging Has-based constructors
-    distributeDepT,
     component,
+    --distributeDepT,
 
+    -- * Interfacing with "simple" advices
+    toSimple,
+    fromSimple,
+
     -- * "sop-core" re-exports
     -- $sop
     Top,
@@ -124,6 +129,7 @@ import Data.Functor.Identity
 import Data.Kind
 import Data.List.NonEmpty qualified as N
+import Data.List.NonEmpty (NonEmpty)
 import Data.SOP
 import Data.SOP.Dict
 import Data.SOP.NP
@@ -131,6 +137,8 @@ import GHC.Generics qualified as G
 import GHC.TypeLits
 import Data.Coerce
+import Data.Bifunctor (first)
+import Control.Monad.Dep.SimpleAdvice.Internal qualified as SA
 
 -- $setup
 --
@@ -152,7 +160,7 @@ -- >>> import Control.Monad
 -- >>> import Control.Monad.Dep
 -- >>> import Control.Monad.Dep.Advice
--- >>> import Control.Monad.Dep.Advice.Basic (printArgs,returnMempty)
+-- >>> import Control.Monad.Dep.SimpleAdvice.Basic (printArgs,returnMempty)
 -- >>> import Control.Monad.Writer
 -- >>> import Data.Kind
 -- >>> import Data.SOP
@@ -164,9 +172,9 @@ -- >>> import GHC.Generics qualified
 
 -- | A generic transformation of 'DepT'-effectful functions with environment
--- @e_@ of kind @(Type -> Type) -> Type@, base monad @m@ and return type @r@,
--- provided the functions satisfy certain constraint @ca@ of kind @Type ->
--- Constraint@ on all of their arguments.
+-- @e_@, base monad @m@ and return type @r@,
+-- provided the functions satisfy certain constraint @ca@
+-- on all of their arguments.
 --
 -- Note that the type constructor for the environment @e_@ is given unapplied.
 -- That is, @Advice Show NilEnv IO ()@ kind-checks but @Advice Show (NilEnv IO)
@@ -184,18 +192,13 @@   (Type -> Type) ->
   Type ->
   Type
-data Advice ca e_ m r where
+data Advice (ca :: Type -> Constraint) (e_ :: (Type -> Type) -> Type) m r where
   Advice ::
-    forall u ca e_ m r.
-    Proxy u ->
+    forall ca e_ m r.
     ( forall as.
       All ca as =>
       NP I as ->
-      DepT e_ m (u, NP I as)
-    ) ->
-    ( u ->
-      DepT e_ m r ->
-      DepT e_ m r
+      DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
     ) ->
     Advice ca e_ m r
 
@@ -206,104 +209,45 @@ --    The first 'Advice' is the \"outer\" one. It tweaks the function arguments
 --    first, and wraps around the execution of the second, \"inner\" 'Advice'.
 instance Monad m => Semigroup (Advice ca e_ m r) where
-  Advice outer tweakArgsOuter tweakExecutionOuter <> Advice inner tweakArgsInner tweakExecutionInner =
-    let captureExistentials ::
-          forall ca e_ r outer inner.
-          Proxy outer ->
-          ( forall as.
-            All ca as =>
-            NP I as ->
-            DepT e_ m (outer, NP I as)
-          ) ->
-          ( outer ->
-            DepT e_ m r ->
-            DepT e_ m r
-          ) ->
-          Proxy inner ->
-          ( forall as.
-            All ca as =>
-            NP I as ->
-            DepT e_ m (inner, NP I as)
-          ) ->
-          ( inner ->
-            DepT e_ m r ->
-            DepT e_ m r
-          ) ->
-          Advice ca e_ m r
-        captureExistentials _ tweakArgsOuter' tweakExecutionOuter' _ tweakArgsInner' tweakExecutionInner' =
-          Advice
-            (Proxy @(Pair outer inner))
-            ( let tweakArgs ::
-                    forall as.
-                    All ca as =>
-                    NP I as ->
-                    DepT e_ m (Pair outer inner, NP I as)
-                  tweakArgs args =
-                    do
-                      (uOuter, argsOuter) <- tweakArgsOuter' @as args
-                      (uInner, argsInner) <- tweakArgsInner' @as argsOuter
-                      pure (Pair uOuter uInner, argsInner)
-               in tweakArgs
-            )
-            ( let tweakExecution ::
-                    Pair outer inner ->
-                    DepT e_ m r ->
-                    DepT e_ m r
-                  tweakExecution =
-                    ( \(Pair uOuter uInner) action ->
-                        tweakExecutionOuter' uOuter (tweakExecutionInner' uInner action)
-                    )
-               in tweakExecution
-            )
-     in captureExistentials @ca @e_ outer tweakArgsOuter tweakExecutionOuter inner tweakArgsInner tweakExecutionInner
+  Advice outer <> Advice inner = Advice \args -> do
+    (tweakOuter, argsOuter) <- outer args
+    (tweakInner, argsInner) <- inner argsOuter
+    pure (tweakOuter . tweakInner, argsInner)
 
 instance Monad m => Monoid (Advice ca e_ m r) where
   mappend = (<>)
-  mempty = Advice (Proxy @()) (\args -> pure (pure args)) (const id)
+  mempty = Advice \args -> pure (id, args)
 
 -- |
---    The most general (and complex) way of constructing 'Advice's.
---
---    'Advice's work in two phases. First, the arguments of the transformed
---    function are collected into an n-ary product 'NP', and passed to the
---    first argument of 'makeAdvice', which produces a (possibly transformed)
---    product of arguments, along with some summary value of type @u@. Use @()@
---    as the summary value if you don't care about it.
+--    The most general way of constructing 'Advice's.
 --
---    In the second phase, the monadic action produced by the function once all
---    arguments have been given is transformed using the second argument of
---    'makeAdvice'. This second argument also receives the summary value of
---    type @u@ calculated earlier.
+--    An 'Advice' is a function that transforms other functions in an 
+--    arity-polymorphic way. It receives the arguments of the advised
+--    function packed into an n-ary product 'NP', performs some 
+--    effects based on them, and returns a potentially modified version of the 
+--    arguments, along with a function for tweaking the execution of the
+--    advised function.
 --
 -- >>> :{
 --  doesNothing :: forall ca e_ m r. Monad m => Advice ca e_ m r
---  doesNothing = makeAdvice @() (\args -> pure (pure args)) (\() action -> action)
+--  doesNothing = makeAdvice (\args -> pure (id,  args)) 
 -- :}
 --
---    __/TYPE APPLICATION REQUIRED!/__ When invoking 'makeAdvice', you must always give the
---    type of the existential @u@ through a type application. Otherwise you'll
---    get weird \"u is untouchable\" errors.
+--
 makeAdvice ::
-  forall u ca e_ m r.
-  -- | The function that tweaks the arguments.
+  forall ca e_ m r.
+  -- | The function that tweaks the arguments and the execution.
   ( forall as.
     All ca as =>
     NP I as ->
-    DepT e_ m (u, NP I as)
-  ) ->
-  -- | The function that tweaks the execution.
-  ( u ->
-    DepT e_ m r ->
-    DepT e_ m r
+    DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
   ) ->
   Advice ca e_ m r
-makeAdvice = Advice (Proxy @u)
+makeAdvice = Advice
 
 -- |
 --    Create an advice which only tweaks and/or analyzes the function arguments.
 --
---    Notice that there's no @u@ parameter, unlike with 'makeAdvice'.
---
 -- >>> :{
 --  doesNothing :: forall ca e_ m r. Monad m => Advice ca e_ m r
 --  doesNothing = makeArgsAdvice pure
@@ -319,18 +263,13 @@   ) ->
   Advice ca e_ m r
 makeArgsAdvice tweakArgs =
-  makeAdvice @()
-    ( \args -> do
-        args <- tweakArgs args
-        pure ((), args)
-    )
-    (const id)
+  makeAdvice $ \args -> do
+    args' <- tweakArgs args
+    pure (id, args')
 
 -- |
 --    Create an advice which only tweaks the execution of the final monadic action.
 --
---    Notice that there's no @u@ parameter, unlike with 'makeAdvice'.
---
 -- >>> :{
 --  doesNothing :: forall ca e_ m r. Monad m => Advice ca e_ m r
 --  doesNothing = makeExecutionAdvice id
@@ -343,7 +282,7 @@     DepT e_ m r
   ) ->
   Advice ca e_ m r
-makeExecutionAdvice tweakExecution = makeAdvice @() (\args -> pure (pure args)) (\() action -> tweakExecution action)
+makeExecutionAdvice tweakExecution = makeAdvice \args -> pure (tweakExecution, args)
 
 data Pair a b = Pair !a !b
 
@@ -385,7 +324,7 @@ -- >>> :{
 --  foo :: Int -> DepT NilEnv IO String
 --  foo _ = pure "foo"
---  advisedFoo = advise (printArgs stdout "Foo args: ") foo
+--  advisedFoo = advise (fromSimple \_ -> printArgs stdout "Foo args: ") foo
 -- :}
 --
 -- __/TYPE APPLICATION REQUIRED!/__ If the @ca@ constraint of the 'Advice' remains polymorphic,
@@ -394,8 +333,8 @@ -- >>> :{
 --  bar :: Int -> DepT NilEnv IO String
 --  bar _ = pure "bar"
---  advisedBar1 = advise (returnMempty @Top) bar
---  advisedBar2 = advise @Top returnMempty bar
+--  advisedBar1 = advise (fromSimple \_ -> returnMempty @Top) bar
+--  advisedBar2 = advise @Top (fromSimple \_ -> returnMempty) bar
 -- :}
 advise ::
   forall ca e_ m r as advisee.
@@ -405,11 +344,11 @@   -- | A function to be adviced.
   advisee ->
   advisee
-advise (Advice _ tweakArgs tweakExecution) advisee = do
+advise (Advice f) advisee = do
   let uncurried = multiuncurry @as @e_ @m @r advisee
       uncurried' args = do
-        (u, args') <- tweakArgs args
-        tweakExecution u (uncurried args')
+        (tweakExecution, args') <- f args
+        tweakExecution (uncurried args')
    in multicurry @as @e_ @m @r uncurried'
 
 type Multicurryable ::
@@ -494,7 +433,7 @@ --      let foo' = runFromEnv (readIORef envRef) _foo
 --      do r <- foo' 7
 --         print r
---      modifyIORef envRef (\e -> e { _foo = advise @Top returnMempty (_foo e) })
+--      modifyIORef envRef (\e -> e { _foo = advise @Top (fromSimple \_ -> returnMempty) (_foo e) })
 --      do r <- foo' 7
 --         print r
 -- :}
@@ -546,12 +485,12 @@ --
 -- >>> :{
 --  stricterPrintArgs :: forall e_ m r. MonadIO m => Advice (Show `And` Eq `And` Ord) e_ m r
---  stricterPrintArgs = restrictArgs (\Dict -> Dict) (printArgs stdout "foo")
+--  stricterPrintArgs = restrictArgs (\Dict -> Dict) (fromSimple \_ -> printArgs stdout "foo")
 -- :}
 --
 --    or with a type application to 'restrictArgs':
 --
--- >>> stricterPrintArgs = restrictArgs @(Show `And` Eq `And` Ord) (\Dict -> Dict) (printArgs stdout "foo")
+-- >>> stricterPrintArgs = restrictArgs @(Show `And` Eq `And` Ord) (\Dict -> Dict) (fromSimple \_ -> printArgs stdout "foo")
 
 -- | Makes the constraint on the arguments more restrictive.
 restrictArgs ::
@@ -570,32 +509,13 @@ -- because the composition might be done
 -- on the fly, while constructing a record, without a top-level binding with a
 -- type signature.  This seems to favor putting "more" first.
-restrictArgs evidence (Advice proxy tweakArgs tweakExecution) =
-  let captureExistential ::
-        forall more less e_ m r u.
-        (forall x. Dict more x -> Dict less x) ->
-        Proxy u ->
-        ( forall as.
-          All less as =>
-          NP I as ->
-          DepT e_ m (u, NP I as)
-        ) ->
-        ( u ->
-          DepT e_ m r ->
-          DepT e_ m r
-        ) ->
-        Advice more e_ m r
-      captureExistential evidence' _ tweakArgs' tweakExecution' =
-        Advice
-          (Proxy @u)
-          ( let tweakArgs'' :: forall as. All more as => NP I as -> DepT e_ m (u, NP I as)
-                tweakArgs'' = case Data.SOP.Dict.mapAll @more @less evidence' of
-                  f -> case f (Dict @(All more) @as) of
-                    Dict -> \args -> tweakArgs' @as args
-             in tweakArgs''
-          )
-          tweakExecution'
-   in captureExistential evidence proxy tweakArgs tweakExecution
+restrictArgs evidence (Advice advice) = Advice \args ->
+    let advice' :: forall as. All more as => NP I as -> DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
+        advice' args' =
+            case Data.SOP.Dict.mapAll @more @less evidence of
+               f -> case f (Dict @(All more) @as) of
+                        Dict -> advice args'
+     in advice' args
 
 --
 type Gullible ::
@@ -790,17 +710,6 @@ deceiveRecord = _deceiveRecord @e @e_ @m @gullible
 
 
--- | Having a 'DepT' action that returns a record-of-functions with effects in
--- 'DepT' is the same as having the record itself, because we can obtain the initial
--- environment by 'ask'ing for it in each member function.
-distributeDepT 
-    :: forall e_ m record . DistributiveRecord e_ m record => 
-    -- | 'DepT' action that returns the component
-    DepT e_ m (record (DepT e_ m)) ->
-    -- | component whose methods get the environment by 'ask'ing.
-    record (DepT e_ m)
-distributeDepT (DepT (ReaderT action)) = _distribute @e_ @m @record action
-
 -- | Given a constructor that returns a record-of-functions with effects in 'DepT',
 -- produce a record in which the member functions 'ask' for the environment themselves.
 --
@@ -868,11 +777,11 @@ --
 type AdvisedRecord :: (Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> (Type -> Constraint) -> ((Type -> Type) -> Type) -> Constraint
 class AdvisedRecord ca e_ m cr advised where
-  _adviseRecord :: [(TypeRep, String)] -> (forall r. cr r => [(TypeRep, String)] -> Advice ca e_ m r) -> advised (DepT e_ m) -> advised (DepT e_ m)
+  _adviseRecord :: [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised (DepT e_ m) -> advised (DepT e_ m)
 
 type AdvisedProduct :: (Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> (Type -> Constraint) -> (k -> Type) -> Constraint
 class AdvisedProduct ca e_ m cr advised_ where
-  _adviseProduct :: TypeRep -> [(TypeRep, String)] -> (forall r. cr r => [(TypeRep, String)] -> Advice ca e_ m r) -> advised_ k -> advised_ k
+  _adviseProduct :: TypeRep -> [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised_ k -> advised_ k
 
 instance
   ( G.Generic (advised (DepT e_ m)),
@@ -906,7 +815,7 @@ 
 type AdvisedComponent :: RecordComponent -> (Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> (Type -> Constraint) -> Type -> Constraint
 class AdvisedComponent component_type ca e_ m cr advised where
-  _adviseComponent :: [(TypeRep, String)] -> (forall r. cr r => [(TypeRep, String)] -> Advice ca e_ m r) -> advised -> advised
+  _adviseComponent :: [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised -> advised
 
 instance
   ( AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised,
@@ -915,7 +824,7 @@   AdvisedProduct ca e_ m cr (G.S1 ( 'G.MetaSel ( 'Just fieldName) su ss ds) (G.Rec0 advised))
   where
   _adviseProduct tr acc f (G.M1 (G.K1 advised)) =
-    let acc' = acc ++ [(tr, symbolVal (Proxy @fieldName))]
+    let acc' = (tr, symbolVal (Proxy @fieldName)) : acc
      in G.M1 (G.K1 (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @m @cr acc' f advised))
 
 instance
@@ -928,7 +837,7 @@   (Multicurryable as e_ m r advised, All ca as, cr r, Monad m) =>
   AdvisedComponent Terminal ca e_ m cr advised
   where
-  _adviseComponent acc f advised = advise @ca @e_ @m (f acc) advised
+  _adviseComponent acc f advised = advise @ca @e_ @m (f (N.fromList acc)) advised
 
 instance
   AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised =>
@@ -948,7 +857,7 @@ -- which represent the record types and fields names we have
 -- traversed until arriving at the advised function. This info can be useful for
 -- logging advices. It's a list instead of a single tuple because
--- 'adviseRecord' works recursively.
+-- 'adviseRecord' works recursively. The elements come innermost-first.
 --
 -- __/TYPE APPLICATION REQUIRED!/__ The @ca@ constraint on function arguments
 -- and the @cr@ constraint on the result type must be supplied by means of a
@@ -957,7 +866,7 @@   forall ca cr e_ m advised.
   AdvisedRecord ca e_ m cr advised =>
   -- | The advice to apply.
-  (forall r . cr r => [(TypeRep, String)] -> Advice ca e_ m r) ->
+  (forall r . cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) ->
   -- | The record to advise recursively.
   advised (DepT e_ m) ->
   -- | The advised record.
@@ -1037,3 +946,22 @@ -- These functions are helpers for running 'DepT' computations, beyond what 'runDepT' provides.
 --
 -- They aren't directly related to 'Advice's, but they require some of the same machinery, and that's why they are here.
+
+-- | An advice that is polymorphic on the environment (allowing it to unify
+-- with 'Control.Monad.Dep.NilEnv') can be converted to a "simple" 'Control.Monad.Dep.SimpleAdvice.Advice' that doesn't require 'Control.Monad.Dep.DepT' at all. 
+toSimple :: Monad m => Advice ca NilEnv m r -> SA.Advice ca m r
+toSimple (Advice f) = SA.Advice \args -> lift do
+    (withExecution, args') <- f args `runDepT` NilEnv
+    let withExecution' = lift . flip runDepT NilEnv . withExecution . lift . SA.runAspectT
+    pure (withExecution', args')
+
+-- | Convert a simple 'Control.Monad.Dep.SimpleAdvice.Advice' whose monad unifies with `DepT e_ m` into an 'Advice'.
+fromSimple :: forall ca e_ m r. Monad m => (e_ (DepT e_ m) -> SA.Advice ca (DepT e_ m) r) -> Advice ca e_ m r
+fromSimple makeAdvice = Advice \args -> do
+    env <- ask
+    case makeAdvice env of
+        SA.Advice f -> do
+            let SA.AspectT argsAction = f args
+            (tweakExecution, args') <- argsAction
+            pure (coerce tweakExecution, args')
+

@@ -7,21 +7,17 @@ {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE BlockArguments #-}
 
 
 -- |
--- This module contains examples of simple advices.
+-- This module contains basic examples advices.
 --
 -- __/BEWARE!/__ These are provided for illustrative purposes only, they
 -- strive for simplicity and not robustness or efficiency.
 module Control.Monad.Dep.Advice.Basic
   ( -- * Basic advices
-    returnMempty,
-    printArgs,
-    doLocally,
-    AnyEq (..),
-    doCachingBadly,
-    doAsyncBadly
+    doLocally
   )
 where
 
@@ -53,7 +49,7 @@ -- >>> import Control.Monad
 -- >>> import Control.Monad.Dep
 -- >>> import Control.Monad.Dep.Advice
--- >>> import Control.Monad.Dep.Advice.Basic (printArgs,returnMempty)
+-- >>> import Control.Monad.Dep.Advice.Basic
 -- >>> import Data.Kind
 -- >>> import Data.SOP
 -- >>> import Data.SOP.NP
@@ -62,31 +58,6 @@ -- >>> import Data.IORef
 
 
-
--- | Makes functions discard their result and always return 'mempty'.
---
-returnMempty :: forall ca e_ m r. (Monad m, Monoid r) => Advice ca e_ m r
-returnMempty =
-  makeExecutionAdvice
-    ( \action -> do
-        _ <- action
-        pure (mempty :: r)
-    )
-
--- | Given a 'Handle' and a prefix string, makes functions print their
--- arguments to the 'Handle'.
---
-printArgs :: forall e_ m r. MonadIO m => Handle -> String -> Advice Show e_ m r
-printArgs h prefix =
-  makeArgsAdvice
-    ( \args -> do
-        liftIO $ hPutStr h $ prefix ++ ":"
-        hctraverse_ (Proxy @Show) (\(I a) -> liftIO (hPutStr h (" " ++ show a))) args
-        liftIO $ hPutStrLn h "\n"
-        liftIO $ hFlush h
-        pure args
-    )
-
 -- | Use 'local' on the final 'DepT' action of a function.
 --
 -- Allows tweaking the environment that will be seen by the function and all of
@@ -131,65 +102,7 @@ --  >>> runFromEnv (pure envIO) _controllerB 0
 --  logger2 ran
 --
-doLocally :: forall ca e_ m r. Monad m => (forall n. e_ n -> e_ n) -> Advice ca e_ m r 
+doLocally :: forall ca e_ m r. Monad m => (e_ (DepT e_ m) -> e_ (DepT e_ m)) -> Advice ca e_ m r 
 doLocally transform = makeExecutionAdvice (local transform)  
-
-
--- | A helper datatype for universal equality comparisons of existentialized values, used by 'doCachingBadly'.
---
--- For a more complete elaboration of this idea, see the the \"exinst\" package.
-data AnyEq where
-  AnyEq :: forall a. (Typeable a, Eq a) => a -> AnyEq
-
-instance Eq AnyEq where
-  AnyEq any1 == AnyEq any2 =
-    case testEquality (typeOf any1) (typeOf any2) of
-      Nothing -> False
-      Just Refl -> any1 == any2
-
--- | 
--- Given the means for looking up and storing @r@ values in the underlying
--- monad @m@, makes functions (inefficiently) cache their results.
---
--- The monad @m@ and the result type @r@ must be known before building the
--- advice. So, once built, this 'Advice' won't be polymorphic over them.
---
--- The implementation of this function makes use of the existential type
--- parameter @u@ of 'makeAdvice', because the phase that processes the function
--- arguments needs to communicate the calculated `AnyEq` cache key to the phase
--- that processes the function result.
---
--- A better implementation of this advice would likely use an @AnyHashable@
--- helper datatype for the keys.
-doCachingBadly :: forall e_ m r. Monad m => (AnyEq -> m (Maybe r)) -> (AnyEq -> r -> m ()) -> Advice (Eq `And` Typeable) e_ m r
-doCachingBadly cacheLookup cachePut =
-  makeAdvice @AnyEq
-    ( \args ->
-        let key = AnyEq $ cfoldMap_NP (Proxy @(And Eq Typeable)) (\(I a) -> [AnyEq a]) $ args
-         in pure (key, args)
-    )
-    ( \key action -> do
-        mr <- lift $ cacheLookup key
-        case mr of
-          Nothing -> do
-            r <- action
-            lift $ cachePut key r
-            pure r
-          Just r ->
-            pure r
-    )
-
--- | Makes functions that return `()` launch asynchronously.
---
--- A better implementation of this advice would likely use the \"async\"
--- package instead of bare `forkIO`. 
---
--- The @IO@ monad could be generalized to @MonadUnliftIO@.
-doAsyncBadly :: forall ca e_ . Advice ca e_ IO ()
-doAsyncBadly = makeExecutionAdvice (\action -> do
-        e <- ask 
-        _ <- liftIO $ forkIO $ runDepT action e
-        pure ()
-    )
 
 

@@ -0,0 +1,495 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE BlockArguments #-}
+
+-- | 
+--    This module provides the 'Advice' datatype, along for functions for creating,
+--    manipulating, composing and applying values of that type.
+--
+--    'Advice's are type-preserving transformations on effectful functions of
+--    any number of arguments.
+--
+--    For example, assuming we have a record-of-functions like
+--
+-- >>> :{
+--    data Env m = Env {
+--      foo :: m ()
+--    , bar :: Int -> m (Maybe Char)
+--    , baz :: Int -> Bool -> m Char
+--    } deriving Generic
+--    env :: Env IO
+--    env = Env {
+--      foo = pure ()
+--    , bar = \_ -> pure (Just 'c')
+--    , baz = \_ _ -> pure 'i'
+--    }
+-- :}
+--
+-- We can modify all the functions in the record in this way:
+--
+-- >>> :{
+--    env' :: Env IO
+--    env' = env & advising (adviseRecord @_ @Top \_ -> printArgs stdout "prefix ")
+-- :}
+--
+-- using the 'Control.Monad.Dep.SimpleAdvice.Basic.printArgs' advice. 
+--
+-- Or modify an individual function in this way:
+--
+-- >>> :{
+--    env' :: Env IO
+--    env' = env & advising \env -> env { 
+--          bar = advise (printArgs stdout "prefix ") (bar env)
+--      } 
+-- :}
+--
+-- __NOTE__:
+--
+-- This module is an alternative to "Control.Monad.Dep.Advice" with two advantages:
+--
+-- - It doesn't use 'Control.Monad.Dep.DepT'. The types are simpler because
+--   they don't need to refer to 'Control.Monad.Dep.DepT''s environment.
+--
+-- - Unlike in "Control.Monad.Dep.Advice", we can advise components
+--   which work on a fixed concrete monad like 'IO'.
+--
+-- Compared with "Control.Monad.Dep.Advice", it does require the extra step
+-- of invoking the 'advising' helper function on a record-of-functions.
+module Control.Monad.Dep.SimpleAdvice
+  ( -- * Preparing components for being advised
+    advising,
+    AspectT (..),
+    -- * The Advice type
+    Advice,
+
+    -- * Creating Advice values
+    makeAdvice,
+    makeArgsAdvice,
+    makeExecutionAdvice,
+
+    -- * Applying Advices
+    advise,
+
+    -- * Harmonizing Advice argument constraints
+    -- $restrict
+    restrictArgs,
+
+    -- * Advising entire records
+    -- $records
+    adviseRecord,
+
+    -- * "sop-core" re-exports
+    -- $sop
+    Top,
+    And,
+    All,
+    NP (..),
+    I (..),
+    cfoldMap_NP,
+    Dict (..),
+  )
+where
+
+import Data.Coerce
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.Dep.Has
+import Data.Functor.Identity
+import Data.Kind
+import Data.List.NonEmpty qualified as N
+import Data.SOP
+import Data.SOP.Dict
+import Data.SOP.NP
+import Data.List.NonEmpty
+import Data.Typeable
+import GHC.Generics qualified as G
+import GHC.TypeLits
+import Control.Applicative
+import Control.Monad.Cont.Class
+import Control.Monad.Error.Class
+import Control.Monad.IO.Unlift
+import Control.Monad.State.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Identity
+import Control.Monad.Writer.Class
+import Control.Monad.Zip
+import Control.Monad.Dep.SimpleAdvice.Internal 
+
+-- $setup
+--
+-- >>> :set -XTypeApplications
+-- >>> :set -XStandaloneKindSignatures
+-- >>> :set -XMultiParamTypeClasses
+-- >>> :set -XFunctionalDependencies
+-- >>> :set -XRankNTypes
+-- >>> :set -XTypeOperators
+-- >>> :set -XConstraintKinds
+-- >>> :set -XNamedFieldPuns
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XDerivingStrategies
+-- >>> :set -XGeneralizedNewtypeDeriving
+-- >>> :set -XDataKinds
+-- >>> :set -XScopedTypeVariables
+-- >>> :set -XDeriveGeneric
+-- >>> :set -XImportQualifiedPost
+-- >>> import Control.Monad
+-- >>> import Control.Monad.Dep
+-- >>> import Control.Monad.Dep.SimpleAdvice
+-- >>> import Control.Monad.Dep.SimpleAdvice.Basic (printArgs,returnMempty)
+-- >>> import Control.Monad.Writer
+-- >>> import Data.Kind
+-- >>> import Data.SOP
+-- >>> import Data.SOP.NP
+-- >>> import Data.Monoid
+-- >>> import System.IO
+-- >>> import Data.IORef
+-- >>> import GHC.Generics (Generic)
+-- >>> import GHC.Generics qualified
+-- >>> import Data.Function
+
+
+-- |
+--    The most general way of constructing 'Advice's.
+--
+--    An 'Advice' receives the arguments of the advised
+--    function packed into an n-ary product 'NP', performs some 
+--    effects based on them, and returns a potentially modified version of the 
+--    arguments, along with a function for tweaking the execution of the
+--    advised function.
+--
+-- >>> :{
+--  doesNothing :: forall ca m r. Monad m => Advice ca m r
+--  doesNothing = makeAdvice (\args -> pure (id, args)) 
+-- :}
+--
+--
+makeAdvice ::
+  forall ca m r.
+    -- | The function that tweaks the arguments and the execution.
+    ( forall as.
+      All ca as =>
+      NP I as ->
+      AspectT m (AspectT m r -> AspectT m r, NP I as)
+    ) ->
+    Advice ca m r
+makeAdvice = Advice
+
+-- |
+--    Create an advice which only tweaks and/or analyzes the function arguments.
+--
+-- >>> :{
+--  doesNothing :: forall ca m r. Monad m => Advice ca m r
+--  doesNothing = makeArgsAdvice pure
+-- :}
+makeArgsAdvice ::
+  forall ca m r.
+  Monad m =>
+  -- | The function that tweaks the arguments.
+  ( forall as.
+    All ca as =>
+    NP I as ->
+    AspectT m (NP I as)
+  ) ->
+  Advice ca m r
+makeArgsAdvice tweakArgs =
+  makeAdvice $ \args -> do
+    args' <- tweakArgs args
+    pure (id, args')
+
+-- |
+--    Create an advice which only tweaks the execution of the final monadic action.
+--
+-- >>> :{
+--  doesNothing :: forall ca m r. Monad m => Advice ca m r
+--  doesNothing = makeExecutionAdvice id
+-- :}
+makeExecutionAdvice ::
+  forall ca m r.
+  Applicative m =>
+  -- | The function that tweaks the execution.
+  ( AspectT m r ->
+    AspectT m r
+  ) ->
+  Advice ca m r
+makeExecutionAdvice tweakExecution = makeAdvice \args -> pure (tweakExecution, args)
+
+
+-- | Apply an 'Advice' to some compatible function. The function must have its
+-- effects in 'AspectT', and all of its arguments must satisfy the @ca@ constraint.
+--
+-- >>> :{
+--  foo :: Int -> AspectT IO String
+--  foo _ = pure "foo"
+--  advisedFoo = advise (printArgs stdout "Foo args: ") foo
+-- :}
+--
+-- __/TYPE APPLICATION REQUIRED!/__ If the @ca@ constraint of the 'Advice' remains polymorphic,
+-- it must be supplied by means of a type application:
+--
+-- >>> :{
+--  bar :: Int -> AspectT IO String
+--  bar _ = pure "bar"
+--  advisedBar1 = advise (returnMempty @Top) bar
+--  advisedBar2 = advise @Top returnMempty bar
+-- :}
+advise ::
+  forall ca m r as advisee.
+  (Multicurryable as m r advisee, All ca as, Monad m) =>
+  -- | The advice to apply.
+  Advice ca m r ->
+  -- | A function to be adviced.
+  advisee ->
+  advisee
+advise (Advice f) advisee = do
+  let uncurried = multiuncurry @as @m @r advisee
+      uncurried' args = do
+        (tweakExecution, args') <- f args
+        tweakExecution (uncurried args')
+   in multicurry @as @m @r uncurried'
+
+-- | This function \"installs\" an 'AspectT' newtype wrapper for the monad
+-- parameter of a record-of-functions, applies some function on
+-- the tweaked component, and then removes the wrapper from the result.
+--
+-- This is necessary because the typeclass machinery which handles
+-- 'Advice's uses 'AspectT' as a \"mark\" to recognize \"the end of the function\".
+advising 
+    :: Coercible (r_ m) (r_ (AspectT m)) =>
+    -- | transform the record coerced to 'AspectT', for example using 'adviseRecord'
+    (r_ (AspectT m) -> r_ (AspectT m)) ->
+    -- | transform the original record
+    r_ m -> r_ m
+advising f = coerce . f . coerce
+
+type Multicurryable ::
+  [Type] ->
+  (Type -> Type) ->
+  Type ->
+  Type ->
+  Constraint
+class Multicurryable as m r curried | curried -> as m r where
+  multiuncurry :: curried -> NP I as -> AspectT m r
+  multicurry :: (NP I as -> AspectT m r) -> curried
+
+instance Monad m => Multicurryable '[] m r (AspectT m r) where
+  multiuncurry action Nil = action
+  multicurry f = f Nil
+
+instance Multicurryable as m r curried => Multicurryable (a ': as) m r (a -> curried) where
+  multiuncurry f (I a :* as) = multiuncurry @as @m @r @curried (f a) as
+  multicurry f a = multicurry @as @m @r @curried (f . (:*) (I a))
+
+-- $restrict
+--
+--    'Advice' values can be composed using the 'Monoid' instance, but only if
+--    they have the same type parameters. It's unfortunate that—unlike with
+--    normal function constraints—the @ca@ constraints of an 'Advice' aren't
+--    automatically "collected" during composition.
+--
+--    Instead, we need to harmonize the @ca@ constraints of each 'Advice' by
+--    turning them into the combination of all constraints. 'restrictArgs'
+--    helps with that.
+--
+--    'restrictArgs' takes as parameter value-level "\evidence\" that one
+--    constraint implies another. But how to construct such evidence? By using
+--    the 'Dict' GADT, more precisely the deceptively simple-looking term
+--    @\\Dict -> Dict@. That function "absorbs" some constraint present in the
+--    ambient context and re-packages it a a new constraint that is implied by
+--    the former. We can't rely on type inference here; we need to provide
+--    enough type information to the GADT, be it as an explicit signature:
+--
+-- >>> :{
+--  stricterPrintArgs :: forall m r. MonadIO m => Advice (Show `And` Eq `And` Ord) m r
+--  stricterPrintArgs = restrictArgs (\Dict -> Dict) (printArgs stdout "foo")
+-- :}
+--
+--    or with a type application to 'restrictArgs':
+--
+-- >>> stricterPrintArgs = restrictArgs @(Show `And` Eq `And` Ord) (\Dict -> Dict) (printArgs stdout "foo")
+
+-- | Makes the constraint on the arguments more restrictive.
+restrictArgs ::
+  forall more less m r.
+  -- | Evidence that one constraint implies the other. Every @x@ that has a @more@ instance also has a @less@ instance.
+  (forall x. Dict more x -> Dict less x) ->
+  -- | Advice with less restrictive constraint on the args.
+  Advice less m r ->
+  -- | Advice with more restrictive constraint on the args.
+  Advice more m r
+-- about the order of the type parameters... which is more useful?
+-- A possible principle to follow:
+-- We are likely to know the "less" constraint, because advices are likely to
+-- come pre-packaged and having a type signature.
+-- We arent' so sure about having a signature for a whole composed Advice,
+-- because the composition might be done
+-- on the fly, while constructing a record, without a top-level binding with a
+-- type signature.  This seems to favor putting "more" first.
+restrictArgs evidence (Advice advice) = Advice \args ->
+    let advice' :: forall as. All more as => NP I as -> AspectT m (AspectT m r -> AspectT m r, NP I as)
+        advice' args' =
+            case Data.SOP.Dict.mapAll @more @less evidence of
+               f -> case f (Dict @(All more) @as) of
+                        Dict -> advice args'
+     in advice' args
+
+
+-- advising *all* fields of a record
+--
+--
+type AdvisedRecord :: (Type -> Constraint) -> (Type -> Type) -> (Type -> Constraint) -> ((Type -> Type) -> Type) -> Constraint
+class AdvisedRecord ca m cr advised where
+  _adviseRecord :: [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca m r) -> advised (AspectT m) -> advised (AspectT m)
+
+type AdvisedProduct :: (Type -> Constraint) -> (Type -> Type) -> (Type -> Constraint) -> (k -> Type) -> Constraint
+class AdvisedProduct ca m cr advised_ where
+  _adviseProduct :: TypeRep -> [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca m r) -> advised_ k -> advised_ k
+
+instance
+  ( G.Generic (advised (AspectT m)),
+    -- G.Rep (advised (AspectT m)) ~ G.D1 ('G.MetaData name mod p nt) (G.C1 y advised_),
+    G.Rep (advised (AspectT m)) ~ G.D1 x (G.C1 y advised_),
+    Typeable advised,
+    AdvisedProduct ca m cr advised_
+  ) =>
+  AdvisedRecord ca m cr advised
+  where
+  _adviseRecord acc f unadvised =
+    let G.M1 (G.M1 unadvised_) = G.from unadvised
+        advised_ = _adviseProduct @_ @ca @m @cr (typeRep (Proxy @advised)) acc f unadvised_
+     in G.to (G.M1 (G.M1 advised_))
+
+instance
+  ( AdvisedProduct ca m cr advised_left,
+    AdvisedProduct ca m cr advised_right
+  ) =>
+  AdvisedProduct ca m cr (advised_left G.:*: advised_right)
+  where
+  _adviseProduct tr acc f (unadvised_left G.:*: unadvised_right) = _adviseProduct @_ @ca @m @cr tr acc f unadvised_left G.:*: _adviseProduct @_ @ca @m @cr tr acc f unadvised_right
+
+data RecordComponent
+  = Terminal
+  | IWrapped
+  | Recurse
+
+type DiscriminateAdvisedComponent :: Type -> RecordComponent
+type family DiscriminateAdvisedComponent c where
+  DiscriminateAdvisedComponent (a -> b) = Terminal
+  DiscriminateAdvisedComponent (AspectT m x) = Terminal
+  DiscriminateAdvisedComponent (Identity _) = IWrapped
+  DiscriminateAdvisedComponent (I _) = IWrapped
+  DiscriminateAdvisedComponent _ = Recurse
+
+type AdvisedComponent :: RecordComponent -> (Type -> Constraint) -> (Type -> Type) -> (Type -> Constraint) -> Type -> Constraint
+class AdvisedComponent component_type ca m cr advised where
+  _adviseComponent :: [(TypeRep, String)] -> (forall r. cr r => NonEmpty (TypeRep, String) -> Advice ca m r) -> advised -> advised
+
+instance
+  ( AdvisedComponent (DiscriminateAdvisedComponent advised) ca m cr advised,
+    KnownSymbol fieldName
+  ) =>
+  AdvisedProduct ca m cr (G.S1 ( 'G.MetaSel ( 'Just fieldName) su ss ds) (G.Rec0 advised))
+  where
+  _adviseProduct tr acc f (G.M1 (G.K1 advised)) =
+    let acc' = (tr, symbolVal (Proxy @fieldName)) : acc
+     in G.M1 (G.K1 (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @m @cr acc' f advised))
+
+instance
+  AdvisedRecord ca m cr advisable =>
+  AdvisedComponent Recurse ca m cr (advisable (AspectT m))
+  where
+  _adviseComponent acc f advised = _adviseRecord @ca @m @cr acc f advised
+
+instance
+  (Multicurryable as m r advised, All ca as, cr r, Monad m) =>
+  AdvisedComponent Terminal ca m cr advised
+  where
+  _adviseComponent acc f advised = advise @ca @m (f (Data.List.NonEmpty.fromList acc)) advised
+
+instance
+  AdvisedComponent (DiscriminateAdvisedComponent advised) ca m cr advised =>
+  AdvisedComponent IWrapped ca m cr (Identity advised)
+  where
+  _adviseComponent acc f (Identity advised) = Identity (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @m @cr acc f advised)
+
+instance
+  AdvisedComponent (DiscriminateAdvisedComponent advised) ca m cr advised =>
+  AdvisedComponent IWrapped ca m cr (I advised)
+  where
+  _adviseComponent acc f (I advised) = I (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @m @cr acc f advised)
+
+-- | Gives 'Advice' to all the functions in a record-of-functions.
+--
+-- The function that builds the advice receives a list of tuples @(TypeRep, String)@
+-- which represent the record types and fields names we have
+-- traversed until arriving at the advised function. This info can be useful for
+-- logging advices. It's a list instead of a single tuple because
+-- 'adviseRecord' works recursively. The elements come innermost-first.
+--
+-- __/TYPE APPLICATION REQUIRED!/__ The @ca@ constraint on function arguments
+-- and the @cr@ constraint on the result type must be supplied by means of a
+-- type application. Supply 'Top' if no constraint is required.
+adviseRecord ::
+  forall ca cr m advised.
+  AdvisedRecord ca m cr advised =>
+  -- | The advice to apply.
+  (forall r . cr r => NonEmpty (TypeRep, String) -> Advice ca m r) ->
+  -- | The record to advise recursively.
+  advised (AspectT m) ->
+  -- | The advised record.
+  advised (AspectT m)
+adviseRecord = _adviseRecord @ca @m @cr []
+
+-- $sop
+-- Some useful definitions re-exported the from \"sop-core\" package.
+--
+-- 'NP' is an n-ary product used to represent the arguments of advised functions.
+--
+-- 'I' is an identity functor. The arguments processed by an 'Advice' come wrapped in it.
+--
+-- 'cfoldMap_NP' is useful to construct homogeneous lists out of the 'NP' product, for example:
+--
+-- >>> cfoldMap_NP (Proxy @Show) (\(I a) -> [show a]) (I False :* I (1::Int) :* Nil)
+-- ["False","1"]
+
+-- $constraints
+--
+-- Some useful definitions re-exported the from \"constraints\" package.
+--
+-- 'Dict' and '(:-)' are GADTs used to capture and transform constraints. Used in the 'restrictArgs' function.
+
+-- $constrainthelpers
+--
+-- To help with the constraint @ca@ that parameterizes 'Advice', this library re-exports the following helpers from \"sop-core\":
+--
+-- * 'Top' is the \"always satisfied\" constraint, useful when whe don't want to require anything specific in @ca@.
+--
+-- * 'And' combines two constraints so that an 'Advice' can request them both, for example @Show \`And\` Eq@.
+--
+-- Also, the 'All' constraint says that some constraint is satisfied by all the
+-- components of an 'NP' product. It's in scope when processing the function
+-- arguments inside an 'Advice'.
+
+-- $invocation
+-- These functions are helpers for running 'AspectT' computations, beyond what 'runAspectT' provides.
+--
+-- They aren't directly related to 'Advice's, but they require some of the same machinery, and that's why they are here.

@@ -0,0 +1,141 @@+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE BlockArguments #-}
+
+-- |
+-- This module contains basic examples advices.
+--
+-- __/BEWARE!/__ These are provided for illustrative purposes only, they
+-- strive for simplicity and not robustness or efficiency.
+module Control.Monad.Dep.SimpleAdvice.Basic
+  ( -- * Basic advices
+    returnMempty,
+    printArgs,
+    AnyEq (..),
+    doCachingBadly,
+    doAsyncBadly
+  )
+where
+
+import Control.Monad.Dep
+import Control.Monad.Dep.SimpleAdvice
+import Data.Proxy
+import Data.SOP
+import Data.SOP (hctraverse_)
+import Data.SOP.NP
+import Data.Type.Equality
+import System.IO
+import Type.Reflection
+import Control.Concurrent
+import Control.Monad.IO.Unlift
+
+-- $setup
+--
+-- >>> :set -XTypeApplications
+-- >>> :set -XStandaloneKindSignatures
+-- >>> :set -XMultiParamTypeClasses
+-- >>> :set -XFunctionalDependencies
+-- >>> :set -XRankNTypes
+-- >>> :set -XTypeOperators
+-- >>> :set -XConstraintKinds
+-- >>> :set -XNamedFieldPuns
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XFlexibleInstances
+-- >>> :set -XAllowAmbiguousTypes
+-- >>> :set -XBlockArguments
+-- >>> import Control.Monad
+-- >>> import Control.Monad.Dep
+-- >>> import Control.Monad.Dep.SimpleAdvice
+-- >>> import Control.Monad.Dep.SimpleAdvice.Basic (printArgs,returnMempty)
+-- >>> import Data.Kind
+-- >>> import Data.SOP
+-- >>> import Data.SOP.NP
+-- >>> import Data.Monoid
+-- >>> import System.IO
+-- >>> import Data.IORef
+
+
+
+-- | Makes functions discard their result and always return 'mempty'.
+--
+returnMempty :: forall ca m r. (Monad m, Monoid r) => Advice ca m r
+returnMempty =
+  makeExecutionAdvice
+    ( \action -> do
+        _ <- action
+        pure (mempty :: r)
+    )
+
+-- | Given a 'Handle' and a prefix string, makes functions print their
+-- arguments to the 'Handle'.
+--
+printArgs :: forall m r. MonadIO m => Handle -> String -> Advice Show m r
+printArgs h prefix =
+  makeArgsAdvice
+    ( \args -> do
+        liftIO $ hPutStr h $ prefix ++ ":"
+        hctraverse_ (Proxy @Show) (\(I a) -> liftIO (hPutStr h (" " ++ show a))) args
+        liftIO $ hPutStrLn h "\n"
+        liftIO $ hFlush h
+        pure args
+    )
+
+-- | A helper datatype for universal equality comparisons of existentialized values, used by 'doCachingBadly'.
+--
+-- For a more complete elaboration of this idea, see the the \"exinst\" package.
+data AnyEq where
+  AnyEq :: forall a. (Typeable a, Eq a) => a -> AnyEq
+
+instance Eq AnyEq where
+  AnyEq any1 == AnyEq any2 =
+    case testEquality (typeOf any1) (typeOf any2) of
+      Nothing -> False
+      Just Refl -> any1 == any2
+
+-- | 
+-- Given the means for looking up and storing @r@ values in the underlying
+-- monad @m@, makes functions (inefficiently) cache their results.
+--
+-- The monad @m@ and the result type @r@ must be known before building the
+-- advice. So, once built, this 'Advice' won't be polymorphic over them.
+--
+-- The implementation of this function makes use of the existential type
+-- parameter @u@ of 'makeAdvice', because the phase that processes the function
+-- arguments needs to communicate the calculated `AnyEq` cache key to the phase
+-- that processes the function result.
+--
+-- A better implementation of this advice would likely use an @AnyHashable@
+-- helper datatype for the keys.
+doCachingBadly :: forall m r. Monad m => (AnyEq -> m (Maybe r)) -> (AnyEq -> r -> m ()) -> Advice (Eq `And` Typeable) m r
+doCachingBadly cacheLookup cachePut = makeAdvice \args ->
+        let key = AnyEq $ cfoldMap_NP (Proxy @(And Eq Typeable)) (\(I a) -> [AnyEq a]) $ args
+            tweakExecution action = do
+                mr <- lift $ cacheLookup key
+                case mr of
+                  Nothing -> do
+                    r <- action
+                    lift $ cachePut key r
+                    pure r
+                  Just r ->
+                    pure r
+         in pure (tweakExecution, args)
+
+-- | Makes functions that return `()` launch asynchronously.
+--
+-- A better implementation of this advice would likely use the \"async\"
+-- package instead of bare `forkIO`. 
+--
+-- The @IO@ monad could be generalized to @MonadUnliftIO@.
+doAsyncBadly :: forall ca m . MonadUnliftIO m => Advice ca m ()
+doAsyncBadly = makeExecutionAdvice \action -> do
+    _ <- withRunInIO (\unlift -> forkIO (unlift action))
+    pure ()
+
+

@@ -0,0 +1,126 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE BlockArguments #-}
+
+module Control.Monad.Dep.SimpleAdvice.Internal where
+
+import Data.Coerce
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.Dep.Has
+import Data.Functor.Identity
+import Data.Kind
+import Data.List.NonEmpty qualified as N
+import Data.SOP
+import Data.SOP.Dict
+import Data.SOP.NP
+import Data.Typeable
+import GHC.Generics qualified as G
+import GHC.TypeLits
+import Control.Applicative
+import Control.Monad.Reader
+import Control.Monad.Cont.Class
+import Control.Monad.Error.Class
+import Control.Monad.IO.Unlift
+import Control.Monad.State.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Identity
+import Control.Monad.Writer.Class
+import Control.Monad.Zip
+
+-- | A generic transformation of 'AspectT'-effectful functions with 
+-- base monad @m@ and return type @r@,
+-- provided the functions satisfy certain constraint @ca@
+-- on all of their arguments.
+--
+-- 'Advice's that don't care about the @ca@ constraint (because they don't
+-- touch function arguments) can leave it polymorphic, and this facilitates
+-- 'Advice' composition, but then the constraint must be given the catch-all
+-- `Top` value (using a type application) at the moment of calling 'advise'.
+--
+-- See "Control.Monad.Dep.SimpleAdvice.Basic" for examples.
+type Advice ::
+  (Type -> Constraint) ->
+  (Type -> Type) ->
+  Type ->
+  Type
+data Advice (ca :: Type -> Constraint) m r where
+  Advice ::
+    forall ca m r.
+    ( forall as.
+      All ca as =>
+      NP I as ->
+      AspectT m (AspectT m r -> AspectT m r, NP I as)
+    ) ->
+    Advice ca m r
+
+
+-- |
+--    'Advice's compose \"sequentially\" when tweaking the arguments, and
+--    \"concentrically\" when tweaking the final 'AspectT' action.
+--
+--    The first 'Advice' is the \"outer\" one. It tweaks the function arguments
+--    first, and wraps around the execution of the second, \"inner\" 'Advice'.
+instance Monad m => Semigroup (Advice ca m r) where
+  Advice outer <> Advice inner = Advice \args -> do
+    (tweakOuter, argsOuter) <- outer args
+    (tweakInner, argsInner) <- inner argsOuter
+    pure (tweakOuter . tweakInner, argsInner)
+
+instance Monad m => Monoid (Advice ca m r) where
+  mappend = (<>)
+  mempty = Advice \args -> pure (id, args)
+
+
+-- | This transformer is isomorphic to 'Control.Monad.Trans.Identity.IdentityT'.
+--
+-- It doesn't really do anything, it only helps the typeclass machinery.
+type AspectT ::
+  (Type -> Type) ->
+  Type ->
+  Type
+newtype AspectT (m :: Type -> Type) (r :: Type) = AspectT {runAspectT :: m r}
+  deriving
+    ( Functor,
+      Applicative,
+      Alternative,
+      Monad,
+      MonadFix,
+      MonadFail,
+      MonadZip,
+      MonadPlus,
+      MonadCont,
+      MonadIO,
+      MonadUnliftIO
+    )
+
+instance MonadTrans AspectT where
+  lift = AspectT 
+
+deriving newtype instance MonadReader env m => MonadReader env (AspectT m)
+deriving newtype instance MonadState s m => MonadState s (AspectT m)
+deriving newtype instance MonadWriter w m => MonadWriter w (AspectT m)
+deriving newtype instance MonadError e m => MonadError e (AspectT m)
+
+data Pair a b = Pair !a !b
+

@@ -5,6 +5,8 @@ main =
   doctest
     [ "-ilib",
-      "lib/Control/Monad/Dep/Advice.hs",
-      "lib/Control/Monad/Dep/Advice/Basic.hs"
+      "lib/Control/Monad/Dep/Advice.hs"
+    , "lib/Control/Monad/Dep/Advice/Basic.hs"
+    , "lib/Control/Monad/Dep/SimpleAdvice.hs"
+    , "lib/Control/Monad/Dep/SimpleAdvice/Basic.hs"
     ]

@@ -0,0 +1,178 @@+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE BlockArguments #-}
+
+module Main (main) where
+
+import Prelude hiding (log)
+import Barbies
+import Control.Monad.Dep
+import Control.Monad.Dep.SimpleAdvice
+import Control.Monad.Dep.SimpleAdvice.Basic
+import Control.Monad.Dep.Has
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Data.List.NonEmpty 
+import Data.Typeable
+import Data.Coerce
+import Data.Functor.Identity
+import Data.Kind
+import Data.List (intercalate)
+import Data.SOP
+import GHC.Generics
+import Test.Tasty
+import Test.Tasty.HUnit
+import Data.IORef
+import System.IO
+
+printArgs' :: forall m r. MonadIO m => Handle -> String -> Advice (Show `And` Eq) m r
+printArgs' h s = restrictArgs (\Dict -> Dict) (printArgs h s) 
+
+-- the "component" we want to decorate
+data Foo m = Foo { 
+        runFoo :: Int -> Bool -> m () 
+    ,   runBar :: m Int
+    ,   runBaz :: Char -> m Char
+    } 
+    deriving stock Generic
+
+fooFunc :: MonadWriter [String] m => Int -> Bool -> m ()  
+fooFunc = \_ _ -> tell ["foo"] 
+
+foo :: MonadWriter [String] m => Foo m
+foo = Foo fooFunc (pure 5) (\_ -> pure 'c')
+
+-- works with functions of any number of arguments
+someAdvice :: MonadWriter [String] m => Advice Top m r 
+someAdvice = makeExecutionAdvice \action -> do
+    tell ["before"]
+    r <- action
+    tell ["after"]
+    pure r
+
+someAdvice' :: MonadWriter [String] m => Advice Top m r 
+someAdvice' = 
+    (makeExecutionAdvice \action -> do
+        r <- action
+        tell ["after"]
+        pure r)
+    <>
+    (makeExecutionAdvice \action -> do
+        tell ["before"]
+        r <- action
+        pure r)
+
+advisedFoo :: MonadWriter [String] m => Foo m
+advisedFoo = advising (adviseRecord @Top @Top \_ -> someAdvice) foo
+
+-- Unlike regular advices, which require decorated
+-- functions to be sufficiently polymorphic,
+-- "simple" advices can decorate
+-- non-DepT *concrete* monads.
+concreteFoo :: IORef [String] -> Foo IO
+concreteFoo ref = Foo {
+        runFoo = \_ _ -> modifyIORef ref (\xs -> xs ++ ["foo"])
+    ,   runBar = pure 5
+    ,   runBaz = \_ -> pure 'c'
+    }
+
+refAdvice :: MonadIO m => IORef [String] -> Advice Top m r 
+refAdvice ref = makeExecutionAdvice \action -> do
+    liftIO $ modifyIORef ref (\xs -> xs ++ ["before"])
+    r <- action
+    liftIO $ modifyIORef ref (\xs -> xs ++ ["after"])
+    pure r
+
+concreteAdvisedFoo :: IORef [String] -> Foo IO
+concreteAdvisedFoo ref =
+    advising (adviseRecord @Top @Top \_ -> refAdvice ref) (concreteFoo ref)
+
+printAdvisedFoo :: IORef [String] -> Foo IO
+printAdvisedFoo ref =
+    advising (adviseRecord @_ @Top (\_ -> printArgs' stdout "args: ")) (concreteFoo ref)
+
+--
+-- Stuff for testing the TypeReps in adviseRecord
+data AAA m = AAA { aaa :: BBB m } deriving Generic
+-- just to check that newtypes are handled correctly
+newtype BBB m = BBB { bbb :: CCC m } deriving Generic 
+data CCC m = CCC { ccc :: Int -> Bool ->  m () } deriving Generic
+
+type Trace = Writer [(TypeRep, String)]
+
+tracedEnv :: AAA Trace
+tracedEnv = AAA {
+        aaa = BBB {
+            bbb = CCC { 
+               ccc = \_ _ -> pure () 
+            }
+        }
+    }
+
+doTrace :: NonEmpty (TypeRep, String) -> Advice ca Trace r
+doTrace trace = makeExecutionAdvice \action -> do
+    tell (toList trace) 
+    action
+
+--
+--
+tests :: TestTree
+tests =
+  testGroup
+    "All"
+    [
+      testCase "adviseBare" $
+        assertEqual "" ["before","foo","after"] $
+            let advisedFunc = advise @Top someAdvice fooFunc
+             in execWriter $ runAspectT $ advisedFunc 0 False
+    , testCase "adviseBare_monoid" $
+        assertEqual "" ["before","foo","after"] $
+            let advisedFunc = advise @Top someAdvice' fooFunc
+             in execWriter $ runAspectT $ advisedFunc 0 False
+    , testCase "adviseRecord" $
+        assertEqual "" ["before","foo","after"] $
+          let advised = advising (adviseRecord @Top @Top \_ -> someAdvice) foo
+           in execWriter $ runFoo advised 0 False
+    , testCase "concrete adviseRecord" $ do
+        ref <- newIORef []
+        () <- runFoo (concreteAdvisedFoo ref) 0 False
+        result <- readIORef ref
+        assertEqual "" ["before","foo","after"] result
+    , testCase "print adviseRecord" $ do
+        ref <- newIORef []
+        () <- runFoo (printAdvisedFoo ref) 0 False
+        result <- readIORef ref
+        assertEqual "" ["foo"] result
+    , testCase "trace" $ do
+        let tracedEnv' = advising (adviseRecord @Top @Top doTrace) tracedEnv
+            result = execWriter $ (ccc . bbb . aaa) tracedEnv' 0 False
+            expected = [
+                  (typeRep (Proxy @CCC), "ccc")
+                , (typeRep (Proxy @BBB), "bbb")
+                , (typeRep (Proxy @AAA), "aaa")
+                ]
+        assertEqual "" expected result
+    ]
+
+main :: IO ()
+main = defaultMain tests

@@ -24,6 +24,7 @@ 
 module Main (main) where
 
+import Prelude hiding (log)
 import Control.Monad.Dep
 import Control.Monad.Dep.Has
 import Control.Monad.Dep.Env
@@ -34,11 +35,6 @@ import Control.Monad.RWS
 import Data.Kind
 import Data.List (intercalate,lookup)
-import Rank2 qualified
-import Rank2.TH qualified
-import Test.Tasty
-import Test.Tasty.HUnit
-import Prelude hiding (log)
 import Data.Proxy
 import System.IO
 import GHC.Generics (Generic)
@@ -58,7 +54,8 @@ import Data.IORef
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
-
+import Test.Tasty
+import Test.Tasty.HUnit
 
 --
 --
@@ -91,6 +88,9 @@ makeStdoutLogger :: MonadIO m => MessagePrefix -> env -> Logger m
 makeStdoutLogger prefix _ = Logger (\msg -> liftIO (putStrLn (Text.unpack prefix ++ msg)))
 
+nullLogger :: Applicative m => Logger m
+nullLogger = Logger (\_ -> pure ())
+
 makeInMemoryRepository 
     :: (Has Logger m env, MonadIO m) 
     => IORef (Map Int String) 
@@ -132,20 +132,13 @@           call findById key 
     }
 
--- from purely Has-using to MonadDep-using
--- this is very verbose, how to automate it?
--- makeController'' :: forall e_ m . (Has Logger (DepT e_ m) (e_ (DepT e_ m)), Has Repository (DepT e_ m) (e_ (DepT e_ m)), Monad m) => Controller (DepT e_ m)
--- makeController'' = Controller {
---         create = askFinalDepT $ fmap create makeController
---       , append = askFinalDepT $ fmap append makeController
---       , inspect = askFinalDepT $ fmap inspect makeController
---     }
-
 allocateMap :: ContT () IO (IORef (Map Int String))
 allocateMap = ContT $ bracket (newIORef Map.empty) pure
 
+-- using component in islation. gnarly signature
 makeController''' :: forall e_ m . (Has Logger (DepT e_ m) (e_ (DepT e_ m)), Has Repository (DepT e_ m) (e_ (DepT e_ m)), Monad m) => Controller (DepT e_ m)
 makeController''' = component makeController
+--
 
 type EnvHKD :: (Type -> Type) -> (Type -> Type) -> Type
 data EnvHKD h m = EnvHKD
@@ -157,11 +150,11 @@ 
 deriving via Autowired (EnvHKD Identity m) instance Autowireable r_ m (EnvHKD Identity m) => Has r_ m (EnvHKD Identity m)
 
+type Configurator = Kleisli Parser Value 
+
 parseConf :: FromJSON a => Configurator a
 parseConf = Kleisli parseJSON
 
-type Configurator = Kleisli Parser Value 
-
 type Allocator = ContT () IO
 
 type Phases = Configurator `Compose` Allocator `Compose` Identity
@@ -179,7 +172,12 @@     , controller = 
         skipPhase @Configurator $
         skipPhase @Allocator $ 
-        pure $ component makeController
+        pure $ let c = component makeController 
+                   -- For the create method we'll use nullLogger 
+                   -- instead of the default one, 
+                   -- even in sub-calls to other components.
+                   theAdvice = doLocally \env -> env {logger = pure nullLogger}
+                in c { create = advise theAdvice (create c) }
 }
 
 testEnvConstruction :: Assertion

@@ -13,12 +13,15 @@ {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Main (main) where
 
 import Control.Monad.Dep
 import Control.Monad.Dep.Advice
 import Control.Monad.Dep.Advice.Basic
+import Control.Monad.Dep.SimpleAdvice.Basic
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.RWS
@@ -31,6 +34,9 @@ import Prelude hiding (log)
 import Data.Proxy
 import System.IO
+import Data.List.NonEmpty
+import Data.Typeable
+import GHC.Generics
 
 -- Some helper typeclasses.
 --
@@ -197,17 +203,16 @@ -- Experiment about adding instrumetation
 
 doLogging :: forall e m r. (Ensure HasLogger e m, Monad m) => Advice Show e m r
-doLogging = makeAdvice @()
-        (\args -> do
-            e <- ask
-            let args' = cfoldMap_NP (Proxy @Show) (\(I a) -> [show a]) args
-            logger e $ "advice before: " ++ intercalate "," args'
-            pure (pure args))
-        (\() action -> do 
+doLogging = makeAdvice \args -> do
+    e <- ask
+    let args' = cfoldMap_NP (Proxy @Show) (\(I a) -> [show a]) args
+    logger e $ "advice before: " ++ intercalate "," args'
+    let tweakExecution action = do
             e <- ask
             r <- action
             logger e $ "advice after"
-            pure r)
+            pure r
+    pure (tweakExecution,  args)
 
 advicedEnv :: Env (DepT Env (Writer TestTrace))
 advicedEnv =
@@ -222,9 +227,9 @@ weirdAdvicedEnv :: Env (DepT Env (Writer TestTrace))
 weirdAdvicedEnv =
    env {
-         _controller = advise (doLogging <> returnMempty) (_controller env), --,
+         _controller = advise (doLogging <> fromSimple \_ -> returnMempty) (_controller env), --,
          -- This advice below doesn't really do anything, I'm just experimenting with passing the constraints with type application
-         _logger = advise @(Show `And` Eq) (makeAdvice @() (\args -> pure (pure args)) (\_ -> id)) (_logger env)
+         _logger = advise @(Show `And` Eq) (makeAdvice (\args -> pure (id, args))) (_logger env)
        }
 
 -- type EnsureLoggerAndWriter :: ((Type -> Type) -> Type) -> (Type -> Type) -> Constraint
@@ -248,15 +253,16 @@ 
 -- Checking that constraints on the results are collected "automatically"
 returnMempty' :: forall ca e m r. (Monad m, Monoid r, Show r, Read r) => Advice ca e m r
-returnMempty' = returnMempty
+returnMempty' = fromSimple \_ -> returnMempty
 
 justAResultConstraint :: forall ca e m r. (Monad m, Show r, Read r) => Advice ca e m r
 justAResultConstraint = mempty
 
 returnMempty'' :: forall ca e m r. (Monad m, Monoid r, Show r, Read r) => Advice ca e m r
-returnMempty'' = returnMempty <> justAResultConstraint
+returnMempty'' = fromSimple (\_ -> returnMempty) <> justAResultConstraint
 
-printArgs' = restrictArgs @(Eq `And` Ord `And` Show) (\Dict -> Dict) (printArgs @NilEnv @IO stdout "foo")
+printArgs' :: Advice (Eq `And` Ord `And` Show) e_ IO ()
+printArgs' = restrictArgs @(Eq `And` Ord `And` Show) (\Dict -> Dict) (fromSimple \_ -> printArgs stdout "foo")
  
 -- does EnvConstraint compile?
 
@@ -298,27 +304,50 @@ 
 type ExpensiveComputationMonad = RWS () ([String],()) [(AnyEq,String)]
 
-cacheLookup :: AnyEq -> ExpensiveComputationMonad (Maybe String)
+cacheLookup :: MonadState [(AnyEq,String)] m => AnyEq -> m (Maybe String)
 cacheLookup key = do
     cache <- get
     pure $ lookup key cache
 
-cachePut :: AnyEq -> String -> ExpensiveComputationMonad ()
+cachePut :: MonadState [(AnyEq,String)] m => AnyEq -> String -> m ()
 cachePut key v = modify ((key,v) :)
 
 cacheTestEnv :: CachingTestEnv (DepT CachingTestEnv ExpensiveComputationMonad)
 cacheTestEnv = CachingTestEnv {
         _cacheTestLogic = cacheTestLogic,
-        _expensiveComputation = advise (doCachingBadly cacheLookup cachePut) mkFakeExpensiveComputation,
+        _expensiveComputation = advise (fromSimple \_ -> doCachingBadly cacheLookup cachePut) mkFakeExpensiveComputation,
         _logger2 = mkFakeLogger
     }
 
 expectedCached :: ([String],())
 expectedCached = (["Doing expensive computation","0False","Doing expensive computation","1True","0False","1True"],())
 
+
 --
+-- Stuff for testing the TypeReps in adviseRecord
+data AAA m = AAA { aaa :: BBB m } deriving Generic
+data BBB m = BBB { bbb :: CCC m } deriving Generic
+data CCC m = CCC { ccc :: Int -> Bool ->  m () } deriving Generic
+
+type Trace = Writer [(TypeRep, String)]
+
+tracedEnv :: AAA (DepT AAA Trace)
+tracedEnv = AAA {
+        aaa = BBB {
+            bbb = CCC { 
+               ccc = \_ _ -> pure () 
+            }
+        }
+    }
+
+doTrace :: MonadWriter [(TypeRep, String)] m => NonEmpty (TypeRep, String) -> Advice ca AAA m r
+doTrace trace = makeExecutionAdvice \action -> do
+    tell (toList trace) 
+    action
+
 --
 --
+--
 
 tests :: TestTree
 tests =
@@ -326,15 +355,24 @@     "All"
     [ testCase "hopeThisWorks" $
         assertEqual "" expected $
-          execWriter $ runDepT (do e <- ask; (_controller . _inner) e 7) biggerEnv,
-      testCase "hopeAOPWorks" $
+          execWriter $ runDepT (do e <- ask; (_controller . _inner) e 7) biggerEnv
+    , testCase "hopeAOPWorks" $
         assertEqual "" expectedAdviced $
-          execWriter $ runDepT (do e <- ask; _controller e 7) advicedEnv,
-      testCase "hopeCachingWorks" $
+          execWriter $ runDepT (do e <- ask; _controller e 7) advicedEnv
+    , testCase "hopeCachingWorks" $
         assertEqual "" expectedCached $
           let action = runFromEnv (pure cacheTestEnv) _cacheTestLogic 
               (_,w) = execRWS action () mempty
            in w
+    , testCase "trace" $ do
+        let tracedEnv' = adviseRecord @Top @Top doTrace tracedEnv
+            result = execWriter $ runFromEnv (pure tracedEnv') (ccc . bbb . aaa) 0 False
+            expected = [
+                  (typeRep (Proxy @CCC), "ccc")
+                , (typeRep (Proxy @BBB), "bbb")
+                , (typeRep (Proxy @AAA), "aaa")
+                ]
+        assertEqual "" expected result
     ]
 
 main :: IO ()