Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

WIP: Applicative support #75

Merged
merged 19 commits into from May 12, 2020

Conversation

TheAngryByrd
Copy link
Collaborator

@TheAngryByrd TheAngryByrd commented Apr 12, 2020

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
Copy link

@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
Copy link
Collaborator Author

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

@demystifyfp
Copy link
Owner

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
Copy link
Collaborator Author

@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
Copy link
Collaborator Author

@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
Copy link
Owner

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

@TheAngryByrd TheAngryByrd marked this pull request as draft April 28, 2020 16:00
@TheAngryByrd
Copy link
Collaborator Author

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 TheAngryByrd marked this pull request as ready for review May 12, 2020 21:13
@TheAngryByrd
Copy link
Collaborator Author

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.

@TheAngryByrd TheAngryByrd merged commit 4aa516b into demystifyfp:master May 12, 2020
TheAngryByrd added a commit that referenced this pull request May 25, 2020
- Adds Applicative Support for FSharp 5.0. Credits [Jimmy Byrd](https://github.com/TheAngryByrd) - (#75)
- Reduces required FSharp.Core version to 4.3.4. Credits [Jimmy Byrd](https://github.com/TheAngryByrd) - (#80)
TheAngryByrd added a commit that referenced this pull request May 25, 2020
- Adds Applicative Support for FSharp 5.0. Credits [Jimmy Byrd](https://github.com/TheAngryByrd) - (#75)
- Reduces required FSharp.Core version to 4.3.4. Credits [Jimmy Byrd](https://github.com/TheAngryByrd) - (#80)
@TheAngryByrd TheAngryByrd deleted the applicative-support branch January 11, 2022 15:08
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

Successfully merging this pull request may close these issues.

None yet

3 participants