TL;DR: How do I get the actual property value from a quotation of the form
<# myInstance.myProperty #>
I'm trying to simplify INotifyPropertyChanged using F#. Instead of subscribing directly to PropertyChanged, I want to use a method that takes a code quotation containing the property I want to subscribe to (e.g. <# vm.IsChanged #>) and a callback (or alternatively just the quotation and returns an observable of the relevant property). For example:
type MyVm() =
inherit INPCBaseWithObserveMethod()
...
let vm = new MyVm()
vm.Observe <# vm.IsChanged #> (fun isChanged -> ...)
I'm new to code quotations and I'm struggling with the implementation of the Observe method. I know how to get the property name from this kind of expression, but not the value. Here's what I have so far (note the placeholder in propInfo.GetValue):
type ViewModelBase() =
// Start INPC boilerplate
let propertyChanged = new Event<_, _>()
interface INotifyPropertyChanged with
[<CLIEvent>]
member __.PropertyChanged = propertyChanged.Publish
member this.OnPropertyChanged(propertyName : string) =
propertyChanged.Trigger(this, new PropertyChangedEventArgs(propertyName))
// End INPC boilerplate
member this.Observe (query: Expr<'a>) (callback: 'a -> unit) : unit =
match query with
| PropertyGet(instanceExpr, propInfo, _) ->
(this :> INotifyPropertyChanged).PropertyChanged
|> Observable.filter (fun args -> args.PropertyName = propInfo.Name)
|> Observable.map (fun _ -> propInfo.GetValue(TODO) :?> 'a)
|> Observable.add callback
| _ -> failwith "Expression must be a non-static property getter"
I figured it out based on some experimentation and this quotation eval function. In the most simple case (when vm in <# vm.MyProperty #> is a local let-bound value), the instance expression will match the Value pattern:
| PropertyGet(Some (Value (instance, _)), propInfo, [])
instance can then be passed to PropertyInfo.GetValue. However, if vm is a field (class-level let binding) or anything else, then the pattern will be different (e.g. containing a nested FieldGet which will need to be evaluated to get the correct instance you can pass to PropertyInfo.GetValue).
In short, it seems the best course of action is simply using the eval function I linked to. The whole ViewModelBase class then becomes (see this snippet for a more complete implementation):
type ViewModelBase() =
/// Evaluates an expression. From http://www.fssnip.net/h1
let rec eval = function
| Value (v, _) -> v
| Coerce (e, _) -> eval e
| NewObject (ci, args) -> ci.Invoke (evalAll args)
| NewArray (t, args) ->
let array = Array.CreateInstance (t, args.Length)
args |> List.iteri (fun i arg -> array.SetValue (eval arg, i))
box array
| NewUnionCase (case, args) -> FSharpValue.MakeUnion (case, evalAll args)
| NewRecord (t, args) -> FSharpValue.MakeRecord (t, evalAll args)
| NewTuple args ->
let t = FSharpType.MakeTupleType [| for arg in args -> arg.Type |]
FSharpValue.MakeTuple (evalAll args, t)
| FieldGet (Some (Value (v, _)), fi) -> fi.GetValue v
| PropertyGet (None, pi, args) -> pi.GetValue (null, evalAll args)
| PropertyGet (Some x, pi, args) -> pi.GetValue (eval x, evalAll args)
| Call (None, mi, args) -> mi.Invoke (null, evalAll args)
| Call (Some x, mi, args) -> mi.Invoke (eval x, evalAll args)
| x -> raise <| NotSupportedException(string x)
and evalAll args = [| for arg in args -> eval arg |]
let propertyChanged = new Event<_,_>()
interface INotifyPropertyChanged with
[<CLIEvent>]
member __.PropertyChanged = propertyChanged.Publish
member this.OnPropertyChanged(propertyName : string) =
propertyChanged.Trigger(this, new PropertyChangedEventArgs(propertyName))
/// Given a property-getter quotation, calls the callback with the value of
/// the expression every time INotifyPropertyChanged is raised for this property.
member this.Observe (expr: Expr<'a>) (callback: 'a -> unit) : unit =
match expr with
| PropertyGet (_, propInfo, _) ->
(this :> INotifyPropertyChanged).PropertyChanged
|> Observable.filter (fun args -> args.PropertyName = propInfo.Name)
|> Observable.map (fun _ -> eval expr :?> 'a)
|> Observable.add callback
| _ -> failwith "Expression must be a property getter"
Observe can of course be trivially modified to return an observable instead of subscribing directly.
Note that in many scenarios Observable.DistinctUntilChanged might be desired after Observable.map. (I use Observe to, among other things, trigger animations from view model properties, and due assumptions in my particular animation code, the animations got all wonky when there were several subsequent calls to the callback with an unchanged property value.)
Related
Please explain the following function signature which appeared when I hovered over the function in VS Code. I'm especially curious what exactly "requires" means and why 'b is 'a.
val handleSingleEvent:
: Request
-> 'b (requires :> seq<list<string>>)
Generic Parameters
'b is 'a
Below is the code
let handleEvents (requests: Request list, reqEventQueue: EventQueue, session: Session) =
let rec handleSingleEvent (request: Request) : seq<list<string>> =
seq {
let eventObj = reqEventQueue.NextEvent()
match eventObj.Type with
| Event.EventType.REQUEST_STATUS -> yield processMiscEvents eventObj |> makeJson
| Event.EventType.ADMIN -> yield processAdminEvent eventObj |> makeJson
| Event.EventType.AUTHORIZATION_STATUS -> yield processAuthEvent eventObj session |> makeJson
| Event.EventType.PARTIAL_RESPONSE ->
yield processReferenceResponseEvent eventObj
|> makeJson
yield! handleSingleEvent request
| Event.EventType.RESPONSE -> yield processReferenceResponseEvent eventObj |> makeJson
| _ -> yield processMiscEvents eventObj |> makeJson
} |> ignore
handleSingleEvent request
List.map (fun request -> handleSingleEvent request) requests
After adding the return type annotation seq<list<string>>, hovering over the function in VS Code now displays the function signature as
val handleSingleEvent:
: Request
-> seq<list<string>>
"requires" disappeared and "Generic Parameters `b is `a" disappeared.
'requires' indicates a member constraint, meaning that the generic type argument is constrained to exhibit such member. As a brief example:
let inline f<'b when 'b : (member Name : string)> (x: 'b) = x
The generic type 'b is now constrained to have a member Name that returns a string.
https://learn.microsoft.com/en-us/dotnet/fsharp/language-reference/generics/constraints
I'm trying to substitute types in a F# Expr, before converting it to an Expression for consumption by a c# lib.
But upon the call to LeafExpressionConverter.QuotationToExpression I receive the error
InvalidOperationException: The variable 't' was not found in the translation context
Basically I'm trying to substitute the equivalent of
<# fun (t: Record) -> t.A = 10 #> to
<# fun (t: Dict) -> t["A"] = 10 #>
Here is the code
type Record = {
A: int
}
type Dict () = //this is the type the c# lib wants (a dictionary representation of a type)
inherit Dictionary<string, obj>()
let substitute<'a> (ex: Expr<'a->bool>) =
let replaceVar (v: Var) = if v.Type = typeof<'a> then Var(v.Name, typeof<Dict>) else v
let tEntityItem = typeof<Dict>.GetProperty("Item")
let isATypeShapeVar = function | ShapeVar var -> var.Type = typeof<'a> | _ -> false
let rec substituteExpr =
function
| PropertyGet(exOpt, propOrValInfo, c) ->
match exOpt with
| None -> Expr.PropertyGet(propOrValInfo)
| Some ex ->
let args = c |> List.map substituteExpr
let newex = substituteExpr ex
match isATypeShapeVar ex with
| true ->
let getter = Expr.PropertyGet(newex, tEntityItem, [Expr.Value(propOrValInfo.Name)] )
Expr.Coerce(getter, propOrValInfo.PropertyType)
| false -> Expr.PropertyGet(newex, propOrValInfo, args)
| ShapeVar var -> Expr.Var (var |> replaceVar)
| ShapeLambda (var, expr) -> Expr.Lambda(var |> replaceVar, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
substituteExpr ex |> LeafExpressionConverter.QuotationToExpression
substitute<Record> (<# fun t -> t.A = 10 #>)
I suspect I've missed something in the substitution, but I'm stumped as to what.
The the .ToString() result of the substituted F# Expr is
Lambda (t,
Call (None, op_Equality,
[Coerce (PropertyGet (Some (t), Item, [Value ("A")]), Int32),
Value (10)]))
which looks correct. And other than the coersion, is the equivalent of <# fun (t: Dict) -> t["A"] = 10 #>.ToString()
Why is the QuotationToExpression failing ?
Every time you call replaceVar, you return a different instance of Var. So when you replace the lambda parameter, it's one instance of Var, and later, when you replace newex, that's another instance of Var.
Lambda (t, Call (None, op_Equality, [Coerce (PropertyGet (Some (t), ... ))
^ ^
| |
---------------------------------------------------------
These are different `t`, unrelated, despite the same name
To make this work, you have to make it the same t. The dumbest, most straightforward way would be this:
let substitute<'a> (ex: Expr<'a->bool>) =
let newArg = Var("arg", typeof<Dict>)
let replaceVar (v: Var) = if v.Type = typeof<'a> then newArg else v
...
This will make your particular example work as expected, but it is still unsound, because you're replacing not just specifically the lambda parameter, but any variable of the same type. Which means that if the expression happens to contain any variables of the same type as the parameter, you'd still hit the same problem. For example, try converting this:
<# fun t -> let z = { A = 15 } in z.A = 15 && t.A = 10 #>
You'll get a similar error, but this time complaining about variable z.
A better way would be to maintain a map of variable substitutions as you go, insert new variables as you encounter them for the first time, but get them from the map on subsequent encounters.
An alternative approach would be to fish out specifically the lambda parameter and then replace only it, rather than comparing variable types.
But then there's the next level of weirdness: you're converting any property accessor to an indexer accessor, but in my example above, z.A shouldn't be thus converted. So you have to somehow recognize whether the object of property access is in fact the argument, and that may not be as trivial.
If you're willing to settle for just the case of t.A and fail on more complicated cases like (if true then t else t).A, then you can just match on the lambda argument and pass through any other expression:
let substitute<'a> (ex: Expr<'a->bool>) =
let arg =
match ex with
| ShapeLambda (v, _) -> v
| _ -> failwith "This is not a lambda. Shouldn't happen."
let newArg = Var("arg", typeof<Dict>)
let replaceVar (v: Var) = if v = arg then newArg else v
let tEntityItem = typeof<Dict>.GetProperty("Item")
let isATypeShapeVar = function | ShapeVar var -> var.Type = typeof<'a> | _ -> false
let rec substituteExpr =
function
| PropertyGet(Some (ShapeVar a), propOrValInfo, c) when a = arg ->
let getter = Expr.PropertyGet(Expr.Var newArg, tEntityItem, [Expr.Value(propOrValInfo.Name)] )
Expr.Coerce(getter, propOrValInfo.PropertyType)
| ShapeVar var -> Expr.Var (var |> replaceVar)
| ShapeLambda (var, expr) -> Expr.Lambda(var |> replaceVar, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
| ex -> ex
substituteExpr ex |> LeafExpressionConverter.QuotationToExpression
> substituteExpr <# fun t -> let z = { A = 15 } in z.A = 15 && t.A = 10 #>
val it: System.Linq.Expressions.Expression =
ToFSharpFunc(arg => z => ((z.A == 15) AndAlso (Convert(arg.get_Item("A"), Int32) == 10)).Invoke(new Record(15)))
Hi I have the following code which works as I expect but the compiler warns me about incomplete pattern matching when I pattern match in the Option.defaultWith function. Is there a smarter way to achieve the same effect but without warnings?
I have been thinking about throwing an exception for the rest of the cases but that's pretty ugly.
namespace JsonParser
open System
open System.Globalization
open FSharp.Data
open FSharp.Data.Runtime
type public Key = string
type public Value =
| Int of int
| Double of double
| Decimal of decimal
| String of string
| DateTime of DateTime
| Boolean of Boolean
| Array of Value []
| Guid of Guid
| Null
| Object of Record []
and public Record =
{ Key: Key
Value: Value }
module public Json =
let private culture = CultureInfo.InvariantCulture
let private emptyArray = Array.empty<String>
let rec private map (value: JsonValue) =
JsonConversions.AsInteger culture value
|> Option.map Value.Int
|> Option.orElseWith (fun () -> JsonConversions.AsDecimal culture value |> Option.map Value.Decimal)
|> Option.orElseWith (fun () -> JsonConversions.AsFloat emptyArray true culture value |> Option.map Decimal |> Option.map Value.Decimal)
|> Option.orElseWith (fun () -> JsonConversions.AsGuid value |> Option.map Value.Guid)
|> Option.orElseWith (fun () -> JsonConversions.AsDateTime culture value |> Option.map Value.DateTime)
|> Option.orElseWith (fun () -> JsonConversions.AsBoolean value |> Option.map Value.Boolean)
|> Option.defaultWith (fun () ->
match value with
| JsonValue.String x -> Value.String x
| JsonValue.Null -> Value.Null
| JsonValue.Array x ->
x
|> Array.map map
|> Value.Array
| JsonValue.Record x ->
x
|> Array.map (fun (x, y) ->
{ Key = x
Value = map y })
|> Value.Object)
The answer really depends on how you want to handle various corner cases in your JSON data.
The operations in JsonConversions are implemented in a way where they attempt to convert the value to the target type whenever this can reasonably be done. This means that using those, a value true, 1 and "yes" will all be converted to boolan true. Is this what you want? If so, then I would probably just add a case to the pattern match that throws an exception, saying that the situation should not happen:
match value with
| JsonValue.String x -> Value.String x
| JsonValue.Null -> Value.Null
| JsonValue.Array x -> (...)
| JsonValue.Record x -> (...)
| JsonValue.Float _ | JsonValue.Number _ | JsonValue.Boolean _ ->
failwith "should never happen: Numbers and booleans handled earlier!"
If you want to turn JSON value "yes" to Value.String("yes") rather than to Value.Boolean(true), then it is a lot easier if you directly pattern match on JsonValue:
let rec private map (value: JsonValue) =
match value with
| JsonValue.Float f -> Value.Double f
| JsonValue.Number n -> Value.Decimal n
| JsonValue.Boolean b -> Value.Boolean b
| JsonValue.String x -> Value.String x
| JsonValue.Null -> Value.Null
| JsonValue.Array x ->
x |> Array.map map |> Value.Array
| JsonValue.Record x ->
x |> Array.map (fun (x, y) -> { Key = x; Value = map y }) |> Value.Object
You can find the details about how JsonConversions work by looking at the relevant file in the source code: JsonConversions and TextConversions.
given the following type
type Foo = { foo: string; bar: int };;
and the following code quotation
<#fun v x -> { x with foo = v; bar = 99 } #>;;
this will result in
val it : Quotations.Expr<(string -> Foo -> Foo)> =
Lambda (v, Lambda (x, NewRecord (Foo, v, Value (99))))
Which is expected. Also the following code quotation
<#fun v x -> { x with bar = v;foo = "foo" } #>;;
yields the expected result.
val it : Quotations.Expr<(int -> Foo -> Foo)> =
Lambda (v, Lambda (x, NewRecord (Foo, Value ("foo"), v)))
However this (changing the order and assigning the value to the second field)
<#fun v x -> { x with bar = 66;foo = v } #>;;
yields
val it : Quotations.Expr<(string -> Foo -> Foo)> =
Lambda (v, Lambda (x, Let (bar, Value (66), NewRecord (Foo, v, bar))))
a let. But there is no let in the code. Why is this?
Quotations only guarantee that they'll generate expressions with the correct behaviour, not any specific shape.
For example the quotation <## 1 = 2 || 2 = 3 ##> will generate an expression comprising of an if statement (i.e. if 1 = 2 then true else 2 = 3).
Normalising the resulting expressions is a pretty deep rabbit hole, but you can see some basic normalisers here: https://github.com/mavnn/Algebra.Boolean/blob/master/Algebra.Boolean/Transforms.fs
Specifically, check unbind at the end of the file.
let unbind quote =
let rec findLet q =
match q with
| Let (var, value, body) ->
findLet (replaceVar var.Name value body)
| ShapeLambda (v, e) ->
Expr.Lambda(v, findLet e)
| ShapeVar v ->
Expr.Var v
| ShapeCombination (o, es) ->
RebuildShapeCombination(o, es |> List.map findLet)
and replaceVar name value q =
match q with
| Let (v, e, e') ->
if v.Name = name then
findLet (Expr.Let(v, e, e'))
else
Expr.Let(v, replaceVar name value e, replaceVar name value e')
| ShapeLambda (v, e) ->
Expr.Lambda(v, replaceVar name value e)
| ShapeVar v ->
if v.Name = name then
value
else
Expr.Var v
| ShapeCombination (o, es) ->
RebuildShapeCombination(o, es |> List.map (replaceVar name value))
findLet quote
As to why these specific expressions are different? No idea, I'm afraid!
I believe what you are seeing here is a particular case of de-sugaring of the with syntax on records. I think what is happening here it is using the v to capture the value to ensure that the expressions are evaluated in the correct order of the fields. So in this case the let binding is introduce as the passed in parameter is the 2nd value being utilised.
This is from the F# language spec.
Primitive record constructions are an elaborated form in which the
fields appear in the same order as in the record type definition.
Record expressions themselves elaborate to a form that may introduce
local value definitions to ensure that expressions are evaluated in
the same order that the field definitions appear in the original
expression
The class below is a wrapper around an async MailboxProcessor that exposes
a few operations to C# assemblies. However, I don't want just a few
Map<string,int>
instances, I need several different Map<'K,'V> instances where 'K and 'V vary.
I hope I don't need a functor for that (it probably doesn't exist in F#).
module Flib.AsyncEvents
open System.Collections.Generic
type KVcoll = Map<string,int>
type Msg = Request of string * int option | Fetch of AsyncReplyChannel<KVcoll> | Clear
#nowarn "40"
type myAgent () = class
let dictAgent = MailboxProcessor.Start(fun inbox->
let dict = ref Map.empty
let rec loop = async {
let! msg = inbox.Receive()
match msg with
| Request (key, Some value) -> dict := Map.add key value !dict
| Request (key, None) -> dict := Map.remove key !dict
| Fetch(reply) -> reply.Reply(!dict)
| Clear -> dict := Map.empty
return! loop
}
loop)
member this.add(key, value) = dictAgent.Post (Request (key, Some value))
member this.del(key) = dictAgent.Post (Request(key, None))
member this.fetch() = dictAgent.PostAndReply((fun reply -> Fetch(reply)), timeout = 9000)
member this.lookup(key) = try 0, Map.find key (this.fetch()) // success
with | :? KeyNotFoundException -> -1, 0 // failure
member this.size() = this.fetch().Count
member this.clear() = dictAgent.Post (Clear)
member this.print() =
this.fetch() |> Map.iter (fun k v -> printfn "%s => %d" k v)
printfn "done"
end
By the way, this is prototype quality code, clearly not as good as it can be.
I'm not sure I understand the question fully, but if you want to create a type that can be used with different types of values, you can define the class as generic:
type Msg<'K, 'V when 'K : comparison> =
| Request of 'K * 'V option
| Fetch of AsyncReplyChannel<Map<'K, 'V>>
| Clear
type MyAgent<'K, 'V when 'K : comparison> () = class
let dictAgent = MailboxProcessor.Start(fun inbox->
let dict : Map<'K, 'V> ref = ref Map.empty
let rec loop = async {
// (same as before)
}
loop)
To make this work, you'll need to avoid code that restricts the type of keys and values to a particular type. In you case lookup was returning 0 as the default value and print was expecting strings. So you can replace those with something like:
member this.lookup(key) = Map.tryFind key (this.fetch())
member this.print() =
this.fetch() |> Map.iter (fun k v -> printfn "%A => %A" k v)
printfn "done"