Using IWSAMs to deal with Dynamic Error Trees

IWSAMsErrorApproach.fs

#r "nuget: FsToolkit.ErrorHandling"

open FsToolkit.ErrorHandling
open System

type SensorReadings = int


module RegularApproach =

    (* Regular approach with two distinct error types *)


    type EngineError =
        | Overheated
        | LowOil

    let startEngine0 (sensorReading : SensorReadings) : Result<unit, EngineError> =
        if sensorReading <= 10 then Error Overheated
        elif sensorReading <= 20 then Error LowOil
        else Ok ()

    type AudioError =
        | DeviceNotPaired

    let initializeAudio0 (sensorReading : SensorReadings) : Result<unit, AudioError> =
        if sensorReading <= 30 then Error DeviceNotPaired else Ok ()

    // We must unify the engine and audio errors in one DU as follows:

    type CarError =
        | EngineError of EngineError
        | AudioError of AudioError

    // ... and map errors in order to use sub-computations which return different error types in on expression.

    let startCar0 (sensorReading : SensorReadings) : Result<unit, CarError> = result {
        do! startEngine0 sensorReading |> Result.mapError EngineError
        do! initializeAudio0 sensorReading |> Result.mapError AudioError
    }

    let run () =
        match startCar0 15 with
        | Ok () -> printfn "Car started successfully"
        | Error (EngineError e) ->
            match e with
            | Overheated -> printfn "Engine overheated"
            | LowOil -> printfn "Low oil level"
        | Error (AudioError e) ->
            match e with
            | DeviceNotPaired -> printfn "Audio device not paired"

    // two annoying things about this approach:
    // 1. If we re-use startCar0 anywhere, it has to bring all the deep CarError types with it, even if we only care about a subset of them.
    // 2. If we want to add a new error type (e.g. BedError) and use it together with CarError, we need to define a new DU which unifies all the error types (e.g. StartOfDayError), and then map all the errors from CarError to StartOfDayError, which is boilerplate and error-prone.





module IWSAMApproach =

    #nowarn "3535"
    (* Automatic merging of errors using IWSAMs *)

    // Represent errors not as DUs but as "abstract languages" using IWSAMs

    type EngineError<'e> =
        static abstract Overheated : 'e
        static abstract LowOil : 'e

    let startEngine<'e when EngineError<'e>> (sensorReading : SensorReadings)  =
        if sensorReading <= 10 then Error 'e.Overheated
        elif sensorReading <= 20 then Error 'e.LowOil
        else Ok ()

    type AudioError<'e> =
        static abstract DeviceNotPaired : 'e

    let initializeAudio<'e when AudioError<'e>> (sensorReading : SensorReadings)  =
        if sensorReading <= 30 then Error 'e.DeviceNotPaired else Ok ()

    // Define a single error type "at the edge" which serves as the interpretation of both error types

    type CarError<'e> =
        inherit EngineError<'e>
        inherit AudioError<'e>

    // Then to get exhausting pattern matching 

    type StartCarError =
        | Overheated2
        | LowOil2
        | DeviceNotPaired2

        interface CarError<StartCarError> with
            static member Overheated = Overheated2
            static member LowOil = LowOil2
            static member DeviceNotPaired = DeviceNotPaired2


    // Errors automatically merged into the single type by type inference/annotation.

    let startCar (sensorReading : SensorReadings)  = result {
        // Prioritize engine errors above audio errors
        do! startEngine sensorReading
        do! initializeAudio sensorReading
    }


    let run() =
        match startCar 15 with
        | Ok () -> printfn "Car started successfully"
        | Error e ->
            match e with
            | Overheated2 -> printfn "Engine overheated"
            | LowOil2 -> printfn "Low oil level"
            | DeviceNotPaired2 -> printfn "Audio device not paired"



    // Adding a new error type is as simple as defining a new IWSAM and implementing it in the "edge" error type, without needing to change existing code.

    type BedError<'e> =
        static abstract TooCold : int -> 'e
        static abstract AlarmFailed : 'e


    let getOutOfBed<'e when BedError<'e>>  (d : DateTime) =
        if d.Hour < 6 then Error ('e.TooCold 5)
        elif d.Hour > 9 then Error 'e.AlarmFailed
        else Ok ()


    type StartOfDayError =
        | TooCold2 of int
        | AlarmFailed2
        | CarError3 of StartCarError

        interface BedError<StartOfDayError> with
            static member TooCold e = TooCold2 e
            static member AlarmFailed = AlarmFailed2

        interface CarError<StartOfDayError> with
            static member Overheated = CarError3 Overheated2
            static member LowOil = CarError3 LowOil2
            static member DeviceNotPaired = CarError3 DeviceNotPaired2

    let startDay () = result {
        do! getOutOfBed (DateTime.Now)
        do! startCar 15
    }


    let runStartOfDay () =
        match startDay () with
        | Ok () -> printfn "Started day successfully"
        | Error e ->
            match e with
            | TooCold2 temp -> printfn "Too cold to get out of bed: %d degrees" temp
            | AlarmFailed2 -> printfn "Alarm failed to go off"
            | CarError3 carError ->
                match carError with
                | Overheated2 -> printfn "Engine overheated"
                | LowOil2 -> printfn "Low oil level"
                | DeviceNotPaired2 -> printfn "Audio device not paired"