Skip to content

Commit 269d2ba

Browse files
authored
Add Array errorhandling (#279)
1 parent a456aaa commit 269d2ba

File tree

5 files changed

+879
-0
lines changed

5 files changed

+879
-0
lines changed

src/FsToolkit.ErrorHandling/Array.fs

Lines changed: 239 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,239 @@
1+
namespace FsToolkit.ErrorHandling
2+
3+
[<RequireQualifiedAccess>]
4+
module Array =
5+
let rec private traverseResultM' (state: Result<_, _>) (f: _ -> Result<_, _>) xs =
6+
match xs with
7+
| [||] ->
8+
state
9+
|> Result.map Array.rev
10+
| arr ->
11+
let x = Array.head arr
12+
let xs = Array.skip 1 arr
13+
14+
let res =
15+
result {
16+
let! y = f x
17+
let! ys = state
18+
return Array.append [| y |] ys
19+
}
20+
21+
match res with
22+
| Ok _ -> traverseResultM' res f xs
23+
| Error _ -> res
24+
25+
let rec private traverseAsyncResultM'
26+
(state: Async<Result<_, _>>)
27+
(f: _ -> Async<Result<_, _>>)
28+
xs
29+
=
30+
match xs with
31+
| [||] ->
32+
state
33+
|> AsyncResult.map Array.rev
34+
| arr ->
35+
let x = Array.head arr
36+
let xs = Array.skip 1 arr
37+
38+
async {
39+
let! r =
40+
asyncResult {
41+
let! ys = state
42+
let! y = f x
43+
return Array.append [| y |] ys
44+
}
45+
46+
match r with
47+
| Ok _ -> return! traverseAsyncResultM' (Async.singleton r) f xs
48+
| Error _ -> return r
49+
}
50+
51+
let traverseResultM f xs = traverseResultM' (Ok [||]) f xs
52+
53+
let sequenceResultM xs = traverseResultM id xs
54+
55+
let traverseAsyncResultM f xs =
56+
traverseAsyncResultM' (AsyncResult.retn [||]) f xs
57+
58+
let sequenceAsyncResultM xs = traverseAsyncResultM id xs
59+
60+
let rec private traverseResultA' state f xs =
61+
match xs with
62+
| [||] ->
63+
state
64+
|> Result.eitherMap Array.rev Array.rev
65+
| arr ->
66+
let x = Array.head arr
67+
let xs = Array.skip 1 arr
68+
69+
match state, f x with
70+
| Ok ys, Ok y -> traverseResultA' (Ok(Array.append [| y |] ys)) f xs
71+
| Error errs, Error e -> traverseResultA' (Error(Array.append [| e |] errs)) f xs
72+
| Ok _, Error e -> traverseResultA' (Error [| e |]) f xs
73+
| Error e, Ok _ -> traverseResultA' (Error e) f xs
74+
75+
let rec private traverseAsyncResultA' state f xs =
76+
match xs with
77+
| [||] ->
78+
state
79+
|> AsyncResult.eitherMap Array.rev Array.rev
80+
81+
| arr ->
82+
let x = Array.head arr
83+
let xs = Array.skip 1 arr
84+
85+
async {
86+
let! s = state
87+
let! fR = f x
88+
89+
match s, fR with
90+
| Ok ys, Ok y ->
91+
return! traverseAsyncResultA' (AsyncResult.retn (Array.append [| y |] ys)) f xs
92+
| Error errs, Error e ->
93+
return!
94+
traverseAsyncResultA'
95+
(AsyncResult.returnError (Array.append [| e |] errs))
96+
f
97+
xs
98+
| Ok _, Error e ->
99+
return! traverseAsyncResultA' (AsyncResult.returnError [| e |]) f xs
100+
| Error e, Ok _ -> return! traverseAsyncResultA' (AsyncResult.returnError e) f xs
101+
}
102+
103+
let traverseResultA f xs = traverseResultA' (Ok [||]) f xs
104+
105+
let sequenceResultA xs = traverseResultA id xs
106+
107+
let rec private traverseValidationA' state f xs =
108+
match xs with
109+
| [||] ->
110+
state
111+
|> Result.eitherMap Array.rev Array.rev
112+
| arr ->
113+
let x = Array.head arr
114+
let xs = Array.skip 1 arr
115+
let fR = f x
116+
117+
match state, fR with
118+
| Ok ys, Ok y -> traverseValidationA' (Ok(Array.append [| y |] ys)) f xs
119+
| Error errs1, Error errs2 ->
120+
let errs = Array.append errs2 errs1
121+
traverseValidationA' (Error errs) f xs
122+
| Ok _, Error errs
123+
| Error errs, Ok _ -> traverseValidationA' (Error errs) f xs
124+
125+
let traverseValidationA f xs = traverseValidationA' (Ok [||]) f xs
126+
127+
let sequenceValidationA xs = traverseValidationA id xs
128+
129+
let traverseAsyncResultA f xs =
130+
traverseAsyncResultA' (AsyncResult.retn [||]) f xs
131+
132+
let sequenceAsyncResultA xs = traverseAsyncResultA id xs
133+
134+
let rec private traverseOptionM' (state: Option<_>) (f: _ -> Option<_>) xs =
135+
match xs with
136+
| [||] ->
137+
state
138+
|> Option.map Array.rev
139+
| arr ->
140+
let x = Array.head arr
141+
let xs = Array.skip 1 arr
142+
143+
let r =
144+
option {
145+
let! y = f x
146+
let! ys = state
147+
return Array.append [| y |] ys
148+
}
149+
150+
match r with
151+
| Some _ -> traverseOptionM' r f xs
152+
| None -> r
153+
154+
let rec private traverseAsyncOptionM' (state: Async<Option<_>>) (f: _ -> Async<Option<_>>) xs =
155+
match xs with
156+
| [||] ->
157+
state
158+
|> AsyncOption.map Array.rev
159+
| arr ->
160+
let x = Array.head arr
161+
let xs = Array.skip 1 arr
162+
163+
async {
164+
let! o =
165+
asyncOption {
166+
let! y = f x
167+
let! ys = state
168+
return Array.append [| y |] ys
169+
}
170+
171+
match o with
172+
| Some _ -> return! traverseAsyncOptionM' (Async.singleton o) f xs
173+
| None -> return o
174+
}
175+
176+
/// <summary>
177+
/// Applies the given function <paramref name="f"/> to each element in the input list <paramref name="xs"/>,
178+
/// and returns an option containing a list of the results. If any of the function applications return None,
179+
/// the entire result will be None.
180+
/// </summary>
181+
/// <param name="f">The function to apply to each element in the input list.</param>
182+
/// <param name="xs">The input list.</param>
183+
/// <returns>An option containing a list of the results of applying the function to each element in the input list,
184+
/// or None if any of the function applications return None.</returns>
185+
let traverseOptionM f xs = traverseOptionM' (Some [||]) f xs
186+
187+
/// <summary>
188+
/// Applies the monadic function <paramref name="id"/> to each element in the input list <paramref name="xs"/>,
189+
/// and returns the result as an option. If any element in the list is None, the entire result will be None.
190+
/// </summary>
191+
/// <param name="xs">The input list.</param>
192+
/// <returns>An option containing the result of applying <paramref name="id"/> to each element in <paramref name="xs"/>.</returns>
193+
let sequenceOptionM xs = traverseOptionM id xs
194+
195+
let traverseAsyncOptionM f xs =
196+
traverseAsyncOptionM' (AsyncOption.retn [||]) f xs
197+
198+
let sequenceAsyncOptionM xs = traverseAsyncOptionM id xs
199+
200+
#if !FABLE_COMPILER
201+
let rec private traverseVOptionM' (state: voption<_>) (f: _ -> voption<_>) xs =
202+
match xs with
203+
| [||] ->
204+
state
205+
|> ValueOption.map Array.rev
206+
| arr ->
207+
let x = Array.head arr
208+
let xs = Array.skip 1 arr
209+
210+
let r =
211+
voption {
212+
let! y = f x
213+
let! ys = state
214+
return Array.append [| y |] ys
215+
}
216+
217+
match r with
218+
| ValueSome _ -> traverseVOptionM' r f xs
219+
| ValueNone -> r
220+
221+
/// <summary>
222+
/// Applies the given function <paramref name="f"/> to each element in the input list <paramref name="xs"/>,
223+
/// and returns an option containing a list of the results. If any of the function applications return ValueNone,
224+
/// the entire result will be ValueNone.
225+
/// </summary>
226+
/// <param name="f">The function to apply to each element in the input list.</param>
227+
/// <param name="xs">The input list</param>
228+
/// <returns>An Option monad containing the collected results.</returns>
229+
let traverseVOptionM f xs = traverseVOptionM' (ValueSome [||]) f xs
230+
231+
/// <summary>
232+
/// Applies the <paramref name="id"/> function to each element in the input list <paramref name="xs"/>,
233+
/// and returns the result as a value option. If any element in the list is ValueNone, the entire result will be ValueNone.
234+
/// </summary>
235+
/// <param name="xs">The input list.</param>
236+
/// <returns>A <see cref="Option{T}"/> representing the sequence of results.</returns>
237+
let sequenceVOptionM xs = traverseVOptionM id xs
238+
239+
#endif

src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@
3838
<Compile Include="AsyncResultOptionCE.fs" />
3939
<Compile Include="AsyncResultOptionOp.fs" />
4040
<Compile Include="List.fs" />
41+
<Compile Include="Array.fs" />
4142
<Compile Include="Seq.fs" />
4243
<None Include="Script.fsx" />
4344
<None Include="paket.references" />

0 commit comments

Comments
 (0)