dep-t-advice 0.5.0.0 → 0.5.1.0

raw patch · 18 files changed

+2352/−1846 lines, 18 filesdep +microlensdep ~dep-tPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: microlens

Dependency ranges changed: dep-t

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README.md +8/−4
• dep-t-advice.cabal +18/−6
• lib/Control/Monad/Dep/Advice.hs +4/−964
• lib/Control/Monad/Dep/Advice/Basic.hs +4/−105
• lib/Control/Monad/Dep/SimpleAdvice.hs +4/−491
• lib/Control/Monad/Dep/SimpleAdvice/Basic.hs +4/−138
• lib/Control/Monad/Dep/SimpleAdvice/Internal.hs +0/−126
• lib/Dep/Advice.hs +972/−0
• lib/Dep/Advice/Basic.hs +108/−0
• lib/Dep/SimpleAdvice.hs +495/−0
• lib/Dep/SimpleAdvice/Basic.hs +238/−0
• lib/Dep/SimpleAdvice/Internal.hs +126/−0
• test/simple-advice-tests.hs +3/−3
• test/synthetic-callstack-tests.hs +349/−0
• test/tests-has-conversion.hs +4/−4
• test/tests.hs +3/−3
• test/weird-advice-tests.hs +2/−2

@@ -1,5 +1,15 @@ # Revision history for dep-t-advice
 
+## 0.5.1.0 
+
+* `Control.Monad.whatever` renamed to `whatever`. 
+
+  The old modules still remain, but deprecated.
+
+* Added `fromSimple_`.
+
+* Added `injectFailures` and `keepCallStack`.
+
 ## 0.5.0.0 
 
 * The Advice type has changed to get rid of the existential type.

@@ -6,6 +6,8 @@ functions in your record-of-functions, in a way that is composable and
 independent of each function's particular number of arguments.
 
