Code examples from fsharpforfunandprofit.com/posts/dependencies-5/

SixDependencyApproachesInPractice.fsx

(* ===================================
Code from my series of posts "Six approaches to dependency injection"
=================================== *)

open System


(*
## The requirements

Say that we have some kind of web app with users, and each user has a "profile" with their name, email, preferences, etc.
A use-case for updating their profile might be something like this:

1. Receive a new profile (parsed from a JSON request, say)
2. Read the user's current profile from the database
3. If the profile has changed, update the user's profile in the database
4. If the email has changed, send a verification email message to the user's new email 

We will also add a little bit of logging into the mix.

*)

(* ======================================================================
Common types used thoughout the examples
====================================================================== *)


module Domain =

    type UserId = UserId of int
    type UserName = string
    type EmailAddress = EmailAddress of string

    type Profile = {
        UserId : UserId 
        Name : UserName 
        EmailAddress : EmailAddress 
    }

    type EmailMessage = {
        To : EmailAddress
        Body : string
        }
  

module Infrastructure =
    open Domain 

    type ILogger =
        abstract Info : string -> unit
        abstract Error : string -> unit

    type InfrastructureError =
        | DbError of string
        | SmtpError of string

    type DbConnection = DbConnection of unit // dummy definition

    type IDbService = 
        abstract NewDbConnection : 
            unit -> DbConnection 
        abstract QueryProfile : 
            DbConnection -> UserId -> Async<Result<Profile,InfrastructureError>>
        abstract UpdateProfile : 
            DbConnection -> Profile -> Async<Result<unit,InfrastructureError>>

    type SmtpCredentials = SmtpCredentials of unit // dummy definition

    type IEmailService = 
        abstract SendChangeNotification : 
            SmtpCredentials -> EmailMessage -> Async<Result<unit,InfrastructureError>>

    let globalLogger = {new ILogger with
        member __.Info str = printfn "INFO %s" str
        member __.Error str = printfn "ERROR %s" str
        }

    let defaultDbService = {new IDbService with
        member __.NewDbConnection() = DbConnection()

        member __.QueryProfile dbConnection (UserId userId) = 
            printfn "DB.QueryProfile: %A" userId 
            async {
                let profile = {
                    UserId = UserId userId
                    Name = ""
                    EmailAddress = EmailAddress (sprintf "user%i@example.com" userId)
                    }
                return Ok profile
            }

        member __.UpdateProfile dbConnection profileDto = 
            printfn "DB.UpdateProfile: %A" profileDto
            async {
                return Ok ()
                }
        }

    let defaultSmtpCredentials = SmtpCredentials()  // dummy

    let defaultEmailService = {new IEmailService with
        member __.SendChangeNotification smtpCreditials emailMessage = 
            printfn "Email.SendEmailChangedNotification: %A" emailMessage 
            async {
                return Ok ()
                }
        }

(* ======================================================================
Result library
====================================================================== *)

type AsyncResult<'Success,'Failure> = 
    Async<Result<'Success,'Failure>>

module AsyncResult =
    /// Lift a function to AsyncResult
    let map f (xAS:AsyncResult<_,_>) : AsyncResult<_,_> =
        async {
            let! x = xAS
            return (Result.map f) x
            }

    /// Lift a value to AsyncResult
    let retn x : AsyncResult<_,_> =
        x |> Result.Ok |> async.Return

    let bind (f: 'a -> AsyncResult<'b,'c>) (xAsyncResult : AsyncResult<_, _>) :AsyncResult<_,_> = async {
        let! xResult = xAsyncResult
        match xResult with
        | Ok x -> return! f x
        | Error err -> return (Error err)
        }

[<AutoOpen>]
module AsyncResultComputationExpression =
   
    type AsyncResultBuilder() =
        member __.Return(x) = AsyncResult.retn x
        member __.Bind(x, f) = AsyncResult.bind f x
        member __.ReturnFrom(x) = x
        member this.Zero() = this.Return ()
        member this.Combine (a:AsyncResult<_,_>, b:unit->AsyncResult<_,_>) = AsyncResult.bind b a
        member this.Combine (a:AsyncResult<_,_>, b:AsyncResult<_,_>) = AsyncResult.bind (fun () -> b) a
        member __.Delay(f) = async.Delay(f) 

    let asyncResult = AsyncResultBuilder()

(* ======================================================================
Approach 1. Dependency Retention
====================================================================== *)


module DependencyRetention =
    open Domain
    open Infrastructure

    // val updateCustomerProfile : newProfile:Domain.Profile -> AsyncResult<unit,Infrastructure.InfrastructureError>
    let updateCustomerProfile (newProfile:Profile) :AsyncResult<unit,InfrastructureError> =
        let dbConnection = defaultDbService.NewDbConnection()
        let smtpCredentials = defaultSmtpCredentials
        asyncResult {
            let! currentProfile = defaultDbService.QueryProfile dbConnection newProfile.UserId

            if currentProfile <> newProfile then
                globalLogger.Info("Updating Profile")
                do! defaultDbService.UpdateProfile dbConnection newProfile

            if currentProfile.EmailAddress <> newProfile.EmailAddress then
                let emailMessage = {
                    To = newProfile.EmailAddress
                    Body = "Please verify your email"
                    }
                globalLogger.Info("Sending email")
                do! defaultEmailService.SendChangeNotification smtpCredentials emailMessage 
            }
        

(* ======================================================================
Approach 2. Dependency Rejection
====================================================================== *)

module DependencyRejection =
    open Domain

    // -----------------------------------------------
    // Pure core
    // -----------------------------------------------

    module Pure = 
        let globalLogger = Infrastructure.globalLogger

        type Decision =
            | NoAction
            | UpdateProfileOnly of Profile
            | UpdateProfileAndNotify of Profile * EmailMessage

        // pure code, which is easy to test
        // (assuming globalLogger is allowed)
        let updateCustomerProfile (newProfile:Profile) (currentProfile:Profile) =
            if currentProfile <> newProfile then
                globalLogger.Info("Updating Profile")
                if currentProfile.EmailAddress <> newProfile.EmailAddress then
                    let emailMessage = {
                        To = newProfile.EmailAddress
                        Body = "Please verify your email"
                        }
                    globalLogger.Info("Sending email")
                    UpdateProfileAndNotify (newProfile, emailMessage)
                else
                    UpdateProfileOnly newProfile
            else
                NoAction

    // -----------------------------------------------
    // Impure shell
    // -----------------------------------------------

    module Shell =
        open Infrastructure
        open Pure

        // infrastructure services are hard-coded inline
        let updateCustomerProfile (newProfile:Profile) :AsyncResult<unit,InfrastructureError> =
            let dbConnection = defaultDbService.NewDbConnection()
            let smtpCredentials = defaultSmtpCredentials
            asyncResult {
                // ----------- impure ----------------
                let! currentProfile = defaultDbService.QueryProfile dbConnection newProfile.UserId

                // ----------- pure ----------------
                let decision = Pure.updateCustomerProfile newProfile currentProfile 

                // ----------- impure ----------------
                match decision with
                | NoAction ->
                    ()
                | UpdateProfileOnly profile ->
                    do! defaultDbService.UpdateProfile dbConnection profile 
                | UpdateProfileAndNotify (profile,emailMessage) ->
                    do! defaultDbService.UpdateProfile dbConnection profile 
                    do! defaultEmailService.SendChangeNotification smtpCredentials emailMessage
                }


(* ======================================================================
Approach 3. Dependency Parameterization
====================================================================== *)

