Skip to content

Instantly share code, notes, and snippets.

@mrange
Created March 18, 2017 12:32
Show Gist options
  • Star 24 You must be signed in to star a gist
  • Fork 4 You must be signed in to fork a gist
  • Save mrange/1d2f3a26ca039588726fd3bd43cc8df3 to your computer and use it in GitHub Desktop.
Save mrange/1d2f3a26ca039588726fd3bd43cc8df3 to your computer and use it in GitHub Desktop.
Railway Oriented Programming and F# Result

Railway Oriented Programming and F# Result

Full source: https://gist.github.com/mrange/aa9e0898492b6d384dd839bc4a2f96a1

Option<_> is great for ROP (Railway Oriented Programming) but we get no info on what went wrong (the failure value is None which carries no info).

With the introduction F# 4.1 we got Result<_, _> a "smarter" Option<_> as it allows us to pass a failure value.

However, when one inspects the signature of Result.bind one sees a potential issue for ROP:

val bind: binder:('T -> Result<'U, 'TError>) -> result:Result<'T, 'TError> -> Result<'U, 'TError>

bind requires the same 'TError for both result and binder.

This means that composing two functions like this is difficult:

let f () : Result<int, string>  = Ok 1
let g i  : Result<int, exn>     = Ok 1

let x = f () |> Result.bind g // Doesn't compile as string doesn't match exn for 'TError

Result allows us to map errors using Result.mapError allowing us to overcome this issue by mapping exn to string:

let y = f () |> Result.bind (g >> Result.mapError (fun e -> e.Message))

Or let's say we cast 'TError to obj always:

let toObj v = v :> obj
let z = f () |> Result.mapError toObj |> Result.bind (g >> Result.mapError toObj)

Or more succinct:

let rerrorToObj t = Result.mapError (fun v -> v :> obj) t
let z = f () |> rerrorToObj |> Result.bind (g >> rerrorToObj)

It feels a bit clunky and if we always cast all error objects to obj perhaps 'TError should always be obj?

let f () : Result<int, obj> = Ok 1
let g i  : Result<int, obj> = Ok 1

let x = f () |> Result.bind g // Compiles fine now

Finding a homogeneous error type

This is a bit how exceptions in .NET works. We combine objects of heterogeneous types but all exceptions inherits a common base class exn.

Exceptions and ROP wants to solve the same problem: "How can we make sure that happy path code isn't hidden by the error-handling for all unhappy paths".

It's not unreasonable to think that to enable ROP we need a homogeneous error type. I would suggest something other than obj though.

One suggestion is this:

[<RequireQualifiedAccess>]
type RBad =
  | Message         of string
  | Exception       of exn
  | Object          of obj
  | DescribedObject of string*obj

This allows us to pass messages, exceptions but also all kinds of objects that we didn't foresee as errors. For tracing we also allow describing an error object.

However, when implementing result combinators one realizes that there is a need to combine errors as well.

Consider the common functional pattern Applicative:

let r =
  Ok someFunction
  <*> argument1
  <*> argument2
  <*> argument3
  <*> argument4

Applicative will apply argument 1 to 4 to someFunction if and only if all arguments are Ok. Otherwise it returns an Error. It can be sensible that Error contains all argument errors, not just the first one.

In addition there is sometimes the need to pair results:

let p = rpair (x, y)

But rpair should also pair the error results if any.

In order to support that the error type could look like this:

[<RequireQualifiedAccess>]
type RBadTree =
  | Leaf  of RBad
  | Fork  of RBadTree*RBadTree

RResult<_>

We are ready to define our result type:

type RResult<'T> = Result<'T, RBadTree>

But as type abbreviations has limitations I instead will define RResult<_> as this:

[<RequireQualifiedAccess>]
[<Struct>]
type RResult<'T> =
  | Good  of good : 'T
  | Bad   of bad  : RBadTree

It's easy to define common functions for this type:

  let inline rreturn  v = RResult.Good v
  let inline rbind (uf : 'T -> RResult<'U>) (t : RResult<'T>) : RResult<'U> =
    match t with
    | RResult.Bad   tbad  -> RResult.Bad tbad
    | RResult.Good  tgood -> uf tgood

  // Kleisli

  let inline rarr f         = fun v -> rreturn (f v)
  let inline rkleisli uf tf = fun v -> rbind uf (tf v)

  // Applicative

  let inline rpure  f = rreturn f
  let inline rapply (t : RResult<'T>)  (f : RResult<'T -> 'U>) : RResult<'U> =
    match f, t with
    | RResult.Bad   fbad  , RResult.Bad   tbad  -> RResult.Bad (fbad.Join tbad)
    | RResult.Bad   fbad  , _                   -> RResult.Bad fbad
    | _                   , RResult.Bad   tbad  -> RResult.Bad tbad
    | RResult.Good  fgood , RResult.Good  tgood -> rreturn (fgood tgood)

  // Functor

  let inline rmap (m : 'T -> 'U) (t : RResult<'T>) : RResult<'U> =
    match t with
    | RResult.Bad   tbad  -> RResult.Bad tbad
    | RResult.Good  tgood -> rreturn (m tgood)

  // Lifts

  let inline rgood    v   = rreturn v
  let inline rbad     b   = RResult.Bad (RBadTree.Leaf b)
  let inline rmsg     msg = rbad (RBad.Message msg)
  let inline rexn     e   = rbad (RBad.Exception e)

As this is a type, not a type abbreviation, we can also extend it with common operators:

type RResult<'T> with
  static member inline (>>=)  (x, uf) = RResult.rbind    uf x
  static member inline (<*>)  (x, t)  = RResult.rapply    t x
  static member inline (|>>)  (x, m)  = RResult.rmap      m x
  static member inline (<|>)  (x, s)  = RResult.rorElse   s x
  static member inline (~%%)  x       = RResult.rderef    x
  static member inline (%%)   (x, bf) = RResult.rderefOr bf x

Note that rapply joins the bad results which can be seen in this example:

rgood (fun x y z -> x + y + z)
  |> rapply (rgood 1        )
  |> rapply (rmsg  "Bad"    )
  |> rapply (rmsg  "Result" )
  |> printfn "%A"

Or more succinct using the rapply operator <*>:

rgood (fun x y z -> x + y + z)
  <*> rgood 1
  <*> rmsg  "Bad"
  <*> rmsg  "Result"
  |> printfn "%A"

This prints:

Bad (Fork (Leaf (Message "Bad"),Leaf (Message "Result")))

In Scott Wlaschin amazing ROP presentation he presents the an example on a workflow that needs error handling:

receiveRequest
>> validateRequest
>> canonicalizeEmail
>> updateDbFromRequest
>> sendEmail

Scott claims that with ROP the code with error handling and without error handling can be made to look the same. How does his example look with RResult<_>?

fun uri ->
  receiveRequest uri
  >>= validateRequest
  >>= canonicalizeEmail
  >>= updateDbFromRequest
  >>= sendEmail

Pretty good but can get even neater if one define the kleisli operator >=>:

receiveRequest
>=> validateRequest
>=> canonicalizeEmail
>=> updateDbFromRequest
>=> sendEmail

Wrapping up

At my work at Atomize AB I am been collecting information from various sources and combining them into results.

I found ROP to be a very useful pattern but Option<_> doesn't work for me as I need to pass not only the result but also what went wrong if there was an error.

I found Result<_, _> difficult to compose because the 'TError type might be incompatible. In addition, I was lacking a way to aggregate multiple errors into a homogeneous result.

That's why I created something that look very much like RResult<_> and that has proven itself useful as it's homogeneous error result simplifies ROP as well as it's ability to join error results is useful in my use case.

I hope this was interesting.

@kspeakman
Copy link

kspeakman commented Mar 20, 2017

This for the article. It is interesting.

There's basically 2 categories of errors here. The IO-based errors (receive request, update DB, and send email) at the outer layer which generally stop after the first one. And the validation errors which can return multiple errors and be combined. Rather than using a leaf/branch tree structure, have you considered just making a specific union type for validation errors and adding them as a case for the outer layer? E.g.

    type ValidationError =
    | UseCaseErrors of UseCaseError list // replace UseCase with operation
    | ...

    type OuterError =
    | ValidationFailed of ValidationError
    | ReceiveFailed of exn
    | UpdateFailed of exn
    | EmailSendFailed of exn

Then, the multiple-errors code can convert their errors up to ValidationFailed before returning to the outer layer.

I work mostly with APIs, so my version is ValidationFailed of obj list which I convert to JSON. It's more explicit to use an typed object, but since I'm in the necessarily-effectful outer edge of the system when the response is generated, I was ok with serializing obj to JSON.

@mrange
Copy link
Author

mrange commented Mar 22, 2017

Thanks for your feedback.

The purpose of the "outer error" is to be able to join multiple error.

Let's say you have pair function that combines the result of two RResult into a single RResult. The signature of pair is val pair: RResult<'T> -> RResult<'U> - RResult<'T*'U>. If both inputs are in the error state I like to combine them which I do through a Fork.

In your use case AFAICT there's no clean way to join multiple EmailSendFailed errors. If that is a problem or not depends on your use case.

@dburriss
Copy link

Nice write-up. Thanks for sharing!

@voronoipotato
Copy link

Why do the Rresult functions all have "r" before them?

@KirtisChristensen
Copy link

I would greatly benefit from reviewing some simple to complex examples of using this code. Specifically a match on RBadTree being unpackaged and acted upon. Also example of packaging RBad and RbadTree . I can see the value of this, but I'm lacking the prior understanding of the F# and functional language and semantics for using it. Do you have some handy examples I can learn from ? Beyond your descriptions of your design and why you developed this approach. I like it but am having time applying it. My code seems more cluttered now rather than cleaner so I know I'm doing it wrong. what does right look like?

@mrange
Copy link
Author

mrange commented Jan 28, 2024

@KirtisChristensen the RBadTree is basically a way to preserve the structure of multiple failures. If you have an "exception" to you can basically just preserve the first error which is often good enough but not what I want for validation for example.

RBad is then the "exception" type that contains the information about the error.

If you can share code that you are not happy with perhaps I can give some subjective pointers?

@KirtisChristensen
Copy link

KirtisChristensen commented Feb 7, 2024

I have tried to implement a computation expression that might package a number failed retries into the RBadTree called errorResult
and then return that tree once the retries max count was exceeded.
You would see a series of err placed into RResult.rbad and then into the RbadTree that returns all of them together.
How do I load them below in the spot where you see the "erroResult.?" comment

<UPDATE .. I just found your exmple in an article seperate from the code here ->
_

rgood (fun x y z -> x + y + z)
<> rgood 1
<
> rmsg "Bad"
<*> rmsg "Result"
|> printfn "%A"
This prints:

Bad (Fork (Leaf (Message "Bad"),Leaf (Message "Re

_

I'll try to rapply or <*> the bad results of try response below in the spot where "errorResult.?" is with err <*> rmsg

type IncidentResponseRetryBuilder(max) =

      member x.Return(a) = a               // Enable 'return'
      member x.Delay(f) = f                // Gets wrapped body and returns it (as it is)
                                           // so that the body is passed to 'Run'

      member x.Zero() = 
            // Support if .. then 
            (IncidentResponse.ErrorResponse("incident response error exceeded retry count") 
            |> RResult.rbad )

      member x.Run(f) =                    // Gets function created by 'Delay'
        let mutable errorResult = RResult.rbad(IncidentResponse.ErrorResponse("default")) |> RResult.rbad
        let rec loop(n) = 
          if n = 0 then  // Number of retries exceeded    
             // IncidentResponse.ErrorResponse("incident response error exceeded retry count") |> ?errorResult.? |> RResult.rbad 
            errorResult <- errorResult <*> rbad  IncidentResponse.ErrorResponse("incident response error exceeded retry count")
          else match f() with 
            | Ok result -> result |> RResult.Good
           // | Error err -> err |> RResult.rbad |> errorResult.? ; loop(n-1)
            | Error err -> errorResult <- errorResult <*> rmsg err; loop(n-1) // ?? type mismatch 
        loop max

I'm getting a type mismatch however:

"Severity Code Description Project File Line Suppression State
Error FS0043 Type mismatch. Expecting a
'RResult<('a -> 'b)>'
but given a
'RResult<'b>'
The types ''a' and ''b -> 'a' cannot be unified."

@KirtisChristensen
Copy link

KirtisChristensen commented Feb 8, 2024

Just to spare you any time fixing this but allow you to coach or suggest if you see anything that I could have done better, here is the fixed example of comphrension expression for server post retries based on the response validation us RResult returns from the validation function and the Run member.

type ServerResponseRetryBuilder(max) =

      member x.Return(a) = RResult.rgood a              // Enable 'return'
      member x.Delay(f) = f                // Gets wrapped body and returns it (as it is)
                                           // so that the body is passed to 'Run'
      member m.ReturnFrom(r) = r        // Enable Return!
      member x.Zero() = 
            // Support if .. then 
            (ServerResponse.ServerErrorResponse("xfracas incident response error exceeded retry count") 
            |> RResult.rbad )

      member x.Run(f) =                    // Gets function created by 'Delay'
        let mutable errorResult = ServerResponse.ServerErrorResponse("default") |> RResult.rbad
        let rec loop(n) = 
          if n = 0 then // Number of retries exceeded    
              // IncidentResponse.ErrorResponse("incident response error exceeded retry count") |> ?errorResult.? |> RResult.rbad 
            errorResult <-  rbad (ServerResponse.ServerErrorResponse("incident response error exceeded retry count"))
            errorResult
          else match f() with 
            //| Ok result -> result //|> RResult.Good
            ////| Error err -> errorResult <- ServerResponse.ServerErrorResponse(err) ; loop(n-1)
            //| Error err -> errorResult <- rmsg err; loop(n-1)
            | RResult.Good result -> result //|> RResult.Good
            
            | RResult.Bad err -> 
                errorResult <- rbad err; 
                System.Threading.Thread.Sleep(5000) //5 seconds delay to give server time to get itself together
                loop(n-1)
        loop max

I need to prove with a unit test that the Run(f) is loading the RbadTree and not just overwritting with the latest err. I expect there is a way to do the accumulated errorResult of each retry without it being gathered and returned in the internal immutable. I will sometimes use an immutable inside function to get it done but keep it only inside there.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment