From 2498b07d78efc5ae2058594c96f293b9547edb96 Mon Sep 17 00:00:00 2001 From: DashieTM Date: Tue, 22 Oct 2024 10:20:26 +0200 Subject: [PATCH] Add Array errorhandling --- src/FsToolkit.ErrorHandling/Array.fs | 239 +++++++ .../FsToolkit.ErrorHandling.fsproj | 1 + tests/FsToolkit.ErrorHandling.Tests/Array.fs | 637 ++++++++++++++++++ .../FsToolkit.ErrorHandling.Tests.fsproj | 1 + tests/FsToolkit.ErrorHandling.Tests/Main.fs | 1 + 5 files changed, 879 insertions(+) create mode 100644 src/FsToolkit.ErrorHandling/Array.fs create mode 100644 tests/FsToolkit.ErrorHandling.Tests/Array.fs diff --git a/src/FsToolkit.ErrorHandling/Array.fs b/src/FsToolkit.ErrorHandling/Array.fs new file mode 100644 index 00000000..6e6ed2da --- /dev/null +++ b/src/FsToolkit.ErrorHandling/Array.fs @@ -0,0 +1,239 @@ +namespace FsToolkit.ErrorHandling + +[] +module Array = + let rec private traverseResultM' (state: Result<_, _>) (f: _ -> Result<_, _>) xs = + match xs with + | [||] -> + state + |> Result.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + let res = + result { + let! y = f x + let! ys = state + return Array.append [| y |] ys + } + + match res with + | Ok _ -> traverseResultM' res f xs + | Error _ -> res + + let rec private traverseAsyncResultM' + (state: Async>) + (f: _ -> Async>) + xs + = + match xs with + | [||] -> + state + |> AsyncResult.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + async { + let! r = + asyncResult { + let! ys = state + let! y = f x + return Array.append [| y |] ys + } + + match r with + | Ok _ -> return! traverseAsyncResultM' (Async.singleton r) f xs + | Error _ -> return r + } + + let traverseResultM f xs = traverseResultM' (Ok [||]) f xs + + let sequenceResultM xs = traverseResultM id xs + + let traverseAsyncResultM f xs = + traverseAsyncResultM' (AsyncResult.retn [||]) f xs + + let sequenceAsyncResultM xs = traverseAsyncResultM id xs + + let rec private traverseResultA' state f xs = + match xs with + | [||] -> + state + |> Result.eitherMap Array.rev Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + match state, f x with + | Ok ys, Ok y -> traverseResultA' (Ok(Array.append [| y |] ys)) f xs + | Error errs, Error e -> traverseResultA' (Error(Array.append [| e |] errs)) f xs + | Ok _, Error e -> traverseResultA' (Error [| e |]) f xs + | Error e, Ok _ -> traverseResultA' (Error e) f xs + + let rec private traverseAsyncResultA' state f xs = + match xs with + | [||] -> + state + |> AsyncResult.eitherMap Array.rev Array.rev + + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + async { + let! s = state + let! fR = f x + + match s, fR with + | Ok ys, Ok y -> + return! traverseAsyncResultA' (AsyncResult.retn (Array.append [| y |] ys)) f xs + | Error errs, Error e -> + return! + traverseAsyncResultA' + (AsyncResult.returnError (Array.append [| e |] errs)) + f + xs + | Ok _, Error e -> + return! traverseAsyncResultA' (AsyncResult.returnError [| e |]) f xs + | Error e, Ok _ -> return! traverseAsyncResultA' (AsyncResult.returnError e) f xs + } + + let traverseResultA f xs = traverseResultA' (Ok [||]) f xs + + let sequenceResultA xs = traverseResultA id xs + + let rec private traverseValidationA' state f xs = + match xs with + | [||] -> + state + |> Result.eitherMap Array.rev Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + let fR = f x + + match state, fR with + | Ok ys, Ok y -> traverseValidationA' (Ok(Array.append [| y |] ys)) f xs + | Error errs1, Error errs2 -> + let errs = Array.append errs2 errs1 + traverseValidationA' (Error errs) f xs + | Ok _, Error errs + | Error errs, Ok _ -> traverseValidationA' (Error errs) f xs + + let traverseValidationA f xs = traverseValidationA' (Ok [||]) f xs + + let sequenceValidationA xs = traverseValidationA id xs + + let traverseAsyncResultA f xs = + traverseAsyncResultA' (AsyncResult.retn [||]) f xs + + let sequenceAsyncResultA xs = traverseAsyncResultA id xs + + let rec private traverseOptionM' (state: Option<_>) (f: _ -> Option<_>) xs = + match xs with + | [||] -> + state + |> Option.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + let r = + option { + let! y = f x + let! ys = state + return Array.append [| y |] ys + } + + match r with + | Some _ -> traverseOptionM' r f xs + | None -> r + + let rec private traverseAsyncOptionM' (state: Async>) (f: _ -> Async>) xs = + match xs with + | [||] -> + state + |> AsyncOption.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + async { + let! o = + asyncOption { + let! y = f x + let! ys = state + return Array.append [| y |] ys + } + + match o with + | Some _ -> return! traverseAsyncOptionM' (Async.singleton o) f xs + | None -> return o + } + + /// + /// Applies the given function to each element in the input list , + /// and returns an option containing a list of the results. If any of the function applications return None, + /// the entire result will be None. + /// + /// The function to apply to each element in the input list. + /// The input list. + /// An option containing a list of the results of applying the function to each element in the input list, + /// or None if any of the function applications return None. + let traverseOptionM f xs = traverseOptionM' (Some [||]) f xs + + /// + /// Applies the monadic function to each element in the input list , + /// and returns the result as an option. If any element in the list is None, the entire result will be None. + /// + /// The input list. + /// An option containing the result of applying to each element in . + let sequenceOptionM xs = traverseOptionM id xs + + let traverseAsyncOptionM f xs = + traverseAsyncOptionM' (AsyncOption.retn [||]) f xs + + let sequenceAsyncOptionM xs = traverseAsyncOptionM id xs + +#if !FABLE_COMPILER + let rec private traverseVOptionM' (state: voption<_>) (f: _ -> voption<_>) xs = + match xs with + | [||] -> + state + |> ValueOption.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + let r = + voption { + let! y = f x + let! ys = state + return Array.append [| y |] ys + } + + match r with + | ValueSome _ -> traverseVOptionM' r f xs + | ValueNone -> r + + /// + /// Applies the given function to each element in the input list , + /// and returns an option containing a list of the results. If any of the function applications return ValueNone, + /// the entire result will be ValueNone. + /// + /// The function to apply to each element in the input list. + /// The input list + /// An Option monad containing the collected results. + let traverseVOptionM f xs = traverseVOptionM' (ValueSome [||]) f xs + + /// + /// Applies the function to each element in the input list , + /// and returns the result as a value option. If any element in the list is ValueNone, the entire result will be ValueNone. + /// + /// The input list. + /// A representing the sequence of results. + let sequenceVOptionM xs = traverseVOptionM id xs + +#endif diff --git a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj index 7e5f981d..86409b09 100644 --- a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj +++ b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj @@ -38,6 +38,7 @@ + diff --git a/tests/FsToolkit.ErrorHandling.Tests/Array.fs b/tests/FsToolkit.ErrorHandling.Tests/Array.fs new file mode 100644 index 00000000..a6421cc2 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/Array.fs @@ -0,0 +1,637 @@ +module ArrayTests + + +#if FABLE_COMPILER_PYTHON +open Fable.Pyxpecto +#endif +#if FABLE_COMPILER_JAVASCRIPT +open Fable.Mocha +#endif +#if !FABLE_COMPILER +open Expecto +#endif +open SampleDomain +open TestData +open TestHelpers +open System +open FsToolkit.ErrorHandling + + +let traverseResultMTests = + testList "Array.traverseResultM Tests" [ + testCase "traverseResult with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = + Array.map tweet tweets + |> Ok + + let actual = Array.traverseResultM Tweet.TryCreate tweets + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "traverseResultM with few invalid data" + <| fun _ -> + let tweets = [| + "" + "Hello" + aLongerInvalidTweet + |] + + let actual = Array.traverseResultM Tweet.TryCreate tweets + + Expect.equal + actual + (Error emptyTweetErrMsg) + "traverse the array and return the first error" + ] + +let traverseOptionMTests = + testList "Array.traverseOptionM Tests" [ + let tryTweetOption x = + match x with + | x when String.IsNullOrEmpty x -> None + | _ -> Some x + + testCase "traverseOption with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = Some tweets + let actual = Array.traverseOptionM tryTweetOption tweets + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "traverseOption with few invalid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + String.Empty + |] + + let expected = None + let actual = Array.traverseOptionM tryTweetOption tweets + + Expect.equal actual expected "traverse the array and return none" + ] + +let sequenceResultMTests = + testList "Array.sequenceResultM Tests" [ + testCase "traverseResult with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = + Array.map tweet tweets + |> Ok + + let actual = Array.sequenceResultM (Array.map Tweet.TryCreate tweets) + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "sequenceResultM with few invalid data" + <| fun _ -> + let tweets = [| + "" + "Hello" + aLongerInvalidTweet + |] + + let actual = Array.sequenceResultM (Array.map Tweet.TryCreate tweets) + + Expect.equal + actual + (Error emptyTweetErrMsg) + "traverse the array and return the first error" + ] + +let sequenceOptionMTests = + testList "Array.sequenceOptionM Tests" [ + let tryTweetOption x = + match x with + | x when String.IsNullOrEmpty x -> None + | _ -> Some x + + testCase "traverseOption with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = Some tweets + let actual = Array.sequenceOptionM (Array.map tryTweetOption tweets) + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "sequenceOptionM with few invalid data" + <| fun _ -> + let tweets = [| + String.Empty + "Hello" + String.Empty + |] + + let actual = Array.sequenceOptionM (Array.map tryTweetOption tweets) + + Expect.equal actual None "traverse the array and return none" + ] + +let traverseResultATests = + testList "Array.traverseResultA Tests" [ + testCase "traverseResultA with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = + Array.map tweet tweets + |> Ok + + let actual = Array.traverseResultA Tweet.TryCreate tweets + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "traverseResultA with few invalid data" + <| fun _ -> + let tweets = [| + "" + "Hello" + aLongerInvalidTweet + |] + + let actual = Array.traverseResultA Tweet.TryCreate tweets + + Expect.equal + actual + (Error [| + emptyTweetErrMsg + longerTweetErrMsg + |]) + "traverse the array and return all the errors" + ] + + +let sequenceResultATests = + testList "Array.sequenceResultA Tests" [ + testCase "traverseResult with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = + Array.map tweet tweets + |> Ok + + let actual = Array.sequenceResultA (Array.map Tweet.TryCreate tweets) + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "sequenceResultM with few invalid data" + <| fun _ -> + let tweets = [| + "" + "Hello" + aLongerInvalidTweet + |] + + let actual = Array.sequenceResultA (Array.map Tweet.TryCreate tweets) + + Expect.equal + actual + (Error [| + emptyTweetErrMsg + longerTweetErrMsg + |]) + "traverse the array and return all the errors" + ] + + +let traverseValidationATests = + testList "Array.traverseValidationA Tests" [ + testCase "traverseValidationA with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = + Array.map tweet tweets + |> Ok + + let actual = + Array.traverseValidationA + (Tweet.TryCreate + >> (Result.mapError Array.singleton)) + tweets + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "traverseValidationA with few invalid data" + <| fun _ -> + let tweets = [| + "" + "Hello" + aLongerInvalidTweet + |] + + let actual = + Array.traverseValidationA + (Tweet.TryCreate + >> (Result.mapError Array.singleton)) + tweets + + Expect.equal + actual + (Error [| + emptyTweetErrMsg + longerTweetErrMsg + |]) + "traverse the array and return all the errors" + ] + + +let sequenceValidationATests = + let tryCreateTweet = + Tweet.TryCreate + >> (Result.mapError Array.singleton) + + testList "Array.sequenceValidationA Tests" [ + testCase "traverseValidation with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = + Array.map tweet tweets + |> Ok + + let actual = Array.sequenceValidationA (Array.map tryCreateTweet tweets) + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "sequenceValidationM with few invalid data" + <| fun _ -> + let tweets = [| + "" + "Hello" + aLongerInvalidTweet + |] + + let actual = Array.sequenceValidationA (Array.map tryCreateTweet tweets) + + Expect.equal + actual + (Error [| + emptyTweetErrMsg + longerTweetErrMsg + |]) + "traverse the array and return all the errors" + ] + +let userId1 = Guid.NewGuid() +let userId2 = Guid.NewGuid() +let userId3 = Guid.NewGuid() +let userId4 = Guid.NewGuid() + + +let traverseAsyncResultMTests = + + let userIds = + Array.map UserId [| + userId1 + userId2 + userId3 + |] + + testList "Array.traverseAsyncResultM Tests" [ + testCaseAsync "traverseAsyncResultM with an array of valid data" + <| async { + let expected = + userIds + |> Array.map (fun (UserId user) -> (newPostId, user)) + + let actual = + Array.traverseAsyncResultM (notifyNewPostSuccess (PostId newPostId)) userIds + + do! Expect.hasAsyncOkValue expected actual + } + + testCaseAsync "traverseResultA with few invalid data" + <| async { + let expected = sprintf "error: %s" (userId1.ToString()) + + let actual = + Array.traverseAsyncResultM (notifyNewPostFailure (PostId newPostId)) userIds + + do! Expect.hasAsyncErrorValue expected actual + } + ] + +let traverseAsyncOptionMTests = + + let userIds = [| + userId1 + userId2 + userId3 + |] + + testList "Array.traverseAsyncOptionM Tests" [ + testCaseAsync "traverseAsyncOptionM with an array of valid data" + <| async { + let expected = Some userIds + let f x = async { return Some x } + let actual = Array.traverseAsyncOptionM f userIds + + match expected with + | Some e -> do! Expect.hasAsyncSomeValue e actual + | None -> failwith "Error in the test case code" + } + + testCaseAsync "traverseOptionA with few invalid data" + <| async { + let expected = None + let f _ = async { return None } + let actual = Array.traverseAsyncOptionM f userIds + + match expected with + | Some _ -> failwith "Error in the test case code" + | None -> do! Expect.hasAsyncNoneValue actual + } + ] + +let notifyFailure (PostId _) (UserId uId) = + async { + if + (uId = userId1 + || uId = userId3) + then + return + sprintf "error: %s" (uId.ToString()) + |> Error + else + return Ok() + } + + +let traverseAsyncResultATests = + let userIds = + Array.map UserId [| + userId1 + userId2 + userId3 + userId4 + |] + + testList "Array.traverseAsyncResultA Tests" [ + testCaseAsync "traverseAsyncResultA with an array of valid data" + <| async { + let expected = + userIds + |> Array.map (fun (UserId user) -> (newPostId, user)) + + let actual = + Array.traverseAsyncResultA (notifyNewPostSuccess (PostId newPostId)) userIds + + do! Expect.hasAsyncOkValue expected actual + } + + testCaseAsync "traverseResultA with few invalid data" + <| async { + let expected = [| + sprintf "error: %s" (userId1.ToString()) + sprintf "error: %s" (userId3.ToString()) + |] + + let actual = Array.traverseAsyncResultA (notifyFailure (PostId newPostId)) userIds + + do! Expect.hasAsyncErrorValue expected actual + } + ] + + +let sequenceAsyncResultMTests = + let userIds = + Array.map UserId [| + userId1 + userId2 + userId3 + userId4 + |] + + testList "Array.sequenceAsyncResultM Tests" [ + testCaseAsync "sequenceAsyncResultM with an array of valid data" + <| async { + let expected = + userIds + |> Array.map (fun (UserId user) -> (newPostId, user)) + + let actual = + Array.map (notifyNewPostSuccess (PostId newPostId)) userIds + |> Array.sequenceAsyncResultM + + do! Expect.hasAsyncOkValue expected actual + } + + testCaseAsync "sequenceAsyncResultM with few invalid data" + <| async { + let expected = sprintf "error: %s" (userId1.ToString()) + + let actual = + Array.map (notifyFailure (PostId newPostId)) userIds + |> Array.sequenceAsyncResultM + + do! Expect.hasAsyncErrorValue expected actual + } + ] + +let sequenceAsyncOptionMTests = + + let userIds = [| + userId1 + userId2 + userId3 + |] + + testList "Array.sequenceAsyncOptionM Tests" [ + testCaseAsync "sequenceAsyncOptionM with an array of valid data" + <| async { + let expected = Some userIds + let f x = async { return Some x } + + let actual = + Array.map f userIds + |> Array.sequenceAsyncOptionM + + match expected with + | Some e -> do! Expect.hasAsyncSomeValue e actual + | None -> failwith "Error in the test case code" + } + + testCaseAsync "sequenceOptionA with few invalid data" + <| async { + let expected = None + let f _ = async { return None } + + let actual = + Array.map f userIds + |> Array.sequenceAsyncOptionM + + match expected with + | Some _ -> failwith "Error in the test case code" + | None -> do! Expect.hasAsyncNoneValue actual + } + ] + +let sequenceAsyncResultATests = + let userIds = + Array.map UserId [| + userId1 + userId2 + userId3 + userId4 + |] + + testList "Array.sequenceAsyncResultA Tests" [ + testCaseAsync "sequenceAsyncResultA with an array of valid data" + <| async { + let expected = + userIds + |> Array.map (fun (UserId user) -> (newPostId, user)) + + let actual = + Array.map (notifyNewPostSuccess (PostId newPostId)) userIds + |> Array.sequenceAsyncResultA + + do! Expect.hasAsyncOkValue expected actual + } + + testCaseAsync "sequenceAsyncResultA with few invalid data" + <| async { + let expected = [| + sprintf "error: %s" (userId1.ToString()) + sprintf "error: %s" (userId3.ToString()) + |] + + let actual = + Array.map (notifyFailure (PostId newPostId)) userIds + |> Array.sequenceAsyncResultA + + do! Expect.hasAsyncErrorValue expected actual + } + ] + +#if !FABLE_COMPILER +let traverseVOptionMTests = + testList "Array.traverseVOptionM Tests" [ + let tryTweetVOption x = + match x with + | x when String.IsNullOrEmpty x -> ValueNone + | _ -> ValueSome x + + testCase "traverseVOption with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = ValueSome tweets + let actual = Array.traverseVOptionM tryTweetVOption tweets + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "traverseVOption with few invalid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + String.Empty + |] + + let actual = Array.traverseVOptionM tryTweetVOption tweets + Expect.equal actual ValueNone "traverse the array and return value none" + ] + +let sequenceVOptionMTests = + testList "Array.sequenceVOptionM Tests" [ + let tryTweetOption x = + match x with + | x when String.IsNullOrEmpty x -> ValueNone + | _ -> ValueSome x + + testCase "traverseVOption with an array of valid data" + <| fun _ -> + let tweets = [| + "Hi" + "Hello" + "Hola" + |] + + let expected = ValueSome tweets + let actual = Array.sequenceVOptionM (Array.map tryTweetOption tweets) + + Expect.equal actual expected "Should have an array of valid tweets" + + testCase "sequenceVOptionM with few invalid data" + <| fun _ -> + let tweets = [| + String.Empty + "Hello" + String.Empty + |] + + let actual = Array.sequenceVOptionM (Array.map tryTweetOption tweets) + Expect.equal actual ValueNone "traverse the array and return value none" + ] + +#endif + +let allTests = + testList "Array Tests" [ + traverseResultMTests + traverseOptionMTests + sequenceResultMTests + sequenceOptionMTests + traverseResultATests + sequenceResultATests + traverseValidationATests + sequenceValidationATests + traverseAsyncResultMTests + traverseAsyncOptionMTests + traverseAsyncResultATests + sequenceAsyncResultMTests + sequenceAsyncOptionMTests + sequenceAsyncResultATests +#if !FABLE_COMPILER + traverseVOptionMTests + sequenceVOptionMTests +#endif + ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj index b0585dd7..b52c5140 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj @@ -29,6 +29,7 @@ + diff --git a/tests/FsToolkit.ErrorHandling.Tests/Main.fs b/tests/FsToolkit.ErrorHandling.Tests/Main.fs index 779e81c4..118c6472 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/Main.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/Main.fs @@ -22,6 +22,7 @@ let allTests = AsyncOptionTests.allTests AsyncOptionCETests.allTests ListTests.allTests + ArrayTests.allTests SeqTests.allTests AsyncResultTests.allTests AsyncResultCETests.allTests