WIP: Applicative support

[TheAngryByrd]

This adds support for the new applicative in F# 5.0.

The result CE will remain mostly the same. It will still return a Result<'a,'err>. and! only gives users some performance optimization.

The new validation CE will be a much bigger difference. It's return type will be Result<'a, 'err list>. When given the example:

            let expected = Error ["Error 1"; "Error 2"]
            let actual = validation {
                let! a = Ok 3
                // and! b = Ok 2
                and! b = (Ok 2 : Result<_,string>)
                and! c = Error "Error 1"
                and! d = Error "Error 2"
                return a + b - c - d
            }
            Expect.equal actual expected "Should be Error"

using and! in this case will run each operation parallel resulting in a list of 'err to be given. Currently you do have to use some type annotations to tell the compiler how to handle the overload resolution. @cartermp, is there something I can do about my implementation so consumers don't have to specify that type annotation?

CE's to finish:

• Result CE
• Validation CE
• AsyncResult CE
• AsyncValidation CE
• TaskResult CE
• TaskValidation CE
• JobResult CE
• JobValidation CE

[cartermp]

@TheAngryByrd this program runs without an annotation in the CE:

// Learn more about F# at http://fsharp.org
open System

type Validation<'a,'err> = Result<'a, 'err list>

[<RequireQualifiedAccess>]
module Validation =

  let ok x : Validation<_,_> = Ok x
  let error e : Validation<_,_> = List.singleton e |> Error

  let ofResult x =
    Result.mapError List.singleton x
  
  let apply f x =
    match f, x with
    | Ok f, Ok x -> Ok (f x)
    | Error errs, Ok _ | Ok _, Error errs -> Error errs
    | Error errs1, Error errs2 -> Error  (errs1 @ errs2)

  let retn x = ofResult (Ok x)
  
  let map2 f x y =
    apply (apply (retn f) x) y
  
  let map3 f x y z =
    apply (map2 f x y) z

  let bind (f : 'a -> Validation<'b, 'err>) (x : Validation<'a,'err>) : Validation<_,_>=
    Result.bind f x

  let zip x1 x2 : Validation<_,_> = 
    match x1,x2 with
    | Ok x1res, Ok x2res -> Ok (x1res, x2res)
    | Error e, Ok _ -> Error e
    | Ok _, Error e -> Error e
    | Error e1, Error e2 -> Error (e1 @ e2)

[<AutoOpen>]
module ValidationCE =
    type ValidationBuilder() =
        member __.Return (value: 'T) =
            Validation.ok value

        member _.BindReturn(x: Validation<'T,'U>, f) : Validation<_,_> = Result.map f x


        member __.Bind
            (result: Validation<'T, 'TError>, binder: 'T -> Validation<'U, 'TError>)
            : Validation<'U, 'TError> =
            Validation.bind binder result
            

        member _.MergeSources(t1: Validation<'T,'U>, t2: Validation<'T1,'U>) : Validation<_,_> = Validation.zip t1 t2

    let validation = ValidationBuilder()

[<AutoOpen>]
module ValidationCEExtensions =

  // Having Choice<_> members as extensions gives them lower priority in
  // overload resolution and allows skipping more type annotations.
    type ValidationBuilder with
        member __.Bind
            (result: Result<'T, 'TError>, binder: 'T -> Validation<'U, 'TError>)
            : Validation<'U, 'TError> =
            result
            |> Validation.ofResult
            |> Validation.bind binder 
            
        member _.BindReturn(x: Result<'T,'U>, f) : Validation<_,_> = x |> Validation.ofResult |> Result.map f

        member _.MergeSources(t1: Validation<'T,'U>, t2: Result<'T1,'U>) : Validation<_,_> = Validation.zip t1 (Result.mapError List.singleton t2)
        member _.MergeSources(t1: Result<'T,'U>, t2: Validation<'T1,'U>) : Validation<_,_> = Validation.zip (Result.mapError List.singleton t1) t2
        member _.MergeSources(t1: Result<'T,'U>, t2: Result<'T1,'U>) : Validation<_,_> = Validation.zip (Result.mapError List.singleton t1) (Result.mapError List.singleton t2)
        

let f () =
    let expected = Error ["Error 1"; "Error 2"]
    let actual = validation {
        let! a = Ok 3
        and! b = Ok 2
        and! c = Error "Error 1"
        and! d = Error "Error 2"
        return a + b - c - d
    }
    printfn "%A %A" expected actual
    ()

[<EntryPoint>]
let main argv =
    f()
    0 // return an integer exit code

However I have also noticed that in some cases a type annotation is needed. Thanks for testing this out though, @dsyme is looking for more folks to give it a shot

[TheAngryByrd]

Ok I can also get it to compile just fine now. Please call an exorcist.

[demystifyfp]

Thanks, @TheAngryByrd for taking this up. Due to some personal reasons, I am not in a position to actively work on this library.

I am checking the email notifications periodically, and I will jump in if required.

Thanks again :)

[TheAngryByrd]

@demystifyfp No worries! I use this extensively at work so I’m fine with maintaining it fully. Would you be willing to add me as an owner of the nuget package so I can push whenever PRs get merged?

[TheAngryByrd]

@cartermp I am once again asking for your support. I hope summoning you scares the code into behaving again.

I'm trying to add overloads for BindResult and MergeSources for the AsyncResult CE, however I cannot get both of these test cases to build.

     testCaseAsync "Happy Path AsyncResult" <| async {
            let! actual = asyncResult {
                let! a = AsyncResult.retn 3
                and! b = AsyncResult.retn 2
                and! c = AsyncResult.retn 1
                return a + b - c
            }
            Expect.equal actual (Ok 4) "Should be ok"
        }

     testCaseAsync "Happy Path Async" <| async {
            let! actual = asyncResult {
                let! a = Async.singleton 3
                and! b = Async.singleton 2
                and! c = Async.singleton 1
                return a + b - c
            }
            Expect.equal actual (Ok 4) "Should be ok"
        }

This is the compiler error I end up getting for the second test:

/Users/jimmybyrd/Documents/GitHub/FsToolkit.ErrorHandling/tests/FsToolkit.ErrorHandling.Tests/AsyncResultCE.fs(326,26): error FS0041: A unique overload for method 'MergeSources' could not be determined based on type information prior to this program point. A type annotation may be needed.Known types of arguments: Async<int> * Async<Result<(int * int),'a>>Candidates: - member AsyncResultBuilder.MergeSources : t1:Async<'T> * t2:Async<'T1> -> Async<Result<('T * 'T1),'a2>> - member AsyncResultBuilder.MergeSources : t1:Async<'T> * t2:Async<Result<'T1,'U>> -> Async<Result<('T * 'T1),'U>> [/Users/jimmybyrd/Documents/GitHub/FsToolkit.ErrorHandling/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj]
/Users/jimmybyrd/Documents/GitHub/FsToolkit.ErrorHandling/tests/FsToolkit.ErrorHandling.Tests/AsyncResultCE.fs(326,17): error FS0041: A unique overload for method 'BindReturn' could not be determined based on type information prior to this program point. A type annotation may be needed.Known types of arguments: 'a * ( ^b * ( ^c *  ^e) ->  ^f) when ( ^b or  ^c) : (static member ( + ) :  ^b *  ^c ->  ^d) and ( ^d or  ^e) : (static member ( - ) :  ^d *  ^e ->  ^f)Candidates: - member AsyncResultBuilder.BindReturn : x:Async<'T> * f:('T -> 'a1) -> Async<Result<'a1,'a2>> - member AsyncResultBuilder.BindReturn : x:Async<Choice<'T,'U>> * f:('T -> 'a2) -> Async<Result<'a2,'U>> - member AsyncResultBuilder.BindReturn : x:Async<Result<'T,'U>> * f:('T -> 'd) -> Async<Result<'d,'U>> - member AsyncResultBuilder.BindReturn : x:Choice<'T,'U> * f:('T -> 'a2) -> Async<Result<'a2,'U>> - member AsyncResultBuilder.BindReturn : x:Result<'T,'U> * f:('T -> 'a2) -> Async<Result<'a2,'U>> - member AsyncResultBuilder.BindReturn : x:Task<'T> * f:('T -> 'a1) -> Async<Result<'a1,'a2>> - member AsyncResultBuilder.BindReturn : x:Task<Result<'T,'U>> * f:('T -> 'a2) -> Async<Result<'a2,'U>> [/Users/jimmybyrd/Documents/GitHub/FsToolkit.ErrorHandling/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj]

We are using the hack of using extension members which has a lower priority when binding, so maybe this just isn't possible.

You can pull the latest at d9e960e which has this issue. You can't use FAKE to build until fsprojects/FAKE#2499 is merged, so just cd tests/FsToolkit.ErrorHandling.Tests and run dotnet watch run.

[demystifyfp]

Thanks, @TheAngryByrd. I have added you as an owner of the packages in NuGet.

[TheAngryByrd]

Given the amount of work to do for AsyncValidation/TaskValidation/JobValidation and the lack of use cases around those currently, I'm opting to not implementing them for now.

[TheAngryByrd]

I'm having issues with travis: dotnet/core#4542 (comment)

I'm going to accept this PR since I don't want to fight with it. I'll open a separate issue to get it fixed.