module DependencyParameterization =
    open Domain

    // -----------------------------------------------
    // Pure core
    // -----------------------------------------------

    module Pure =
        type ILogger = Infrastructure.ILogger
    
        type Decision =
            | NoAction
            | UpdateProfileOnly of Profile
            | UpdateProfileAndNotify of Profile * EmailMessage

        let updateCustomerProfile (logger:ILogger) (newProfile:Profile) (currentProfile:Profile) =
            if currentProfile <> newProfile then
                logger.Info("Updating Profile")
                if currentProfile.EmailAddress <> newProfile.EmailAddress then
                    let emailMessage = {
                        To = newProfile.EmailAddress
                        Body = "Please verify your email"
                        }
                    logger.Info("Sending email")
                    UpdateProfileAndNotify (newProfile, emailMessage)
                else
                    UpdateProfileOnly newProfile
            else
                NoAction

    // -----------------------------------------------
    // Impure shell
    // -----------------------------------------------

    module Shell =
        open Infrastructure
        open Pure

        type IServices = {
            Logger : ILogger
            DbService : IDbService
            EmailService : IEmailService
            }

        // Uses infrastructure but all interfaces are passed in as parameters
        // This is easy to mock, or to change infrastructure implementation
        let updateCustomerProfile (services:IServices) (newProfile:Profile) :AsyncResult<unit,InfrastructureError> =
            let dbConnection = services.DbService.NewDbConnection()
            let smtpCredentials = defaultSmtpCredentials
            let logger = services.Logger

            asyncResult {
                // ----------- Impure ----------------
                let! currentProfile = services.DbService.QueryProfile dbConnection newProfile.UserId

                // ----------- pure ----------------
                let decision = Pure.updateCustomerProfile logger newProfile currentProfile 

                // ----------- Impure ----------------
                match decision with
                | NoAction ->
                    ()
                | UpdateProfileOnly profile ->
                    do! services.DbService.UpdateProfile dbConnection profile 
                | UpdateProfileAndNotify (profile,emailMessage) ->
                    do! services.DbService.UpdateProfile dbConnection profile 
                    do! services.EmailService.SendChangeNotification smtpCredentials emailMessage
                }
        

        /// Top-level "composition root"
        let updateCustomerProfileApi (newProfile:Profile) =
            let services = {
                Logger = globalLogger
                DbService = defaultDbService
                EmailService = defaultEmailService
                }
            updateCustomerProfile services newProfile

(* ======================================================================
Approach 4. Dependency Injection -- OO Style
====================================================================== *)

module DependencyInjection =
    open Domain

    // -----------------------------------------------
    // Pure core
    // -----------------------------------------------

    module Pure =

        type ILogger = Infrastructure.ILogger

        type Decision =
            | NoAction
            | UpdateProfileOnly of Profile
            | UpdateProfileAndNotify of Profile * EmailMessage

        let updateCustomerProfile (logger:ILogger) (newProfile:Profile) (currentProfile:Profile) =
                if currentProfile <> newProfile then
                    logger.Info("Updating Profile")
                    if currentProfile.EmailAddress <> newProfile.EmailAddress then
                        let emailMessage = {
                            To = newProfile.EmailAddress
                            Body = "Please verify your email"
                            }
                        logger.Info("Sending email")
                        UpdateProfileAndNotify (newProfile, emailMessage)
                    else
                        UpdateProfileOnly newProfile
                else
                    NoAction

    // -----------------------------------------------
    // Impure shell
    // -----------------------------------------------

    module Shell =
        
        open Infrastructure
        open Pure

        type IServices = {
            Logger : ILogger
            DbService : IDbService
            EmailService : IEmailService
            }

        // define a class with a constructor that accepts the dependencies
        type MyWorkflow (services:IServices) =

            member this.UpdateCustomerProfile (newProfile:Profile) =
                let dbConnection = services.DbService.NewDbConnection()
                let smtpCredentials = defaultSmtpCredentials
                let logger = services.Logger

                asyncResult {
                    // ----------- Impure ----------------
                    let! currentProfile = services.DbService.QueryProfile dbConnection newProfile.UserId

                    // ----------- pure ----------------
                    let decision = Pure.updateCustomerProfile logger newProfile currentProfile 

                    // ----------- Impure ----------------
                    match decision with
                    | NoAction ->
                        ()
                    | UpdateProfileOnly profile ->
                        do! services.DbService.UpdateProfile dbConnection profile 
                    | UpdateProfileAndNotify (profile,emailMessage) ->
                        do! services.DbService.UpdateProfile dbConnection profile 
                        do! services.EmailService.SendChangeNotification smtpCredentials emailMessage
                    }
        

        /// Top-level "composition root"
        let updateCustomerProfileApi (newProfile:Profile) =
            let services = {
                Logger = globalLogger
                DbService = defaultDbService
                EmailService = defaultEmailService
                }
            let myWorkflow = MyWorkflow(services)
            myWorkflow.UpdateCustomerProfile newProfile


