Adding binding options to Morozov’s WPF MVC framework

Inspired by Dmitry Morozov’s MVC series (among the best F# articles I’ve ever seen!), I wanted to extend his data binding DSL to allow the setting of binding properties individually for each model property. The end result I was after, was to be able to write binding expression quotations like

<@
  view.Control.LastName.Text <- model.LastName |> UpdateSourceOnChange
  view.Control.Bitness.Text  <- model.Bitness |> string |> Mode BindingMode.OneTime
@>

The simplest way of doing this, is to add a few functions and their corresponding pattern matches to Dmitry’s BindingExpression active pattern. This would enable us to write expressions like

<@
  view.Control.LastName.Text <- UpdateSourceOnChange model.LastName
  view.Control.Bitness.Text  <- Mode BindingMode.OneTime (string model.Bitness)
@>

which isn’t quite what we’re aiming for. Either the BindingExpression pattern will have to be modified to handle the |> operator, or we need to write a function that transforms all expressions containing |> operators into plain old function calls. I chose the latter alternative, since it’s more general and leaves most of Dmitry’s original code intact. Let’s start with the most interesting bit; the pipe to call transformation.

Transforming function calls with piped arguments into straight forward calls

This is the skeleton of the pipe to call transformation function:

let rec rewritePipeIntoCall (e : Expr) =
    let rec unpipe (vars : Map<string, Expr>) (pipedArgs : Expr list) (expr : Expr) =
        match expr with
        // Matches to come here.
    // -----
    unpipe Map.empty [] e

The unpipe function will do all the heavy lifting and takes three arguments. The vars argument contains all variables that we collect as we recurse our way down the expression’s abstract syntax tree (AST) and is a Map<string, Expr> of variable names and the expressions they’re bound to. pipedArgs is a list of function arguments that are piped to functions (e.g. 1 |> f1). expr is the expression we’re transforming.

In order to get a closer look at how quoted calls look, we define a few functions:

let f1 y = y+10
let f2 y = y+20
let f3 y z = y+z+30
let f4 y z t = y-z+t

If we execute the above lines in F# Interactive (fsi), we can type the quoted call <@ f1 5 @> and fsi will reply

Call (None, f1, [Value (5)])

The values in the tuple after Call are (object, method, argumentList), where object = None, because we don’t have any object in our case, method = f1 and argumentList = [Value(5)]. Expressions with parentheses look so much nicer when viewed as trees:

tree01

The None object reference isn’t very interesting in our context, so I’ll take the liberty of omitting it during the rest of this post, like this:

tree01a

Quote a call to the 3 argument function, <@ f4 1 2 3 @>, and the reply will unsurprisingly be

Call (None, f4, [Value (1), Value (2), Value (3)])

tree02

A quotation with a nested call like <@ f2 (f1 5) @> will look like

Call (None, f2, [Call (None, f1, [Value (5)])])

tree03

We will want to rewrite all our forward pipes into calls like these. So, how does a piped call like 5 |> f1 look? Entering <@ 5 |> f1 @> into fsi gives us

Call (None, op_PipeRight, [Value (5), Lambda (y, Call (None, f1, [y]))])

tree08

The above picture shows the AST correctly, but the tree view will make more sense if we take yet another liberty with tree renderings and depict it as follows:

tree10

Let’s concentrate on the right side of the |> operator for a while:

Lambda (y, Call (None, f1, [y]))

tree05

We obviously get a lambda expression when arguments are missing. Another way of saying this is that first class function values are represented as lambda expressions. These consist of a single argument (in our case: y) and the body of the lambda expression (in our case: the call to f1).

As we saw in the tree resulting from <@ 5 |> f1 @>, the argument y is the first argument in the op_PipeRight call. Now it’s time to extend our unpipe skeleton with pattern matches for the |> operator and lambda expressions:

let rec rewritePipeIntoCall (e : Expr) =
    let rec unpipe (vars : Map<string, Expr>) (pipedArgs : Expr list) (expr : Expr) =
        match expr with
        | SpecificCall <@ (|>) @> (None, _, [pipedArg; rightOfPipe]) ->
            unpipe vars (pipedArg::pipedArgs) rightOfPipe
        | Lambda (arg, lambdaExpr) ->
            match pipedArgs with
            | hd::tl ->
                let vars' = vars.Add(arg.Name, hd)
                unpipe vars' tl lambdaExpr
            | [] -> failwith "Missing argument."
    // -----
    unpipe Map.empty [] e

When encountering a pipedArg |> rightOfPipe expression, the SpecificCall match case just adds the piped argument to the list of piped arguments and continues processing the right hand expression.

The Lambda match case consumes the most recently added piped argument (y in the above example) and adds it to the map of collected variables (vars).

According to the F# documentation, “Lambda expressions that have multiple arguments are decomposed one argument at a time”. To see how that works, let’s reference a function that takes multiple arguments, f4, and supply it with all its arguments by way of piping, which you normally don’t because it looks as hideous this: <@ 3 |> (2 |> (1 |> f4)) @>. Fsi’s reply looks even more ungainly and obfuscated than the quotation did:

  Call (None, op_PipeRight,
      [Value (3),
       Call (None, op_PipeRight,
             [Value (2),
              Call (None, op_PipeRight,
                    [Value (1),
                     Lambda (y,
                             Lambda (z, Lambda (t, Call (None, f4, [y, z, t]))))])])])

The tree view brings clarity to this Lispish mess of parentheses:

tree09

From this tree, the code we have so far will build a vars map consisting of:
("y", Value(1))
("z", Value(2))
("t", Value(3))

Now, we can add a match case for function calls:

        | Call(_, fcn, args) ->
            let argValues =
                [for arg in args ->
                    match arg with
                    | Var v -> vars.[v.Name]
                    | e     -> e
                ] |> List.map rewritePipeIntoCall
            Expr.Call(fcn, argValues)

Any variable references in the argument list are simply looked up in the vars map, and substituted for their bound expressions. All other types of arguments are left unchanged, and everything in the argValues argument list is subsequently piped recursively to rewritePipeIntoCall. The end result of the function call match case is a straight forward, non piped function call created by Expr.Call(fcn, argValues).

You wouldn’t normally write function calls in the 3 |> (2 |> (1 |> f4)) style, unless you’re participating in an obfuscated coding contest. A much more useful case is something like myModel.MyProperty |> Mode BindingMode.OneTime.

Lets’s try this with our f4 sample function and supply it with a couple but not all of its arguments, say <@ f4 1 2 @>. Fsi will respond with a tree of let bindings to bind variables to the supplied argument values:

Let (y, Value (1), Let (z, Value (2), Lambda (t, Call (None, f4, [y, z, t]))))

tree07

The type of the let binding, put very informally, is (variable being defined * the body of the let expression * everything that comes after the let body). A more formal definition can be found here.

We already have the vars map for variables and their bound values in place, so all we have to do in our Let match case, is to add the variable definition to vars and continue processing whatever comes after the let body:

        | Let (var, letExpr, inBody) ->
            let vars' = vars.Add(var.Name, letExpr)
            unpipe vars' pipedArgs inBody

The rewritePipeIntoCall function is beginning to look quite complete by now. All that’s left is a match case for expressions that we don’t want to mess with:

        | e -> e  // Leave all other expression types untouched.

The function is now complete and looks like this:

open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.DerivedPatterns
open Microsoft.FSharp.Quotations.Patterns

let rec rewritePipeIntoCall (e : Expr) =
    let rec unpipe (vars : Map<string, Expr>) (pipedArgs : Expr list) (expr : Expr) =
        match expr with
        | SpecificCall <@ (|>) @> (None, _, [pipedArg; rightOfPipe]) ->
            unpipe vars (pipedArg::pipedArgs) rightOfPipe
        | Lambda (arg, lambdaExpr) ->
            match pipedArgs with
            | hd::tl ->
                let vars' = vars.Add(arg.Name, hd)
                unpipe vars' tl lambdaExpr
            | [] -> failwith "Missing argument."
        | Let (var, letExpr, inBody) ->
            let vars' = vars.Add(var.Name, letExpr)
            unpipe vars' pipedArgs inBody
        | Call(_, fcn, args) ->
            let argValues =
                [for arg in args ->
                    match arg with
                    | Var v -> vars.[v.Name]
                    | e     -> e
                ] |> List.map rewritePipeIntoCall
            Expr.Call(fcn, argValues)
        | e -> e  // Leave all other expression types untouched.
    // -----
    unpipe Map.empty [] e

Adding binding property modifiers

Now for the easy part: the binding property modifier functions to add to Dmitry’s data binding DSL. As a basis, I’ve chosen the code for chapter 13 in his WPF MVC article series, because it’s the last chapter about .NET 4.0, so you can use it to target the 37% of computer users still on XP. The modified code with my additions is available for download here (as VS2012 project files).

Comment from Dmitry about .NET 4.0 targeting: You still can use VS2012 chapter as the basis – just remove INotifyDataErrorInfo & ExceptionDispatchInfo. Everything else can be compiled down to .NET 4.

We’ll add the modifiers to Dmitry’s Binding.fs file. The module BindingOptions is added just before the Patterns module:

module BindingOptions =
    let Mode (_ : BindingMode) (_ : 'T) : 'T                 = undefined
    let OneWay (_ : 'T) : 'T                                 = undefined
    let UpdateSource (_ : UpdateSourceTrigger) (_ : 'T) : 'T = undefined
    let UpdateSourceOnChange (_ : 'T) : 'T                   = undefined
    let FallbackValue (_ : obj) (_ : 'T) : 'T                = undefined
    let TargetNullValue (_ : obj) (_ : 'T) : 'T              = undefined
    let ValidatesOnDataErrors (_ : bool) (_ : 'T) : 'T       = undefined
    let ValidatesOnExceptions (_ : bool) (_ : 'T) : 'T       = undefined

There are a few shorthands in the code above: while the Mode function can be used to set BindingMode.OneWay, this often used binding mode can also be set by just referencing the OneWay function. In the same manner, UpdateSourceOnChange is a shorthand for UpdateSource UpdateSourceTrigger.PropertyChanged.

None of these functions should ever be executed, there just there to be recognised by Dmitry’s BindingExpression active pattern. Thus, they’re all defined as undefined, contradictory though it may sound.

Let’s take a look at the aforementioned BindingExpression pattern (still in Binding.fs, which is the only file we need to touch) in its original form:

    let rec (|BindingExpression|) = function
        | PropertyPath path -> 
            Binding path
        | Coerce( BindingExpression binding, _) 
        | SpecificCall <@ string @> (None, _, [ BindingExpression binding ]) 
        | Nullable( BindingExpression binding) -> 
            binding
        | StringFormat(format, BindingExpression binding) -> 
            binding.StringFormat <- format
            binding

        ...

This is where we insert our SpecificCall match cases for the binding property modifier functions:

    let rec (|BindingExpression|) = function
        | PropertyPath path -> 
            Binding path
        | Coerce( BindingExpression binding, _) 
        | SpecificCall <@ string @> (None, _, [ BindingExpression binding ]) 
        | Nullable( BindingExpression binding) -> 
            binding

        | SpecificCall <@ BindingOptions.Mode @> (None, _, [ Value(mode, _); BindingExpression binding ]) ->
            binding.Mode <- unbox mode
            binding
        | SpecificCall <@ BindingOptions.OneWay @> (None, _, [ BindingExpression binding ]) ->
            binding.Mode <- BindingMode.OneWay
            binding
        | SpecificCall <@ BindingOptions.UpdateSource @> (None, _, [ Value(trigger, _); BindingExpression binding ]) ->
            binding.UpdateSourceTrigger <- unbox trigger
            binding
        | SpecificCall <@ BindingOptions.UpdateSourceOnChange @> (None, _, [ BindingExpression binding ]) ->
            binding.UpdateSourceTrigger <- UpdateSourceTrigger.PropertyChanged
            binding
        | SpecificCall <@ BindingOptions.FallbackValue @> (None, _, [ Value(value, _); BindingExpression binding ]) ->
            binding.FallbackValue <- value
            binding
        | SpecificCall <@ BindingOptions.TargetNullValue @> (None, _, [ Value(value, _); BindingExpression binding ]) ->
            binding.TargetNullValue <- value
            binding
        | SpecificCall <@ BindingOptions.ValidatesOnDataErrors @> (None, _, [ Value(value, _); BindingExpression binding ]) ->
            binding.ValidatesOnDataErrors <- unbox value
            binding
        | SpecificCall <@ BindingOptions.ValidatesOnExceptions @> (None, _, [ Value(value, _); BindingExpression binding ]) ->
            binding.ValidatesOnExceptions <- unbox value
            binding

        | StringFormat(format, BindingExpression binding) -> 
            binding.StringFormat <- format
            binding

        ...

Evidently, setting binding properties is completely straight forward. The next thing we need to do, is to plug in our rewritePipeIntoCall function. Where should we put that function? I chose the existing Expr type extension in Binding.fs and added it as a static member of that type:

type Expr with
    static member RewritePipeIntoCall (e : Expr) =
        // The rest of the code as before ...

Note that the type declaration (or extension, to be precise) is already present in Binding.fs, we just add our own function to it. The last thing that remains, is to see to that the WPF data binding expressions get massaged by our pipe to call transformation. This means modifying the existing Expr.ToBindingExpression from this:

member this.ToBindingExpr(?mode, ?updateSourceTrigger, ?fallbackValue, ?targetNullValue, ?validatesOnDataErrors, ?validatesOnExceptions) = 
    match this with
    | PropertySet(Target target, targetProperty, [], BindingExpression binding) ->

        if mode.IsSome then binding.Mode <- mode.Value
        ...

… to this:

member this.ToBindingExpr(?mode, ?updateSourceTrigger, ?fallbackValue, ?targetNullValue, ?validatesOnDataErrors, ?validatesOnExceptions) = 
    match this with
    | PropertySet(Target target, targetProperty, [], bindingExpr) ->
        let (BindingExpression binding) = Expr.RewritePipeIntoCall bindingExpr

        if mode.IsSome then binding.Mode <- mode.Value
        ...

That’s it! Having done these changes, we can now rewrite Dmitry’s stock picker sample (StockPicker.fs) from this:

    override this.SetBindings model = 
        Binding.FromExpression 
            <@ 
                this.Control.CompanyName.Text <- model.CompanyName
                this.Control.AddToChart.IsEnabled <- model.AddToChartEnabled
                this.Control.Retrieve.IsEnabled <- isNotNull model.Symbol
            @>

        Binding.UpdateSourceOnChange <@ this.Control.Symbol.Text <- model.Symbol @>
        ...

…into this:

    override this.SetBindings model = 
        Binding.FromExpression 
            <@ 
                this.Control.CompanyName.Text <- model.CompanyName
                this.Control.AddToChart.IsEnabled <- model.AddToChartEnabled
                this.Control.Retrieve.IsEnabled <- isNotNull model.Symbol
                this.Control.Symbol.Text <- model.Symbol |> BindingOptions.UpdateSourceOnChange
            @>
        ...

There we are, no more need for separate quotation bodies in order to set individual binding properties.

And that, ladies and gentlemen, is how we do that.

  1. No comments yet.

  1. July 14th, 2013