Extending F# through Computation Expressions

Ryan Riley

Prerequisites

Motivation

This talk was prepared for Open FSharp 2017.
One of the goals of this conference was to not dive into
language features for their own sake. I don't intend to
just tell you about computation expressions, nor do I intend
to cover the academic aspects, which you can find in other
talks and papers.
I want to convey the power of computation expressions as they
relate to solving problems. What sorts of problems? I hope
to show computation expressions are useful for solving many
different types of problems, as many as may be solved by
writing computer programs.
That seems quite broad, and I agree. It's quite possible that
computation expressions are really just a fancy way to do
what we already do in F# or any other language, but I'll leave
you to decide that at the end. I hope to show you that, at the
very least, computation expressions can offer a useful model
for writing correct programs for a given domain.

Topics

Computation Expressions

Query Expressions

Type Extensions

Domain Specific Languages

Examples

Seq<'T>

1:	`seq { for i in 1..10 -> i }`

seq [1; 2; 3; 4; ...]

1:	`seq { for i in 1..10 do yield i }`

seq [1; 2; 3; 4; ...]

Concatenating Seq<'T>

1:	`Seq.append xs ys`

No value has been returned

Concatenating Seq<'T>

1: 
2: 
3: 
4: 
5: 
6: 
7:

let xs = seq { for i in 1..10 do yield i }
let ys = seq { for i in 11..20 do yield i }

seq {
    yield! xs
    yield! ys
}

seq [1; 2; 3; 4; ...]

Async<'T>

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9:

async {
    let req = WebRequest.Create("https://www.openfsharp.org/")
    let! resp = req.AsyncGetResponse()
    use stream = resp.GetResponseStream()
    let! bytes = stream.AsyncRead(95)
    let text = Text.Encoding.UTF8.GetString(bytes)
    return (resp :?> HttpWebResponse).StatusCode, text
}
|> Async.RunSynchronously

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8:

val it : HttpStatusCode * string =
  (OK {value__ = 200;},
   "<!DOCTYPE html>
<html lang="en-us">
    <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

Nine for Mortal Men doomed to die

Computation Expressions

Why should we care?

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13:

let one = Some 1

let tryDivide num den =
    match den with
    | 0 -> None
    | n -> Some(num / n)

match one with
| Some x ->
    match tryDivide x 0 with
    | Some y -> Some(x + y)
    | None -> None
| None -> None

Option Monad

1: 
2: 
3: 
4:

type OptionMonad() =
    member __.Bind(m, f) = Option.bind f m
    member __.Return(x) = Some x
let opt = OptionMonad()

OptionBuilder

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11:

type OptionBuilder() =
    member __.Bind(m, f) = Option.bind f m
    member __.Return(x) = Some x
    member __.ReturnFrom(m: 'T option) = m
    member __.Zero() = None
    member __.Combine(m, f: unit -> _) =
        match m with Some _ -> m | None -> f()
    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: 
11: 
12: 
13: 
14: 
15:

type OptionMonad2() =
    inherit OptionMonad()

    member __.ReturnFrom(m) = m
    member __.Combine(m1, m2) =
        match m1 with Some _ -> m1 | None -> m2
    member __.Delay(f) = f()

let optMany = OptionMonad2()

optMany {
    return 1
    printfn "delayed should not print"
    return! None
}

1: 
2:

delayed should not print
val it : int option = Some 1

Delayed Computations (cont)

1: 
2: 
3: 
4: 
5:

maybe {
    return 1
    printfn "delayed should not print"
    return! None
}

Some 1

Function Wrapper Types

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

Back to the One Ring ...

Monad (+more) libraries

Seven for the Dwarf-lords in their halls of stone

Query Expressions

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:

type FSharp.Control.AsyncBuilder with

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

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

Parallel Async Example

Async with 1000ms Sleep

1: 
2: 
3: 
4: 
5: 
6:

let a (sw:Diagnostics.Stopwatch) = async {
    printfn "starting a %O" sw.ElapsedMilliseconds
    do! Async.Sleep 1000
    printfn "returning a %O" sw.ElapsedMilliseconds
    return 1
}

Async with 500ms Sleep

1: 
2: 
3: 
4: 
5: 
6:

let b (sw:Diagnostics.Stopwatch) = async {
    printfn "starting b %O" sw.ElapsedMilliseconds
    do! Async.Sleep 500
    do printfn "returning b %O" sw.ElapsedMilliseconds
    return 2
}

Sequential

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9:

let compBind sw = async {
    let! x = a sw
    let! y = b sw
    return x + y
}
let sw = Diagnostics.Stopwatch.StartNew()
let resultBind = compBind sw |> Async.RunSynchronously
sw.Stop()
printfn "compBind ran in %Oms with result %i" sw.ElapsedMilliseconds resultBind

1: 
2: 
3: 
4: 
5:

starting a 7
returning a 1010
starting b 1016
returning b 1518
compBind ran in 1521ms with result 3

Parallel

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10:

let comp sw = async {
    for x in a sw do
    ``and!`` y in b sw
    return x + y
}
sw.Reset()
sw.Start()
let result = comp sw |> Async.RunSynchronously
sw.Stop()
printfn "comp ran in %Oms with result %i" sw.ElapsedMilliseconds result

1: 
2: 
3: 
4: 
5:

starting a 4
starting b 4
returning b 505
returning a 1004
comp ran in 1005ms with result 3

Another Async with 1500ms Sleep

1: 
2: 
3: 
4: 
5: 
6:

let c (sw:Diagnostics.Stopwatch) = async {
    printfn "starting c %O" sw.ElapsedMilliseconds
    do! Async.Sleep 1500
    do printfn "returning c %O" sw.ElapsedMilliseconds
    return 3
}

2+ Asyncs

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11:

let comp3 sw = async {
    for x in a sw do
    ``and!`` y in b sw
    ``and!`` z in c sw
    return x + y + z
}
sw.Reset()
sw.Start()
let result3 = comp3 sw |> Async.RunSynchronously
sw.Stop()
printfn "comp3 ran in %Oms with result %i" sw.ElapsedMilliseconds result3

1: 
2: 
3: 
4: 
5: 
6: 
7:

starting a starting b 3
3
starting c 4
returning b 504
returning a 1004
returning c 1506
comp3 ran in 1510ms with result 6

`CustomOperation` Overloading

 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'
        }

You may assume that method overloading is as easy as adding another,
similar named method. After all, many people extend `AsyncBuilder`
with implementations of `Bind` that deal with `Task<'T>` and `Task`
so that they don't have to deal with the `Async.AwaitTask`.
Interestingly, that's not allowed with custom operations if you:
1) attempt to add it directly to the builder class and/or
2) attempt to add the same attribute again with the same name.
If you add an extension member outside the type definition and assign
the name to a CustomOperation attribute on only one member, you _can_
add overloads. This appears to work through the class method dispatch
and is technically a bug, but it will allow you to overload custom
operations until official support is released, which is currently a
work in progress:
https://github.com/fsharp/fslang-design/blob/master/RFCs/FS-1056-allow-custom-operation-overloads.md

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

