// thinkbeforecoding

Applicative Computation Expressions

2020-10-07T18:55:59 / jeremie chassaing

In the last post we saw how to implement applicatives using map, map2 and apply to define <!>and <*>operators.

This time, we will use Computation Expressions to achieve the same result. This is not yet part of F# 5.0, you need the --langversion:preview flag to compile the following code.

Let's start again with our Query<'t>type.

As a reminder, we created it to access a service that is called with a list of properties to return for a given document.

This is a mock version of such service. In real world, you'll call Elastic Search indicating the document id and the properties you need:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
let queryService (properties: string Set) : Map<string,string> =
    Map.ofList [
        if Set.contains "firstname" properties then
            "firstname", "John"
        if Set.contains "lastname" properties then
            "lastname", "Doe"
        if Set.contains "age" properties then
            "age", "42"
        if Set.contains "favoritelanguage" properties then
            "favoritelanguage", "F#"
    ]

The problem with this kind of service is that there is usually no way to be sure that all properties used in the result have been correctly requested. This types contains both a list of properties to query from an external service as well a the code using fetched properties to build the result.

1: 
2: 
3: 
type Query<'t> = 
    { Properties: string Set
      Get: Map<string,string> -> 't}

It can be used to call service:

1: 
2: 
3: 
let callService (query: Query<'t>) : 't =
    queryService query.Properties
    |> query.Get

From here we defined a function to create a query from a single column:

1: 
2: 
3: 
4: 
5: 
module Query =
    let prop name =
        { Properties = Set.singleton name 
          Get = fun m ->
            m.[name] }

And the map function that applies a given function to the result.

1: 
2: 
3: 
4: 
5: 
    let map f q =
        { Properties = q.Properties
          Get = fun m -> 
            let value = q.Get m
            f value }

We also defined a map2 to combine two queries as a single. This query will request the unions of the argument queries properties, and call the first query to get its result, the second to get the other result, and pass both to the given function to combine them:

1: 
2: 
3: 
4: 
5: 
6: 
    let map2 f x y =
        { Properties = x.Properties + y.Properties
          Get = fun m ->
          let vx = x.Get m
          let vy = y.Get m
          f vx vy }

With map2 we can define a zip function that takes two Query arguments and will combine their results as a pair. We will use this function in our builder.

1: 
2: 
    let zip x y =
        map2 (fun vx vy -> vx,vy) x y

Computation Expressions are created using types that implement specific members corresponding to the different operations. For applicatives, we new to implement BindReturn with the following signature:

1: 
M<'a> * ('a -> 'b) -> M<'b>

Where M in our case is Query. You should spot that it's the same signature as map (with the function as the second argument).

The second one is MergeSources and is used to zip parameter together:

1: 
M<'a> * M<'b> -> M<'a * 'b>

Here we will use the zip function we defined before.

Here is the builder definition:

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9: 
type QueryBuilder() =
    
    member _.BindReturn(x : Query<'a>,f: 'a -> 'b) : Query<'b> = 
        Query.map f x
    
    member _.MergeSources(x : Query<'a>,y: Query<'b>) : Query<'a * 'b> = 
        Query.zip x y

let query = QueryBuilder()

For our sample, use define a User and the basic properties defined by the service:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
type User =
    { FullName: string 
      Age: int
      FavoriteLanguage: string}

module Props =
    let firstname = Query.prop "firstname"
    let lastname = Query.prop "lastname"
    let age = Query.prop "age" |> Query.map int
    let favoriteLanguage = Query.prop "favoritelanguage" 

Is is now possible to use the query computation expression to compute new derived properties. Here we define fullname that queries firstname and last name and append them together. When using this derived property, it will request both firstname and last properties from the service.

1: 
2: 
3: 
4: 
5: 
6: 
7: 
module DerivedProps =
    let fullname = 
        query {
            let! firstname = Props.firstname
            and! lastname = Props.lastname
            return firstname + " " + lastname
        }

you can notice that we use let! and and! here.

The meaning of let! is: Give this name (here firstname) to the value inside the structure on the right (the query). Since we have a Query<string> on the right, firstname will be a string.

The and! means: and at the same time, give this name to this value inside this other structure on the right.

This is at the same time extracting both values with zip. The actuall code looks like this:

1: 
2: 
3: 
query.BindReturn(
    query.MergeSources(Props.firstname, Props.lastname), 
    fun (firstname, lastname) -> firstname + " " + lastname)

We can the compose queries further by reusing derived properties inside new queries:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
let user =
    query {
        let! fullname = DerivedProps.fullname
        and! age = Props.age
        and! favoriteLanguage = Props.favoriteLanguage
        return 
            { FullName = fullname
              Age = age 
              FavoriteLanguage = favoriteLanguage }
    }

callService user

Let's use it for async.

We define a BindReturn and a MergeSources member. Using a type extension, it is not advised to use async {} blocks in the implementation because it can go recursive...

I still put the equivalent construct as a comment:

 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: 
type AsyncBuilder with
    member _.BindReturn(x: 'a Async,f: 'a -> 'b) : 'b Async = 
        // this is the same as:
        // async { return f v }
        async.Bind(x, fun v -> async.Return (f v))

    member _.MergeSources(x: 'a Async, y: 'b Async) : ('a * 'b) Async =
        // this is the same as:
        // async {
        //    let! xa = Async.StartChild x
        //    let! ya = Async.StartChild y
        //    let! xv = xa  // wait x value
        //    let! yv = ya  // wait y value
        //    return xv, yv // pair values
        // }
        async.Bind(Async.StartChild x,
            fun xa ->
                async.Bind(Async.StartChild y,
                    fun ya ->
                        async.Bind(xa, fun xv ->
                            async.Bind(ya, fun yv ->
                                async.Return (xv,yv)
                            
                            )
                        )
                )
            )

The zippopotam.us service returns informations about zip codes. We will use the JsonProvider to load the data asynchronously and parse the result.

1: 
2: 
3: 
4: 
5: 
6: 
open FSharp.Data
type ZipCode = FSharp.Data.JsonProvider<"http://api.zippopotam.us/GB/EC1">

/// Gets latitude/logitude for a returned zip info
let coord (zip: ZipCode.Root) =
    zip.Places.[0].Latitude, zip.Places.[0].Longitude

We use The pythagorean theorem to compute the distance given latitude and longitude of two points:

1: 
2: 
3: 
4: 
5: 
let dist (lata: decimal,longa: decimal) (latb: decimal, longb: decimal) =
    let x = float (longb - longa) * cos (double (latb + lata)  / 2. * Math.PI / 360.)
    let y = float (latb - lata)
    let z = sqrt (x*x + y*y)
    z * 1.852 * 60. |> decimal

Now using let! and! we fetch and compute the coodinates of paris and london in parallel and the use both results to get the distance:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
async {
    let! parisCoords = 
        async {
            let! paris = ZipCode.AsyncLoad "http://api.zippopotam.us/fr/75020"
            return coord paris }
    and! londonCoords = 
        async { 
            let! london = ZipCode.AsyncLoad "http://api.zippopotam.us/GB/EC1"
            return coord london}
    
    return dist parisCoords londonCoords
}
|> Async.RunSynchronously

It's obviously possible to use both Computation Expressions and the approach with operators from the last post for more fun !

namespace System
val queryService : properties:Set<string> -> Map<string,string>
val properties : Set<string>
Multiple items
val string : value:'T -> string

--------------------
type string = String
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IReadOnlyCollection<'T>
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  ...

--------------------
new : elements:seq<'T> -> Set<'T>
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IReadOnlyDictionary<'Key,'Value>
  interface IReadOnlyCollection<KeyValuePair<'Key,'Value>>
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  ...

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val ofList : elements:('Key * 'T) list -> Map<'Key,'T> (requires comparison)
val contains : element:'T -> set:Set<'T> -> bool (requires comparison)
type Query<'t> =
  { Properties: Set<string>
    Get: Map<string,string> -> 't }
Query.Properties: Set<string>
Query.Get: Map<string,string> -> 't
val callService : query:Query<'t> -> 't
val query : Query<'t>
val prop : name:string -> Query<string>
val name : string
val singleton : value:'T -> Set<'T> (requires comparison)
val m : Map<string,string>
val map : f:('a -> 'b) -> q:Query<'a> -> Query<'b>
val f : ('a -> 'b)
val q : Query<'a>
val value : 'a
Query.Get: Map<string,string> -> 'a
val map2 : f:('a -> 'b -> 'c) -> x:Query<'a> -> y:Query<'b> -> Query<'c>
val f : ('a -> 'b -> 'c)
val x : Query<'a>
val y : Query<'b>
val vx : 'a
val vy : 'b
Query.Get: Map<string,string> -> 'b
val zip : x:Query<'a> -> y:Query<'b> -> Query<'a * 'b>
Multiple items
type QueryBuilder =
  new : unit -> QueryBuilder
  member BindReturn : x:Query<'a> * f:('a -> 'b) -> Query<'b>
  member MergeSources : x:Query<'a> * y:Query<'b> -> Query<'a * 'b>

--------------------
new : unit -> QueryBuilder
Multiple items
module Query

from 2020-10-07-applicative-computation-expressions

--------------------
type Query<'t> =
  { Properties: Set<string>
    Get: Map<string,string> -> 't }
val query : QueryBuilder
type User =
  { FullName: string
    Age: int
    FavoriteLanguage: string }
User.FullName: string
User.Age: int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

--------------------
type int = int32

--------------------
type int<'Measure> = int
User.FavoriteLanguage: string
val firstname : Query<string>
val lastname : Query<string>
val age : Query<int>
val favoriteLanguage : Query<string>
val fullname : Query<string>
val firstname : string
module Props

from 2020-10-07-applicative-computation-expressions
val lastname : string
member QueryBuilder.BindReturn : x:Query<'a> * f:('a -> 'b) -> Query<'b>
member QueryBuilder.MergeSources : x:Query<'a> * y:Query<'b> -> Query<'a * 'b>
val user : Query<User>
val fullname : string
module DerivedProps

from 2020-10-07-applicative-computation-expressions
val age : int
val favoriteLanguage : string
type AsyncBuilder =
  private new : unit -> AsyncBuilder
  member Bind : computation:Async<'T> * binder:('T -> Async<'U>) -> Async<'U>
  member Combine : computation1:Async<unit> * computation2:Async<'T> -> Async<'T>
  member Delay : generator:(unit -> Async<'T>) -> Async<'T>
  member For : sequence:seq<'T> * body:('T -> Async<unit>) -> Async<unit>
  member Return : value:'T -> Async<'T>
  member ReturnFrom : computation:Async<'T> -> Async<'T>
  member TryFinally : computation:Async<'T> * compensation:(unit -> unit) -> Async<'T>
  member TryWith : computation:Async<'T> * catchHandler:(exn -> Async<'T>) -> Async<'T>
  member Using : resource:'T * binder:('T -> Async<'U>) -> Async<'U> (requires 'T :> IDisposable)
  ...
val x : Async<'a>
Multiple items
type Async =
  static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
  static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
  static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
  static member AwaitTask : task:Task -> Async<unit>
  static member AwaitTask : task:Task<'T> -> Async<'T>
  static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
  static member CancelDefaultToken : unit -> unit
  static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
  static member Choice : computations:seq<Async<'T option>> -> Async<'T option>
  static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
  ...

--------------------
type Async<'T> =
val async : AsyncBuilder
member AsyncBuilder.Bind : computation:Async<'T> * binder:('T -> Async<'U>) -> Async<'U>
val v : 'a
member AsyncBuilder.Return : value:'T -> Async<'T>
val y : Async<'b>
static member Async.StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
val xa : Async<'a>
val ya : Async<'b>
val xv : 'a
val yv : 'b
Multiple items
namespace FSharp

--------------------
namespace Microsoft.FSharp
Multiple items
namespace FSharp.Data

--------------------
namespace Microsoft.FSharp.Data
type ZipCode = JsonProvider<...>
type JsonProvider


<summary>Typed representation of a JSON document.</summary>
           <param name='Sample'>Location of a JSON sample file or a string containing a sample JSON document.</param>
           <param name='SampleIsList'>If true, sample should be a list of individual samples for the inference.</param>
           <param name='RootName'>The name to be used to the root type. Defaults to `Root`.</param>
           <param name='Culture'>The culture used for parsing numbers and dates. Defaults to the invariant culture.</param>
           <param name='Encoding'>The encoding used to read the sample. You can specify either the character set name or the codepage number. Defaults to UTF8 for files, and to ISO-8859-1 the for HTTP requests, unless `charset` is specified in the `Content-Type` response header.</param>
           <param name='ResolutionFolder'>A directory that is used when resolving relative file references (at design time and in hosted execution).</param>
           <param name='EmbeddedResource'>When specified, the type provider first attempts to load the sample from the specified resource
              (e.g. 'MyCompany.MyAssembly, resource_name.json'). This is useful when exposing types generated by the type provider.</param>
           <param name='InferTypesFromValues'>If true, turns on additional type inference from values.
              (e.g. type inference infers string values such as "123" as ints and values constrained to 0 and 1 as booleans.)</param>
val coord : zip:JsonProvider<...>.Root -> decimal * decimal


 Gets latitude/logitude for a returned zip info
val zip : JsonProvider<...>.Root
type Root =
  inherit IJsonDocument
  new : postCode: string * country: string * countryAbbreviation: string * places: Placis [] -> Root + 1 overload
  member Country : string
  member CountryAbbreviation : string
  member JsonValue : JsonValue
  member Places : Placis []
  member PostCode : string
property JsonProvider<...>.Root.Places: JsonProvider<...>.Placis [] with get
val dist : lata:decimal * longa:decimal -> latb:decimal * longb:decimal -> decimal
val lata : decimal
Multiple items
val decimal : value:'T -> decimal (requires member op_Explicit)

--------------------
type decimal = Decimal

--------------------
type decimal<'Measure> = decimal
val longa : decimal
val latb : decimal
val longb : decimal
val x : float
Multiple items
val float : value:'T -> float (requires member op_Explicit)

--------------------
type float = Double

--------------------
type float<'Measure> = float
val cos : value:'T -> 'T (requires member Cos)
Multiple items
val double : value:'T -> double (requires member op_Explicit)

--------------------
type double = Double
type Math =
  static val E : float
  static val PI : float
  static member Abs : value:float -> float + 6 overloads
  static member Acos : d:float -> float
  static member Acosh : d:float -> float
  static member Asin : d:float -> float
  static member Asinh : d:float -> float
  static member Atan : d:float -> float
  static member Atan2 : y:float * x:float -> float
  static member Atanh : d:float -> float
  ...
field Math.PI: float = 3.14159265359
val y : float
val z : float
val sqrt : value:'T -> 'U (requires member Sqrt)
val parisCoords : decimal * decimal
val paris : JsonProvider<...>.Root
JsonProvider<...>.AsyncLoad(uri: string) : Async<JsonProvider<...>.Root>


Loads JSON from the specified uri
val london : JsonProvider<...>.Root
static member Async.RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:Threading.CancellationToken -> 'T