Merge pull request #8 from TypedUseCase/feature/update-error-handling

Update error handling

Author: MortalFlesh

CHANGELOG.md

@@ -2,6 +2,7 @@
 
 <!-- There is always Unreleased section on the top. Subsections (Add, Changed, Fix, Removed) should be Add as needed. -->
 ## Unreleased
+- [_Internal_] Update `ErrorHandling`
 
 ## 3.0.0 - 2021-08-12
 - [**BC**] Change function `Parser.parse` to return Async Result

src/ErrorHandling/Result.fs

@@ -1,9 +1,12 @@
 namespace ErrorHandling
 
+open System
+open System.Threading.Tasks
+
 /// Functions for Result type (functor and monad).
 /// For applicatives, see Validation.
 [<RequireQualifiedAccess>]  // RequireQualifiedAccess forces the `Result.xxx` prefix to be used
-module Result =
+module internal Result =
     let tee f = function
         | Ok x -> f x; Ok x
         | Error x -> Error x
@@ -81,7 +84,7 @@ module Result =
         | Ok option -> option
         | Error e -> failwithf "Error %A" e
 
-    module Operators =
+    module internal Operators =
         /// Result.bind
         let inline (>>=) r f = Result.bind f r
 
@@ -120,7 +123,7 @@ module Result =
             fR >> Result.mapError fE
 
 [<AutoOpen>]
-module ResultComputationExpression =
+module internal ResultComputationExpression =
     // https://github.com/swlaschin/DomainModelingMadeFunctional/blob/master/src/OrderTaking/Result.fs#L178
 
     type ResultBuilder() =
@@ -169,7 +172,7 @@ type Validation<'Success,'Failure> =
 
 /// Functions for the `Validation` type (mostly applicative)
 [<RequireQualifiedAccess>]  // RequireQualifiedAccess forces the `Validation.xxx` prefix to be used
-module Validation =
+module internal Validation =
 
     /// Apply a Validation<fn> to a Validation<x> applicatively
     let apply (fV:Validation<_, _>) (xV:Validation<_, _>) :Validation<_, _> =
@@ -210,7 +213,7 @@ module Validation =
 //==============================================
 
 [<RequireQualifiedAccess>]  // RequireQualifiedAccess forces the `Async.xxx` prefix to be used
-module Async =
+module internal Async =
 
     /// Lift a function to Async
     let map f xA =
@@ -245,64 +248,63 @@ module Async =
 type AsyncResult<'Success,'Failure> =
     Async<Result<'Success,'Failure>>
 
-[<RequireQualifiedAccess>]  // RequireQualifiedAccess forces the `AsyncResult.xxx` prefix to be used
-module AsyncResult =
+[<RequireQualifiedAccess>]
+module internal AsyncResult =
 
     /// Lift a function to AsyncResult
-    let map f (x:AsyncResult<_, _>) : AsyncResult<_, _> =
+    let map (f: 'SuccessA -> 'SuccessB) (x: AsyncResult<'SuccessA, 'Error>): AsyncResult<'SuccessB, 'Error> =
         Async.map (Result.map f) x
 
     /// Lift a function to AsyncResult
-    let mapError f (x:AsyncResult<_, _>) : AsyncResult<_, _> =
+    let mapError (f: 'ErrorA -> 'ErrorB) (x: AsyncResult<'Success, 'ErrorA>): AsyncResult<'Success, 'ErrorB> =
         Async.map (Result.mapError f) x
 
     /// Apply ignore to the internal value
-    let ignore x =
+    let ignore (x: AsyncResult<'Success, 'Error>): AsyncResult<unit, 'Error> =
         x |> map ignore
 
     /// Lift a value to AsyncResult