Other Limitations

Three Rings for the Elven-kings under the sky

Domain Specific Languages

Builds with Xake

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

#r "paket:
  nuget Xake ~> 1.1 prerelease
  nuget Xake.Dotnet ~> 1.1 prerelease //"

open Xake
open Xake.Dotnet

do xakeScript {
  rules [
    "main" <== ["helloworld.exe"]

    "helloworld.exe" ..> csc {src !!"helloworld.cs"}
  ]
}

Testing with Expecto

1: 
2: 
3: 
4: 
5:

let tests =
  test "A simple test" {
    let subject = "Hello World"
    Expect.equal subject "Hello World" "The strings should equal"
  }

Emitting CIL with LicenseToCIL

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"

HTTP Protocol with Freya

1: 
2: 
3: 
4:

let machine =
    freyaMachine {
        methods [GET; HEAD; OPTIONS]
        handleOk hello }

1: 
2: 
3:

let router =
    freyaRouter {
        resource "/hello{/name}" machine }

MVC with Saturn

1: 
2: 
3: 
4: 
5: 
6:

let commentController userId = controller {
    index (fun ctx -> (sprintf "Comment Index handler for user %i" userId ) |> Controller.text ctx)
    add (fun ctx -> (sprintf "Comment Add handler for user %i" userId ) |> Controller.text ctx)
    show (fun (ctx, id) -> (sprintf "Show comment %s handler for user %i" id userId ) |> Controller.text ctx)
    edit (fun (ctx, id) -> (sprintf "Edit comment %s handler for user %i" id userId )  |> Controller.text ctx)
}

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9:

let app = application {
    pipe_through endpointPipe

    router topRouter
    url "http://0.0.0.0:8085/"
    memory_cache
    use_static "static"
    use_gzip
}

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 validations

Questions?

Why Not Macros?

Since we are talking about language extensions, we must
talk about macros. After all, languages in the Lisp family
support macros, to the extent that much of the language is built
in macros. What could be more powerful? In short, nothing.
However, F# does not provide a mechanism for writing macros,
and it's a fair question to ask, "Why not?"
Macros require a pre-compiler or a compiler plugin mechanism.
When you introduce something like this, you rely on another
tool to handle some of the work of compiling a program.
This can drastically increase and complicate compile times or even
create very difficult-to-debug compiler crashes.
In addition, macros don't play very well with typed languages
as you are essentially relying on something typed to rely on
something untyped-until-generated.
Type Providers are the closest thing F# has to macros, but these
only provide types and don't extend the language.
Computation expressions don't carry the full power of macros,
but they cover the most important use cases to the point you won't
likely miss macros.