UnCarbonated Monad … work in progress

This time we can start from a nice F# introduction of Scott Wlaschin, from where it comes the following “bad code” example.

uncarbonated

My problem with this example is that it assumes you can have the same type (int) of result passing around (until it gets done, ie. “carbonated”). Which is not realistic. Unless you resort to some task, async, etc… but they are different things for different contexts.

Let’s look at a real world function

let loadInvoices ctx = async {
    self.Status <- "waiting for excel files \nto be loaded..."
    payments.Clear()
    do! Async.SwitchToThreadPool()
    let lib = GasLib()
    match getOpenPath("Select Passive Invoices Excel to import") with
    | Some passiveInvoicePath ->
        match getOpenPath("Select Active Invoices Excel to import") with
        | Some activeInvoicePath ->
            match getOpenPath("Select Accruals Excel to import") with
            | Some accrualPath ->
                let res = lib.extractPayment passiveInvoicePath activeInvoicePath accrualPath internalBU.Value 
                do! Async.SwitchToContext ctx
                res
                |> Array.iter (fun p1 -> payments.Add(p1))
                self.Status <- "excel files loaded\n\nkeep outlook open and ready"
            | None ->
                do! Async.SwitchToContext ctx
                self.Status <- "no accruals excel selected"
        | None ->
            do! Async.SwitchToContext ctx
            self.Status <- "no active invoices excel selected"
    | None -> 
        do! Async.SwitchToContext ctx
        self.Status <- "no passive invoices excel selected"
    }          

Can we reasonably refactor the code above?

Let’s say that the underlying results are of type string, for the sake of simplicity.

Functional idea

We want to define a generic result.

type WorkInProgress = {Results: string list; NextMsg: string}
type FlowResult =
| FlowSuccess of WorkInProgress
| FlowError of string

Further more we also need abstract flow

type Flow (cont: string -> string option, err: string, next: string) =
    member x.Continuation = cont
    member x.Error = err
    member x.NextMsg = next
    member x.GetNext (wip: WorkInProgress) =
        match x.Continuation wip.NextMsg with
        | Some result ->
            wip.Results
            |> List.append [result]
            |> fun r -> FlowSuccess {Results=r; NextMsg= next}
        | None -> FlowError err
    static member (>=>) (f1: FlowResult, f2: Flow) =
        match f1 with
        | FlowSuccess wip  -> f2.GetNext wip
        | FlowError err -> FlowError err

The real world solution

What’s next? Let’s do the refactor exercise. Can you guess it?
… work in progress … try by yourself before going on!

let loadInvoices ctx = async {
    self.Status <- "waiting for excel files \nto be loaded..."
    payments.Clear()
    do! Async.SwitchToThreadPool()
    let lib = GasLib()
    
    let flow =  
       FlowSuccess {Results =[]; NextMsg= "Select Passive Invoices Excel to import"}
       >=> Flow(getOpenPath, "no passive invoices excel selected", "Select Active Invoices Excel to import")
       >=> Flow(getOpenPath, "no active invoices excel selected", "Select Accruals Excel to import")
       >=> Flow(getOpenPath, "no accruals excel selected", "excel files loaded\n\nkeep outlook open and ready")
    
    
    match flow with
    | FlowError error -> 
        do! Async.SwitchToContext ctx
        self.Status <- error
    | FlowSuccess wip ->
        let passiveInvoicePath, activeInvoicePath, accrualPath = wip.Results.[2], wip.Results.[1], wip.Results.[0] 
        let res = lib.extractPayment passiveInvoicePath activeInvoicePath accrualPath internalBU.Value self.RaiseCollChanged 
        do! Async.SwitchToContext ctx
        res
        |> Array.iter (fun p1 -> payments.Add(p1))
        self.Status <- wip.NextMsg
    }

Does it look nicer? It’s up to you to decide (but let me know in the comments please).

Even more elegant

We can do better with finer typed intermediate results.

type PartialResult = {passiveInvoicePath: string option; activeInvoicePath: string option; accrualPath: string option}
type WorkInProgress = {Res: PartialResult; NextMsg: string}
type Result = {passiveInvoicePath: string ; activeInvoicePath: string ; accrualPath: string; finalMsg: string }
type WorkDone = OK of Result | KO of string
type FlowResult =
| FlowSuccess of WorkInProgress
| FlowError of string

type Flow (cont: string -> string option, upd: string -> PartialResult -> PartialResult, err: string, next: string) =
    member x.Continuation = cont
    member x.Error = err
    member x.NextMsg = next
    member x.GetNext (wip: WorkInProgress) =
        match x.Continuation wip.NextMsg with
        | Some result -> 
            wip.Res 
            |> upd result
            |> fun r -> FlowSuccess {Res = r; NextMsg= next}
        | None -> FlowError err
    static member (>=>) (f1: FlowResult, f2: Flow) : FlowResult =
        match f1 with
        | FlowSuccess wip  -> f2.GetNext wip
        | FlowError err -> FlowError err
    static member validate (f1: FlowResult) : WorkDone =
        match f1 with
        | FlowSuccess wip -> 
            match wip.Res.passiveInvoicePath, wip.Res.activeInvoicePath, wip.Res.accrualPath with
            | Some passiveInvoicePathFound, Some activeInvoicePathFound, Some accrualPathFound -> 
                OK {passiveInvoicePath = passiveInvoicePathFound; activeInvoicePath = activeInvoicePathFound; accrualPath=accrualPathFound; finalMsg=wip.NextMsg}
            | _ -> KO "incomplete results from pipeline"
        | FlowError error -> KO error

and our final version of the function will be

let loadInvoices ctx = async {
    self.Status <- "waiting for excel files \nto be loaded..."
    payments.Clear()
    do! Async.SwitchToThreadPool()
    let lib = GasLib()
    
    let setPassiveInvoice path (res:PartialResult) = {res with passiveInvoicePath = Some path }
    let setActiveInvoice path (res:PartialResult) = {res with activeInvoicePath = Some path }
    let setAccrual path (res:PartialResult) = {res with accrualPath = Some path }
    let flow =  
       FlowSuccess {Res = {passiveInvoicePath=None; activeInvoicePath=None; accrualPath=None}; NextMsg= "Select Passive Invoices Excel to import"}
       >=> Flow(getOpenPath, setPassiveInvoice , "no passive invoices excel selected", "Select Active Invoices Excel to import")
       >=> Flow(getOpenPath, setActiveInvoice,  "no active invoices excel selected", "Select Accruals Excel to import")
       >=> Flow(getOpenPath, setAccrual, "no accruals excel selected", "excel files loaded\n\nkeep outlook open and ready")
       |> Flow.validate 
    
    match flow with
    | KO error -> 
        do! Async.SwitchToContext ctx
        self.Status <- error
    | OK work ->
        let res = lib.extractPayment work.passiveInvoicePath work.activeInvoicePath work.accrualPath internalBU.Value self.RaiseCollChanged 
        do! Async.SwitchToContext ctx
        res
        |> Array.iter (fun p1 -> payments.Add(p1))
        self.Status <- work.finalMsg
    }           

One thought on “UnCarbonated Monad … work in progress

  1. Scott Wlaschin proposed a simpler solution

    where the getOpenPath options go parallel whilst I keep asking getOpenPath in a sequential pipeline and I skip the following getOpenPath if the previous one was a None… I guess we can borrow the terminology of category theory and haskell to say that usually applicatives compose more easily than monads.

    Like

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s