-    let retn x : AsyncResult<_, _> =
+    let retn (x: 'Success): AsyncResult<'Success, 'Error> =
         x |> Result.Ok |> Async.retn
 
-    /// Handles asynchronous exceptions and maps them into Failure cases using the provided function
-    let catch f (x:AsyncResult<_, _>) : AsyncResult<_, _> =
+    /// Handles asynchronous exceptions and maps them into Error cases using the provided function
+    let catch (f: exn -> 'Error) (x: AsyncResult<'Success, 'Error>): AsyncResult<'Success, 'Error> =
         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<_, _> =
+    let applyM (fAsyncResult: AsyncResult<'SuccessA -> 'SuccessB, 'Error>) (xAsyncResult: AsyncResult<'SuccessA, 'Error>): AsyncResult<'SuccessB, 'Error> =
         fAsyncResult |> Async.bind (fun fResult ->
-        xAsyncResult |> Async.map (fun xResult -> Result.apply fResult xResult))
+            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<_, _> =
+    let applyA (fAsyncResult: AsyncResult<'SuccessA -> 'SuccessB, 'Error list>) (xAsyncResult: AsyncResult<'SuccessA, 'Error list>): AsyncResult<'SuccessB, 'Error list> =
         fAsyncResult |> Async.bind (fun fResult ->
-        xAsyncResult |> Async.map (fun xResult -> Validation.apply fResult xResult))
+            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
+    let bind (f: 'SuccessA -> AsyncResult<'SuccessB, 'Error>) (xAsyncResult: AsyncResult<'SuccessA, 'Error>): AsyncResult<'SuccessB, 'Error> = async {
+        match! xAsyncResult with
         | Ok x -> return! f x
         | Error err -> return (Error err)
-        }
+    }
 
     /// Apply a monadic function to an AsyncResult error
-    let bindError (f: 'a -> AsyncResult<'b,'c>) (xAsyncResult : AsyncResult<_, _>) :AsyncResult<_, _> = async {
-        let! xResult = xAsyncResult
-        match xResult with
+    let bindError (f: 'ErrorA -> AsyncResult<'Success, 'ErrorB>) (xAsyncResult: AsyncResult<'Success, 'ErrorA>): AsyncResult<'Success, 'ErrorB> = async {
+        match! xAsyncResult with
         | Ok x -> return (Ok x)
         | Error err -> return! f 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 =
+    /// Only the first error is returned. The error type NEED NOT be a list.
+    let sequenceM (results: AsyncResult<'Success, 'Error> list): AsyncResult<'Success list, 'Error> =
         let (<*>) = applyM
         let (<!>) = map
         let cons head tail = head::tail
@@ -311,23 +313,21 @@ module AsyncResult =
 
         // loop through the list, prepending each element
         // to the initial value
-        List.foldBack consR resultList  initialValue
+        List.foldBack consR results  initialValue
 
-    let tee f (xAsyncResult: AsyncResult<_, _>): AsyncResult<_, _> =
-        async {
-            let! xResult = xAsyncResult
-            return xResult |> Result.tee f
-        }
+    let tee (f: 'Success -> unit) (xAsyncResult: AsyncResult<'Success, 'Error>): AsyncResult<'Success, 'Error> = async {
+        let! xResult = xAsyncResult
+        return xResult |> Result.tee f
+    }
 
-    let teeError f (xAsyncResult: AsyncResult<_, _>): AsyncResult<_, _> =
-        async {
-            let! xResult = xAsyncResult
-            return xResult |> Result.teeError f
-        }
+    let teeError (f: 'Error -> unit) (xAsyncResult: AsyncResult<'Success, 'Error>): AsyncResult<'Success, 'Error> = async {
+        let! xResult = xAsyncResult
+        return xResult |> Result.teeError f
+    }
 
     /// 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 =
+    /// All the errors are returned. The error type MUST be a list.
+    let sequenceA (results: AsyncResult<'Success, 'Error list> list): AsyncResult<'Success list, 'Error list> =
         let (<*>) = applyA
         let (<!>) = map
         let cons head tail = head::tail
@@ -336,44 +336,48 @@ module AsyncResult =
 
         // loop through the list, prepending each element
         // to the initial value
-        List.foldBack consR resultList  initialValue
+        List.foldBack consR results  initialValue
 
     //-----------------------------------
     // Converting between AsyncResults and other types
 
     /// Lift a value into an Ok inside a AsyncResult
-    let ofSuccess x : AsyncResult<_, _> =
+    let ofSuccess (x: 'Success): AsyncResult<'Success, 'Error> =
         x |> Result.Ok |> Async.retn
 
     /// Lift a value into an Error inside a AsyncResult
-    let ofError x : AsyncResult<_, _> =
+    let ofError (x: 'Error): AsyncResult<'Success, 'Error> =
         x |> Result.Error |> Async.retn
 
     /// Lift a Result into an AsyncResult
-    let ofResult x : AsyncResult<_, _> =
+    let ofResult (x: Result<'Success, 'Error>): AsyncResult<'Success, 'Error> =
         x |> Async.retn
 
-    /// Lift an Option into an AsyncResult
-    let ofOption e x : AsyncResult<_, _> =
-        x |> Result.ofOption e |> ofResult
-
     /// Lift a Async into an AsyncResult
-    let ofAsync x : AsyncResult<_, _> =
+    let ofAsync (x: Async<'Success>): AsyncResult<'Success, 'Error> =
         x |> Async.map Result.Ok
 
     /// Lift a Async into an AsyncResult and handles exception into Result
-    let ofAsyncCatch f x : AsyncResult<_, _> =
+    let ofAsyncCatch (f: exn -> 'Error) (x: Async<'Success>): AsyncResult<'Success, 'Error> =
         x |> ofAsync |> catch f
 
     /// Lift a Task into an AsyncResult
-    let ofTask x : AsyncResult<_, _> =
+    let ofTask (x: Task<'Success>): AsyncResult<'Success, 'Error> =
         x |> Async.AwaitTask |> ofAsync
 
     /// Lift a Task into an AsyncResult and handles exception into Result
-    let ofTaskCatch f x : AsyncResult<_, _> =
+    let ofTaskCatch (f: exn -> 'Error) (x: Task<'Success>): AsyncResult<'Success, 'Error> =
         x |> ofTask |> catch f
 
-     /// Run asyncResults in Parallel, handles the errors and concats results
+    /// Lift a Task into an AsyncResult
+    let ofEmptyTask (x: Task): AsyncResult<unit, 'Error> =
+        x |> Async.AwaitTask |> ofAsync
+
+    /// Lift a Task into an AsyncResult and handles exception into Result
+    let ofEmptyTaskCatch (f: exn -> 'Error) (x: Task): AsyncResult<unit, 'Error> =
+        x |> ofEmptyTask |> catch f
+
+    /// Run asyncResults in Parallel, handles the errors and concats results
     let ofParallelAsyncResults<'Success, 'Error> (f: exn -> 'Error) (results: AsyncResult<'Success, 'Error> list): AsyncResult<'Success list, 'Error list> =
         results
         |> List.map (mapError List.singleton)
@@ -416,7 +420,7 @@ module AsyncResult =
     //-----------------------------------
     // Utilities lifted from Async
 
-    let sleep (ms: int) =
+    let sleep (ms: int): AsyncResult<unit, 'Error> =
         Async.Sleep ms |> ofAsync
 
     module Operators =
@@ -438,15 +442,38 @@ module AsyncResult =
         /// AsyncResult.mapError
         let inline (<@>) r f = mapError f r
 
+        /// Kleisli composition (composition of 2 functions, which returns an AsyncResult)
+        let inline (>=>) fR fR2 =
+            fR >> bind fR2
+
+        /// Kleisli composition for errors (composition of 2 functions, which returns an AsyncResult)
+        let inline (>->) fR fR2 =
+            fR >> bindError fR2
+
+        /// Composition of 2 functions by mapping a Success from 1st function into the 2nd
+        let inline (>!>) fR f =
+            fR >> map f
+
+        /// Composition of 2 functions by mapping an Error from 1st function into the 2nd
+        let inline (>@>) fR fE =
+            fR >> mapError fE
+
+        /// Compose with tee function
+        let inline (>@*>) fR f =
+            fR >> tee f
+
+        /// Compose with tee error function
+        let inline (>@@>) fR fE =
+            fR >> teeError fE
+
 // ==================================
 // AsyncResult computation expression
 // ==================================
 
 /// The `asyncResult` computation expression is available globally without qualification
+/// See https://github.com/cmeeren/Cvdm.ErrorHandling/blob/master/src/Cvdm.ErrorHandling/AsyncResultBuilder.fs
 [<AutoOpen>]
-module AsyncResultComputationExpression =
-    open System
-
+module internal AsyncResultComputationExpression =
     type AsyncResultBuilder() =
         member __.Return (value: 'Success): AsyncResult<'Success, 'Error> =
             async.Return <| result.Return value