dep-t 0.4.5.0 → 0.4.6.0

raw patch · 10 files changed

+938/−27 lines, 10 filesdep +aesondep +barbiesdep +bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson, barbies, bytestring, containers, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +30/−8
• dep-t.cabal +20/−1
• lib/Control/Monad/Dep.hs +2/−1
• lib/Control/Monad/Dep/Class.hs +1/−1
• lib/Control/Monad/Dep/Env.hs +506/−0
• lib/Control/Monad/Dep/Has.hs +9/−9
• test/doctests.hs +1/−1
• test/tests_env.hs +219/−0
• test/tests_has.hs +146/−6

@@ -1,5 +1,9 @@ # Revision history for dep-t
 
+## 0.4.6.0
+
+* added new module Control.Monad.Dep.Env with helpers for defining environments of records.
+
 ## 0.4.5.0
 
 * added "asCall" to Control.Monad.Dep.Has

@@ -166,6 +166,15 @@ `DepT` has `MonadReader` and `LiftDep` instances, so the effects of
 `mkController` can take place on it.
 
+## Inter-module dependencies
+
+[![dep-t.png](https://i.postimg.cc/KcwgCBWv/dep-t.png)](https://postimg.cc/bd0JtD8K)
+
+- __Control.Monad.Dep.Class__ can be used to program against both `ReaderT` and `DepT`.
+- __Control.Monad.Dep__ contains the actual `DepT` monad transformer.
+- __Control.Monad.Dep.Has__ can be useful independently of `ReaderT`, `DepT` or any monad transformer.
+- __Control.Monad.Dep.Env__ provides extra definitions that help when building environments of records.
+
 ## So how do we invoke the controller now?
 
 I suggest something like
@@ -223,6 +232,16 @@ general method of extending the behaviour of `DepT`-effectful functions, in a
 way reminiscent of aspect-oriented programming.
 
+## What if I don't want to use DepT, or any other monad transformer for that matter?
+
+Check out the function `fixEnv` in module `Control.Monad.Dep.Env`, which
+provides a transformer-less way to perform dependency injection, based on
+knot-tying.
+
+That method requires an environment parameterized by _two_ type constructors:
+one that wraps each field, and another that works as the effect monad for the
+components.
+
 ## Caveats
 
 The structure of the `DepT` type might be prone to trigger a [known infelicity
@@ -249,7 +268,7 @@   [Adventures assembling records of
   capabilities](https://discourse.haskell.org/t/adventures-assembling-records-of-capabilities/623)
   which relies on having "open" and "closed" versions of the environment
-  record. 
+  record, and getting the latter from the former by means of knot-tying. 
 
   It seems that, with `DepT`, functions in the environment obtain their
   dependencies anew every time they are invoked. If we change a function in the
@@ -265,14 +284,13 @@   Context](http://logback.qos.ch/manual/mdc.html).
 
   So perhaps `DepT` will be overkill in a lot of cases, offering unneeded
-  flexibility. [This
-  gist](https://gist.github.com/danidiaz/358fdccdef51ad37bbec932631dcc4d2)
-  contains an example of `DepT`-less and `ReaderT`-less dependency injection.
-  It does use `Control.Monad.Dep.Has`, in combination with "open" and "closed"
-  versions of the environment record. Unlike in "Adventures..." the gist
-  doesn't use an extensible record for the environment but, to keep things
-  simple, a suitably parameterized conventional one.
+  flexibility. Perhaps using `fixEnv` from `Control.Monad.Dep.Env` will end up
+  being simpler.
 
+  Unlike in "Adventures..." the `fixEnv` method doesn't use an extensible
+  record for the environment but, to keep things simple, a suitably
+  parameterized conventional one.
+
 - Another exploration of dependency injection with `ReaderT`:
   [ReaderT-OpenProduct-Environment](https://github.com/keksnicoh/ReaderT-OpenProduct-Environment).
 
@@ -311,4 +329,8 @@ - [registry](http://hackage.haskell.org/package/registry) is a package that
   implements an alternative approach to dependency injection, one different
   from the `ReaderT`-based one. 
+
+- [Printf("%s %s", dependency, injection)](https://www.fredrikholmqvist.com/posts/print-dependency-injection/). Commented on [HN](https://news.ycombinator.com/item?id=28915630), [Lobsters](https://lobste.rs/s/4axrt6/printf_s_s_dependency_injection).
+
+- [This book](https://www.goodreads.com/book/show/44416307-dependency-injection-principles-practices-and-patterns) about DI is good.
 

@@ -1,7 +1,7 @@ cabal-version:       3.0
 
 name:                dep-t
-version:             0.4.5.0
+version:             0.4.6.0
 synopsis:            Reader-like monad transformer for dependency injection.
 description:         Put all your functions in the environment record! Let all
                      your functions read from the environment record! No favorites!
@@ -29,6 +29,7 @@   exposed-modules:     Control.Monad.Dep
                        Control.Monad.Dep.Class
                        Control.Monad.Dep.Has
+                       Control.Monad.Dep.Env
   hs-source-dirs:      lib 
 
 test-suite dep-t-test
@@ -68,6 +69,24 @@     tasty              >=  1.3.1,
     tasty-hunit        >=  0.10.0.2,
     sop-core           ^>= 0.5.0.0,
+    barbies            ^>= 2.0
+
+test-suite dep-t-test-env
+  import: common
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             tests_env.hs
+  build-depends:       
+    dep-t, 
+    rank2classes       ^>= 1.4.1,
+    template-haskell,
+    tasty              >=  1.3.1,
+    tasty-hunit        >=  0.10.0.2,
+    sop-core           ^>= 0.5.0.0,
+    aeson              ^>= 2.0,
+    bytestring,
+    text,
+    containers
 
 
 -- VERY IMPORTANT for doctests to work: https://stackoverflow.com/a/58027909/1364288

@@ -8,6 +8,7 @@ {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE KindSignatures #-}
 
 -- |
 --    This package provides 'DepT', a monad transformer similar to 'ReaderT'.
@@ -74,7 +75,7 @@   (Type -> Type) ->
   Type ->
   Type
-newtype DepT e_ m r = DepT {toReaderT :: ReaderT (e_ (DepT e_ m)) m r}
+newtype DepT (e_ :: (Type -> Type) -> Type) (m :: Type -> Type) (r :: Type) = DepT {toReaderT :: ReaderT (e_ (DepT e_ m)) m r}
   deriving
     ( Functor,
       Applicative,

@@ -136,7 +136,7 @@   Type ->
   (Type -> Type) ->
   Constraint
-type family MonadDep dependencies d e m where
+type family MonadDep (dependencies :: [(Type -> Type) -> Type -> Constraint]) (d :: Type -> Type) (e :: Type) (m :: Type -> Type) where
   MonadDep '[] d e m = (LiftDep d m, MonadReader e m)
   MonadDep (dependency ': dependencies) d e m = (dependency d e, MonadDep dependencies d e m)
 

@@ -0,0 +1,506 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GADTs #-}
+
+-- | This module provides helpers for building dependency injection
+-- environments composed of records.
+--
+-- It's not necessary when defining the record components themselves, in that
+-- case 'Control.Monad.Dep.Has' should suffice.
+--
+-- >>> :{
+-- type Logger :: (Type -> Type) -> Type
+-- newtype Logger d = Logger {
+--     info :: String -> d ()
+--   }
+-- --
+-- data Repository d = Repository
+--   { findById :: Int -> d (Maybe String)
+--   , putById :: Int -> String -> d ()
+--   , insert :: String -> d Int
+--   }
+-- --
+-- data Controller d = Controller 
+--   { create :: d Int
+--   , append :: Int -> String -> d Bool 
+--   , inspect :: Int -> d (Maybe String)
+--   } 
+-- --
+-- type EnvHKD :: (Type -> Type) -> (Type -> Type) -> Type
+-- data EnvHKD h m = EnvHKD
+--   { logger :: h (Logger m),
+--     repository :: h (Repository m),
+--     controller :: h (Controller m)
+--   } deriving stock Generic
+-- -- deriving anyclass (FieldsFindableByType, DemotableFieldNames, Phased)
+-- -- deriving via Autowired (EnvHKD Identity m) instance Autowireable r_ m (EnvHKD Identity m) => Has r_ m (EnvHKD Identity m)
+-- :}
+--
+-- The module also provides a monad transformer-less way of performing dependency
+-- injection, by means of 'fixEnv'.
+--
+module Control.Monad.Dep.Env (
+      -- * A general-purpose Has
+      Has
+      -- * Helpers for deriving Has
+      -- ** via the default field name
+    , TheDefaultFieldName (..)
+      -- ** via arbitrary field name
+    , TheFieldName (..)
+      -- ** via autowiring
+    , FieldsFindableByType (..)
+    , Autowired (..)
+    , Autowireable
+      -- * Managing phases
+    , Phased (..)
+    , pullPhase
+    , mapPhase
+    , liftA2Phase
+      -- ** Working with field names
+    , DemotableFieldNames (..)
+    , demoteFieldNames
+    , mapPhaseWithFieldNames
+      -- ** Constructing phases
+      -- $phasehelpers
+    , bindPhase
+    , skipPhase  
+      -- * Injecting dependencies by tying the knot
+    , fixEnv
+    , Constructor
+    , constructor
+      -- * Inductive environment with anonymous fields
+    , InductiveEnv (..)
+    , addDep
+    , emptyEnv
+    -- * Re-exports
+    , Identity (..)
+    , Constant (..)
+    , Compose (..)
+    ) where
+
+import Data.Kind
+import GHC.Records
+import GHC.TypeLits
+import Data.Coerce
+import GHC.Generics qualified as G
+import Control.Applicative
+import Control.Monad.Dep.Has 
+import Data.Proxy
+import Data.Functor ((<&>), ($>))
+import Data.Functor.Compose
+import Data.Functor.Constant
+import Data.Functor.Identity
+import Data.Function (fix)
+import Data.String
+import Data.Type.Equality (type (==))
+
+-- $setup
+--
+-- >>> :set -XTypeApplications
+-- >>> :set -XMultiParamTypeClasses
+-- >>> :set -XImportQualifiedPost
+-- >>> :set -XTemplateHaskell
+-- >>> :set -XStandaloneKindSignatures
+-- >>> :set -XNamedFieldPuns
+-- >>> :set -XFunctionalDependencies
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XDataKinds
+-- >>> :set -XBlockArguments
+-- >>> :set -XFlexibleInstances
+-- >>> :set -XTypeFamilies
+-- >>> :set -XDeriveGeneric
+-- >>> :set -XViewPatterns
+-- >>> :set -XDerivingStrategies
+-- >>> :set -XDerivingVia
+-- >>> :set -XDeriveAnyClass
+-- >>> :set -XStandaloneDeriving
+-- >>> :set -XUndecidableInstances
+-- >>> import Data.Kind
+-- >>> import Control.Monad.Dep.Has
+-- >>> import Control.Monad.Dep.Env
+-- >>> import GHC.Generics (Generic)
+--
+
+
+-- via the default field name
+
+-- | Helper for @DerivingVia@ 'HasField' instances.
+--
+-- It expects the component to have as field name the default fieldname
+-- specified by 'Dep'.
+--
+-- This is the same behavior as the @DefaultSignatures@ implementation for
+-- 'Has', so maybe it doesn't make much sense to use it, except for
+-- explicitness.
+newtype TheDefaultFieldName (env :: Type) = TheDefaultFieldName env
+
+instance (Dep r_, HasField (DefaultFieldName r_) (env_ m) u, Coercible u (r_ m)) 
+         => Has r_ m (TheDefaultFieldName (env_ m)) where
+   dep (TheDefaultFieldName env) = coerce . getField @(DefaultFieldName r_) $ env
+
+-- | Helper for @DerivingVia@ 'HasField' instances.
+--
+-- The field name is specified as a 'Symbol'.
+type TheFieldName :: Symbol -> Type -> Type
+newtype TheFieldName (name :: Symbol) (env :: Type) = TheFieldName env
+
+instance (HasField name (env_ m) u, Coercible u (r_ m)) 
+         => Has r_ m (TheFieldName name (env_ m)) where
+   dep (TheFieldName env) = coerce . getField @name $ env
+
+-- via autowiring
+
+-- | Class for getting the field name from the field's type.
+--
+-- The default implementation of 'FindFieldByType' requires a 'G.Generic'
+-- instance, but users can write their own implementations.
+type FieldsFindableByType :: Type -> Constraint
+class FieldsFindableByType (env :: Type) where
+    type FindFieldByType env (r :: Type) :: Symbol 
+    type FindFieldByType env r = FindFieldByType_ env r
+
+-- | Helper for @DerivingVia@ 'HasField' instances.
+--
+-- The fields are identified by their types.
+--
+-- It uses 'FindFieldByType' under the hood.
+--
+-- __BEWARE__: for large records with many components, this technique might
+-- incur in long compilation times.
+type Autowired :: Type -> Type
+newtype Autowired (env :: Type) = Autowired env
+
+-- | Constraints required when @DerivingVia@ /all/ possible instances of 'Has' in
+-- a single definition.
+--
+-- This only works for environments where all the fields come wrapped in
+-- "Data.Functor.Identity".
+type Autowireable r_ (m :: Type -> Type) (env :: Type) = HasField (FindFieldByType env (r_ m)) env (Identity (r_ m))
+
+instance (
+           FieldsFindableByType (env_ m),
+           HasField (FindFieldByType (env_ m) (r_ m)) (env_ m) u,
+           Coercible u (r_ m) 
+         ) 
+         => Has r_ m (Autowired (env_ m)) where
+   dep (Autowired env) = coerce @u $ getField @(FindFieldByType (env_ m) (r_ m)) env
+
+type FindFieldByType_ :: Type -> Type -> Symbol
+type family FindFieldByType_ env r where
+    FindFieldByType_ env r = IfMissing r (GFindFieldByType (ExtractProduct (G.Rep env)) r)
+
+type ExtractProduct :: (k -> Type) -> k -> Type
+type family ExtractProduct envRep where
+    ExtractProduct (G.D1 _ (G.C1 _ z)) = z
+
+type IfMissing :: Type -> Maybe Symbol -> Symbol
+type family IfMissing r ms where
+    IfMissing r Nothing = 
+        TypeError (
+                 Text "The component " 
+            :<>: ShowType r 
+            :<>: Text " could not be found in environment.")
+    IfMissing _ (Just name) = name
+
+-- The k -> Type alwasy trips me up
+type GFindFieldByType :: (k -> Type) -> Type -> Maybe Symbol
+type family GFindFieldByType r x where
+    GFindFieldByType (left G.:*: right)                                          r = 
+        WithLeftResult_ (GFindFieldByType left r) right r
+    GFindFieldByType (G.S1 (G.MetaSel ('Just name) _ _ _) (G.Rec0 r))            r = Just name
+    -- Here we are saying "any wrapper whatsoever over r". Too general?
+    -- If the wrapper is not coercible to the underlying r, we'll fail later.
+    GFindFieldByType (G.S1 (G.MetaSel ('Just name) _ _ _) (G.Rec0 (_ r)))        r = Just name
+    GFindFieldByType _                                                           _ = Nothing
+
+type WithLeftResult_ :: Maybe Symbol -> (k -> Type) -> Type -> Maybe Symbol 
+type family WithLeftResult_ leftResult right r where
+    WithLeftResult_ ('Just ls) right r = 'Just ls
+    WithLeftResult_ Nothing    right r = GFindFieldByType right r
+
+--
+--
+-- Managing Phases
+
+-- see also https://github.com/haskell/cabal/issues/7394#issuecomment-861767980
+
+-- | Class of 2-parameter environments for which the first parameter @h@ wraps
+-- each field and corresponds to phases in the construction of the environment,
+-- and the second parameter @m@ is the effect monad used by each component.
+--
+-- @h@ will typically be a composition of applicative functors, each one
+-- representing a phase. We advance through the phases by \"pulling out\" the
+-- outermost phase and running it in some way, until we are are left with a
+-- 'Constructor' phase, which we can remove using 'fixEnv'.
+--
+-- 'Phased' resembles [FunctorT, TraversableT and ApplicativeT](https://hackage.haskell.org/package/barbies-2.0.3.0/docs/Data-Functor-Transformer.html) from the [barbies](https://hackage.haskell.org/package/barbies) library. 'Phased' instances can be written in terms of them.
+type Phased :: ((Type -> Type) -> (Type -> Type) -> Type) -> Constraint
+class Phased (env_ :: (Type -> Type) -> (Type -> Type) -> Type) where
+    -- | Used to implement 'pullPhase' and 'mapPhase',  typically you should use those functions instead.
+    traverseH :: 
+        Applicative f 
+        => (forall x . h x -> f (g x)) -> env_ h m -> f (env_ g m)
+    default traverseH 
+        :: ( G.Generic (env_ h m)
+           , G.Generic (env_ g m)
+           , GTraverseH h g (G.Rep (env_ h m)) (G.Rep (env_ g m))
+           , Applicative f )
+        => (forall x . h x -> f (g x)) -> env_ h m -> f (env_ g m)
+    traverseH t env = G.to <$> gTraverseH t (G.from env)
+    -- | Used to implement 'liftA2Phase', typically you should use that function instead.
+    liftA2H ::  (forall x. a x -> f x -> f' x) -> env_ a m -> env_ f m -> env_ f' m
+    default liftA2H
+        :: ( G.Generic (env_ a m)
+           , G.Generic (env_ f m)
+           , G.Generic (env_ f' m)
+           , GLiftA2Phase a f f' (G.Rep (env_ a m)) (G.Rep (env_ f m)) (G.Rep (env_ f' m))
+           )
+        => (forall x. a x -> f x -> f' x) -> env_ a m -> env_ f m -> env_ f' m
+    liftA2H f enva env = G.to (gLiftA2Phase f (G.from enva) (G.from env))
+
+-- | Take the outermost phase wrapping each component and \"pull it outwards\",
+-- aggregating the phase's applicative effects.
+pullPhase :: forall f g env_ m . (Applicative f, Phased env_) => env_ (Compose f g) m -> f (env_ g m)
+-- f first to help annotate the phase
+pullPhase = traverseH getCompose
+
+-- | Modify the outermost phase wrapping each component.
+mapPhase :: forall f' f g env_ m . Phased env_ => (forall x. f x -> f' x) -> env_ (Compose f g) m -> env_ (Compose f' g) m
+-- f' first to help annotate the *target* of the transform?
+mapPhase f env = runIdentity $ traverseH (\(Compose fg) -> Identity (Compose (f fg))) env
+
+-- | Combine two environments with a function that works on their outermost phases.
+liftA2Phase :: forall f' a f g env_ m . Phased env_ => (forall x. a x -> f x -> f' x) -> env_ (Compose a g) m -> env_ (Compose f g) m -> env_ (Compose f' g) m
+-- f' first to help annotate the *target* of the transform?
+liftA2Phase f = liftA2H (\(Compose fa) (Compose fg) -> Compose (f fa fg))
+
+class GTraverseH h g env env' | env -> h, env' -> g where
+    gTraverseH :: Applicative f => (forall x . h x -> f (g x)) -> env x -> f (env' x)
+
+instance (GTraverseH h g fields fields')
+    => GTraverseH h 
+               g
+               (G.D1 metaData (G.C1 metaCons fields)) 
+               (G.D1 metaData (G.C1 metaCons fields')) where
+    gTraverseH t (G.M1 (G.M1 fields)) = 
+        G.M1 . G.M1 <$> gTraverseH @h @g t fields
+
+instance (GTraverseH h g left left',
+          GTraverseH h g right right') 
+        => GTraverseH h g (left G.:*: right) (left' G.:*: right') where
+     gTraverseH t (left G.:*: right) = 
+        let left' = gTraverseH @h @g t left
+            right' = gTraverseH @h @g t right
+         in liftA2 (G.:*:) left' right'
+
+instance GTraverseH h g (G.S1 metaSel (G.Rec0 (h bean))) 
+                   (G.S1 metaSel (G.Rec0 (g bean))) where
+     gTraverseH t (G.M1 (G.K1 (hbean))) =
+         G.M1 . G.K1 <$> t hbean 
+--
+--
+class GLiftA2Phase a f f' enva env env' | enva -> a, env -> f, env' -> f' where
+    gLiftA2Phase :: (forall r. a r -> f r -> f' r) -> enva x -> env x -> env' x
+
+instance GLiftA2Phase a f f' fieldsa fields fields'
+    => GLiftA2Phase 
+               a
+               f 
+               f'
+               (G.D1 metaData (G.C1 metaCons fieldsa)) 
+               (G.D1 metaData (G.C1 metaCons fields)) 
+               (G.D1 metaData (G.C1 metaCons fields')) where
+    gLiftA2Phase f (G.M1 (G.M1 fieldsa)) (G.M1 (G.M1 fields)) = 
+        G.M1 (G.M1 (gLiftA2Phase @a @f @f' f fieldsa fields))
+
+instance ( GLiftA2Phase a f f' lefta left left',
+           GLiftA2Phase a f f' righta right right'
+         ) 
+         => GLiftA2Phase a f f' (lefta G.:*: righta) (left G.:*: right) (left' G.:*: right') where
+     gLiftA2Phase f (lefta G.:*: righta) (left G.:*: right) = 
+        let left' = gLiftA2Phase @a @f @f' f lefta left
+            right' = gLiftA2Phase @a @f @f' f righta right
+         in (G.:*:) left' right'
+
+instance   GLiftA2Phase a f f' (G.S1 metaSel (G.Rec0 (a bean)))
+                               (G.S1 metaSel (G.Rec0 (f bean))) 
+                               (G.S1 metaSel (G.Rec0 (f' bean))) where
+     gLiftA2Phase f (G.M1 (G.K1 abean)) (G.M1 (G.K1 fgbean)) =
+         G.M1 (G.K1 (f abean fgbean))
+
+-- | Class of 2-parameter environments for which it's possible to obtain the
+-- names of each field as values.
+type DemotableFieldNames :: ((Type -> Type) -> (Type -> Type) -> Type) -> Constraint
+class DemotableFieldNames env_ where
+    demoteFieldNamesH :: (forall x. String -> h String x) -> env_ (h String) m
+    default demoteFieldNamesH 
+        :: ( G.Generic (env_ (h String) m)
+           , GDemotableFieldNamesH h (G.Rep (env_ (h String) m)))
+           => (forall x. String -> h String x) 
+           -> env_ (h String) m
+    demoteFieldNamesH f = G.to (gDemoteFieldNamesH f)
+
+-- | Bring down the field names of the environment to the term level and store
+-- them in the accumulator of "Data.Functor.Constant".
+demoteFieldNames :: forall env_ m . DemotableFieldNames env_ => env_ (Constant String) m
+demoteFieldNames = demoteFieldNamesH Constant
+
+class GDemotableFieldNamesH h env | env -> h where
+    gDemoteFieldNamesH :: (forall x. String -> h String x) -> env x
+            
+instance GDemotableFieldNamesH h fields
+    => GDemotableFieldNamesH h (G.D1 metaData (G.C1 metaCons fields)) where
+    gDemoteFieldNamesH f = G.M1 (G.M1 (gDemoteFieldNamesH f))
+
+instance ( GDemotableFieldNamesH h left,
+           GDemotableFieldNamesH h right) 
+        => GDemotableFieldNamesH h (left G.:*: right) where
+     gDemoteFieldNamesH f = 
+         gDemoteFieldNamesH f G.:*: gDemoteFieldNamesH f
+
+instance KnownSymbol name => GDemotableFieldNamesH h (G.S1 (G.MetaSel ('Just name) u v w) (G.Rec0 (h String bean))) where
+     gDemoteFieldNamesH f = 
+         G.M1 (G.K1 (f (symbolVal (Proxy @name))))
+
+-- | Modify the outermost phase wrapping each component, while having access to
+-- the field name of the component.
+--
+-- A typical usage is modifying a \"parsing the configuration\" phase so that
+-- each component looks into a different section of the global configuration
+-- field.
+mapPhaseWithFieldNames :: forall f' f g env_ m. (Phased env_, DemotableFieldNames env_) 
+    => (forall x. String -> f x -> f' x) -> env_ (Compose f g) m -> env_ (Compose f' g) m
+-- f' first to help annotate the *target* of the transform?
+mapPhaseWithFieldNames  f env =
+    liftA2Phase (\(Constant name) z -> f name z) (runIdentity $ traverseH (\(Constant z) -> Identity (Compose (Constant z))) demoteFieldNames) env
+
+
+-- constructing phases
+
+-- $phasehelpers
+--
+-- Small convenience functions to help build nested compositions of functors.
+--
+
+-- | Use the result of the previous phase to build the next one.
+--
+-- Can be useful infix.
+bindPhase :: forall f g a b . Functor f => f a -> (a -> g b) -> Compose f g b 
+-- f as first type parameter to help annotate the current phase
+bindPhase f k = Compose (f <&> k)
+
+-- | Don't do anything for the current phase, just wrap the next one.
+skipPhase :: forall f g a . Applicative f => g a -> Compose f g a 
+-- f as first type parameter to help annotate the current phase
+skipPhase g = Compose (pure g)
+
+-- | A phase with the effect of \"constructing each component by reading its
+-- dependencies from a completed environment\". 
+--
+-- The 'Constructor' phase for an environment will typically be parameterized
+-- with the environment itself.
+type Constructor (env_ :: (Type -> Type) -> (Type -> Type) -> Type) (m :: Type -> Type) = ((->) (env_ Identity m)) `Compose` Identity
+
+
+-- | Turn an environment-consuming function into a 'Constructor' that can be slotted 
+-- into some field of a 'Phased' environment.
+constructor :: forall r_ env_ m . (env_ Identity m -> r_ m) -> Constructor env_ m (r_ m)
+-- same order of type parameters as Has
+constructor = coerce
+
+-- | This is a method of performing dependency injection that doesn't require
+-- "Control.Monad.Dep.DepT" at all. In fact, it doesn't require the use of
+-- /any/ monad transformer!
+--
+-- If we have a environment whose fields are functions that construct each
+-- component by searching for its dependencies in a \"fully built\" version of
+-- the environment, we can \"tie the knot\" to obtain the \"fully built\"
+-- environment. This works as long as there aren't any circular dependencies
+-- between components.
+--
+-- Think of it as a version of "Data.Function.fix" that, instead of \"tying\" a single
+-- function, ties a whole record of them.
+--
+-- The @env_ (Constructor env_ m) m@ parameter might be the result of peeling
+-- away successive layers of applicative functor composition using 'pullPhase',
+-- until only the wiring phase remains.
+fixEnv :: Phased env_ => env_ (Constructor env_ m) m -> env_ Identity m
+fixEnv env = fix (pullPhase env)
+
+-- | An inductively constructed environment with anonymous fields.
+--
+-- Can be useful for simple tests, and also for converting `Has`-based
+-- components into functions that take their dependencies as separate
+-- positional parameters.
+--
+-- > makeController :: (Monad m, Has Logger m env, Has Repository m env) => env -> Controller m
+-- > makeController = undefined
+-- > makeControllerPositional :: Monad m => Logger m -> Repository m -> Controller m
+-- > makeControllerPositional a b = makeController $ addDep @Logger a $ addDep @Repository b $ emptyEnv
+-- 
+--
+--
+data InductiveEnv (rs :: [(Type -> Type) -> Type]) (h :: Type -> Type) (m :: Type -> Type) where
+    AddDep :: forall r_ m rs h . h (r_ m) -> InductiveEnv rs h m -> InductiveEnv (r_ : rs) h m
+    EmptyEnv :: forall m h . InductiveEnv '[] h m
+
+-- | Unlike the 'AddDep' constructor, this sets @h@ to 'Identity'.
+addDep :: forall r_ m rs . r_ m -> InductiveEnv rs Identity m -> InductiveEnv (r_ : rs) Identity m
+addDep = AddDep @r_ @m @rs . Identity
+
+-- | Unlike the 'EmptyEnv' constructor, this sets @h@ to 'Identity'.
+emptyEnv :: forall m . InductiveEnv '[] Identity m
+emptyEnv = EmptyEnv @m @Identity
+
+instance Phased (InductiveEnv rs) where
+    traverseH t EmptyEnv = pure EmptyEnv
+    traverseH t (AddDep hx rest) = 
+        let headF = t hx
+            restF = traverseH t rest
+         in AddDep <$> headF <*> restF
+    liftA2H t EmptyEnv EmptyEnv = EmptyEnv
+    liftA2H t (AddDep ax arest) (AddDep hx hrest) = 
+        AddDep (t ax hx) (liftA2H t arest hrest)
+ 
+-- | Works by searching on the list of types.
+instance InductiveEnvFind r_ m rs => Has r_ m (InductiveEnv rs Identity m) where
+    dep = inductiveEnvDep
+
+class InductiveEnvFind r_ m rs where
+    inductiveEnvDep :: InductiveEnv rs Identity m -> r_ m
+
+instance  TypeError (
+                 Text "The component " 
+            :<>: ShowType r_ 
+            :<>: Text " could not be found in environment.") => InductiveEnvFind r_ m '[] where
+    inductiveEnvDep = error "never happens"
+
+instance InductiveEnvFind' (r_ == r_') r_ m (r_' : rs) => InductiveEnvFind r_ m (r_' : rs) where
+    inductiveEnvDep = inductiveEnvDep' @(r_ == r_')
+
+class InductiveEnvFind' (matches :: Bool) r_ m rs where
+    inductiveEnvDep' :: InductiveEnv rs Identity m -> r_ m
+
+instance InductiveEnvFind' True r_ m (r_ : rs) where
+    inductiveEnvDep' (AddDep (Identity r) _) = r
+
+instance InductiveEnvFind r_ m rs => InductiveEnvFind' False r_ m (x : rs) where
+    inductiveEnvDep' (AddDep _ rest) = inductiveEnvDep rest
+
+

@@ -13,6 +13,8 @@ {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE TypeOperators #-}
 
 -- | This module provides a general-purpose 'Has' class favoring a style in
 -- which the components of the environment, instead of being bare functions,
@@ -79,13 +81,12 @@ --
 --
 module Control.Monad.Dep.Has (
-        -- * A general-purpose Has
-        Has (..) 
-        -- * call helper
-    ,   asCall
-        -- * Component defaults
-    ,   Dep (..)
---    ,   useCall
+      -- * A general-purpose Has
+      Has (..) 
+      -- * call helper
+    , asCall
+      -- * Component defaults
+    , Dep (..)
     ) where
 
 import Data.Kind
@@ -99,7 +100,7 @@ -- record-of-functions @r_@, produces a 2-place constraint that can used on its
 -- own, or with "Control.Monad.Dep.Class".
 type Has :: ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Constraint
-class Has r_ m env | env -> m where
+class Has r_ (m :: Type -> Type) (env :: Type) | env -> m where
   -- |  Given an environment @e@, produce a record-of-functions parameterized by the environment's effect monad @m@.
   --
   -- The hope is that using a selector function on the resulting record will
@@ -154,5 +155,4 @@ -- >>> import Control.Monad.Dep
 -- >>> import GHC.Generics (Generic)
 --
-
 

@@ -1,5 +1,5 @@ module Main (main) where
 
 import Test.DocTest
-main = doctest ["-ilib", "lib/Control/Monad/Dep.hs", "lib/Control/Monad/Dep/Class.hs", "lib/Control/Monad/Dep/Has.hs"]
+main = doctest ["-ilib", "lib/Control/Monad/Dep.hs", "lib/Control/Monad/Dep/Class.hs", "lib/Control/Monad/Dep/Has.hs", "lib/Control/Monad/Dep/Env.hs"]
 

@@ -0,0 +1,219 @@+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE ApplicativeDo #-}
+
+module Main (main) where
+
+import Control.Monad.Dep.Has
+import Control.Monad.Dep.Env
+import Control.Monad.Reader
+import Data.Functor.Constant
+import Data.Functor.Compose
+import Data.Coerce
+import Data.Kind
+import Data.List (intercalate)
+import GHC.Generics (Generic)
+import Test.Tasty
+import Test.Tasty.HUnit
+import Prelude hiding (log)
+import Data.Functor.Identity
+import GHC.TypeLits
+import Control.Monad.Trans.Cont
+import Data.Aeson
+import Data.Aeson.Types
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.IORef
+import System.IO
+import Control.Exception
+import Control.Arrow (Kleisli (..))
+import Data.Text qualified as Text
+import Data.ByteString.Lazy qualified as Bytes
+import Data.Function ((&))
+import Data.Functor ((<&>), ($>))
+import Data.String
+
+type Logger :: (Type -> Type) -> Type
+newtype Logger d = Logger {
+    info :: String -> d ()
+  }
+
+data Repository d = Repository
+  { findById :: Int -> d (Maybe String)
+  , putById :: Int -> String -> d ()
+  , insert :: String -> d Int
+  }
+
+data Controller d = Controller 
+  { create :: d Int
+  , append :: Int -> String -> d Bool 
+  , inspect :: Int -> d (Maybe String)
+  } 
+
+type MessagePrefix = Text.Text
+
+data LoggerConfiguration = LoggerConfiguration { 
+        messagePrefix :: MessagePrefix
+    } deriving stock (Show, Generic)
+      deriving anyclass FromJSON
+
+makeStdoutLogger :: MonadIO m => MessagePrefix -> env -> Logger m
+makeStdoutLogger prefix _ = Logger (\msg -> liftIO (putStrLn (Text.unpack prefix ++ msg)))
+
+allocateMap :: ContT () IO (IORef (Map Int String))
+allocateMap = ContT $ bracket (newIORef Map.empty) pure
+
+makeInMemoryRepository 
+    :: Has Logger IO env 
+    => IORef (Map Int String) 
+    -> env 
+    -> Repository IO
+makeInMemoryRepository ref (asCall -> call) = do
+    Repository {
+         findById = \key -> do
+            call info "I'm going to do a lookup in the map!"
+            theMap <- readIORef ref
+            pure (Map.lookup key theMap)
+       , putById = \key content -> do
+            theMap <- readIORef ref
+            writeIORef ref $ Map.insert key content theMap 
+       , insert = \content -> do 
+            call info "I'm going to insert in the map!"
+            theMap <- readIORef ref
+            let next = Map.size theMap
+            writeIORef ref $ Map.insert next content theMap 
+            pure next
+    }
+
+makeController :: (Has Logger m env, Has Repository m env, Monad m) => env -> Controller m
+makeController (asCall -> call) = Controller {
+      create = do
+          call info "Creating a new empty resource."
+          key <- call insert ""
+          pure key
+    , append = \key extra -> do
+          call info "Appending to a resource"
+          mresource <- call findById key
+          case mresource of
+            Nothing -> do
+                pure False
+            Just resource -> do
+                call putById key (resource ++ extra) 
+                pure True
+    , inspect = \key -> do
+          call findById key 
+    }
+
+-- positional version of the controller constructor
+makeControllerPositionalArgs :: Monad m => Logger m -> Repository m -> Controller m
+makeControllerPositionalArgs a b = makeController $ addDep @Logger a $ addDep @Repository b $ emptyEnv
+
+--
+type EnvHKD :: (Type -> Type) -> (Type -> Type) -> Type
+data EnvHKD h m = EnvHKD
+  { logger :: h (Logger m),
+    repository :: h (Repository m),
+    controller :: h (Controller m)
+  } deriving stock Generic
+    deriving anyclass (Phased, DemotableFieldNames, FieldsFindableByType)
+
+deriving via Autowired (EnvHKD Identity m) instance Autowireable r_ m (EnvHKD Identity m) => Has r_ m (EnvHKD Identity m)
+
+-- deriving via Autowired (EnvHKD Identity m) instance Has Logger m (EnvHKD Identity m)
+-- deriving via Autowired (EnvHKD Identity m) instance Has Repository m (EnvHKD Identity m)
+-- deriving via Autowired (EnvHKD Identity m) instance Has Controller m (EnvHKD Identity m)
+
+-- phases :: Configurator (Allocator (Constructor env_ m (r_ m))) -> Phases env_ m (r_ m)
+-- phases = coerce
+
+parseConf :: FromJSON a => Configurator a
+parseConf = Kleisli parseJSON
+
+type Configurator = Kleisli Parser Value 
+
+type Allocator = ContT () IO
+
+type Phases env_ m = Configurator `Compose` Allocator `Compose` Constructor env_ m
+
+env :: EnvHKD (Phases EnvHKD IO) IO
+env = EnvHKD {
+      logger = 
+        parseConf `bindPhase` \(LoggerConfiguration {messagePrefix}) -> 
+        skipPhase @Allocator $
+        constructor (makeStdoutLogger messagePrefix)
+    , repository = 
+        skipPhase @Configurator $
+        allocateMap `bindPhase` \ref -> 
+        constructor (makeInMemoryRepository ref)
+    , controller = 
+        skipPhase @Configurator $
+        skipPhase @Allocator $ 
+        constructor makeController
+}
+
+testEnvConstruction :: Assertion
+testEnvConstruction = do
+    let parseResult = eitherDecode' (fromString "{ \"logger\" : { \"messagePrefix\" : \"[foo]\" }, \"repository\" : null, \"controller\" : null }")
+    print parseResult 
+    let Right value = parseResult 
+        Kleisli (withObject "configuration" -> parser) = 
+              pullPhase @(Kleisli Parser Object) 
+            $ mapPhaseWithFieldNames 
+                (\fieldName (Kleisli f) -> Kleisli \o -> explicitParseField f o (fromString fieldName)) 
+            $ env
+        Right allocators = parseEither parser value 
+    runContT (pullPhase @Allocator allocators) \constructors -> do
+        let (asCall -> call) = fixEnv constructors
+        resourceId <- call create
+        call append resourceId "foo"
+        call append resourceId "bar"
+        Just result <- call inspect resourceId
+        assertEqual "" "foobar" $ result
+
+--
+--
+--
+tests :: TestTree
+tests =
+  testGroup
+    "All"
+    [
+          testCase "fieldNames" $
+            let fieldNames :: EnvHKD (Constant String) IO
+                fieldNames = demoteFieldNames
+             in
+             assertEqual "" "logger repository controller" $
+                 let EnvHKD { logger = Constant loggerField
+                            , repository = Constant repositoryField  
+                            , controller = Constant controllerField  
+                            } = fieldNames
+                  in intercalate " " [loggerField, repositoryField, controllerField]
+        , testCase "environmentConstruction" testEnvConstruction
+    ]
+
+main :: IO ()
+main = defaultMain tests

@@ -20,11 +20,16 @@ {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveAnyClass #-}
 
 module Main (main) where
 
 import Control.Monad.Dep
 import Control.Monad.Dep.Has
+import Control.Monad.Dep.Env
 import Control.Monad.Dep.Class
 import Control.Monad.Reader
 import Control.Monad.Writer
@@ -38,11 +43,15 @@ import Test.Tasty
 import Test.Tasty.HUnit
 import Prelude hiding (log)
+import Data.Functor.Identity
+import Data.Functor.Product
+import GHC.TypeLits
+import Barbies
 
 -- https://stackoverflow.com/questions/53498707/cant-derive-generic-for-this-type/53499091#53499091
 -- There are indeed some higher kinded types for which GHC can currently derive Generic1 instances, but the feature is so limited it's hardly worth mentioning. This is mostly an artifact of taking the original implementation of Generic1 intended for * -> * (which already has serious limitations), turning on PolyKinds, and keeping whatever sticks, which is not much.
 type Logger :: (Type -> Type) -> Type
-newtype Logger d = Logger {log :: String -> d ()} deriving (Generic)
+newtype Logger d = Logger {log :: String -> d ()} deriving stock Generic
 
 instance Dep Logger where
   type DefaultFieldName Logger = "logger"
@@ -56,7 +65,7 @@ instance Dep Repository where
   type DefaultFieldName Repository = "repository"
 
-newtype Controller d = Controller {serve :: Int -> d String} deriving (Generic)
+newtype Controller d = Controller {serve :: Int -> d String} deriving stock Generic
 
 instance Dep Controller where
   type DefaultFieldName Controller = "controller"
@@ -95,8 +104,8 @@   Controller \url ->
     useEnv \e -> do
       let (asCall -> call) = e
-      call log "I'm going to insert in the db!"
-      call select "select * from ..."
+      call @Logger log "I'm going to insert in the db!"
+      call @Repository select "select * from ..."
       call insert [5, 3, 43]
       return "view"
 
@@ -145,11 +154,142 @@   }
 
 instance Has Logger m (EnvHKD I m)
-
 instance Has Repository m (EnvHKD I m)
-
 instance Has Controller m (EnvHKD I m)
 
+--
+-- Test TheDefaultFieldName
+type EnvHKD' :: (Type -> Type) -> (Type -> Type) -> Type
+data EnvHKD' h m = EnvHKD'
+  { logger :: h (Logger m),
+    repository :: h (Repository m),
+    controller :: h (Controller m)
+  }
+
+deriving via (TheDefaultFieldName (EnvHKD' I m)) instance Has Logger m (EnvHKD' I m)
+deriving via (TheDefaultFieldName (EnvHKD' I m)) instance Has Repository m (EnvHKD' I m)
+deriving via (TheDefaultFieldName (EnvHKD' I m)) instance Has Controller m (EnvHKD' I m)
+
+--- Test isolated instance definitions for autowired
+type EnvHKD2 :: (Type -> Type) -> (Type -> Type) -> Type
+data EnvHKD2 h m = EnvHKD2
+  { logger :: h (Logger m),
+    repository :: h (Repository m),
+    controller :: h (Controller m)
+  } deriving stock Generic
+    deriving anyclass FieldsFindableByType 
+
+deriving via (Autowired (EnvHKD2 Identity m)) instance Has Logger m (EnvHKD2 Identity m)
+deriving via (Autowired (EnvHKD2 Identity m)) instance Has Repository m (EnvHKD2 Identity m)
+
+-- findLogger2 :: EnvHKD2 Identity m -> Logger m
+-- findLogger2 env = dep env
+
+type EnvHKD3 :: (Type -> Type) -> (Type -> Type) -> Type
+data EnvHKD3 h m = EnvHKD3
+  { logger :: h (Logger m),
+    repository :: h (Repository m),
+    controller :: h (Controller m)
+  } deriving stock Generic
+    deriving anyclass FieldsFindableByType
+    
+deriving via Autowired (EnvHKD3 Identity m) instance Autowireable r_ m (EnvHKD3 Identity m) => Has r_ m (EnvHKD3 Identity m)
+
+findLogger3 :: EnvHKD3 Identity m -> Logger m
+findLogger3 env = dep env
+
+
+
+type EnvHKD4 :: (Type -> Type) -> (Type -> Type) -> Type
+data EnvHKD4 h m = EnvHKD4
+  { loggerx :: h (Logger m),
+    repositoryx :: h (Repository m),
+    controllerx :: h (Controller m)
+  } deriving (Generic)
+    
+type Correspondence4 :: Type -> Symbol
+type family Correspondence4 r :: Symbol where
+    Correspondence4 (Logger m) = "loggerx"
+    -- Correspondence4 (Identity (Logger m)) = "logger"
+    Correspondence4 (Repository m) = "repositoryx"
+    Correspondence4 (Controller m) = "controllerx"
+    Correspondence4 _ = TypeError (Text "what")
+
+-- non-default FieldsFindableByType instance
+instance FieldsFindableByType                    (EnvHKD4 Identity m) where
+    type FindFieldByType                         (EnvHKD4 Identity m) r = Correspondence4 r
+
+deriving via Autowired (EnvHKD4 Identity m) instance Autowireable r_ m (EnvHKD4 Identity m) => Has r_ m (EnvHKD4 Identity m)
+
+findLogger4 :: EnvHKD4 Identity m -> Logger m
+findLogger4 env = dep env
+findRepository4 :: EnvHKD4 Identity m -> Repository m
+findRepository4 env = dep env
+findController4 :: EnvHKD4 Identity m -> Controller m
+findController4 env = dep env
+
+type EnvHKD5 :: (Type -> Type) -> Type
+data EnvHKD5 m = EnvHKD5
+  { loggerx :: Logger m,
+    repositoryx :: Repository m,
+    controllerx :: Controller m
+  } deriving stock Generic
+    deriving anyclass FieldsFindableByType 
+
+deriving via Autowired (EnvHKD5 m) instance Has Logger m (EnvHKD5 m)
+deriving via Autowired (EnvHKD5 m) instance Has Repository m (EnvHKD5 m)
+deriving via Autowired (EnvHKD5 m) instance Has Controller m (EnvHKD5 m)
+
+findLogger5 :: EnvHKD5 m -> Logger m
+findLogger5 env = dep env
+findRepository5 :: EnvHKD5 m -> Repository m
+findRepository5 env = dep env
+findController5 :: EnvHKD5 m -> Controller m
+findController5 env = dep env
+
+-- Test TheFieldName
+type EnvHKD6 :: (Type -> Type) -> Type
+data EnvHKD6 m = EnvHKD6
+  { loggerx :: (Logger m),
+    repositoryx :: (Repository m),
+    controllerx :: (Controller m)
+  } deriving stock Generic
+    
+deriving via (TheFieldName "loggerx" (EnvHKD6 m)) instance Has Logger m (EnvHKD6 m)
+deriving via (TheFieldName "repositoryx" (EnvHKD6 m)) instance Has Repository m (EnvHKD6 m)
+deriving via (TheFieldName "controllerx" (EnvHKD6 m)) instance Has Controller m (EnvHKD6 m)
+
+findLogger6 :: EnvHKD6 m -> Logger m
+findLogger6 env = dep env
+findRepository6 :: EnvHKD6 m -> Repository m
+findRepository6 env = dep env
+findController6 :: EnvHKD6 m -> Controller m
+findController6 env = dep env
+
+
+-- Deriving Phased using the barbies library, to check that they are compatible
+-- typeclasses
+
+-- newtype B e_ h m = B (e_ h m)
+
+-- instance (FunctorT e_, TraversableT e_, ApplicativeT e_) => Phased (B e_) where
+--     traverseH f (B e) = B <$> ttraverse f e
+--     liftA2H f (B ax) (B hx) = B $ tmap (\(Pair az hz) -> f az hz) $ tprod ax hx
+
+type EnvHKD7 :: (Type -> Type) -> (Type -> Type) -> Type
+data EnvHKD7 h m = EnvHKD7
+  { logger :: h (Logger m),
+    repository :: h (Repository m),
+    controller :: h (Controller m)
+  } deriving stock Generic
+    deriving anyclass (FunctorT, TraversableT, ApplicativeT)
+
+instance Phased EnvHKD7 where
+    traverseH f e = ttraverse f e
+    liftA2H f ax hx = tmap (\(Pair az hz) -> f az hz) $ tprod ax hx
+
+
+--
 --
 --
 tests :: TestTree