Dependency injection with registry

registry.hs

{-

See https://www.reddit.com/r/haskell/comments/q1oyws/dependency_injection_using_a_recordoffunctions
for full context

-}


{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric #-}
module Test.App where

import Data.Registry
import Protolude

data User = User deriving Show

data Logger m = Logger {
  logMsg :: Text -> m ()
} deriving Generic

data UserRepository m = UserRepository {
  saveUser :: User -> m (),
  findUser :: m User
} deriving Generic

data UserController m = UserController {
  userEndpoint :: m User
}

newLogger :: Logger IO
newLogger = Logger { logMsg = print }

noLogger :: Logger IO
noLogger = Logger { logMsg = const (pure ()) }

newUserRepository :: Logger IO -> UserRepository IO
newUserRepository logger = UserRepository {..} where

  saveUser :: User -> IO ()
  saveUser _user =
    logMsg logger "saving user"

  findUser :: IO User
  findUser = do
    logMsg logger "finding user"
    pure User

newUserController :: forall m. Monad m => Logger m -> UserRepository m ->UserController m
newUserController logger repository = UserController {..} where

  userEndpoint :: m User
  userEndpoint = do
    logMsg logger "entering endpoint"
    user <- findUser repository
    logMsg logger "exiting endpoint"
    pure user

registry =
     fun (newUserController @IO)
  <: fun (newUserRepository)
  <: fun (newLogger)

userController = make @(UserController IO) registry

-- Override the Logger
testRegistry =
     fun noLogger
  <: registry

testUserController = make @(UserController IO) testRegistry