/
Result.fs
470 lines (363 loc) · 14.9 KB
/
Result.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
namespace global // note use of GLOBAL namespace
open System
//==============================================
// Helpers for Result type and AsyncResult type
//==============================================
// F# VERSION DIFFERENCE
// The "Result" type is built-in to F# 4.1 and newer (from VS2017),
// so uncomment the Result type if you are using an older version of F#
(*
/// The Result type represents a choice between success and failure
type Result<'success, 'failure> =
| Ok of 'success
| Error of 'failure
*)
/// Functions for Result type (functor and monad).
/// For applicatives, see Validation.
[<RequireQualifiedAccess>] // RequireQualifiedAccess forces the `Result.xxx` prefix to be used
module Result =
/// Pass in a function to handle each case of `Result`
let bimap onSuccess onError xR =
match xR with
| Ok x -> onSuccess x
| Error err -> onError err
// F# VERSION DIFFERENCE
// The `map`, `mapError` and `bind` functions are built-in to F# 4.1 and newer (from VS2017),
// so uncomment these if you are using an older version of F#
(*
let map f result =
match result with
| Ok success -> Ok (f success)
| Error err -> Error err
let mapError f result =
match result with
| Ok success -> Ok success
| Error err -> Error (f err)
let bind f result =
match result with
| Ok success -> f success
| Error err -> Error err
*)
// F# VERSION DIFFERENCE
// The `map`, `mapError` and `bind` functions are in a different module in F# 4.1 and newer (from VS2017),
// so these aliases make them available in this module.
// In older versions of F#, where the functions are defined above, please comment them out
let map = Result.map
let mapError = Result.mapError
let bind = Result.bind
// Like `map` but with a unit-returning function
let iter (f : _ -> unit) result =
map f result |> ignore
/// Apply a Result<fn> to a Result<x> monadically
let apply fR xR =
match fR, xR with
| Ok f, Ok x -> Ok (f x)
| Error err1, Ok _ -> Error err1
| Ok _, Error err2 -> Error err2
| Error err1, Error _ -> Error err1
// combine a list of results, monadically
let sequence aListOfResults =
let (<*>) = apply // monadic
let (<!>) = map
let cons head tail = head::tail
let consR headR tailR = cons <!> headR <*> tailR
let initialValue = Ok [] // empty list inside Result
// loop through the list, prepending each element
// to the initial value
List.foldBack consR aListOfResults initialValue
//-----------------------------------
// Lifting
/// Lift a two parameter function to use Result parameters
let lift2 f x1 x2 =
let (<!>) = map
let (<*>) = apply
f <!> x1 <*> x2
/// Lift a three parameter function to use Result parameters
let lift3 f x1 x2 x3 =
let (<!>) = map
let (<*>) = apply
f <!> x1 <*> x2 <*> x3
/// Lift a four parameter function to use Result parameters
let lift4 f x1 x2 x3 x4 =
let (<!>) = map
let (<*>) = apply
f <!> x1 <*> x2 <*> x3 <*> x4
/// Apply a monadic function with two parameters
let bind2 f x1 x2 = lift2 f x1 x2 |> bind id
/// Apply a monadic function with three parameters
let bind3 f x1 x2 x3 = lift3 f x1 x2 x3 |> bind id
//-----------------------------------
// Predicates
/// Predicate that returns true on success
let isOk =
function
| Ok _ -> true
| Error _ -> false
/// Predicate that returns true on failure
let isError xR =
xR |> isOk |> not
/// Lift a given predicate into a predicate that works on Results
let filter pred =
function
| Ok x -> pred x
| Error _ -> true
//-----------------------------------
// Mixing simple values and results
/// On success, return the value. On error, return a default value
let ifError defaultVal =
function
| Ok x -> x
| Error _ -> defaultVal
//-----------------------------------
// Mixing options and results
/// Apply a monadic function to an Result<x option>
let bindOption f xR =
match xR with
| Some x -> f x |> map Some
| None -> Ok None
/// Convert an Option into a Result. If none, use the passed-in errorValue
let ofOption errorValue opt =
match opt with
| Some v -> Ok v
| None -> Error errorValue
/// Convert a Result into an Option
let toOption xR =
match xR with
| Ok v -> Some v
| Error _ -> None
/// Convert the Error case into an Option
/// (useful with List.choose to find all errors in a list of Results)
let toErrorOption =
function
| Ok _ -> None
| Error err -> Some err
//==============================================
// Computation Expression for Result
//==============================================
[<AutoOpen>]
module ResultComputationExpression =
type ResultBuilder() =
member __.Return(x) = Ok x
member __.Bind(x, f) = Result.bind f x
member __.ReturnFrom(x) = x
member this.Zero() = this.Return ()
member __.Delay(f) = f
member __.Run(f) = f()
member this.While(guard, body) =
if not (guard())
then this.Zero()
else this.Bind( body(), fun () ->
this.While(guard, body))
member this.TryWith(body, handler) =
try this.ReturnFrom(body())
with e -> handler e
member this.TryFinally(body, compensation) =
try this.ReturnFrom(body())
finally compensation()
member this.Using(disposable:#System.IDisposable, body) =
let body' = fun () -> body disposable
this.TryFinally(body', fun () ->
match disposable with
| null -> ()
| disp -> disp.Dispose())
member this.For(sequence:seq<_>, body) =
this.Using(sequence.GetEnumerator(),fun enum ->
this.While(enum.MoveNext,
this.Delay(fun () -> body enum.Current)))
member this.Combine (a,b) =
this.Bind(a, fun () -> b())
let result = new ResultBuilder()
//==============================================
// The `Validation` type is the same as the `Result` type but with a *list* for failures
// rather than a single value. This allows `Validation` types to be combined
// by combining their errors ("applicative-style")
//==============================================
type Validation<'Success,'Failure> =
Result<'Success,'Failure list>
/// Functions for the `Validation` type (mostly applicative)
[<RequireQualifiedAccess>] // RequireQualifiedAccess forces the `Validation.xxx` prefix to be used
module Validation =
/// Alias for Result.Map
let map = Result.map
/// Apply a Validation<fn> to a Validation<x> applicatively
let apply (fV:Validation<_,_>) (xV:Validation<_,_>) :Validation<_,_> =
match fV, xV with
| Ok f, Ok x -> Ok (f x)
| Error errs1, Ok _ -> Error errs1
| Ok _, Error errs2 -> Error errs2
| Error errs1, Error errs2 -> Error (errs1 @ errs2)
// combine a list of Validation, applicatively
let sequence (aListOfValidations:Validation<_,_> list) =
let (<*>) = apply
let (<!>) = Result.map
let cons head tail = head::tail
let consR headR tailR = cons <!> headR <*> tailR
let initialValue = Ok [] // empty list inside Result
// loop through the list, prepending each element
// to the initial value
List.foldBack consR aListOfValidations initialValue
//-----------------------------------
// Converting between Validations and other types
let ofResult xR :Validation<_,_> =
xR |> Result.mapError List.singleton
let toResult (xV:Validation<_,_>) :Result<_,_> =
xV
//==============================================
// Async utilities
//==============================================
[<RequireQualifiedAccess>] // RequireQualifiedAccess forces the `Async.xxx` prefix to be used
module Async =
/// Lift a function to Async
let map f xA =
async {
let! x = xA
return f x
}
/// Lift a value to Async
let retn x =
async.Return x
/// Apply an Async function to an Async value
let apply fA xA =
async {
// start the two asyncs in parallel
let! fChild = Async.StartChild fA // run in parallel
let! x = xA
// wait for the result of the first one
let! f = fChild
return f x
}
/// Apply a monadic function to an Async value
let bind f xA = async.Bind(xA,f)
//==============================================
// AsyncResult
//==============================================
type AsyncResult<'Success,'Failure> =
Async<Result<'Success,'Failure>>
[<RequireQualifiedAccess>] // RequireQualifiedAccess forces the `AsyncResult.xxx` prefix to be used
module AsyncResult =
/// Lift a function to AsyncResult
let map f (x:AsyncResult<_,_>) : AsyncResult<_,_> =
Async.map (Result.map f) x
/// Lift a function to AsyncResult
let mapError f (x:AsyncResult<_,_>) : AsyncResult<_,_> =
Async.map (Result.mapError f) x
/// Apply ignore to the internal value
let ignore x =
x |> map ignore
/// Lift a value to AsyncResult
let retn x : AsyncResult<_,_> =
x |> Result.Ok |> Async.retn
/// Handles asynchronous exceptions and maps them into Failure cases using the provided function
let catch f (x:AsyncResult<_,_>) : AsyncResult<_,_> =
x
|> Async.Catch
|> Async.map(function
| Choice1Of2 (Ok v) -> Ok v
| Choice1Of2 (Error err) -> Error err
| Choice2Of2 ex -> Error (f ex))
/// Apply an AsyncResult function to an AsyncResult value, monadically
let applyM (fAsyncResult : AsyncResult<_, _>) (xAsyncResult : AsyncResult<_, _>) :AsyncResult<_,_> =
fAsyncResult |> Async.bind (fun fResult ->
xAsyncResult |> Async.map (fun xResult -> Result.apply fResult xResult))
/// Apply an AsyncResult function to an AsyncResult value, applicatively
let applyA (fAsyncResult : AsyncResult<_, _>) (xAsyncResult : AsyncResult<_, _>) :AsyncResult<_,_> =
fAsyncResult |> Async.bind (fun fResult ->
xAsyncResult |> Async.map (fun xResult -> Validation.apply fResult xResult))
/// Apply a monadic function to an AsyncResult value
let bind (f: 'a -> AsyncResult<'b,'c>) (xAsyncResult : AsyncResult<_, _>) :AsyncResult<_,_> = async {
let! xResult = xAsyncResult
match xResult with
| Ok x -> return! f x
| Error err -> return (Error err)
}
/// Convert a list of AsyncResult into a AsyncResult<list> using monadic style.
/// Only the first error is returned. The error type need not be a list.
let sequenceM resultList =
let (<*>) = applyM
let (<!>) = map
let cons head tail = head::tail
let consR headR tailR = cons <!> headR <*> tailR
let initialValue = retn [] // empty list inside Result
// loop through the list, prepending each element
// to the initial value
List.foldBack consR resultList initialValue
/// Convert a list of AsyncResult into a AsyncResult<list> using applicative style.
/// All the errors are returned. The error type must be a list.
let sequenceA resultList =
let (<*>) = applyA
let (<!>) = map
let cons head tail = head::tail
let consR headR tailR = cons <!> headR <*> tailR
let initialValue = retn [] // empty list inside Result
// loop through the list, prepending each element
// to the initial value
List.foldBack consR resultList initialValue
//-----------------------------------
// Converting between AsyncResults and other types
/// Lift a value into an Ok inside a AsyncResult
let ofSuccess x : AsyncResult<_,_> =
x |> Result.Ok |> Async.retn
/// Lift a value into an Error inside a AsyncResult
let ofError x : AsyncResult<_,_> =
x |> Result.Error |> Async.retn
/// Lift a Result into an AsyncResult
let ofResult x : AsyncResult<_,_> =
x |> Async.retn
/// Lift a Async into an AsyncResult
let ofAsync x : AsyncResult<_,_> =
x |> Async.map Result.Ok
//-----------------------------------
// Utilities lifted from Async
let sleep (ms:int) =
Async.Sleep ms |> ofAsync
// ==================================
// AsyncResult computation expression
//
// IMPORTANT - this is a simple version -- for production
// choose a properly maintained version such as FsToolkit.ErrorHandling
// ==================================
/// The `asyncResult` computation expression is available globally without qualification
[<AutoOpen>]
module AsyncResultComputationExpression =
type AsyncResultBuilder() =
member __.Return(result) = AsyncResult.retn result
member __.Bind(asyncResult, f) = AsyncResult.bind f asyncResult
member __.ReturnFrom(asyncResult) = asyncResult
member __.Zero () : AsyncResult<unit, 'TError> =
result.Zero() |> async.Return
member __.Delay
(generator: unit -> AsyncResult<'T, 'TError>)
: AsyncResult<'T, 'TError> =
async.Delay generator
member this.Combine
(computation1: AsyncResult<unit, 'TError>,
computation2: AsyncResult<'U, 'TError>)
: AsyncResult<'U, 'TError> =
this.Bind(computation1, fun () -> computation2)
member __.TryWith
(computation: AsyncResult<'T, 'TError>,
handler: System.Exception -> AsyncResult<'T, 'TError>)
: AsyncResult<'T, 'TError> =
async.TryWith(computation, handler)
member __.TryFinally
(computation: AsyncResult<'T, 'TError>,
compensation: unit -> unit)
: AsyncResult<'T, 'TError> =
async.TryFinally(computation, compensation)
member __.Using
(resource: 'T when 'T :> IDisposable,
binder: 'T -> AsyncResult<'U, 'TError>)
: AsyncResult<'U, 'TError> =
async.Using(resource, binder)
member this.While
(guard: unit -> bool, computation: AsyncResult<unit, 'TError>)
: AsyncResult<unit, 'TError> =
if not <| guard () then this.Zero ()
else this.Bind(computation, fun () -> this.While (guard, computation))
member this.For
(sequence: #seq<'T>, binder: 'T -> AsyncResult<unit, 'TError>)
: AsyncResult<unit, 'TError> =
this.Using(sequence.GetEnumerator (), fun enum ->
this.While(enum.MoveNext,
this.Delay(fun () -> binder enum.Current)))
let asyncResult = AsyncResultBuilder()