Helpers

Async.fs

namespace Utils

module Async =

    let retn x =
        async { return x }

    let lift f =
        f >> retn

    let lift2 f a =
        f a >> retn

    let bind f x =
        async {
            let! x' = x
            return! f x'
        }

    let map f x =
        //bind (f >> retn)
        async {
            let! x' = x
            return f x'
        }

    let map2 f x y =
        async {
            let! x' = x
            let! y' = y
            return f x' y'
        }

    let tryEx fEx f x =
        async {
            try
                return! f x
            with ex ->
                return fEx ex
                
        }

    let apply x f =
        //bind (flip map x)
        async {
            let! f' = f
            let! x' = x
            return f' x'
        }

    let tee f x =
        //map (tee f)
        async {
            let! x' = x
            do f x'
            return x'
        }

    let teeAsync (f:'a -> Async<unit>) (x:Async<'a>) : Async<'a> =
        //bind f x |> bind (always x)
        async {
            let! x' = x
            do! f x'
            return x'
        }


    let sequence sq =
        let append sq item = seq { yield! sq; yield item }
        Seq.fold (map2 append) (retn Seq.empty) sq


    let sequenceList list =
        let cons = curry List.Cons
        List.foldBack (map2 cons) list (retn [])


    module Operators =
        let (>>=) x f =
            bind f x

        let (>>!) x f =
            map f x

        let (<*>) g x =
            apply x g

        let (<!>) = map
        

AsyncResult.fs

namespace Utils

type AsyncResult<'T, 'TError> = Async<Result<'T, 'TError>>

module AsyncResult =

    let retn x = Result.retn x |> Async.retn
    let error x = Result.error x |> Async.retn

    let ofOption err opt =
        match opt with
        | None -> error err
        | Some x -> retn x

    let lift f = f >> retn
    let liftError fError = fError >> error

    let liftEx fEx f =
        Result.liftEx fEx f >> Async.retn

    let liftErrorEx fEx fError =
        Result.liftErrorEx fEx fError >> Async.retn

    let either fError f =
        Async.map (Result.either fError f)

    let bind f =
        Async.bind (Result.either error f)

    let bimap fError f x =
        either (Result.liftError fError) (Result.lift f) x

    let map f =
        bimap id f

    let mapError fError =
        bimap fError id

    let bimapEx fEx fError f =
        either (Result.liftErrorEx fEx fError) (Result.liftEx fEx f)

    let mapEx fEx f =
        bimapEx fEx id f

    let mapErrorEx fEx fError =
        bimapEx fEx fError id

    let bitee fError f =
        Async.teeAsync (Result.either fError f >> Async.retn)

    let tee f =
        bitee ignore f

    let teeError fError =
        bitee fError ignore

    let apply x =
        bind (flip map x)

    let map2 f x y =
        map f x |> apply y

    let zip = map2


    let sequence sq =
        let append sq item = seq { yield! sq; yield item }
        Seq.fold (map2 append) (retn Seq.empty) sq


    let sequenceList list =
        let cons = curry List.Cons
        List.foldBack (map2 cons) list (retn [])

    let retnAsync x = Async.map Result.retn x
    let errorAsync x = Async.map Result.error x
    let liftAsync f = f >> Async.map Result.retn
    let liftErrorAsync fError = fError >> Async.map Result.error

    let liftAsyncEx fEx f =
        Async.tryEx (Result.liftError fEx) (liftAsync f)

    let liftErrorAsyncEx fEx fError =
        Async.tryEx (Result.liftError fEx) (liftErrorAsync fError)

    let eitherAsync fError f =
        Async.bind (Result.either fError f)

    let bimapAsync f fError =
        eitherAsync (liftErrorAsync fError) (liftAsync f)

    let mapAsync f =
        bimapAsync Async.retn f

    let mapErrorAsync fError =
        bimapAsync fError Async.retn

    let bimapAsyncEx fEx fError f =
        eitherAsync (liftErrorAsyncEx fEx fError) (liftAsyncEx fEx f)

    let mapAsyncEx fEx f =
        bimapAsyncEx fEx Async.retn f

    let mapErrorAsyncEx fEx fError =
        bimapAsyncEx fEx fError Async.retn

    let biteeAsync fError f x =
        eitherAsync (fError >> Async.bind (always x)) (f >> Async.bind (always x)) x

    let teeAsync f =
        biteeAsync Async.retn f

    let teeErrorAsync fError =
        biteeAsync fError Async.retn

    module Operators =
        /// Bind a function to the Ok value. Inline operator for flip bind (aka flatmap).
        let (>>=) x f =
            bind f x

        /// compose two functions which return Result
        let (>=>) g f =
            f >> bind g

        /// compose two functions, one which maps the result value from the first
        let (>!>) g f =
            g >> map f

        /// apply a Result success value to a Result success function. 
        /// useful for partially applying results to a function
        let (<*>) g x =
            apply x g


        /// map the Ok value to another type. This is the inline operator for map.
        let (<!>) = map

        
        /// apply a mapping function to the Ok value. This is the inline operator for flip map.
        let (>>!) x f =
            map f x

