Extending F# through Computation Expressions

Ryan Riley

Prerequisites

Motivation

Examples

Seq<'T>

1: 
2: 
3: 
4: 
seq {
    for i in 1..10 do
    yield i
}
seq [1; 2; 3; 4; ...]

Concatenating Seq<'T>

1: 
2: 
3: 
4: 
5: 
6: 
let xs = seq { for i in 1..10 -> i }
let ys = seq { for i in 11..20 -> i }
seq {
    yield! xs
    yield! ys
}
seq [1; 2; 3; 4; ...]

Concatenating Seq<'T>

1: 
Seq.append xs ys
Could not find reference 'seq-concat'

Async<'T>

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9: 
async {
    let req = WebRequest.Create("http://openfsharp.org/")
    let! resp = req.AsyncGetResponse()
    use stream = resp.GetResponseStream()
    let! bytes = stream.AsyncRead(91)
    let text = Text.Encoding.UTF8.GetString(bytes)
    return (resp :?> HttpWebResponse).StatusCode, text
}
|> Async.RunSynchronously
(OK,
 "<!DOCTYPE html>
<html lang="en">
<head>
	<meta charset="UTF-8">
	<title>Open F#</title>")

Patterns

Three Rings for the Elven-kings under the sky,
Seven for the Dwarf-lords in their halls of stone,
Nine for Mortal Men doomed to die,
One for the Dark Lord on his dark throne

In the Land of Mordor where the Shadows lie.
One Ring to rule them all, One Ring to find them,
One Ring to bring them all and in the darkness bind them
In the Land of Mordor where the Shadows lie.

— J.R.R. Tolkien's epigraph to The Lord of the Rings

One for the Dark Lord on his dark throne

The One Ring

Nine for Mortal Men doomed to die

Nine rings for mortal men

OptionBuilder

1: 
2: 
3: 
4: 
5: 
type OptionMonad() =
    member __.Bind(m, f) = Option.bind f m
    member __.Return(x) = Some x

let opt = OptionMonad()

Computation Expressions

OptionBuilder

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
type OptionBuilder() =
    member __.Bind(m, f) = Option.bind f m
    member __.Return(x) = Some x
    member __.ReturnFrom(m: 'T option) = m
    member __.Zero() = Some ()
    member __.Combine(m, f: unit -> _) = Option.bind f m
    member __.Delay(f: unit -> 'T) = f
    member __.Run(f) = f()

let maybe = OptionBuilder()

Expansion

1: 
2: 
3: 
4: 
5: 
maybe { return 1 }

maybe.Run(
    maybe.Delay(fun () ->
        maybe.Return 1))

Expansion

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9: 
maybe {
    let! value = maybe { return 1}
    return value
}

maybe.Run(
    maybe.Delay(fun () ->
        maybe.Bind(maybe.Return 1, fun value ->
            maybe.Return value)))

Delayed Computations

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
let one = maybe { return 1 }
let double x = maybe { return x * 2 }
maybe {
    if false then
        printfn "proceeding"
        let! x = one
        let! y = double x
        return x + y
    else return! None
}
<null>

Delayed Computations (cont)

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
maybe {
    if false then
        printfn "proceeding"
        let! x = maybe { return 1 }
        let! y = maybe { return x * 2 }
        return x + y
    else return! None
}
<null>

Function Wrapper Types

1: 
type Maybe<'T> = Maybe of (unit -> 'T option)

Why should we care?

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9: 
if false then
    printfn "proceeding"
    match one with
    | Some x ->
        match double x with
        | Some y -> Some(x + y)
        | None -> None
    | None -> None
else None

Back to the One Ring ...

Eye of Sauron

Nazgul

Monad (+more) libraries

Seven for the Dwarf-lords in their halls of stone

Dwarf lords

QueryBuilder

1: 
2: 
3: 
4: 
5: 
6: 
query {
    for x in 1..10 do
    for y in 11..20 do
    where (x % 2 = 1 && y % 2 = 0)
    select (x + y)
}
seq [13; 15; 17; 19; ...]

FSharp.Control.Reactive

1: 
2: 
3: 
4: 
5: 
6: 
rxquery {
    for x in (Observable.ofSeq [|1..10|]) do
    zip y in (Observable.ofSeq [|11..20|])
    select (x + y)
}
|> Observable.subscribe (printfn "%i")
No output has been produced.

RxQueryBuilder Select and Zip

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
type RxQueryBuilder with

    [<CustomOperation("select", AllowIntoPattern=true)>]
    member __.Select (s:IObservable<_>, 
                      [<ProjectionParameter>] selector : _ -> _) =
        s.Select(selector)

    [<CustomOperation("zip", IsLikeZip=true)>]
    member __.Zip (s1:IObservable<_>,
                   s2:IObservable<_>,
                   [<ProjectionParameter>] resultSelector : _ -> _) =
        s1.Zip(s2, new Func<_,_,_>(resultSelector))

Extending Existing Builders

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
type FSharp.Control.AsyncBuilder with

    [<CustomOperation("and!", IsLikeZip=true)>]
    member __.Merge(x, y,
                    [<ProjectionParameter>] resultSelector : _ -> _) =
        async {
            let! x' = Async.StartChildAsTask x
            let! y' = Async.StartChildAsTask y
            do Task.WaitAll(x',y')
            let! x'' = Async.AwaitTask x'
            let! y'' = Async.AwaitTask y'
            return resultSelector x'' y''
        }

    member __.For(m, f) = __.Bind(m, f)

Async Applicative Example

Caveat emptor

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
type FSharp.Control.AsyncBuilder with

    [<CustomOperation("and!", IsLikeZip=true)>]
    member __.Merge(x: Task<'a>, y: Task<'b>,
                    [<ProjectionParameter>] resultSelector : _ -> _) =
        async {
            do Task.WaitAll(x,y)
            let! x' = Async.AwaitTask x
            let! y' = Async.AwaitTask y
            return resultSelector x' y'
        }
1: 
2: 
3: 
4: 
5: 
async {
    for x in Task.FromResult(1) do
    ``and!`` y in Task.FromResult(2)
    return x + y
}

The custom operation 'and!' refers to a method which is overloaded. The implementations of custom operations may not be overloaded.
custom operation: and! var in collection
Calls AsyncBuilder.Merge

Overloading workaround

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
module Inference =
    type Defaults =
        | Defaults
        static member Value (x: Async<int>) =
            x
        static member inline Value (x: int) =
            async.Return x
        static member inline Value (x: string) =
            int x |> async.Return

    let inline defaults (a: ^a, _: ^b) =
        ((^a or ^b) : (static member Value : ^a -> Async<_>) a)
    
    let inline infer (a: 'a) =
        defaults(a, Defaults)

Overloading workaround (cont)

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
type FSharp.Control.AsyncBuilder with
    [<CustomOperation("add", MaintainsVariableSpaceUsingBind=true)>]
    member inline __.Add(m, x) =
        async {
            let! a = m
            let! b = Inference.infer x
            return a + b
        }
1: 
2: 
3: 
4: 
5: 
async {
    let! m = async.Return 0
    add "1"
    add "2"
} |> Async.RunSynchronously
3

Other Limitations

Three Rings for the Elven-kings under the sky

Elven kings

Domain specific languages

Implementations of Common Intermediate Language (CIL):

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
cil {
    yield ldc'i4 1
    yield ldc'i4 2
    yield add
    yield ldc'i4 3
    yield add
    yield ret
} |> toDelegate<Func<int>> "myFunction1"

Protocols

Freya implements the HTTP state machine

1: 
2: 
3: 
4: 
let machine =
    freyaMachine {
        methods [GET; HEAD; OPTIONS]
        handleOk hello }
1: 
2: 
3: 
let router =
    freyaRouter {
        resource "/hello{/name}" machine }

HTTP Protocol

1: 
GET http://openfsharp.org/ HTTP/1.1

Hypermedia

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
"actions": [
  {
    "name":"update-customer",
    "title":"Update Customer",
    "method":"POST",
    "href":"http://example.org/customers/123",
    "type":"application/x-www-form-urlencoded",
    "fields": [
      {"name":"status","type":"hidden","value":"partial"},
      {"name":"return","type":"hidden","value":"full"},
      {"name":"email","type":"text" },
      {"name":"sms","type":"number" }
    ]
  }
]

Session Types

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
module example;

type <xsd> "{http://www.acme.com/types}Greetings" from "http://www.acme.com/types/Greetings.xsd" as Greetings;
type <xsd> "{http://www.acme.com/types}Compliments" from "http://www.acme.com/types/Compliments.xsd" as Compliments;
type <xsd> "{http://www.acme.com/types}Salutations" from "http://www.acme.com/types/Salutations.xsd" as Salutations;

global protocol HelloWorld(role Me, role World) {
    hello(Greetings) from Me to World;
    choice at World {
        goodMorning(Compliments) from World to Me;
    } or {
        goodAfternoon(Salutations) from World to Me;
    }
}

How?

Query Expressions Revisited

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
let xn s = XName.Get s
let xml = """<people>
    <person firstName="Mathias" lastName="Brandewinder" />
    <person firstName="Andrew" lastName="Cherry" />
    <person firstName="" lastName="Riley" />
</people>"""
let doc = XDocument.Parse xml
query {
    for el in doc.Descendants(xn "person") do
    where (el.Attribute(xn "firstName").Value <> "")
    select (el.Attribute(xn "lastName").Value)
}
seq ["Brandewinder"; "Cherry"]

Freya's Graph

HTTP state diagram

Freya's core components
Freya's responses

Freya's validations

Questions?

Why Not Macros?

Research

MacroML

MetaML

Will F# ever get Type Classes?

Classes for the Masses

References

  1. Computation Expressions
  2. Query Expressions
  3. Computation Expresssions in F# 3.0
  4. Introducing F# Asynchronous Workflows
  5. The F# Computation Expression Zoo
  6. F# for fun and profit
  7. Support let! .. and... for applicative functors