+[![dep-t-advice.png](https://i.postimg.cc/L8Cm279S/dep-t-advice.png)](https://postimg.cc/tsxKzBnv)
+
 ## Rationale
 
 So, you have decided to structure your program in a record-of-functions style,
@@ -118,20 +120,22 @@ 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`?
+## What about `Dep.SimpleAdvice`?
 
-`Advice`s form `Control.Monad.Dep.Advice` work with the `DepT` monad, but
+`Advice`s form `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
+`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).
+through [`fixEnv`](https://hackage.haskell.org/package/dep-t-0.5.0.0/docs/Control-Monad-Dep-Env.html#v:fixEnv).
 
 There are conversion functions between the two versions of `Advice`.
+
+See [this thread](https://discourse.haskell.org/t/decorate-your-records-of-functions-with-this-weird-trick/3675) in the Haskell Discourse for more info.
 
 ## Historical aside
 

@@ -1,8 +1,8 @@ cabal-version:       3.0
 
 name:                dep-t-advice
-version:             0.5.0.0
-synopsis:            Giving good advice to functions in a record-of-functions.
+version:             0.5.1.0
+synopsis:            Giving good advice to functions in records-of-functions.
 description:         
                      Companion to the dep-t package. Easily add behaviour to
                      functions living in a record-of-functions, whatever the
@@ -30,7 +30,7 @@   build-depends:       base >=4.10.0.0 && < 5,
                        sop-core ^>= 0.5.0.0,
                        transformers ^>= 0.5.0.0,
-                       dep-t ^>= 0.5.0.0,
+                       dep-t >= 0.5.1.0 && < 0.6,
                        mtl ^>= 2.2,
                        unliftio-core ^>= 0.2.0.0,
   default-language:    Haskell2010
@@ -54,11 +54,16 @@ 
 library
   import: common
-  exposed-modules:     Control.Monad.Dep.Advice
+  exposed-modules:     Dep.Advice
+                       Dep.Advice.Basic
+                       Dep.SimpleAdvice
+                       Dep.SimpleAdvice.Basic
+                       -- deprecated
+                       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    
+  other-modules:       Dep.SimpleAdvice.Internal    
                         
   hs-source-dirs:      lib 
 
@@ -81,13 +86,20 @@   build-depends:       
                        barbies            ^>= 2.0.2.0
 
-
 test-suite tests-has-conversion
   import:              common-tasty
   type:                exitcode-stdio-1.0
   main-is:             tests-has-conversion.hs
   build-depends:       aeson,
                        containers
+
+test-suite synthetic-callstack-tests
+  import:              common-tasty
+  type:                exitcode-stdio-1.0
+  main-is:             synthetic-callstack-tests.hs
+  build-depends:       aeson,
+                       containers,
+                       microlens ^>= 0.4.12.0
 
 -- VERY IMPORTANT for doctests to work: https://stackoverflow.com/a/58027909/1364288
 -- http://hackage.haskell.org/package/cabal-doctest

@@ -1,967 +1,7 @@-{-# 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 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 'DepT'-effectful functions of
---    any number of arguments.
---
--- >>> :{
---    foo0 :: DepT NilEnv IO (Sum Int)
---    foo0 = pure (Sum 5)
---    foo1 :: Bool -> DepT NilEnv IO (Sum Int)
---    foo1 _ = foo0
---    foo2 :: Char -> Bool -> DepT NilEnv IO (Sum Int)
---    foo2 _ = foo1
--- :}
---
--- They work for @DepT@-actions of zero arguments:
---
--- >>> 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 (fromSimple \_ -> printArgs stdout "foo1") foo1 False `runDepT` NilEnv
--- foo1: False
--- <BLANKLINE>
--- Sum {getSum = 5}
---
--- >>> 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 (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 (fromSimple \_ -> printArgs stdout "foo2" <> returnMempty) foo2 'd' False `runDepT` NilEnv
--- foo2: 'd' False
--- <BLANKLINE>
--- Sum {getSum = 0}
---
--- Although sometimes composition might require harmonizing the constraints
--- each 'Advice' places on the arguments, if they differ.
-module Control.Monad.Dep.Advice
-  ( -- * The Advice type
-    Advice,
-
-    -- * Creating Advice values
-    makeAdvice,
-    makeArgsAdvice,
-    makeExecutionAdvice,
-
-    -- * Applying Advices
-    advise,
-
-    -- * Constraint helpers
-    -- $constrainthelpers
-    Ensure,
-
-    -- * Harmonizing Advice argument constraints
-    -- $restrict
-    restrictArgs,
-
-    -- * Invocation helpers
-    -- $invocation
-    runFinalDepT,
-    runFromEnv,
-    runFromDep,
-    -- askFinalDepT,
-    -- * Making functions see a different environment
-    deceive,
-
-    -- * Advising and deceiving entire records
-    -- $records
-    adviseRecord,
-    deceiveRecord,
-    -- * Plugging Has-based constructors
-    component,
-    --distributeDepT,
-
-    -- * Interfacing with "simple" advices
-    toSimple,
-    fromSimple,
-
-    -- * "sop-core" re-exports
-    -- $sop
-    Top,
-    And,
-    All,
-    NP (..),
-    I (..),
-    cfoldMap_NP,
-    Dict (..),
+module Control.Monad.Dep.Advice {-# DEPRECATED "Renamed to Dep.Advice" #-}
+  (
+    module Dep.Advice
   )
 where
 
-import Control.Monad.Dep
-import Control.Monad.Dep.Has
-import Control.Monad.Dep.Env
-import Control.Monad.Trans.Reader (ReaderT (..), withReaderT)
-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
-import Data.Typeable
-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
---
--- >>> :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.Advice
--- >>> 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
-
--- | A generic transformation of 'DepT'-effectful functions with environment
--- @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)
--- IO ()@ doesn't. See also 'Ensure'.
---
--- '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.Advice.Basic" for examples.
-type Advice ::
-  (Type -> Constraint) ->
-  ((Type -> Type) -> Type) ->
-  (Type -> Type) ->
-  Type ->
-  Type
-data Advice (ca :: Type -> Constraint) (e_ :: (Type -> Type) -> Type) m r where
-  Advice ::
-    forall ca e_ m r.
-    ( forall as.
-      All ca as =>
-      NP I as ->
-      DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
-    ) ->
-    Advice ca e_ m r
-
--- |
---    'Advice's compose \"sequentially\" when tweaking the arguments, and
---    \"concentrically\" when tweaking the final 'DepT' 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 e_ 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 e_ m r) where
-  mappend = (<>)
-  mempty = Advice \args -> pure (id, args)
-
--- |
---    The most general way of constructing 'Advice's.
---
---    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 (id,  args)) 
--- :}
---
---
-makeAdvice ::
-  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 (DepT e_ m r -> DepT e_ m r, NP I as)
-  ) ->
-  Advice ca e_ m r
-makeAdvice = Advice
-
--- |
---    Create an advice which only tweaks and/or analyzes the function arguments.
---
--- >>> :{
---  doesNothing :: forall ca e_ m r. Monad m => Advice ca e_ m r
---  doesNothing = makeArgsAdvice pure
--- :}
-makeArgsAdvice ::
-  forall ca e_ m r.
-  Monad m =>
-  -- | The function that tweaks the arguments.
-  ( forall as.
-    All ca as =>
-    NP I as ->
-    DepT e_ m (NP I as)
-  ) ->
-  Advice ca e_ 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 e_ m r. Monad m => Advice ca e_ m r
---  doesNothing = makeExecutionAdvice id
--- :}
-makeExecutionAdvice ::
-  forall ca e_ m r.
-  Applicative m =>
-  -- | The function that tweaks the execution.
-  ( DepT e_ m r ->
-    DepT e_ m r
-  ) ->
-  Advice ca e_ m r
-makeExecutionAdvice tweakExecution = makeAdvice \args -> pure (tweakExecution, args)
-
-data Pair a b = Pair !a !b
-
--- |
--- 'Ensure' is a helper for lifting typeclass definitions of the form:
---
--- >>> :{
---  type HasLogger :: (Type -> Type) -> Type -> Constraint
---  class HasLogger d e | e -> d where
---    logger :: e -> String -> d ()
--- :}
---
--- To work as a constraints on the @e_@ and @m@ parameters of an 'Advice', like this:
---
--- >>> :{
---  requiresLogger :: forall e_ m r. (Ensure HasLogger e_ m, Monad m) => Advice Show e_ m r
---  requiresLogger = mempty
---  :}
---
--- Why is it necessary? Two-place @HasX@-style constraints receive the \"fully
--- applied\" type of the record-of-functions. That is: @NilEnv IO@ instead of
--- simply @NilEnv@. This allows them to also work with monomorphic environments
--- (like those in <http://hackage.haskell.org/package/rio RIO>) whose type
--- isn't parameterized by any monad.
---
--- But the @e_@ type parameter of 'Advice' has kind @(Type -> Type) -> Type@.
--- That is: @NilEnv@ alone.
---
--- Furthermore, 'Advices' require @HasX@-style constraints to be placed on the
--- @DepT@ transformer, not directly on the base monad @m@. @Ensure@ takes care
--- of that as well.
-type Ensure :: ((Type -> Type) -> Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> Constraint
-
-type Ensure c e_ m = c (DepT e_ m) (e_ (DepT e_ m))
-
--- | Apply an 'Advice' to some compatible function. The function must have its
--- effects in 'DepT', and all of its arguments must satisfy the @ca@ constraint.
---
--- >>> :{
---  foo :: Int -> DepT NilEnv IO String
---  foo _ = pure "foo"
---  advisedFoo = advise (fromSimple \_ -> 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 -> DepT NilEnv IO String
---  bar _ = pure "bar"
---  advisedBar1 = advise (fromSimple \_ -> returnMempty @Top) bar
---  advisedBar2 = advise @Top (fromSimple \_ -> returnMempty) bar
--- :}
-advise ::
-  forall ca e_ m r as advisee.
-  (Multicurryable as e_ m r advisee, All ca as, Monad m) =>
-  -- | The advice to apply.
-  Advice ca e_ m r ->
-  -- | A function to be adviced.
-  advisee ->
-  advisee
-advise (Advice f) advisee = do
-  let uncurried = multiuncurry @as @e_ @m @r advisee
-      uncurried' args = do
-        (tweakExecution, args') <- f args
-        tweakExecution (uncurried args')
-   in multicurry @as @e_ @m @r uncurried'
-
-type Multicurryable ::
-  [Type] ->
-  ((Type -> Type) -> Type) ->
-  (Type -> Type) ->
-  Type ->
-  Type ->
-  Constraint
-class Multicurryable as e_ m r curried | curried -> as e_ m r where
-  type DownToBaseMonad as e_ m r curried :: Type
-  multiuncurry :: curried -> NP I as -> DepT e_ m r
-  multicurry :: (NP I as -> DepT e_ m r) -> curried
-  _runFromEnv :: m (e_ (DepT e_ m)) -> (e_ (DepT e_ m) -> curried) -> DownToBaseMonad as e_ m r curried
-  _askFinalDepT :: (e_ (DepT e_ m) -> m curried) -> curried
-
-instance Monad m => Multicurryable '[] e_ m r (DepT e_ m r) where
-  type DownToBaseMonad '[] e_ m r (DepT e_ m r) = m r
-  multiuncurry action Nil = action
-  multicurry f = f Nil
-  _runFromEnv producer extractor = do
-    e <- producer
-    runDepT (extractor e) e
-  _askFinalDepT f = do
-    env <- ask
-    r <- lift (f env)
-    r
-
-instance (Functor m, Multicurryable as e_ m r curried) => Multicurryable (a ': as) e_ m r (a -> curried) where
-  type DownToBaseMonad (a ': as) e_ m r (a -> curried) = a -> DownToBaseMonad as e_ m r curried
-  multiuncurry f (I a :* as) = multiuncurry @as @e_ @m @r @curried (f a) as
-  multicurry f a = multicurry @as @e_ @m @r @curried (f . (:*) (I a))
-  _runFromEnv producer extractor a = _runFromEnv @as @e_ @m @r @curried producer (\f -> extractor f a)
-  _askFinalDepT f = 
-    let switcheroo action a = fmap ($ a) action
-     in _askFinalDepT @as @e_ @m @r . flip (fmap switcheroo f)
-
--- | Given a base monad @m@ action that gets hold of the 'DepT' environment, run
--- the 'DepT' transformer at the tip of a curried function.
---
--- >>> :{
---  foo :: Int -> Int -> Int -> DepT NilEnv IO ()
---  foo _ _ _ = pure ()
--- :}
---
---  >>> runFinalDepT (pure NilEnv) foo 1 2 3 :: IO ()
-runFinalDepT ::
-  forall as e_ m r curried.
-  Multicurryable as e_ m r curried =>
-  -- | action that gets hold of the environment
-  m (e_ (DepT e_ m)) ->
-  -- | function to invoke with effects in 'DepT'
-  curried ->
-  -- | a new function with effects in the base monad
-  DownToBaseMonad as e_ m r curried
-runFinalDepT producer extractor = _runFromEnv producer (const extractor)
-
-askFinalDepT ::
-  forall as e_ m r curried. 
-  Multicurryable as e_ m r curried =>
-  (e_ (DepT e_ m) -> m curried) -> curried
-askFinalDepT = _askFinalDepT @as @e_ @m @r
-
--- | Given a base monad @m@ action that gets hold of the 'DepT' environment,
--- and a function capable of extracting a curried function from the
--- environment, run the 'DepT' transformer at the tip of the resulting curried
--- function.
---
--- Why put the environment behind the @m@ action? Well, since getting to the
--- end of the curried function takes some work, it's a good idea to have some
--- flexibility once we arrive there. For example, the environment could be
--- stored in a "Data.IORef" and change in response to events, perhaps with
--- advices being added or removed.
---
--- >>> :{
---   type MutableEnv :: (Type -> Type) -> Type
---   data MutableEnv m = MutableEnv { _foo :: Int -> m (Sum Int) }
---   :}
---
--- >>> :{
---   do envRef <- newIORef (MutableEnv (pure . Sum))
---      let foo' = runFromEnv (readIORef envRef) _foo
---      do r <- foo' 7
---         print r
---      modifyIORef envRef (\e -> e { _foo = advise @Top (fromSimple \_ -> returnMempty) (_foo e) })
---      do r <- foo' 7
---         print r
--- :}
--- Sum {getSum = 7}
--- Sum {getSum = 0}
-runFromEnv ::
-  forall as e_ m r curried.
-  Multicurryable as e_ m r curried =>
-  -- | action that gets hold of the environment
-  m (e_ (DepT e_ m)) ->
-  -- | gets a function from the environment with effects in 'DepT'
-  (e_ (DepT e_ m) -> curried) ->
-  -- | a new function with effects in the base monad
-  DownToBaseMonad as e_ m r curried
-runFromEnv = _runFromEnv
-
--- | Like 'runFromEnv', but the function to run is extracted from a dependency
--- @dep@ which is found using 'Has'. The selector should be concrete enough to
--- identify @dep@ in the environment.
-runFromDep ::
-  forall dep as e_ m r curried.
-  (Multicurryable as e_ m r curried, Has dep (DepT e_ m) (e_ (DepT e_ m))) =>
-  -- | action that gets hold of the environment
-  m (e_ (DepT e_ m)) ->
-  -- | selector that gets a function from a dependency found using 'Has'
-  (dep (DepT e_ m) -> curried) ->
-  -- | a new function with effects in the base monad
-  DownToBaseMonad as e_ m r curried
-runFromDep envAction member = _runFromEnv envAction (member . dep)
-
--- $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 e_ m r. MonadIO m => Advice (Show `And` Eq `And` Ord) e_ m r
---  stricterPrintArgs = restrictArgs (\Dict -> Dict) (fromSimple \_ -> printArgs stdout "foo")
--- :}
---
---    or with a type application to 'restrictArgs':
---
--- >>> stricterPrintArgs = restrictArgs @(Show `And` Eq `And` Ord) (\Dict -> Dict) (fromSimple \_ -> printArgs stdout "foo")
-
--- | Makes the constraint on the arguments more restrictive.
-restrictArgs ::
-  forall more less e_ 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 e_ m r ->
-  -- | Advice with more restrictive constraint on the args.
-  Advice more e_ 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 -> 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 ::
-  [Type] ->
-  Type ->
-  ((Type -> Type) -> Type) ->
-  (Type -> Type) ->
-  Type ->
-  Type ->
-  Constraint
-class Multicurryable as e_ m r curried => Gullible as e e_ m r curried where
-  type NewtypedEnv as e e_ m r curried :: Type
-  _deceive :: (e_ (DepT e_ m) -> e) -> NewtypedEnv as e e_ m r curried -> curried
-
-instance Monad m => Gullible '[] e e_ m r (DepT e_ m r) where
-  type NewtypedEnv '[] e e_ m r (DepT e_ m r) = ReaderT e m r
-  _deceive f action = DepT (withReaderT f action)
-
-instance (Functor m, Gullible as e e_ m r curried) => Gullible (a ': as) e e_ m r (a -> curried) where
-  type NewtypedEnv (a ': as) e e_ m r (a -> curried) = a -> NewtypedEnv as e e_ m r curried
-  _deceive f g a = deceive @as @e @e_ @m @r f (g a)
-
--- | Makes a function see a newtyped version of the environment record, a version that might have different @HasX@ instances.
---
--- The \"deception\" doesn't affect the dependencies used by the function, only the function itself.
---
--- For example, consider the following setup which features both a \"deceviced\"
--- and an \"undeceived\" version of a controller function:
---
--- >>> :{
---  type HasLogger :: (Type -> Type) -> Type -> Constraint
---  class HasLogger d e | e -> d where
---    logger :: e -> String -> d ()
---  type HasIntermediate :: (Type -> Type) -> Type -> Constraint
---  class HasIntermediate d e | e -> d where
---    intermediate :: e -> String -> d ()
---  type Env :: (Type -> Type) -> Type
---  data Env m = Env
---    { _logger1 :: String -> m (),
---      _logger2 :: String -> m (),
---      _intermediate :: String -> m (),
---      _controllerA :: Int -> m (),
---      _controllerB :: Int -> m ()
---    }
---  instance HasLogger m (Env m) where
---    logger = _logger1
---  instance HasIntermediate m (Env m) where
---    intermediate = _intermediate
---  newtype Switcheroo m = Switcheroo (Env m)
---      deriving newtype (HasIntermediate m)
---  instance HasLogger m (Switcheroo m) where
---    logger (Switcheroo e) = _logger2 e
---  env :: Env (DepT Env (Writer [String]))
---  env =
---    let mkController :: forall d e m. MonadDep [HasLogger, HasIntermediate] d e m => Int -> m ()
---        mkController _ = do e <- ask; liftD $ logger e "foo" ; liftD $ intermediate e "foo"
---        mkIntermediate :: forall d e m. MonadDep '[HasLogger] d e m => String -> m ()
---        mkIntermediate _ = do e <- ask ; liftD $ logger e "foo"
---     in Env
---        {
---          _logger1 =
---             \_ -> tell ["logger 1"],
---          _logger2 =
---             \_ -> tell ["logger 2"],
---          _intermediate =
---             mkIntermediate,
---          _controllerA =
---             mkController,
---          _controllerB =
---             deceive Switcheroo $
---             mkController
---        }
--- :}
---
--- If we run @_controllerA@ the ouput is:
---
--- >>> execWriter $ runFromEnv (pure env) _controllerA 7
--- ["logger 1","logger 1"]
---
--- But if we run the \"deceived\" @_controllerB@, we see that the function and its @_intermediate@ dependency use different loggers:
---
--- >>> execWriter $ runFromEnv (pure env) _controllerB 7
--- ["logger 2","logger 1"]
---
--- Note that the function that is \"deceived\" must be polymorphic over
--- 'Control.Monad.Dep.MonadDep'. Passing a function whose effect monad has
--- already \"collapsed\" into 'DepT' won't work. Therefore, 'deceive' must be applied before any 'Advice'.
-deceive ::
-  forall as e e_ m r curried.
-  Gullible as e e_ m r curried =>
-  -- | The newtype constructor that masks the \"true\" environment.
-  (e_ (DepT e_ m) -> e) ->
-  -- | A function to be deceived. It must be polymorphic over 'Control.Monad.Dep.MonadDep'.
-  NewtypedEnv as e e_ m r curried ->
-  -- | The deceived function, that has effects in 'DepT'.
-  curried
-deceive = _deceive
-
--- deceving *all* fields of a record
---
---
-type GullibleRecord :: Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> ((Type -> Type) -> Type) -> Constraint
-class GullibleRecord e e_ m gullible where
-  _deceiveRecord :: (e_ (DepT e_ m) -> e) -> gullible (ReaderT e m) -> gullible (DepT e_ m)
-
--- https://gitlab.haskell.org/ghc/ghc/-/issues/13952
-type GullibleProduct :: Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> (k -> Type) -> (k -> Type) -> Constraint
-class GullibleProduct e e_ m gullible_ deceived_ | e e_ m deceived_ -> gullible_ where
-  _deceiveProduct :: (e_ (DepT e_ m) -> e) -> gullible_ k -> deceived_ k
-
-instance
-  ( GullibleProduct e e_ m gullible_left deceived_left,
-    GullibleProduct e e_ m gullible_right deceived_right
-  ) =>
-  GullibleProduct e e_ m (gullible_left G.:*: gullible_right) (deceived_left G.:*: deceived_right)
-  where
-  _deceiveProduct f (gullible_left G.:*: gullible_right) = _deceiveProduct @_ @e @e_ @m f gullible_left G.:*: _deceiveProduct @_ @e @e_ @m f gullible_right
-
-data RecordComponent
-  = Terminal
-  | IWrapped
-  | Recurse
-
-type DiscriminateGullibleComponent :: Type -> RecordComponent
-type family DiscriminateGullibleComponent c where
-  DiscriminateGullibleComponent (a -> b) = Terminal
-  DiscriminateGullibleComponent (ReaderT e m x) = Terminal
-  DiscriminateGullibleComponent (Identity _) = IWrapped
-  DiscriminateGullibleComponent (I _) = IWrapped
-  DiscriminateGullibleComponent _ = Recurse
-
-type GullibleComponent :: RecordComponent -> Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type -> Constraint
-class GullibleComponent component_type e e_ m gullible deceived | e e_ m deceived -> gullible where
-  _deceiveComponent :: (e_ (DepT e_ m) -> e) -> gullible -> deceived
-
-instance
-  (Gullible as e e_ m r deceived, NewtypedEnv as e e_ m r deceived ~ gullible) =>
-  GullibleComponent Terminal e e_ m gullible deceived
-  where
-  _deceiveComponent f gullible = deceive @as @e @_ @m @r f gullible
-
-instance
-  GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
-  GullibleComponent IWrapped e e_ m (Identity gullible) (Identity deceived)
-  where
-  _deceiveComponent f (Identity gullible) = Identity (_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m f gullible)
-
-instance
-  GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
-  GullibleComponent IWrapped e e_ m (I gullible) (I deceived)
-  where
-  _deceiveComponent f (I gullible) = I (_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m f gullible)
-
-instance
-  GullibleRecord e e_ m gullible =>
-  GullibleComponent Recurse e e_ m (gullible (ReaderT e m)) (gullible (DepT e_ m))
-  where
-  _deceiveComponent f gullible = _deceiveRecord @e @e_ @m f gullible
-
-instance
-  GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
-  GullibleProduct e e_ m (G.S1 x (G.Rec0 gullible)) (G.S1 x (G.Rec0 deceived))
-  where
-  _deceiveProduct f (G.M1 (G.K1 gullible)) = G.M1 (G.K1 (_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m f gullible))
-
-instance
-  ( G.Generic (gullible (ReaderT e m)),
-    G.Generic (gullible (DepT e_ m)),
-    G.Rep (gullible (ReaderT e m)) ~ G.D1 x (G.C1 y gullible_),
-    G.Rep (gullible (DepT e_ m)) ~ G.D1 x (G.C1 y deceived_),
-    GullibleProduct e e_ m gullible_ deceived_
-  ) =>
-  GullibleRecord e e_ m gullible
-  where
-  _deceiveRecord f gullible =
-    let G.M1 (G.M1 gullible_) = G.from gullible
-        deceived_ = _deceiveProduct @_ @e @e_ @m f gullible_
-     in G.to (G.M1 (G.M1 deceived_))
-
--- | Makes an entire record-of-functions see a different version of the global environment record, a version that might have different @HasX@ instances.
---
--- 'deceiveRecord' must be applied before 'adviseRecord'.
-deceiveRecord ::
-  forall e e_ m gullible.
-  GullibleRecord e e_ m gullible =>
-  -- | The newtype constructor that masks the \"true\" environment.
-  (e_ (DepT e_ m) -> e) ->
-  -- | The record to deceive recursively. The monad parameter must be left polymorphic over @MonadDep@, so that it can unify with `ReaderT`.
-  gullible (ReaderT e m) ->
-  -- | The deceived record.
-  gullible (DepT e_ m)
-deceiveRecord = _deceiveRecord @e @e_ @m @gullible
-
-
--- | 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.
---
--- You must have a sufficiently polymorphic constructor—both in the monad and
--- in the environment—to invoke this function.
---
--- 'component' lets you plug simple component constructors 
--- into a 'DepT'-based environment.
---
--- Compare with 'Control.Monad.Dep.Env.constructor' from "Control.Monad.Dep.Env", which 
--- is intended to be used with 'Control.Monad.Dep.Env.fixEnv'-based environments.
-component 
-    :: forall e_ m record . (Applicative m, DistributiveRecord e_ m record) => 
-    -- | constructor which takes the environment as a positional parameter.
-    (e_ (DepT e_ m) -> record (DepT e_ m)) ->
-    -- | component whose methods get the environment by 'ask'ing.
-    record (DepT e_ m)
-component f = _distribute @e_ @m (pure . f)
-
-
-
-type DistributiveRecord :: ((Type -> Type) -> Type) -> (Type -> Type) -> ((Type -> Type) -> Type) -> Constraint
-class DistributiveRecord e_ m record where
-    _distribute :: (e_ (DepT e_ m) -> m (record (DepT e_ m))) -> record (DepT e_ m)
-
-type DistributiveProduct :: ((Type -> Type) -> Type) -> (Type -> Type) -> (k -> Type) -> Constraint
-class DistributiveProduct e_ m product where
-    _distributeProduct :: (e_ (DepT e_ m) -> m (product k)) -> product k
-
-instance
-  ( G.Generic (advised (DepT e_ m)),
-    G.Rep (advised (DepT e_ m)) ~ G.D1 x (G.C1 y advised_),
-    DistributiveProduct e_ m advised_,
-    Functor m
-  ) =>
-  DistributiveRecord e_ m advised
-  where
-  _distribute f =
-    let advised_ = _distributeProduct @_ @e_ @m (fmap (fmap (G.unM1 . G.unM1 . G.from)) f)
-     in G.to (G.M1 (G.M1 advised_))
-
-instance
-  ( DistributiveProduct e_ m advised_left,
-    DistributiveProduct e_ m advised_right,
-    Functor m
-  ) =>
-  DistributiveProduct e_ m (advised_left G.:*: advised_right)
-  where
-  _distributeProduct f  = 
-      _distributeProduct @_ @e_ @m (fmap (fmap (\(l G.:*: _) -> l)) f) 
-      G.:*: 
-      _distributeProduct @_ @e_ @m (fmap (fmap (\(_ G.:*: r) -> r)) f) 
-
-instance
-  ( 
-    Functor m, 
-    Multicurryable as e_ m r advised
-  ) =>
-  DistributiveProduct e_ m (G.S1 ( 'G.MetaSel msymbol su ss ds) (G.Rec0 advised))
-  where
-  _distributeProduct f = G.M1 . G.K1 $ askFinalDepT @as @e_ @m @r (fmap (fmap (G.unK1 . G.unM1))  f)
-
--- advising *all* fields of a record
---
---
-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 => 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 => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised_ k -> advised_ k
-
-instance
-  ( G.Generic (advised (DepT e_ m)),
-    -- G.Rep (advised (DepT e_ m)) ~ G.D1 ('G.MetaData name mod p nt) (G.C1 y advised_),
-    G.Rep (advised (DepT e_ m)) ~ G.D1 x (G.C1 y advised_),
-    Typeable advised,
-    AdvisedProduct ca e_ m cr advised_
-  ) =>
-  AdvisedRecord ca e_ m cr advised
-  where
-  _adviseRecord acc f unadvised =
-    let G.M1 (G.M1 unadvised_) = G.from unadvised
-        advised_ = _adviseProduct @_ @ca @e_ @m @cr (typeRep (Proxy @advised)) acc f unadvised_
-     in G.to (G.M1 (G.M1 advised_))
-
-instance
-  ( AdvisedProduct ca e_ m cr advised_left,
-    AdvisedProduct ca e_ m cr advised_right
-  ) =>
-  AdvisedProduct ca e_ m cr (advised_left G.:*: advised_right)
-  where
-  _adviseProduct tr acc f (unadvised_left G.:*: unadvised_right) = _adviseProduct @_ @ca @e_ @m @cr tr acc f unadvised_left G.:*: _adviseProduct @_ @ca @e_ @m @cr tr acc f unadvised_right
-
-type DiscriminateAdvisedComponent :: Type -> RecordComponent
-type family DiscriminateAdvisedComponent c where
-  DiscriminateAdvisedComponent (a -> b) = Terminal
-  DiscriminateAdvisedComponent (DepT e_ m x) = Terminal
-  DiscriminateAdvisedComponent (Identity _) = IWrapped
-  DiscriminateAdvisedComponent (I _) = IWrapped
-  DiscriminateAdvisedComponent _ = Recurse
-
-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 => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised -> advised
-
-instance
-  ( AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised,
-    KnownSymbol fieldName
-  ) =>
-  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' = (tr, symbolVal (Proxy @fieldName)) : acc
-     in G.M1 (G.K1 (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @m @cr acc' f advised))
-
-instance
-  AdvisedRecord ca e_ m cr advisable =>
-  AdvisedComponent Recurse ca e_ m cr (advisable (DepT e_ m))
-  where
-  _adviseComponent acc f advised = _adviseRecord @ca @e_ @m @cr acc f advised
-
-instance
-  (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 (N.fromList acc)) advised
-
-instance
-  AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised =>
-  AdvisedComponent IWrapped ca e_ m cr (Identity advised)
-  where
-  _adviseComponent acc f (Identity advised) = Identity (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @m @cr acc f advised)
-
-instance
-  AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised =>
-  AdvisedComponent IWrapped ca e_ m cr (I advised)
-  where
-  _adviseComponent acc f (I advised) = I (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @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 e_ m advised.
-  AdvisedRecord ca e_ m cr advised =>
-  -- | The advice to apply.
-  (forall r . cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) ->
-  -- | The record to advise recursively.
-  advised (DepT e_ m) ->
-  -- | The advised record.
-  advised (DepT e_ m)
-adviseRecord = _adviseRecord @ca @e_ @m @cr []
-
--- $records
---
--- 'adviseRecord' and 'deceiveRecord' are versions of 'advise' and 'deceive' that, instead of working on bare
--- functions, transform entire records-of-functions in one go. They also work
--- with newtypes containing a single function. The records must derive 'GHC.Generics.Generic'.
---
--- Useful with the \"wrapped\" style of components facilitated by @Control.Monad.Dep.Has@.
---
--- >>> :{
---   type Logger :: (Type -> Type) -> Type
---   newtype Logger d = Logger {log :: String -> d ()} deriving Generic
---   type Repository :: (Type -> Type) -> Type
---   data Repository d = Repository
---     { select :: String -> d [Int],
---       insert :: [Int] -> d ()
---     } deriving Generic
---   type Controller :: (Type -> Type) -> Type
---   newtype Controller d = Controller {serve :: Int -> d String} deriving Generic
---   type Env :: (Type -> Type) -> Type
---   data Env m = Env
---     { logger :: Logger m,
---       repository :: Repository m,
---       controller :: Controller m
---     }
---   newtype Wraps x = Wraps x
---   env :: Env (DepT Env (Writer ()))
---   env =
---     let logger = Logger \_ -> pure ()
---         repository =
---           adviseRecord @Top @Top mempty $
---           deceiveRecord Wraps $
---           Repository {select = \_ -> pure [], insert = \_ -> pure ()}
---         controller =
---           adviseRecord @Top @Top mempty $
---           deceiveRecord Wraps $
---           Controller \_ -> pure "view"
---      in Env {logger, repository, controller}
--- :}
-
--- $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 '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')
-
+import Dep.Advice

@@ -1,108 +1,7 @@-{-# 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.Advice.Basic
-  ( -- * Basic advices
-    doLocally
+module Control.Monad.Dep.Advice.Basic {-# DEPRECATED "Renamed to Dep.Advice.Basic" #-}
+  ( 
+    module Dep.Advice.Basic
   )
 where
 
-import Control.Monad.Dep
-import Control.Monad.Dep.Advice
-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
-
--- $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.Advice
--- >>> import Control.Monad.Dep.Advice.Basic
--- >>> import Data.Kind
--- >>> import Data.SOP
--- >>> import Data.SOP.NP
--- >>> import Data.Monoid
--- >>> import System.IO
--- >>> import Data.IORef
-
-
--- | Use 'local' on the final 'DepT' action of a function.
---
--- Allows tweaking the environment that will be seen by the function and all of
--- its sub-calls into dependencies. 
---
--- Perhaps this is __not__ what you want; often, it's better to tweak
--- the environment for the current function only. For those cases,
--- 'Control.Monad.Dep.Advice.deceive' might be a better fit. 
---
--- >>> :{
---  type HasLogger :: Type -> (Type -> Type) -> Constraint
---  class HasLogger em m | em -> m where
---    logger :: em -> String -> m ()
---  type Env :: (Type -> Type) -> Type
---  data Env m = Env
---    { _logger1 :: String -> m (),
---      _logger2 :: String -> m (),
---      _controllerA :: Int -> m (),
---      _controllerB :: Int -> m ()
---    }
---  instance HasLogger (Env m) m where
---    logger = _logger1
---  envIO :: Env (DepT Env IO)
---  envIO = Env 
---    {
---      _logger1 = 
---          \_ -> liftIO $ putStrLn "logger1 ran",
---      _logger2 = 
---          \_ -> liftIO $ putStrLn "logger2 ran",
---      _controllerA = 
---          \_ -> do e <- ask; logger e "foo",
---      _controllerB = 
---          advise @Top 
---          (doLocally \e@Env{_logger2} -> e {_logger1 = _logger2}) 
---          \_ -> do e <- ask; logger e "foo" 
---    }
--- :}
---
---  >>> runFromEnv (pure envIO) _controllerA 0
---  logger1 ran
---
---  >>> runFromEnv (pure envIO) _controllerB 0
---  logger2 ran
---
-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)  
-
-
+import Dep.Advice.Basic

@@ -1,495 +1,8 @@-{-# 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 (..),
+module Control.Monad.Dep.SimpleAdvice {-# DEPRECATED "Renamed to Dep.SimpleAdvice" #-}
+  (
+    module Dep.SimpleAdvice
   )
 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'.
+import Dep.SimpleAdvice
 
--- $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.

@@ -1,141 +1,7 @@-{-# 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
+module Control.Monad.Dep.SimpleAdvice.Basic {-# DEPRECATED "Renamed to Dep.SimpleAdvice.Basic" #-}
+  (
+    module Dep.SimpleAdvice.Basic 
   )
 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 ()
-
-
+import Dep.SimpleAdvice.Basic

@@ -1,126 +0,0 @@-{-# 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
-

@@ -0,0 +1,972 @@+{-# 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 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 'DepT'-effectful functions of
+--    any number of arguments.
+--
+-- >>> :{
+--    foo0 :: DepT NilEnv IO (Sum Int)
+--    foo0 = pure (Sum 5)
+--    foo1 :: Bool -> DepT NilEnv IO (Sum Int)
+--    foo1 _ = foo0
+--    foo2 :: Char -> Bool -> DepT NilEnv IO (Sum Int)
+--    foo2 _ = foo1
+-- :}
+--
+-- They work for @DepT@-actions of zero arguments:
+--
+-- >>> 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 (fromSimple \_ -> printArgs stdout "foo1") foo1 False `runDepT` NilEnv
+-- foo1: False
+-- <BLANKLINE>
+-- Sum {getSum = 5}
+--
+-- >>> 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 (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 (fromSimple \_ -> printArgs stdout "foo2" <> returnMempty) foo2 'd' False `runDepT` NilEnv
+-- foo2: 'd' False
+-- <BLANKLINE>
+-- Sum {getSum = 0}
+--
+-- Although sometimes composition might require harmonizing the constraints
+-- each 'Advice' places on the arguments, if they differ.
+module Dep.Advice
+  ( -- * The Advice type
+    Advice,
+
+    -- * Creating Advice values
+    makeAdvice,
+    makeArgsAdvice,
+    makeExecutionAdvice,
+
+    -- * Applying Advices
+    advise,
+
+    -- * Constraint helpers
+    -- $constrainthelpers
+    Ensure,
+
+    -- * Harmonizing Advice argument constraints
+    -- $restrict
+    restrictArgs,
+
+    -- * Invocation helpers
+    -- $invocation
+    runFinalDepT,
+    runFromEnv,
+    runFromDep,
+    -- askFinalDepT,
+    -- * Making functions see a different environment
+    deceive,
+
+    -- * Advising and deceiving entire records
+    -- $records
+    adviseRecord,
+    deceiveRecord,
+    -- * Plugging Has-based constructors
+    component,
+    --distributeDepT,
+
+    -- * Interfacing with "simple" advices
+    toSimple,
+    fromSimple,
+    fromSimple_,
+
+    -- * "sop-core" re-exports
+    -- $sop
+    Top,
+    And,
+    All,
+    NP (..),
+    I (..),
+    cfoldMap_NP,
+    Dict (..),
+  )
+where
+
+import Dep.Has
+import Dep.Env
+import Control.Monad.Dep
+import Control.Monad.Trans.Reader (ReaderT (..), withReaderT)
+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
+import Data.Typeable
+import GHC.Generics qualified as G
+import GHC.TypeLits
+import Data.Coerce
+import Data.Bifunctor (first)
+import Dep.SimpleAdvice.Internal qualified as SA
+
+-- $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 Dep.Advice
+-- >>> import Dep.SimpleAdvice.Basic (printArgs,returnMempty)
+-- >>> import Control.Monad
+-- >>> import Control.Monad.Dep
+-- >>> 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
+
+-- | A generic transformation of 'DepT'-effectful functions with environment
+-- @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)
+-- IO ()@ doesn't. See also 'Ensure'.
+--
+-- '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.Advice.Basic" for examples.
+type Advice ::
+  (Type -> Constraint) ->
+  ((Type -> Type) -> Type) ->
+  (Type -> Type) ->
+  Type ->
+  Type
+data Advice (ca :: Type -> Constraint) (e_ :: (Type -> Type) -> Type) m r where
+  Advice ::
+    forall ca e_ m r.
+    ( forall as.
+      All ca as =>
+      NP I as ->
+      DepT e_ m (DepT e_ m r -> DepT e_ m r, NP I as)
+    ) ->
+    Advice ca e_ m r
+
+-- |
+--    'Advice's compose \"sequentially\" when tweaking the arguments, and
+--    \"concentrically\" when tweaking the final 'DepT' 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 e_ 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 e_ m r) where
+  mappend = (<>)
+  mempty = Advice \args -> pure (id, args)
+
+-- |
+--    The most general way of constructing 'Advice's.
+--
+--    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 (id,  args)) 
+-- :}
+--
+--
+makeAdvice ::
+  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 (DepT e_ m r -> DepT e_ m r, NP I as)
+  ) ->
+  Advice ca e_ m r
+makeAdvice = Advice
+
+-- |
+--    Create an advice which only tweaks and/or analyzes the function arguments.
+--
+-- >>> :{
+--  doesNothing :: forall ca e_ m r. Monad m => Advice ca e_ m r
+--  doesNothing = makeArgsAdvice pure
+-- :}
+makeArgsAdvice ::
+  forall ca e_ m r.
+  Monad m =>
+  -- | The function that tweaks the arguments.
+  ( forall as.
+    All ca as =>
+    NP I as ->
+    DepT e_ m (NP I as)
+  ) ->
+  Advice ca e_ 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 e_ m r. Monad m => Advice ca e_ m r
+--  doesNothing = makeExecutionAdvice id
+-- :}
+makeExecutionAdvice ::
+  forall ca e_ m r.
+  Applicative m =>
+  -- | The function that tweaks the execution.
+  ( DepT e_ m r ->
+    DepT e_ m r
+  ) ->
+  Advice ca e_ m r
+makeExecutionAdvice tweakExecution = makeAdvice \args -> pure (tweakExecution, args)
+
+data Pair a b = Pair !a !b
+
+-- |
+-- 'Ensure' is a helper for lifting typeclass definitions of the form:
+--
+-- >>> :{
+--  type HasLogger :: (Type -> Type) -> Type -> Constraint
+--  class HasLogger d e | e -> d where
+--    logger :: e -> String -> d ()
+-- :}
+--
+-- To work as a constraints on the @e_@ and @m@ parameters of an 'Advice', like this:
+--
+-- >>> :{
+--  requiresLogger :: forall e_ m r. (Ensure HasLogger e_ m, Monad m) => Advice Show e_ m r
+--  requiresLogger = mempty
+--  :}
+--
+-- Why is it necessary? Two-place @HasX@-style constraints receive the \"fully
+-- applied\" type of the record-of-functions. That is: @NilEnv IO@ instead of
+-- simply @NilEnv@. This allows them to also work with monomorphic environments
+-- (like those in <http://hackage.haskell.org/package/rio RIO>) whose type
+-- isn't parameterized by any monad.
+--
+-- But the @e_@ type parameter of 'Advice' has kind @(Type -> Type) -> Type@.
+-- That is: @NilEnv@ alone.
+--
+-- Furthermore, 'Advices' require @HasX@-style constraints to be placed on the
+-- @DepT@ transformer, not directly on the base monad @m@. @Ensure@ takes care
+-- of that as well.
+type Ensure :: ((Type -> Type) -> Type -> Constraint) -> ((Type -> Type) -> Type) -> (Type -> Type) -> Constraint
+
+type Ensure c e_ m = c (DepT e_ m) (e_ (DepT e_ m))
+
+-- | Apply an 'Advice' to some compatible function. The function must have its
+-- effects in 'DepT', and all of its arguments must satisfy the @ca@ constraint.
+--
+-- >>> :{
+--  foo :: Int -> DepT NilEnv IO String
+--  foo _ = pure "foo"
+--  advisedFoo = advise (fromSimple \_ -> 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 -> DepT NilEnv IO String
+--  bar _ = pure "bar"
+--  advisedBar1 = advise (fromSimple \_ -> returnMempty @Top) bar
+--  advisedBar2 = advise @Top (fromSimple \_ -> returnMempty) bar
+-- :}
+advise ::
+  forall ca e_ m r as advisee.
+  (Multicurryable as e_ m r advisee, All ca as, Monad m) =>
+  -- | The advice to apply.
+  Advice ca e_ m r ->
+  -- | A function to be adviced.
+  advisee ->
+  advisee
+advise (Advice f) advisee = do
+  let uncurried = multiuncurry @as @e_ @m @r advisee
+      uncurried' args = do
+        (tweakExecution, args') <- f args
+        tweakExecution (uncurried args')
+   in multicurry @as @e_ @m @r uncurried'
+
+type Multicurryable ::
+  [Type] ->
+  ((Type -> Type) -> Type) ->
+  (Type -> Type) ->
+  Type ->
+  Type ->
+  Constraint
+class Multicurryable as e_ m r curried | curried -> as e_ m r where
+  type DownToBaseMonad as e_ m r curried :: Type
+  multiuncurry :: curried -> NP I as -> DepT e_ m r
+  multicurry :: (NP I as -> DepT e_ m r) -> curried
+  _runFromEnv :: m (e_ (DepT e_ m)) -> (e_ (DepT e_ m) -> curried) -> DownToBaseMonad as e_ m r curried
+  _askFinalDepT :: (e_ (DepT e_ m) -> m curried) -> curried
+
+instance Monad m => Multicurryable '[] e_ m r (DepT e_ m r) where
+  type DownToBaseMonad '[] e_ m r (DepT e_ m r) = m r
+  multiuncurry action Nil = action
+  multicurry f = f Nil
+  _runFromEnv producer extractor = do
+    e <- producer
+    runDepT (extractor e) e
+  _askFinalDepT f = do
+    env <- ask
+    r <- lift (f env)
+    r
+
+instance (Functor m, Multicurryable as e_ m r curried) => Multicurryable (a ': as) e_ m r (a -> curried) where
+  type DownToBaseMonad (a ': as) e_ m r (a -> curried) = a -> DownToBaseMonad as e_ m r curried
+  multiuncurry f (I a :* as) = multiuncurry @as @e_ @m @r @curried (f a) as
+  multicurry f a = multicurry @as @e_ @m @r @curried (f . (:*) (I a))
+  _runFromEnv producer extractor a = _runFromEnv @as @e_ @m @r @curried producer (\f -> extractor f a)
+  _askFinalDepT f = 
+    let switcheroo action a = fmap ($ a) action
+     in _askFinalDepT @as @e_ @m @r . flip (fmap switcheroo f)
+
+-- | Given a base monad @m@ action that gets hold of the 'DepT' environment, run
+-- the 'DepT' transformer at the tip of a curried function.
+--
+-- >>> :{
+--  foo :: Int -> Int -> Int -> DepT NilEnv IO ()
+--  foo _ _ _ = pure ()
+-- :}
+--
+--  >>> runFinalDepT (pure NilEnv) foo 1 2 3 :: IO ()
+runFinalDepT ::
+  forall as e_ m r curried.
+  Multicurryable as e_ m r curried =>
+  -- | action that gets hold of the environment
+  m (e_ (DepT e_ m)) ->
+  -- | function to invoke with effects in 'DepT'
+  curried ->
+  -- | a new function with effects in the base monad
+  DownToBaseMonad as e_ m r curried
+runFinalDepT producer extractor = _runFromEnv producer (const extractor)
+
+askFinalDepT ::
+  forall as e_ m r curried. 
+  Multicurryable as e_ m r curried =>
+  (e_ (DepT e_ m) -> m curried) -> curried
+askFinalDepT = _askFinalDepT @as @e_ @m @r
+
+-- | Given a base monad @m@ action that gets hold of the 'DepT' environment,
+-- and a function capable of extracting a curried function from the
+-- environment, run the 'DepT' transformer at the tip of the resulting curried
+-- function.
+--
+-- Why put the environment behind the @m@ action? Well, since getting to the
+-- end of the curried function takes some work, it's a good idea to have some
+-- flexibility once we arrive there. For example, the environment could be
+-- stored in a "Data.IORef" and change in response to events, perhaps with
+-- advices being added or removed.
+--
+-- >>> :{
+--   type MutableEnv :: (Type -> Type) -> Type
+--   data MutableEnv m = MutableEnv { _foo :: Int -> m (Sum Int) }
+--   :}
+--
+-- >>> :{
+--   do envRef <- newIORef (MutableEnv (pure . Sum))
+--      let foo' = runFromEnv (readIORef envRef) _foo
+--      do r <- foo' 7
+--         print r
+--      modifyIORef envRef (\e -> e { _foo = advise @Top (fromSimple \_ -> returnMempty) (_foo e) })
+--      do r <- foo' 7
+--         print r
+-- :}
+-- Sum {getSum = 7}
+-- Sum {getSum = 0}
+runFromEnv ::
+  forall as e_ m r curried.
+  Multicurryable as e_ m r curried =>
+  -- | action that gets hold of the environment
+  m (e_ (DepT e_ m)) ->
+  -- | gets a function from the environment with effects in 'DepT'
+  (e_ (DepT e_ m) -> curried) ->
+  -- | a new function with effects in the base monad
+  DownToBaseMonad as e_ m r curried
+runFromEnv = _runFromEnv
+
+-- | Like 'runFromEnv', but the function to run is extracted from a dependency
+-- @dep@ which is found using 'Has'. The selector should be concrete enough to
+-- identify @dep@ in the environment.
+runFromDep ::
+  forall dep as e_ m r curried.
+  (Multicurryable as e_ m r curried, Has dep (DepT e_ m) (e_ (DepT e_ m))) =>
+  -- | action that gets hold of the environment
+  m (e_ (DepT e_ m)) ->
+  -- | selector that gets a function from a dependency found using 'Has'
+  (dep (DepT e_ m) -> curried) ->
+  -- | a new function with effects in the base monad
+  DownToBaseMonad as e_ m r curried
+runFromDep envAction member = _runFromEnv envAction (member . dep)
+
+-- $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 e_ m r. MonadIO m => Advice (Show `And` Eq `And` Ord) e_ m r
+--  stricterPrintArgs = restrictArgs (\Dict -> Dict) (fromSimple \_ -> printArgs stdout "foo")
+-- :}
+--
+--    or with a type application to 'restrictArgs':
+--
+-- >>> stricterPrintArgs = restrictArgs @(Show `And` Eq `And` Ord) (\Dict -> Dict) (fromSimple \_ -> printArgs stdout "foo")
+
+-- | Makes the constraint on the arguments more restrictive.
+restrictArgs ::
+  forall more less e_ 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 e_ m r ->
+  -- | Advice with more restrictive constraint on the args.
+  Advice more e_ 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 -> 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 ::
+  [Type] ->
+  Type ->
+  ((Type -> Type) -> Type) ->
+  (Type -> Type) ->
+  Type ->
+  Type ->
+  Constraint
+class Multicurryable as e_ m r curried => Gullible as e e_ m r curried where
+  type NewtypedEnv as e e_ m r curried :: Type
+  _deceive :: (e_ (DepT e_ m) -> e) -> NewtypedEnv as e e_ m r curried -> curried
+
+instance Monad m => Gullible '[] e e_ m r (DepT e_ m r) where
+  type NewtypedEnv '[] e e_ m r (DepT e_ m r) = ReaderT e m r
+  _deceive f action = DepT (withReaderT f action)
+
+instance (Functor m, Gullible as e e_ m r curried) => Gullible (a ': as) e e_ m r (a -> curried) where
+  type NewtypedEnv (a ': as) e e_ m r (a -> curried) = a -> NewtypedEnv as e e_ m r curried
+  _deceive f g a = deceive @as @e @e_ @m @r f (g a)
+
+-- | Makes a function see a newtyped version of the environment record, a version that might have different @HasX@ instances.
+--
+-- The \"deception\" doesn't affect the dependencies used by the function, only the function itself.
+--
+-- For example, consider the following setup which features both a \"deceviced\"
+-- and an \"undeceived\" version of a controller function:
+--
+-- >>> :{
+--  type HasLogger :: (Type -> Type) -> Type -> Constraint
+--  class HasLogger d e | e -> d where
+--    logger :: e -> String -> d ()
+--  type HasIntermediate :: (Type -> Type) -> Type -> Constraint
+--  class HasIntermediate d e | e -> d where
+--    intermediate :: e -> String -> d ()
+--  type Env :: (Type -> Type) -> Type
+--  data Env m = Env
+--    { _logger1 :: String -> m (),
+--      _logger2 :: String -> m (),
+--      _intermediate :: String -> m (),
+--      _controllerA :: Int -> m (),
+--      _controllerB :: Int -> m ()
+--    }
+--  instance HasLogger m (Env m) where
+--    logger = _logger1
+--  instance HasIntermediate m (Env m) where
+--    intermediate = _intermediate
+--  newtype Switcheroo m = Switcheroo (Env m)
+--      deriving newtype (HasIntermediate m)
+--  instance HasLogger m (Switcheroo m) where
+--    logger (Switcheroo e) = _logger2 e
+--  env :: Env (DepT Env (Writer [String]))
+--  env =
+--    let mkController :: forall d e m. MonadDep [HasLogger, HasIntermediate] d e m => Int -> m ()
+--        mkController _ = do e <- ask; liftD $ logger e "foo" ; liftD $ intermediate e "foo"
+--        mkIntermediate :: forall d e m. MonadDep '[HasLogger] d e m => String -> m ()
+--        mkIntermediate _ = do e <- ask ; liftD $ logger e "foo"
+--     in Env
+--        {
+--          _logger1 =
+--             \_ -> tell ["logger 1"],
+--          _logger2 =
+--             \_ -> tell ["logger 2"],
+--          _intermediate =
+--             mkIntermediate,
+--          _controllerA =
+--             mkController,
+--          _controllerB =
+--             deceive Switcheroo $
+--             mkController
+--        }
+-- :}
+--
+-- If we run @_controllerA@ the ouput is:
+--
+-- >>> execWriter $ runFromEnv (pure env) _controllerA 7
+-- ["logger 1","logger 1"]
+--
+-- But if we run the \"deceived\" @_controllerB@, we see that the function and its @_intermediate@ dependency use different loggers:
+--
+-- >>> execWriter $ runFromEnv (pure env) _controllerB 7
+-- ["logger 2","logger 1"]
+--
+-- Note that the function that is \"deceived\" must be polymorphic over
+-- 'Control.Monad.Dep.MonadDep'. Passing a function whose effect monad has
+-- already \"collapsed\" into 'DepT' won't work. Therefore, 'deceive' must be applied before any 'Advice'.
+deceive ::
+  forall as e e_ m r curried.
+  Gullible as e e_ m r curried =>
+  -- | The newtype constructor that masks the \"true\" environment.
+  (e_ (DepT e_ m) -> e) ->
+  -- | A function to be deceived. It must be polymorphic over 'Control.Monad.Dep.MonadDep'.
+  NewtypedEnv as e e_ m r curried ->
+  -- | The deceived function, that has effects in 'DepT'.
+  curried
+deceive = _deceive
+
+-- deceving *all* fields of a record
+--
+--
+type GullibleRecord :: Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> ((Type -> Type) -> Type) -> Constraint
+class GullibleRecord e e_ m gullible where
+  _deceiveRecord :: (e_ (DepT e_ m) -> e) -> gullible (ReaderT e m) -> gullible (DepT e_ m)
+
+-- https://gitlab.haskell.org/ghc/ghc/-/issues/13952
+type GullibleProduct :: Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> (k -> Type) -> (k -> Type) -> Constraint
+class GullibleProduct e e_ m gullible_ deceived_ | e e_ m deceived_ -> gullible_ where
+  _deceiveProduct :: (e_ (DepT e_ m) -> e) -> gullible_ k -> deceived_ k
+
+instance
+  ( GullibleProduct e e_ m gullible_left deceived_left,
+    GullibleProduct e e_ m gullible_right deceived_right
+  ) =>
+  GullibleProduct e e_ m (gullible_left G.:*: gullible_right) (deceived_left G.:*: deceived_right)
+  where
+  _deceiveProduct f (gullible_left G.:*: gullible_right) = _deceiveProduct @_ @e @e_ @m f gullible_left G.:*: _deceiveProduct @_ @e @e_ @m f gullible_right
+
+data RecordComponent
+  = Terminal
+  | IWrapped
+  | Recurse
+
+type DiscriminateGullibleComponent :: Type -> RecordComponent
+type family DiscriminateGullibleComponent c where
+  DiscriminateGullibleComponent (a -> b) = Terminal
+  DiscriminateGullibleComponent (ReaderT e m x) = Terminal
+  DiscriminateGullibleComponent (Identity _) = IWrapped
+  DiscriminateGullibleComponent (I _) = IWrapped
+  DiscriminateGullibleComponent _ = Recurse
+
+type GullibleComponent :: RecordComponent -> Type -> ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type -> Constraint
+class GullibleComponent component_type e e_ m gullible deceived | e e_ m deceived -> gullible where
+  _deceiveComponent :: (e_ (DepT e_ m) -> e) -> gullible -> deceived
+
+instance
+  (Gullible as e e_ m r deceived, NewtypedEnv as e e_ m r deceived ~ gullible) =>
+  GullibleComponent Terminal e e_ m gullible deceived
+  where
+  _deceiveComponent f gullible = deceive @as @e @_ @m @r f gullible
+
+instance
+  GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
+  GullibleComponent IWrapped e e_ m (Identity gullible) (Identity deceived)
+  where
+  _deceiveComponent f (Identity gullible) = Identity (_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m f gullible)
+
+instance
+  GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
+  GullibleComponent IWrapped e e_ m (I gullible) (I deceived)
+  where
+  _deceiveComponent f (I gullible) = I (_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m f gullible)
+
+instance
+  GullibleRecord e e_ m gullible =>
+  GullibleComponent Recurse e e_ m (gullible (ReaderT e m)) (gullible (DepT e_ m))
+  where
+  _deceiveComponent f gullible = _deceiveRecord @e @e_ @m f gullible
+
+instance
+  GullibleComponent (DiscriminateGullibleComponent gullible) e e_ m gullible deceived =>
+  GullibleProduct e e_ m (G.S1 x (G.Rec0 gullible)) (G.S1 x (G.Rec0 deceived))
+  where
+  _deceiveProduct f (G.M1 (G.K1 gullible)) = G.M1 (G.K1 (_deceiveComponent @(DiscriminateGullibleComponent gullible) @e @e_ @m f gullible))
+
+instance
+  ( G.Generic (gullible (ReaderT e m)),
+    G.Generic (gullible (DepT e_ m)),
+    G.Rep (gullible (ReaderT e m)) ~ G.D1 x (G.C1 y gullible_),
+    G.Rep (gullible (DepT e_ m)) ~ G.D1 x (G.C1 y deceived_),
+    GullibleProduct e e_ m gullible_ deceived_
+  ) =>
+  GullibleRecord e e_ m gullible
+  where
+  _deceiveRecord f gullible =
+    let G.M1 (G.M1 gullible_) = G.from gullible
+        deceived_ = _deceiveProduct @_ @e @e_ @m f gullible_
+     in G.to (G.M1 (G.M1 deceived_))
+
+-- | Makes an entire record-of-functions see a different version of the global environment record, a version that might have different @HasX@ instances.
+--
+-- 'deceiveRecord' must be applied before 'adviseRecord'.
+deceiveRecord ::
+  forall e e_ m gullible.
+  GullibleRecord e e_ m gullible =>
+  -- | The newtype constructor that masks the \"true\" environment.
+  (e_ (DepT e_ m) -> e) ->
+  -- | The record to deceive recursively. The monad parameter must be left polymorphic over @MonadDep@, so that it can unify with `ReaderT`.
+  gullible (ReaderT e m) ->
+  -- | The deceived record.
+  gullible (DepT e_ m)
+deceiveRecord = _deceiveRecord @e @e_ @m @gullible
+
+
+-- | 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.
+--
+-- You must have a sufficiently polymorphic constructor—both in the monad and
+-- in the environment—to invoke this function.
+--
+-- 'component' lets you plug simple component constructors 
+-- into a 'DepT'-based environment.
+--
+-- Compare with 'Control.Monad.Dep.Env.constructor' from "Control.Monad.Dep.Env", which 
+-- is intended to be used with 'Control.Monad.Dep.Env.fixEnv'-based environments.
+component 
+    :: forall e_ m record . (Applicative m, DistributiveRecord e_ m record) => 
+    -- | constructor which takes the environment as a positional parameter.
+    (e_ (DepT e_ m) -> record (DepT e_ m)) ->
+    -- | component whose methods get the environment by 'ask'ing.
+    record (DepT e_ m)
+component f = _distribute @e_ @m (pure . f)
+
+
+
+type DistributiveRecord :: ((Type -> Type) -> Type) -> (Type -> Type) -> ((Type -> Type) -> Type) -> Constraint
+class DistributiveRecord e_ m record where
+    _distribute :: (e_ (DepT e_ m) -> m (record (DepT e_ m))) -> record (DepT e_ m)
+
+type DistributiveProduct :: ((Type -> Type) -> Type) -> (Type -> Type) -> (k -> Type) -> Constraint
+class DistributiveProduct e_ m product where
+    _distributeProduct :: (e_ (DepT e_ m) -> m (product k)) -> product k
+
+instance
+  ( G.Generic (advised (DepT e_ m)),
+    G.Rep (advised (DepT e_ m)) ~ G.D1 x (G.C1 y advised_),
+    DistributiveProduct e_ m advised_,
+    Functor m
+  ) =>
+  DistributiveRecord e_ m advised
+  where
+  _distribute f =
+    let advised_ = _distributeProduct @_ @e_ @m (fmap (fmap (G.unM1 . G.unM1 . G.from)) f)
+     in G.to (G.M1 (G.M1 advised_))
+
+instance
+  ( DistributiveProduct e_ m advised_left,
+    DistributiveProduct e_ m advised_right,
+    Functor m
+  ) =>
+  DistributiveProduct e_ m (advised_left G.:*: advised_right)
+  where
+  _distributeProduct f  = 
+      _distributeProduct @_ @e_ @m (fmap (fmap (\(l G.:*: _) -> l)) f) 
+      G.:*: 
+      _distributeProduct @_ @e_ @m (fmap (fmap (\(_ G.:*: r) -> r)) f) 
+
+instance
+  ( 
+    Functor m, 
+    Multicurryable as e_ m r advised
+  ) =>
+  DistributiveProduct e_ m (G.S1 ( 'G.MetaSel msymbol su ss ds) (G.Rec0 advised))
+  where
+  _distributeProduct f = G.M1 . G.K1 $ askFinalDepT @as @e_ @m @r (fmap (fmap (G.unK1 . G.unM1))  f)
+
+-- advising *all* fields of a record
+--
+--
+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 => 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 => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised_ k -> advised_ k
+
+instance
+  ( G.Generic (advised (DepT e_ m)),
+    -- G.Rep (advised (DepT e_ m)) ~ G.D1 ('G.MetaData name mod p nt) (G.C1 y advised_),
+    G.Rep (advised (DepT e_ m)) ~ G.D1 x (G.C1 y advised_),
+    Typeable advised,
+    AdvisedProduct ca e_ m cr advised_
+  ) =>
+  AdvisedRecord ca e_ m cr advised
+  where
+  _adviseRecord acc f unadvised =
+    let G.M1 (G.M1 unadvised_) = G.from unadvised
+        advised_ = _adviseProduct @_ @ca @e_ @m @cr (typeRep (Proxy @advised)) acc f unadvised_
+     in G.to (G.M1 (G.M1 advised_))
+
+instance
+  ( AdvisedProduct ca e_ m cr advised_left,
+    AdvisedProduct ca e_ m cr advised_right
+  ) =>
+  AdvisedProduct ca e_ m cr (advised_left G.:*: advised_right)
+  where
+  _adviseProduct tr acc f (unadvised_left G.:*: unadvised_right) = _adviseProduct @_ @ca @e_ @m @cr tr acc f unadvised_left G.:*: _adviseProduct @_ @ca @e_ @m @cr tr acc f unadvised_right
+
+type DiscriminateAdvisedComponent :: Type -> RecordComponent
+type family DiscriminateAdvisedComponent c where
+  DiscriminateAdvisedComponent (a -> b) = Terminal
+  DiscriminateAdvisedComponent (DepT e_ m x) = Terminal
+  DiscriminateAdvisedComponent (Identity _) = IWrapped
+  DiscriminateAdvisedComponent (I _) = IWrapped
+  DiscriminateAdvisedComponent _ = Recurse
+
+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 => NonEmpty (TypeRep, String) -> Advice ca e_ m r) -> advised -> advised
+
+instance
+  ( AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised,
+    KnownSymbol fieldName
+  ) =>
+  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' = (tr, symbolVal (Proxy @fieldName)) : acc
+     in G.M1 (G.K1 (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @m @cr acc' f advised))
+
+instance
+  AdvisedRecord ca e_ m cr advisable =>
+  AdvisedComponent Recurse ca e_ m cr (advisable (DepT e_ m))
+  where
+  _adviseComponent acc f advised = _adviseRecord @ca @e_ @m @cr acc f advised
+
+instance
+  (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 (N.fromList acc)) advised
+
+instance
+  AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised =>
+  AdvisedComponent IWrapped ca e_ m cr (Identity advised)
+  where
+  _adviseComponent acc f (Identity advised) = Identity (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @m @cr acc f advised)
+
+instance
+  AdvisedComponent (DiscriminateAdvisedComponent advised) ca e_ m cr advised =>
+  AdvisedComponent IWrapped ca e_ m cr (I advised)
+  where
+  _adviseComponent acc f (I advised) = I (_adviseComponent @(DiscriminateAdvisedComponent advised) @ca @e_ @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 e_ m advised.
+  AdvisedRecord ca e_ m cr advised =>
+  -- | The advice to apply.
+  (forall r . cr r => NonEmpty (TypeRep, String) -> Advice ca e_ m r) ->
+  -- | The record to advise recursively.
+  advised (DepT e_ m) ->
+  -- | The advised record.
+  advised (DepT e_ m)
+adviseRecord = _adviseRecord @ca @e_ @m @cr []
+
+-- $records
+--
+-- 'adviseRecord' and 'deceiveRecord' are versions of 'advise' and 'deceive' that, instead of working on bare
+-- functions, transform entire records-of-functions in one go. They also work
+-- with newtypes containing a single function. The records must derive 'GHC.Generics.Generic'.
+--
+-- Useful with the \"wrapped\" style of components facilitated by @Control.Monad.Dep.Has@.
+--
+-- >>> :{
+--   type Logger :: (Type -> Type) -> Type
+--   newtype Logger d = Logger {log :: String -> d ()} deriving Generic
+--   type Repository :: (Type -> Type) -> Type
+--   data Repository d = Repository
+--     { select :: String -> d [Int],
+--       insert :: [Int] -> d ()
+--     } deriving Generic
+--   type Controller :: (Type -> Type) -> Type
+--   newtype Controller d = Controller {serve :: Int -> d String} deriving Generic
+--   type Env :: (Type -> Type) -> Type
+--   data Env m = Env
+--     { logger :: Logger m,
+--       repository :: Repository m,
+--       controller :: Controller m
+--     }
+--   newtype Wraps x = Wraps x
+--   env :: Env (DepT Env (Writer ()))
+--   env =
+--     let logger = Logger \_ -> pure ()
+--         repository =
+--           adviseRecord @Top @Top mempty $
+--           deceiveRecord Wraps $
+--           Repository {select = \_ -> pure [], insert = \_ -> pure ()}
+--         controller =
+--           adviseRecord @Top @Top mempty $
+--           deceiveRecord Wraps $
+--           Controller \_ -> pure "view"
+--      in Env {logger, repository, controller}
+-- :}
+
+-- $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 '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')
+
+-- | Like 'fromSimple', but for 'Control.Monad.Dep.SimpleAdvice.Advice's that don't use the environment.
+fromSimple_ :: forall ca e_ m r. Monad m => SA.Advice ca (DepT e_ m) r -> Advice ca e_ m r
+fromSimple_ advice = fromSimple \_ -> advice
+

@@ -0,0 +1,108 @@+{-# 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 Dep.Advice.Basic
+  ( -- * Basic advices
+    doLocally
+  )
+where
+
+import Dep.Advice
+import Control.Monad.Dep
+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
+
+-- $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 Dep.Advice
+-- >>> import Dep.Advice.Basic
+-- >>> import Control.Monad
+-- >>> import Control.Monad.Dep
+-- >>> import Data.Kind
+-- >>> import Data.SOP
+-- >>> import Data.SOP.NP
+-- >>> import Data.Monoid
+-- >>> import System.IO
+-- >>> import Data.IORef
+
+
+-- | Use 'local' on the final 'DepT' action of a function.
+--
+-- Allows tweaking the environment that will be seen by the function and all of
+-- its sub-calls into dependencies. 
+--
+-- Perhaps this is __not__ what you want; often, it's better to tweak
+-- the environment for the current function only. For those cases,
+-- 'Control.Monad.Dep.Advice.deceive' might be a better fit. 
+--
+-- >>> :{
+--  type HasLogger :: Type -> (Type -> Type) -> Constraint
+--  class HasLogger em m | em -> m where
+--    logger :: em -> String -> m ()
+--  type Env :: (Type -> Type) -> Type
+--  data Env m = Env
+--    { _logger1 :: String -> m (),
+--      _logger2 :: String -> m (),
+--      _controllerA :: Int -> m (),
+--      _controllerB :: Int -> m ()
+--    }
+--  instance HasLogger (Env m) m where
+--    logger = _logger1
+--  envIO :: Env (DepT Env IO)
+--  envIO = Env 
+--    {
+--      _logger1 = 
+--          \_ -> liftIO $ putStrLn "logger1 ran",
+--      _logger2 = 
+--          \_ -> liftIO $ putStrLn "logger2 ran",
+--      _controllerA = 
+--          \_ -> do e <- ask; logger e "foo",
+--      _controllerB = 
+--          advise @Top 
+--          (doLocally \e@Env{_logger2} -> e {_logger1 = _logger2}) 
+--          \_ -> do e <- ask; logger e "foo" 
+--    }
+-- :}
+--
+--  >>> runFromEnv (pure envIO) _controllerA 0
+--  logger1 ran
+--
+--  >>> runFromEnv (pure envIO) _controllerB 0
+--  logger2 ran
+--
+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)  
+
+

@@ -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 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 Dep.Has
+import Dep.SimpleAdvice.Internal 
+import Data.Coerce
+import Control.Monad
+import Control.Monad.Fix
+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
+
+-- $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 Dep.SimpleAdvice
+-- >>> import Dep.SimpleAdvice.Basic (printArgs,returnMempty)
+-- >>> import Control.Monad
+-- >>> import Control.Monad.Trans
+-- >>> 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,238 @@+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+-- |
+-- This module contains basic examples advices.
+--
+-- __/BEWARE!/__ These are provided for illustrative purposes only, they
+-- strive for simplicity and not robustness or efficiency.
+--
+-- They can be converted to @DepT@-based 'Dep.Advice.Advice's using 'Dep.Advice.fromSimple'.
+module Dep.SimpleAdvice.Basic
+  ( -- * Basic advices
+    returnMempty,
+    printArgs,
+    AnyEq (..),
+    doCachingBadly,
+    doAsyncBadly,
+    injectFailures,
+    -- ** Synthetic call stacks
+    MethodName,
+    StackFrame,
+    SyntheticCallStack,
+    SyntheticCallStackException (..),
+    HasSyntheticCallStack (..),
+    keepCallStack
+  )
+where
+
+import Dep.SimpleAdvice
+import Control.Monad.Reader
+import Control.Monad.Trans
+import Data.Proxy
+import Data.Functor.Constant
+import Data.Functor.Identity
+import Data.SOP
+import Data.SOP (hctraverse_)
+import Data.SOP.NP
+import Data.Type.Equality
+import System.IO
+import Control.Concurrent
+import Control.Monad.IO.Unlift
+import Data.IORef
+import Control.Exception
+import Type.Reflection
+import qualified Data.Typeable as T
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty qualified as NonEmpty
+
+-- $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.Trans
+-- >>> import Dep.SimpleAdvice
+-- >>> import 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`. 
+doAsyncBadly :: forall ca m . MonadUnliftIO m => Advice ca m ()
+doAsyncBadly = makeExecutionAdvice \action -> do
+    _ <- withRunInIO (\unlift -> forkIO (unlift action))
+    pure ()
+
+
+-- | Given a reference with two infinite lists of 'IO' actions, on each
+-- invocation of the advised function, take an action from the first list and
+-- execute it before, and take one action from the second list and execute it
+-- after.
+--
+-- A common use for this would be to pass exception-throwing actions.
+injectFailures :: forall ca m r . (MonadIO m, MonadFail m) => IORef ([IO ()], [IO ()]) -> Advice ca m r
+injectFailures ref = makeExecutionAdvice \action -> do
+    (before, after) <- liftIO $ atomicModifyIORef' ref \(before : befores, after : afters) -> ((befores, afters), (before, after))
+    liftIO before
+    r <- action
+    liftIO after
+    pure r
+
+
+-- Synthetic call stacks
+--
+
+
+type MethodName = String
+
+-- | The typeable representation of the record which contains the invoked
+-- function, along with the field name of the invoked function.
+type StackFrame = (T.TypeRep, MethodName)
+
+type SyntheticCallStack = [StackFrame]
+
+-- | Wraps an exception along with a 'SyntheticCallStack'.
+data SyntheticCallStackException
+  = SyntheticCallStackException SomeException SyntheticCallStack
+  deriving stock Show
+
+instance Exception SyntheticCallStackException
+
+-- | Class of environments that carry a 'SyntheticCallStack' value that can be
+-- modified.
+class HasSyntheticCallStack e where
+    -- | A lens from the environment to the call stack.
+    callStack :: forall f . Functor f => (SyntheticCallStack -> f SyntheticCallStack) -> e -> f e
+
+-- | The trivial case, useful when 'SyntheticCallStack' is the environment type
+-- of a 'Control.Monad.Reader.ReaderT'.
+instance HasSyntheticCallStack SyntheticCallStack where
+    callStack = id
+
+-- | If the environment carries a 'SyntheticCallStack', make advised functions add
+-- themselves to the 'SyntheticCallStack' before they start executing.
+--
+-- This 'Dep.SimpleAdvice.Advice' requires a reader-like base monad to work. It
+-- doesn't need to be 'Control.Monad.Dep.DepT', it can be regular a
+-- 'Control.Monad.Reader.ReaderT'.
+--
+-- Caught exceptions are rethrown wrapped in 'SyntheticCallStackException's,
+-- with the current 'SyntheticCallStack' added.
+keepCallStack ::
+  (MonadUnliftIO m, MonadReader runenv m, HasSyntheticCallStack runenv, Exception e) =>
+  -- | A selector for the kinds of exceptions we want to catch.
+  -- For example @fromException \@IOError@.
+  (SomeException -> Maybe e) ->
+  -- | The path to the current component/method in the environment. Only the
+  -- head is used. It will be usually obtained through
+  -- 'Dep.SimpleAdvice.adviseRecord'.
+  NonEmpty (T.TypeRep, MethodName) ->
+  Advice ca m r
+keepCallStack selector (NonEmpty.head -> method) = makeExecutionAdvice \action -> do
+  currentStack <- asks (view callStack)
+  withRunInIO \unlift -> do
+    er <- tryJust selector (unlift (local (over callStack (method :)) action))
+    case er of
+      Left e -> throwIO (SyntheticCallStackException (toException e) (method : currentStack))
+      Right r -> pure r
+  where
+  view l = getConstant . l Constant
+  over l f = runIdentity . l (Identity . f)
+
+
+

@@ -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 Dep.SimpleAdvice.Internal where
+
+import Dep.Has
+import Data.Coerce
+import Control.Monad
+import Control.Monad.Fix
+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
+

@@ -26,10 +26,10 @@ 
 import Prelude hiding (log)
 import Barbies
+import Dep.Has
+import Dep.SimpleAdvice
+import Dep.SimpleAdvice.Basic
 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 

@@ -0,0 +1,349 @@+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- | An example of how an application can make use of the "dep-t" and
+-- "dep-t-advice" packages for keeping a "synthetic" call stack that tracks the
+-- invocations of monadic functions—though only of those which take part in dependency
+-- injection.
+--
+-- We are assuming that the application follows a "record-of-functions" style.
+module Main (main) where
+
+import Control.Exception
+import Control.Monad.Dep (DepT)
+import Control.Monad.IO.Unlift
+import Control.Monad.Reader
+import Control.Monad.Trans.Cont
+import Data.Function ((&))
+import Data.Functor ((<&>))
+import Data.Functor.Compose
+import Data.Functor.Constant
+import Data.Functor.Identity
+import Data.IORef
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Set (Set)
+import Data.Set qualified as Set
+import Data.Typeable
+import Dep.Advice qualified as A
+import Dep.Env
+  ( Autowireable,
+    Autowired (..),
+    Constructor,
+    DemotableFieldNames,
+    FieldsFindableByType,
+    Phased,
+    bindPhase,
+    constructor,
+    fixEnv,
+    pullPhase,
+    skipPhase,
+  )
+import Dep.Has
+  ( Has (dep),
+    asCall,
+  )
+import Dep.SimpleAdvice
+  ( Advice,
+    AspectT (..),
+    Top,
+    adviseRecord,
+    advising,
+    makeExecutionAdvice,
+  )
+import Dep.SimpleAdvice.Basic (HasSyntheticCallStack (callStack), MethodName, StackFrame, SyntheticCallStack, SyntheticCallStackException (SyntheticCallStackException), injectFailures, keepCallStack)
+import GHC.Generics (Generic)
+import GHC.TypeLits
+import Lens.Micro (Lens', lens)
+import System.IO
+import Test.Tasty
+import Test.Tasty.HUnit
+import Prelude hiding (insert, lookup)
+
+-- THE BUSINESS LOGIC
+--
+--
+
+-- Component interfaces, defined as records polymorphic over the effect monad.
+newtype Logger m = Logger
+  { emitMsg :: String -> m ()
+  }
+  deriving stock (Generic)
+
+data Repository m = Repository
+  { insert :: Int -> m (),
+    lookup :: Int -> m Bool
+  }
+  deriving stock (Generic)
+
+newtype Controller m = Controller
+  { -- insert one arg, look up the other. Nonsensical, but good enough for an example.
+    route :: Int -> Int -> m Bool
+  }
+  deriving stock (Generic)
+
+-- Component implementations, some of which depend on other components.
+--
+makeStdoutLogger :: MonadIO m => Logger m
+makeStdoutLogger = Logger \msg -> liftIO $ putStrLn msg
+
+-- allocation helper.
+allocateSet :: Allocator (IORef (Set Int))
+allocateSet = ContT $ bracket (newIORef Set.empty) pure
+
+-- When a component depends on another, it does so by taking an "env" parameter
+-- in the constructor and requiring 'Has' constraints on it.
+makeInMemoryRepository ::
+  (Has Logger m env, MonadIO m) =>
+  IORef (Set Int) ->
+  env ->
+  Repository m
+makeInMemoryRepository ref (asCall -> call) = do
+  Repository
+    { insert = \key -> do
+        call emitMsg "inserting..."
+        theSet <- liftIO $ readIORef ref
+        liftIO $ writeIORef ref $ Set.insert key theSet,
+      lookup = \key -> do
+        call emitMsg "looking..."
+        theSet <- liftIO $ readIORef ref
+        pure (Set.member key theSet)
+    }
+
+-- This implementation of Controller depends both on the Logger and the
+-- Repository.
+--
+-- In general, the graph of dependencies between components can be a complex
+-- directed acyclic graph.
+makeController ::
+  (Has Logger m env, Has Repository m env, Monad m) =>
+  env ->
+  Controller m
+makeController (asCall -> call) =
+  Controller
+    { route = \toInsert toLookup -> do
+        call emitMsg "serving..."
+        call insert toInsert
+        call lookup toLookup
+    }
+
+-- THE COMPOSITION ROOT
+--
+-- Here we define our dependency injection environment.
+--
+-- We put all the components which will form part of our application in an
+-- environment record.
+--
+-- Each field is wrapped in a functor `h` which controls the "phases" we must
+-- go through in  the construction of the environment. When `h` becomes
+-- Identity, the environment is ready for use. (This is an example of the
+-- "Higer-Kinded Data" pattern.)
+data Env h m = Env
+  { logger :: h (Logger m),
+    repository :: h (Repository m),
+    controller :: h (Controller m)
+  }
+  deriving stock (Generic)
+  deriving anyclass (Phased, DemotableFieldNames, FieldsFindableByType)
+
+-- Locate the components by their types. We could also define the required Has
+-- instance for each component manually, but that's tedious.
+deriving via Autowired (Env Identity m) instance Autowireable r_ m (Env Identity m) => Has r_ m (Env Identity m)
+
+-- The "phases" that components go through until fully built. Each phase
+-- is represented as an applicative functor. The succession of phases is
+-- defined using Data.Functor.Compose.
+--
+
+-- A phase in which we might allocate some resource needed by the component,
+-- also set some bracket-like resource management.
+-- The "managed" library could be used instead of ContT.
+type Allocator = ContT () IO
+
+-- First we allocate any needed resource, then we have a construction phase
+-- during which the component reads its own dependencies from a "completed"
+-- environment.
+--
+-- There could be more phases, like for example an initial "read configuration"
+-- phase.
+type Phases env_ m = Allocator `Compose` Constructor env_ m
+
+-- Environment value
+--
+-- The base monad is a 'ReaderT' holding a SyntheticCallStack value which gets modified
+-- using "local" for each sub-call.
+--
+-- Notice that neither the interfaces nor the implementations which we defined
+-- earlier knew anything about the ReaderT.
+env :: Env (Phases Env (ReaderT SyntheticCallStack IO)) (ReaderT SyntheticCallStack IO)
+env =
+  Env
+    { logger =
+        allocateBombs 1 `bindPhase` \bombs ->
+          constructor (\_ -> makeStdoutLogger)
+            <&> advising
+              ( adviseRecord @Top @Top \method ->
+                  keepCallStack ioEx method <> injectFailures bombs
+              ),
+      repository =
+        allocateSet `bindPhase` \ref ->
+          constructor (makeInMemoryRepository ref)
+            <&> advising
+              ( adviseRecord @Top @Top \method ->
+                  keepCallStack ioEx method
+              ),
+      controller =
+        skipPhase @Allocator $
+          constructor makeController
+            <&> advising
+              ( adviseRecord @Top @Top \method ->
+                  keepCallStack ioEx method
+              )
+    }
+
+-- Catch only IOExceptions for this example.
+ioEx :: SomeException -> Maybe IOError
+ioEx = fromException @IOError
+
+-- Allocate a supply of potentially exception-throwing actions.
+allocateBombs :: Int -> Allocator (IORef ([IO ()], [IO ()]))
+allocateBombs whenToBomb = ContT $ bracket (newIORef bombs) pure
+  where
+    bombs =
+      ( replicate whenToBomb (pure ()) ++ repeat (throwIO (userError "oops")),
+        repeat (pure ())
+      )
+
+-- THE COMPOSITION ROOT - ALTERNATIVE APPROACH
+--
+--
+-- Here we'll define the dependency injection environment in a slightly
+-- different way (but reusing both the "business logic" and the Env type).
+
+-- The basic idea is that we don't perform dependency injection as a separate
+-- Applicative phase (so no Constructor, but a mere Identity phase).
+--
+-- Instead, we shift that task into the base monad's environent.
+
+-- As a result the "phases" are simpler:
+type Phases' = Allocator `Compose` Identity
+
+-- Now the expanded "runtime" environment will hold both the synthetic call
+-- stack and the components. We define this small helper datatype for that. It
+-- augments a preexisting environment with call-related info.
+data CallEnv i e_ m = CallEnv
+  { _callInfo :: i,
+    _ops :: e_ m
+  }
+
+-- Delegate all 'Has' queries to the inner environment.
+instance Has r_ m (e_ m) => Has r_ m (CallEnv i e_ m) where
+  dep = dep . _ops
+
+instance HasSyntheticCallStack (CallEnv SyntheticCallStack e_ m) where
+  callStack = lens _callInfo (\(CallEnv _ ops) i' -> CallEnv i' ops)
+
+-- Here use the DepT monad (a variant of ReaderT) as the base monad.
+--
+-- The environment of DepT includes—just as before—the SyntheticCallStack value
+-- that is used to trace each sub-call.
+--
+-- But now it also includes the dependency injection context with all the
+-- components.
+env' :: Env Phases' (DepT (CallEnv SyntheticCallStack (Env Identity)) IO)
+env' =
+  Env
+    { logger =
+        allocateBombs 1 `bindPhase` \bombs ->
+          Identity (A.component \_ -> makeStdoutLogger)
+            <&> ( A.adviseRecord @Top @Top \method ->
+                    A.fromSimple_ (keepCallStack ioEx method <> injectFailures bombs)
+                ),
+      repository =
+        allocateSet `bindPhase` \ref ->
+          Identity (A.component (makeInMemoryRepository ref))
+            <&> ( A.adviseRecord @Top @Top \method ->
+                    A.fromSimple_ (keepCallStack ioEx method)
+                ),
+      controller =
+        skipPhase @Allocator $
+          Identity (A.component makeController)
+            <&> ( A.adviseRecord @Top @Top \method ->
+                    A.fromSimple_ (keepCallStack ioEx method)
+                )
+    }
+
+-- TESTS
+--
+--
+expectedException :: (IOError, SyntheticCallStack)
+expectedException =
+  ( userError "oops",
+    [ (typeRep (Proxy @Logger), "emitMsg"),
+      (typeRep (Proxy @Repository), "insert"),
+      (typeRep (Proxy @Controller), "route")
+    ]
+  )
+
+-- Test the "Constructor"-based version of the environment.
+testSyntheticCallStack :: Assertion
+testSyntheticCallStack = do
+  let action =
+        runContT (pullPhase @Allocator env) \constructors -> do
+          -- here we complete the construction of the environment
+          let (asCall -> call) = fixEnv constructors 
+          flip
+            runReaderT
+            ([] :: SyntheticCallStack) -- the initial stack trace for the call
+            ( do
+                _ <- call route 1 2
+                pure ()
+            )
+  me <- try @SyntheticCallStackException action
+  case me of
+    Left (SyntheticCallStackException (fromException @IOError -> Just ex) trace) ->
+      assertEqual "exception with callstack" expectedException (ex, trace)
+    Right _ -> assertFailure "expected exception did not appear"
+
+-- Test the "DepT"-based version of the environment.
+testSyntheticCallStack' :: Assertion
+testSyntheticCallStack' = do
+  let action =
+        runContT (pullPhase @Allocator env') \runnable -> do
+          _ <- A.runFromDep (pure (CallEnv [] runnable)) route 1 2
+          pure ()
+  me <- try @SyntheticCallStackException action
+  case me of
+    Left (SyntheticCallStackException (fromException @IOError -> Just ex) trace) ->
+      assertEqual "exception with callstack" expectedException (ex, trace)
+    Right _ -> assertFailure "expected exception did not appear"
+
+tests :: TestTree
+tests =
+  testGroup
+    "All"
+    [ testCase "synthetic call stack" testSyntheticCallStack,
+      testCase "synthetic call stack - DepT" testSyntheticCallStack'
+    ]
+
+main :: IO ()
+main = defaultMain tests

@@ -26,10 +26,10 @@ 
 import Prelude hiding (log)
 import Control.Monad.Dep
-import Control.Monad.Dep.Has
-import Control.Monad.Dep.Env
-import Control.Monad.Dep.Advice
-import Control.Monad.Dep.Advice.Basic
+import Dep.Has
+import Dep.Env
+import Dep.Advice
+import Dep.Advice.Basic
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.RWS

@@ -18,10 +18,10 @@ 
 module Main (main) where
 
+import Dep.Advice
+import Dep.Advice.Basic
+import Dep.SimpleAdvice.Basic
 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

@@ -24,9 +24,9 @@ module Main (main) where
 
 import Barbies
+import Dep.Advice
+import Dep.Has
 import Control.Monad.Dep
-import Control.Monad.Dep.Advice
-import Control.Monad.Dep.Has
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Data.Coerce