Generating dependency graphs for your components with `cauldron`

I recently released a new version of my dependency injection library “cauldron”.

Even if you don’t go all the way with it, and want to keep wiring things manually in IO or (if your components allocate resources on creation) Managed, the library has a feature/hack that I think it’s neat for drawing dependency diagrams of your components.

Imagine that you structure your app as several of records-of-functions, which constructors and configuration datatypes like:

We can manually wire it all in the composition root of our application, close to main:

manuallyWired :: Managed Runner
manuallyWired = do
  jsonConf <-
    let makeJsonConf = Bean.JsonConf.YamlFile.make $ Bean.JsonConf.YamlFile.loadYamlSettings ["conf.yaml"] [] Bean.JsonConf.YamlFile.useEnv
     in liftIO $ makeJsonConf
  logger <- managed withStdOutLogger
  sqlitePoolConf <- liftIO $ Bean.JsonConf.lookupSection @SqlitePoolConf "sqlite" jsonConf
  sqlitePool <- managed $ Bean.Sqlite.Pool.make sqlitePoolConf
  threadLocal <- liftIO makeThreadLocal
  let currentConnection = makeThreadLocalCurrent threadLocal
  let commentsRepository = Comments.Repository.Sqlite.make logger currentConnection
  let commentsServer = makeCommentsServer logger commentsRepository
  runnerConf <- liftIO $ Bean.JsonConf.lookupSection @RunnerConf "runner" jsonConf
  pure $ makeRunner runnerConf sqlitePool threadLocal logger commentsServer

This works fine but, what if we wanted a DOT diagram of the dependencies?

Let’s define the wiring in a slightly different way, in terms of the MonadWiring typeclass from cauldron:

polymorphicallyWired :: (MonadWiring m, ConstructorMonad m ~ Managed) => m (ArgsApplicative m Runner)
polymorphicallyWired = do
  jsonConf <- do
    let makeJsonConf = Bean.JsonConf.YamlFile.make $ Bean.JsonConf.YamlFile.loadYamlSettings ["conf.yaml"] [] Bean.JsonConf.YamlFile.useEnv
    _ioEff_ $ pure makeJsonConf
  logger <- _eff_ $ pure $ managed withStdOutLogger
  sqlitePoolConf <- _ioEff_ $ Bean.JsonConf.lookupSection @SqlitePoolConf "sqlite" <$> jsonConf
  sqlitePool <- _eff_ $ (\conf -> managed $ Bean.Sqlite.Pool.make conf) <$> sqlitePoolConf
  threadLocal <- _ioEff_ $ pure $ makeThreadLocal
  currentConnection <- _val_ $ makeThreadLocalCurrent <$> threadLocal
  commentsRepository <- _val_ $ Comments.Repository.Sqlite.make <$> logger <*> currentConnection
  commentsServer <- _val_ $ makeCommentsServer <$> logger <*> commentsRepository
  runnerConf <- _ioEff_ $ Bean.JsonConf.lookupSection @RunnerConf "runner" <$> jsonConf
  _val_ $ makeRunner <$> runnerConf <*> sqlitePool <*> threadLocal <*> logger <*> commentsServer

It’s different, but not that different. We have to use functions like _val_, _eff_ and _ioEff_. Components are now wrapped in a mistery ArgsApplicative type, so we must put them there (that’s what the pure in logger <- _eff_ $ pure $ does) and use Applicative functions for passing them to constructors.

The thing is, we can instantiate the MonadWiring to Managed, getting exactly what we had before:

polymorphicallyWired' :: Managed Runner
polymorphicallyWired' = runIdentity <$> polymorphicallyWired

But we can also instantiate it to a different monad: Cauldron.Builder.Builder:

polymorphicallyWired'' :: IO (Cauldron Managed)
polymorphicallyWired'' = polymorphicallyWired & execBuilder & either throwIO pure

And use the resulting Cauldron for drawing the dependency graph:

polymorphicallyWiredAppMain'' :: IO ()
polymorphicallyWiredAppMain'' = do
  theCauldron <- polymorphicallyWired''
  writeAsDot (defaultStyle Nothing) "beans.dot" $ collapseToPrimaryBeans $ getDependencyGraph theCauldron
  cook forbidDepCycles theCauldron & either throwIO \action -> with action \beans -> do
    case taste beans of
      Nothing -> error "no bean found"
      Just Runner {runServer} -> runServer

Which looks like

As a bonus, we can later use the Cauldron in, say, the test suite, to overwrite particular beans with mocks and the like, without having to redo the original wiring.

So, what are the limitations? We can’t ever bind two components of the same type. Cauldron is type-directed, so having more than one constructor for the same type confuses it. It will refuse to generate the graph in that case.

5 Likes