Common.fs

namespace Utils

[<AutoOpen>]
module Common =

    let always x _ =
        x

    let tee f x =
        f x; x

    let flip f y x =
        f x y

    let curry f a b =
        f (a, b)

    let uncurry f (a,b) =
        f a b

    let tuple x y =
        x, y

    let tuple3 x y z =
        x, y, z

    let tryEx fEx f x =
        try
            f x
        with ex ->
            fEx ex

Result.fs

namespace Utils

module Result =

    let ofChoice x =
        match x with
        | Choice1Of2 p -> Ok p
        | Choice2Of2 e -> Error e

    let ofOption none x =
        match x with
        | None -> Error none
        | Some x -> Ok x

    /// change a function or value into an Ok Result
    let retn = Ok

    /// change a function or value into an Error Result
    let error = Error

    /// change a function to return an Ok Result
    let lift f = f >> retn

    /// change a function to return an Error Result
    let liftError fError = fError >> error

    /// change a function to return a Result when it may throw an exception
    let liftEx fEx f =
        tryEx (liftError fEx) (lift f)

    /// change a function to return an Error Result when it may also throw an exception
    let liftErrorEx fEx fError =
        tryEx (liftError fEx) (liftError fError)

    /// evaluate either branch of a Result
    let either fError f x =
        match x with
        | Ok p -> f p
        | Error e -> fError e

    /// apply a function returning a Result to the Ok value of another Result
    let bind f =
        either error f

    /// map both branches of a Result
    let bimap fError f =
        either (liftError fError) (lift f)

    /// apply a function to the Ok value
    let map f =
        bimap id f

    /// apply a function to the Error value
    let mapError fError =
        bimap fError id

    /// map both branches of a Result where the map functions may throw an exception
    let bimapEx fEx fError f =
        either (liftErrorEx fEx fError) (liftEx fEx f)

    /// apply a function to the Ok value when the function may throw an exception
    let mapEx fEx f =
        bimapEx fEx id f

    /// apply a function to the Error value when the function may throw an exception
    let mapErrorEx fEx fError =
        bimapEx fEx fError id

    /// apply unit-returning functions on both branches of a Result
    let bitee fError f x =
        either (fError >> always x) (f >> always x) x

    /// apply a function to the Ok branch of a Result but return the original result
    let tee f =
        bitee id f

    /// apply a function to the Error branch of a Result but return the original result
    let teeError fError =
        bitee fError id

    /// apply a Result success value to a Result success function. 
    /// useful for partially applying results to a function
    let apply x =
        either error (flip map x)

    /// zip two success results x and y using the function f
    let map2 f x y =
        map f x |> apply y

    /// zip two success results x and y using the function f
    let zip = map2

    let sequence sq =
        let append sq item = seq { yield! sq; yield item }
        Seq.fold (map2 append) (retn Seq.empty) sq

    let sequenceList list =
        let cons = curry List.Cons
        List.foldBack (map2 cons) list (retn [])

    let toOption x =
        either (always None) Some x

    module Operators =
        /// apply a function returning a Result to the Ok value of another Result
        let (>>=) x f =
            bind f x

        /// compose two functions which return Result
        let (>=>) g f =
            f >> bind g

        /// apply a Result success value to a Result success function. 
        /// useful for partially applying results to a function
        let (<*>) g x =
            apply x g

        /// apply an Ok value to a function
        /// useful for partially applying the first result to a normal function
        let (<!>) = map

        
        /// apply a mapping function to the Ok value. This is the inline operator for flip map.
        let (>>!) x f =
            map f x