(* ======================================================================
Approach 4b. Dependency Injection -- Reader style
====================================================================== *)

type Reader<'env,'a> = Reader of action:('env -> 'a)

module Reader =
    /// Run a Reader with a given environment
    let run env (Reader action)  = 
        action env  // simply call the inner function

    /// Create a Reader which returns the environment itself
    let ask = Reader id 

    /// Map a function over a Reader 
    let map f reader = 
        Reader (fun env -> f (run env reader))

    /// flatMap a function over a Reader 
    let bind f reader =
        let newAction env =
            let x = run env reader 
            run env (f x)
        Reader newAction

    /// Transform a Reader's environment.
    /// Known as `withReader` in Haskell
    let withEnv (f:'env2->'env1) reader = 
        Reader (fun env' -> (run (f env') reader))


[<AutoOpen>]
module ReaderCE =
    type ReaderBuilder() =
        member __.Return(x) = Reader (fun _ -> x)
        member __.Bind(x,f) = Reader.bind f x
        member __.Zero() = Reader (fun _ -> ())
        member this.Combine (a,b) = Reader.bind b a
        

    // the builder instance
    let reader = ReaderBuilder()

module ReaderInjection =
    open Domain

    // -----------------------------------------------
    // Pure core
    // -----------------------------------------------

    module Pure =

        type ILogger = Infrastructure.ILogger

        type Decision =
            | NoAction
            | UpdateProfileOnly of Profile
            | UpdateProfileAndNotify of Profile * EmailMessage

        let updateCustomerProfile (newProfile:Profile) (currentProfile:Profile) :Reader<ILogger,Decision> = 
            reader {
                let! (logger:ILogger) = Reader.ask

                let decision = 
                    if currentProfile <> newProfile then
                        logger.Info("Updating Profile")
                        if currentProfile.EmailAddress <> newProfile.EmailAddress then
                            let emailMessage = {
                                To = newProfile.EmailAddress
                                Body = "Please verify your email"
                                }
                            logger.Info("Sending email")
                            UpdateProfileAndNotify (newProfile, emailMessage)
                        else
                            UpdateProfileOnly newProfile
                    else
                        NoAction

                return decision
            }

    // -----------------------------------------------
    // Impure shell WITHOUT using Reader for top-level IO
    // -----------------------------------------------

    module Shell_v1 =
    
        open Infrastructure
        open Pure

        type IServices = {
            Logger : ILogger
            DbService : IDbService
            EmailService : IEmailService
            }

        // Infrastructure services are passed in as a parameter
        let updateCustomerProfile (services:IServices) (newProfile:Profile) :AsyncResult<unit,InfrastructureError> =
            let dbConnection = services.DbService.NewDbConnection()
            let smtpCredentials = defaultSmtpCredentials
            let logger = services.Logger

            asyncResult {
                // ----------- impure ----------------
                let! currentProfile = services.DbService.QueryProfile dbConnection newProfile.UserId

                // ----------- pure ----------------
                let decision = 
                    Pure.updateCustomerProfile newProfile currentProfile 
                    |> Reader.run logger

                // ----------- impure ----------------
                match decision with
                | NoAction ->
                    ()
                | UpdateProfileOnly profile ->
                    do! services.DbService.UpdateProfile dbConnection profile 
                | UpdateProfileAndNotify (profile,emailMessage) ->
                    do! services.DbService.UpdateProfile dbConnection profile 
                    do! services.EmailService.SendChangeNotification smtpCredentials emailMessage
                }


        /// Top-level "composition root"
        let updateCustomerProfileApi (newProfile:Profile) =
            let services = {
                Logger = globalLogger
                DbService = defaultDbService
                EmailService = defaultEmailService
                }
            updateCustomerProfile services newProfile

    // -----------------------------------------------
    // Impure shell using Reader for top-level I/O
    // -----------------------------------------------

    module Shell_v2 =
        
        open Infrastructure
        open Pure

        type IServices = {
            Logger : ILogger
            DbService : IDbService
            EmailService : IEmailService
            }

        // first step in our mini-app
        let getProfile (userId:UserId) :Reader<IServices, AsyncResult<Profile,InfrastructureError>> = 
            reader {
                let! (services:IServices) = Reader.ask
                let dbConnection = services.DbService.NewDbConnection()
                return services.DbService.QueryProfile dbConnection userId
            }

        // last step in our mini-app
        let handleDecision (decision:Decision) :Reader<IServices, AsyncResult<unit,InfrastructureError>> = 
            reader {
                let! (services:IServices) = Reader.ask
                let dbConnection = services.DbService.NewDbConnection()
                let smtpCredentials = defaultSmtpCredentials
                let action = asyncResult {
                    match decision with
                    | NoAction ->
                        ()
                    | UpdateProfileOnly profile ->
                        do! services.DbService.UpdateProfile dbConnection profile 
                    | UpdateProfileAndNotify (profile,emailMessage) ->
                        do! services.DbService.UpdateProfile dbConnection profile 
                        do! services.EmailService.SendChangeNotification smtpCredentials emailMessage
                    }
                return action
            }

        // Infrastructure services are passed in via a Reader
        let updateCustomerProfile (newProfile:Profile) = 
            reader {
                let! (services:IServices) = Reader.ask
                let getLogger services = services.Logger

                return asyncResult {
                    // ----------- impure ----------------
                    let! currentProfile = 
                        getProfile newProfile.UserId   
                        |> Reader.run services

                    // ----------- pure ----------------
                    let decision = 
                        Pure.updateCustomerProfile newProfile currentProfile 
                        |> Reader.withEnv getLogger
                        |> Reader.run services
                
                    // ----------- impure ----------------
                    do! (handleDecision decision) |> Reader.run services   
                    }
            }

        /// Top-level "composition root"
        let updateCustomerProfileApi (newProfile:Profile) =
            let services = {
                Logger = globalLogger
                DbService = defaultDbService
                EmailService = defaultEmailService
                }
            
            (updateCustomerProfile newProfile)
            |> Reader.run services


