AsyncResult.fs

module AsyncResultModule

type AsyncResult<'a> = Async<Result<'a, exn>>

[<RequireQualifiedAccess>]
module AsyncResult =
    
    // Few basic functions
    
    let bind (f: 'a -> AsyncResult<'b>) (a: AsyncResult<'a>): AsyncResult<'b> =
        async {
            match! a with
            | Ok a -> return! f a
            | Error e -> return Error e
        }
        
    let fromResult(x: Result<'a, #exn>): AsyncResult<'a> = async.Return x
    let fromAsyncTry(x: Async<'a>): AsyncResult<'a> = async {
        try
            let! x = x
            return Ok x
        with e ->
            return Error e
    }
    
    let fromAsync(x: Async<'a>): AsyncResult<'a> =
        async.Bind(x, Result.Ok >> async.Return)
    
    let pure'(x: 'a): AsyncResult<'a> = async.Return(Ok x)

    let delay(f: unit -> AsyncResult<'a>): AsyncResult<'a> = async {
        let! x = f()
        return x
    }   
    
    // Derived functions
    
    let zero: AsyncResult<unit> = pure' ()
    
    let apply(ff: AsyncResult<'a -> 'b>) (a: AsyncResult<'a>): AsyncResult<'b> =
        ff
        |> bind (fun f ->
            bind (f >> pure') a
        )
    
    let map (f: 'a -> 'b) (fa: AsyncResult<'a>) : AsyncResult<'b> =
        apply (pure' f) fa
        
    let product (fa: AsyncResult<'a>) (fb: AsyncResult<'b>): AsyncResult<'a * 'b> =
        apply(map (fun a b -> (a,b)) fa) fb
    
    let map2 (f: 'a -> 'b -> 'c) (fa: AsyncResult<'a>) (fb: AsyncResult<'b>) : AsyncResult<'c> =
        map (fun (a,b) -> f a b) (product fa fb)
    
    let traverse(actions: 'a seq) (f: 'a -> AsyncResult<'b>): AsyncResult<'b list> =
        actions
        |> Seq.fold (fun acc a ->
            map2 (fun a b -> a :: b) (f a) acc
            ) (pure' [])
        
    let parallel (actions: AsyncResult<'a> seq) : AsyncResult<'a list> =
        traverse actions id
        
type AsyncResultBuilder() =
    member _.Bind(x: Result<'a, exn>, f: 'a -> AsyncResult<'b>): AsyncResult<'b> =
        AsyncResult.fromResult x
        |> AsyncResult.bind f
        
    member _.Bind(x: AsyncResult<'a>, f: 'a -> AsyncResult<'b>): AsyncResult<'b> =
        AsyncResult.bind f x
        
    member _.Return x: AsyncResult<'a> = AsyncResult.pure' x
    member _.ReturnFrom (x: Result<'a, exn>): AsyncResult<'a> = AsyncResult.fromResult x
    member _.ReturnFrom (x: AsyncResult<'a>): AsyncResult<'a> = x
    
    member _.For(xs: seq<'a>, f: 'a -> AsyncResult<unit>): AsyncResult<unit> =
        async {
            use enum = xs.GetEnumerator()
            let mutable result = Ok ()
            while (result = Ok () && enum.MoveNext()) do
                match! f enum.Current with
                | Ok () -> ()
                | error -> result <- error
            return result
        }
        
    member _.Zero() = AsyncResult.zero
    
    member _.Combine(a1: AsyncResult<unit>, a2: AsyncResult<'a>): AsyncResult<'a> =
        AsyncResult.bind(fun () -> a2) a1
        
    member _.Delay(generator: unit -> AsyncResult<'a>): AsyncResult<'a> =
        AsyncResult.delay generator
    
let asyncResult = AsyncResultBuilder()

PipeLine porn.fs

module Example

open System
open AsyncResultModule

type BasketId = Guid
type Product = { Name: string; Amount: int }

type PaymentMethod = 
    | Cash 
    | Card of {| Number: string; Date: DateTime |}

type PaymentTransaction =
    { Id : Guid
      Method: PaymentMethod
      Amount: int }

type DbBasket =
    { Id: BasketId
      Items: Product seq
      Payment: PaymentTransaction option }

type PaidBasket =
    { Id: BasketId
      Items: Map<string, Product>
      Payment: PaymentTransaction }
    member basket.asDbBasket: DbBasket =
        { Id = basket.Id
          Items = Map.toSeq basket.Items |> Seq.map snd
          Payment = Some basket.Payment }

type ActiveBasket =
    { Id: BasketId 
      UnpaidItems: Map<string, Product> }
    member basket.changeProduct (product: Product) changeFun =
        let newProducts =
            let newProduct =
                match basket.UnpaidItems.TryFind product.Name with
                | Some oldProduct ->
                    { oldProduct with
                        Amount = changeFun oldProduct.Amount product.Amount }
                | None ->
                    product
                    
            basket.UnpaidItems.Add(newProduct.Name, newProduct)
            
        { basket with
            UnpaidItems = newProducts }
        
    member basket.addProductWithAmount product =
        basket.changeProduct product (+)
        
    member basket.addProductsWithAmount products = 
        products
        |> Seq.fold (fun (resultBasket: ActiveBasket) item ->
            resultBasket.addProductWithAmount item)
            basket
    
    member basket.removeProductWithAmount product =
        basket.changeProduct product (-)

    member basket.payWith method : PaidBasket = 
        { Id = basket.Id
          Items = basket.UnpaidItems
          Payment =
              { Id = Guid.NewGuid()
                Method = method
                Amount = basket.amount } }
    
    member basket.payWithCash : PaidBasket =
        basket.payWith Cash
        
    member basket.amount =
        basket.UnpaidItems
        |> Seq.sumBy (fun (KeyValue(_, product)) ->
            product.Amount)
        
    member basket.asDbBasket: DbBasket = 
        { Id = basket.Id
          Items = []
          Payment = None }

type Basket = 
    | Active of ActiveBasket
    | Paid of PaidBasket

module Basket =
    let inline toDbBasket(basket: ^b): DbBasket =
        ((^b): (member asDbBasket: DbBasket) basket)

module Store =
    let save (_: DbBasket): AsyncResult<unit> =
        AsyncResult.zero
        
    let getBasketById id =
        AsyncResult.pure' { Id = id; UnpaidItems = Map.empty }
        
    let getItemByName name =
        AsyncResult.pure' { Name = name; Amount = 10; }

module Run =

    let run() = asyncResult {
        let! basket = Store.getBasketById(Guid.NewGuid())
        let! item = Store.getItemByName "Test item"
        
        let newBasket = basket.addProductWithAmount item
        
        do! newBasket.payWithCash
            |> Basket.toDbBasket
            |> Store.save
    }