When using the ReaderT
pattern, or a monad like RIO
, it is common to store capabilities in a record, which is then made available to the program logic as a MonadReader
environment.
Suppose we have an environment like the following:
data Env = Env {
simple :: SimpleCapability,
complex :: ComplexCapability
} deriving GHC.Generics.Generic
instance FromRecord Env -- From "red-black-record", will be useful later
instance ToRecord Env -- Ditto.
And capabilities like
data SimpleCapability = SimpleCapability Int
data ComplexCapability = ComplexCapability SimpleCapability
They are trivial and we don’t care here about what methods they enable. But they do have configuration parameters, and the complex capability depends on the simple one. Both of them are available to this dumb bit of program logic:
dummyLogic :: ReaderT Env IO ()
dummyLogic = liftIO $ putStrLn "running the logic!"
Let’s assemble an environment:
env :: Env
env =
let simple' = SimpleCapability 7
in Env { simple = simple', complex = ComplexCapability simple' }
Simple enough! But there are two problems with this way of building the environment:
-
Our main program logic will read its dependencies from the environment record. However, our complex capabilities won’t read their own dependencies in the same way. Instead, these dependencies are assembled outside the record, in a
let
clause. This lack of uniformity between different levels is somewhat unpleasant, and it doesn’t happen in object-oriented dependency inversion frameworks. -
More importantly, it doesn’t let us easily replace beans (sorry, I meant “capabilities”). If we have a value of
Env
lying around, and we overwrite theSimpleCapability
field (say, with a mock version for testing purposes) then our main program logic will see the new capability, but ourComplexCapability
will still see the original version
How to solve this? It’s as if each field of the Env
needed to have available the fully-constructed final value of the record… as the field itself is being constructed! But this is clearly impossible, so let’s give up. Thus finishes the post.
Just kidding. We can do that, with a bit of judicious knot-tying. First we must find a way to give the full Env
record to each field. We can define an auxiliary OpenEnv
data type and wrap each field with a Reader
:
data OpenEnv = OpenEnv {
simple' :: Reader Env SimpleCapability,
complex' :: Reader Env ComplexCapability
}
And then write a function with type
fixEnv :: OpenEnv -> Env
that we can call once we are done modifying the fields of OpenEnv
. The function will tie the knot and return the fully constructed Env
.
The pattern of wrapping all the fields of a record in a type constructor (Reader Env
in our case) is sometimes called Higher-Kinded Data. We will take the approach of using the red-black-record and sop-core libraries to auto-derive these generalized representations from our vanilla data type.
So, instead of defining OpenEnv
manually like we did above, we will define it like this:
openEnv :: Record (Reader Env) (RecordCode Env)
openEnv =
insert @"simple" (pure $ SimpleCapability 7)
. insert @"complex" (makeComplex simple)
$ unit
Using functions from red-black-record. The makeComplex
constructor is defined like this:
makeComplex :: (r -> SimpleCapability) -> Reader r ComplexCapability
makeComplex getter =
do simple' <- asks getter
pure $ ComplexCapability simple'
The constructor receives a getter for simplicity, in a real application it could obtain its dependencies using something like classy lenses or generic-lens.
We also need auxiliary functions that allows us to “tie the knot” and get an Env
as the result:
fixRecord
:: forall r flat. (FromRecord r, Productlike '[] (RecordCode r) flat,
All Top flat)
=> Record (Reader r) (RecordCode r)
-> r
fixRecord = unI . fixHelper I
fixHelper
:: forall r flat f g. (FromRecord r, Productlike '[] (RecordCode r) flat,
All Top flat,
Functor g)
=> (NP f flat -> g (NP (Reader r) flat))
-> Record f (RecordCode r)
-> g r
fixHelper adapt r = do
let moveFunctionOutside np = runReader . sequence_NP $ np
record2record np = fromRecord . fromNP <$> moveFunctionOutside np
fix . record2record <$> adapt (toNP r)
These functions depend on other functions from sop-core, basically versions of sequence and other Applicative
operations that have been generalized to work over n-ary products.
If we overwrite the simple
field of openEnv
with a mock capability, and pass the modified record to fixRecord
, it will do the right thing and propagate the changes to the ComplexCapability
, which will use the mock just as the main program logic will.
do let closedEnv = fixRecord openEnv
runReaderT dummyLogic closedEnv
That was nice. Now suppose—as it is often the case—that capabilities must allocate some resource that will be used for the duration of the computation. Perhaps a file handle for logging, or even some background thread.
How to incorporate this? We could wrap the construction of the environment in bracket
-like operations. But this is unsatisfactory:
-
It disperses the code related to each capability: it moves the allocation away from where the capability is inserted in the record.
-
Even worse: it makes the allocation precede the construction of the record. We won’t have these nice, configurable “open environment” values directly at hand anymore, they will be hidden behind the allocation actions.
We can try a different strategy: putting the allocation code of each capability directly in the corresponding field of the open environment. How? By turning to the managed library and the magic of applicative functor composition:
managedOpenEnv :: Record (Managed :.: Reader Env) (RecordCode Env)
managedOpenEnv =
insert @"simple" (Comp $ pure $ pure $ SimpleCapability 7)
. insert @"complex" (makeManagedComplex simple)
$ unit
-- A capability constructor that performs an allocation
makeManagedComplex
:: (r -> SimpleCapability) -> (Managed :.: Reader r) ComplexCapability
makeManagedComplex getter =
Comp $ managed $ \cnt -> bracket_ (putStrLn "activating")
(putStrLn "deactivating")
(cnt $ makeComplex getter)
fixManagedRecord
:: forall r flat. (FromRecord r, Productlike '[] (RecordCode r) flat,
All Top flat)
=> Record (Managed :.: Reader r) (RecordCode r)
-> Managed r
fixManagedRecord = fixHelper sequence'_NP
:.:
is a version of functor composition defined in sop-core. sequence'_NP
is also from sop-core, it “pulls outward” one layer of the composition.
When we “fix” the managedOpenEnv
using fixManagedRecord
, we get a Managed
action that we can run. If we modify a field before the “fix”, the allocations specified by the old field value won’t be performed. Configuration precedes allocation, as it should be!
with (fixManagedRecord managedOpenEnv) (runReaderT dummyLogic)
Notice the following limitation though: the capabilities specify their allocations actions before reading their dependencies from the environment. They can’t inspect their dependencies to decide what allocations to perform.
Anyway, now that we have started to compose applicatives, the sky is the limit! We could, for example, make each capability constructor carry around a parser for its own configuration. These parsers would be then assembled in a parser for a global configuration object.
What are the disadvantages of the approach described in this post?
Besides the complex types, there’s the usual bane of extensible record libraries: long compile times.
Also, this form of dependency injection is purely name-based: we wire capabilities according to their field names in the environment record. If instead we wanted smarted auto-wiring which used type information ("there’s only one available capability with type Foo
, and this other capability needs a Foo
") a library like registry would better.
The gist with the full code is available here.