(* ======================================================================
Approach 5. Dependency Interpretation
====================================================================== *)

//----------------------------------------------------
// A specific program based on the common requirements
//----------------------------------------------------

#r "nuget: FSharpPlus"

module DependencyInterpretation =

    open Domain
    open FSharpPlus
    open FSharpPlus.Data

    // -----------------------------------------------
    // Instructions used in the pure core
    // -----------------------------------------------

    module Instructions =

        // 1. Define the set of instructions we want to support, and their map
        type LoggerInstruction<'a> =
            | LogInfo of string  * next : (unit -> 'a)
            | LogError of string * next : (unit -> 'a)
            with
                static member Map (x, f) =
                    match x with
                    | LogInfo  (str, next) -> LogInfo  (str, next >> f)
                    | LogError (str, next) -> LogError (str, next >> f)
        
        type DbInstruction<'a> =
            | QueryProfile of UserId * next : (Profile -> 'a)
            | UpdateProfile of Profile * next : (unit -> 'a)
            with
                static member Map (x, f) =
                    match x with
                    | QueryProfile (userId, next)   -> QueryProfile (userId, next >> f)
                    | UpdateProfile (profile, next) -> UpdateProfile (profile, next >> f)

        type EmailInstruction<'a> =
            | SendChangeNotification of EmailMessage * next : (unit-> 'a)
            with
                static member Map (x, f) =
                    match x with
                    | SendChangeNotification (message, next) -> SendChangeNotification (message, next >> f)

        type Program<'next> =
            Free<
                Coproduct<
                    LoggerInstruction<'next>,
                    Coproduct<
                        DbInstruction<'next>,
                        EmailInstruction<'next>>>, 
                'next>
        
        // helpers to use within the computation expression
        let logInfo  x : Program<_> = LogInfo  (x, id) |> InL |> Free.liftF
        let logError x : Program<_> = LogError (x, id) |> InL |> Free.liftF
        let queryProfile userId : Program<_> = QueryProfile (userId, id) |> InL |> InR |> Free.liftF
        let updateProfile profile : Program<_> = UpdateProfile (profile, id) |> InL |> InR |> Free.liftF
        let sendChangeNotification message : Program<_> = SendChangeNotification (message, id) |> InR |> InR |> Free.liftF

        let updateCustomerProfile (newProfile: Profile) (currentProfile: Profile) : Program<unit> = monad {
            if currentProfile <> newProfile then
                do! logInfo "Updating Profile"
                if currentProfile.EmailAddress <> newProfile.EmailAddress then
                    let emailMessage = {
                        To = newProfile.EmailAddress
                        Body = "Please verify your email"
                    }
                    do! updateProfile newProfile
                    do! logInfo "Sending email"
                    do! sendChangeNotification emailMessage
                else
                    do! updateProfile newProfile }

    // -----------------------------------------------
    // Shell
    // -----------------------------------------------

    module Shell =

        open Instructions

        let getProfile (userId: UserId) : Program<Profile> =
            monad {
                return! queryProfile userId
            }

        let updateCustomerProfile (newProfile: Profile) : Program<_> =
            monad {
                let! currentProfile = getProfile newProfile.UserId
                do! updateCustomerProfile newProfile currentProfile
            }

    // -----------------------------------------------
    // The interpreter
    // -----------------------------------------------

    module Interpreter =

        open Instructions
        open Infrastructure

        // modular interpreter for LoggerInstruction
        let interpretLogger = function
            | LogInfo (str, next) ->
                globalLogger.Info str
                let newProgramAS = () |> asyncResult.Return |> ResultT >>= next
                newProgramAS
            | LogError (str, next) ->
                globalLogger.Error str
                let newProgramAS = () |> asyncResult.Return |> ResultT >>= next
                newProgramAS

        // modular interpreter for DbInstruction
        let interpretDbInstruction (dbConnection: DbConnection) = function
            | QueryProfile (userId, next) ->
                let profileAS = defaultDbService.QueryProfile dbConnection userId
                let newProgramAS = profileAS |> ResultT >>= next
                newProgramAS  // returns a : ResultT<Async<Result<'a,InfrastructureError>>>
                
            | UpdateProfile (profile, next) ->
                let unitAS = defaultDbService.UpdateProfile dbConnection profile
                let newProgramAS = unitAS |> ResultT >>= next
                newProgramAS

        // modular interpreter for EmailInstruction
        let interpretEmailInstruction (smtpCredentials: SmtpCredentials) = function
            | SendChangeNotification (message, next) ->
                let unitAS = defaultEmailService.SendChangeNotification smtpCredentials message
                let newProgramAS = unitAS |> ResultT >>= next
                newProgramAS

        let rec interpret (program: Program<_>) =
            // 1. get the extra parameters and partially apply them to make all the interpreters
            // have a consistent shape
            let smtpCredentials = defaultSmtpCredentials
            let dbConnection = defaultDbService.NewDbConnection ()
            let interpretDbInstruction' = interpretDbInstruction dbConnection
            let interpretEmailInstruction' = interpretEmailInstruction smtpCredentials
            
            // 2. define a go function. It has signature:
            //     AsyncResult<Program<'a>,InfrastructureError>) -> AsyncResult<'a,InfrastructureError>            

            let go = function
            | InL x       -> interpretLogger x
            | InR (InL x) -> interpretDbInstruction' x
            | InR (InR x) -> interpretEmailInstruction' x
            
            // 3. iterate with the function
            Free.iterM go program


        /// Top-level "composition root"
        let updateCustomerProfileApi (newProfile: Profile) =
            Shell.updateCustomerProfile newProfile
            |> interpret
            |> ResultT.run
            |> Async.RunSynchronously