I have the following lines of code in C#:
internal static object AssignMatchingPropertyValues(object sourceObject, object targetObject)
{
Type sourceType = sourceObject.GetType();
PropertyInfo[] sourcePropertyInfos = sourceType.GetProperties(BindingFlags.Public | BindingFlags.Instance);
foreach (var sourcePropertyInfo in sourcePropertyInfos)
{
var targetPropertyInfo = targetObject.GetType().GetProperty(sourcePropertyInfo.Name);
if (targetPropertyInfo != null)
{
targetPropertyInfo.SetValue(targetObject, sourcePropertyInfo.GetValue(sourceObject, null), null);
}
}
return targetObject;
}
I want to implement a functional equivalent in F# so I did something like this:
member this.AssignMatchingPropertyValues(sourceObject, targetObject)=
let sourceType = sourceObject.GetType()
let sourcePropertyInfos = sourceType.GetProperties(BindingFlags.Instance)
let assignedProperities = sourcePropertyInfos
|> Seq.map(fun spi -> spi, targetObject.GetType().GetProperty(spi.Name))
|> Seq.map(fun (spi,tpi) -> tpi.SetValue(targetObject, spi.GetValue(sourceObject,null),null))
()
The problem is that it does not work. I think b/c of immutability, I am getting a new collection. Is there a way to ref the original collection? Is this the right path in tackling this problem?
Here is a direct translation of your C#, which your F# code is not:
let AssignMatchingPropertyValues sourceObject targetObject =
let sourceType = sourceObject.GetType()
let targetType = targetObject.GetType()
let sourcePropertyInfos = sourceType.GetProperties(BindingFlags.Public ||| BindingFlags.Instance)
for sourcePropertyInfo in sourcePropertyInfos do
match targetType.GetProperty(sourcePropertyInfo.Name) with
| null -> ()
| targetPropertyInfo -> targetPropertyInfo.SetValue(targetObject, sourcePropertyInfo.GetValue(sourceObject, null), null)
targetObject
Seq.map is lazy and you aren't evaluating it anywhere. You can use Seq.iter:
sourcePropertyInfos
|> Seq.map(fun spi -> spi, targetObject.GetType().GetProperty(spi.Name))
|> Seq.iter(fun (spi,tpi) -> tpi.SetValue(targetObject, spi.GetValue(sourceObject,null),null))
Related
This is not for a practical need, but rather to try to learn something.
I am using FSToolKit's asyncResult expression which is very handy and I would like to know if there is a way to 'combine' expressions, such as async and result here, or does a custom expression have to be written?
Here is an example of my function to set the ip to a subdomain, with CloudFlare:
let setSubdomainToIpAsync zoneName url ip =
let decodeResult (r: CloudFlareResult<'a>) =
match r.Success with
| true -> Ok r.Result
| false -> Error r.Errors.[0].Message
let getZoneAsync (client: CloudFlareClient) =
asyncResult {
let! r = client.Zones.GetAsync()
let! d = decodeResult r
return!
match d |> Seq.filter (fun x -> x.Name = zoneName) |> Seq.toList with
| z::_ -> Ok z // take the first one
| _ -> Error $"zone '{zoneName}' not found"
}
let getRecordsAsync (client: CloudFlareClient) zoneId =
asyncResult {
let! r = client.Zones.DnsRecords.GetAsync(zoneId)
return! decodeResult r
}
let updateRecordAsync (client: CloudFlareClient) zoneId (records: DnsRecord seq) =
asyncResult {
return!
match records |> Seq.filter (fun x -> x.Name = url) |> Seq.toList with
| r::_ -> client.Zones.DnsRecords.UpdateAsync(zoneId, r.Id, ModifiedDnsRecord(Name = url, Content = ip, Type = DnsRecordType.A, Proxied = true))
| [] -> client.Zones.DnsRecords.AddAsync(zoneId, NewDnsRecord(Name = url, Content = ip, Proxied = true))
}
asyncResult {
use client = new CloudFlareClient(Credentials.CloudFlare.Email, Credentials.CloudFlare.Key)
let! zone = getZoneAsync client
let! records = getRecordsAsync client zone.Id
let! update = updateRecordAsync client zone.Id records
return! decodeResult update
}
It is interfacing with a C# lib that handles all the calls to the CloudFlare API and returns a CloudFlareResult object which has a success flag, a result and an error.
I remapped that type to a Result<'a, string> type:
let decodeResult (r: CloudFlareResult<'a>) =
match r.Success with
| true -> Ok r.Result
| false -> Error r.Errors.[0].Message
And I could write an expression for it (hypothetically since I've been using them but haven't written my own yet), but then I would be happy to have an asyncCloudFlareResult expression, or even an asyncCloudFlareResultOrResult expression, if that makes sense.
I am wondering if there is a mechanism to combine expressions together, the same way FSToolKit does (although I suspect it's just custom code there).
Again, this is a question to learn something, not about the practicality since it would probably add more code than it's worth.
Following Gus' comment, I realized it would be good to illustrate the point with some simpler code:
function DoA : int -> Async<AWSCallResult<int, string>>
function DoB : int -> Async<Result<int, string>>
AWSCallResultAndResult {
let! a = DoA 3
let! b = DoB a
return b
}
in this example I would end up with two types that can take an int and return an error string, but they are different. Both have their expressions so I can chain them as needed.
And the original question is about how these can be combined together.
It's possible to extend CEs with overloads.
The example below makes it possible to use the CustomResult type with a usual result builder.
open FsToolkit.ErrorHandling
type CustomResult<'T, 'TError> =
{ IsError: bool
Error: 'TError
Value: 'T }
type ResultBuilder with
member inline _.Source(result : CustomResult<'T, 'TError>) =
if result.IsError then
Error result.Error
else
Ok result.Value
let computeA () = Ok 42
let computeB () = Ok 23
let computeC () =
{ CustomResult.Error = "oops. This went wrong"
CustomResult.IsError = true
CustomResult.Value = 64 }
let computedResult =
result {
let! a = computeA ()
let! b = computeB ()
let! c = computeC ()
return a + b + c
}
I am trying to write an API on top of a C# library. The C# code has a dictionary from types to values that I would like to represent using immutable data structures.
However, I am having trouble writing the type constraints correctly:
open System
// System.Type cannot be used a map key
// TODO: Is this enough data to form a key?
type ComparableType =
{
AssemblyQualifiedName : string
}
type TypeMap<'t> =
private
| TypeMap of Map<ComparableType, 't>
module TypeMap =
let private innerMap =
function
| TypeMap m -> m
let empty () =
TypeMap Map.empty
// Here is the problem line!
let add<'t, 'v when 'v :> 't> (v : 'v) (m : TypeMap<'t>) =
let t = typeof<'v>
let k =
{
AssemblyQualifiedName = t.AssemblyQualifiedName
}
m
|> innerMap
|> Map.add k (v :> 't)
|> TypeMap
Error:
Invalid constraint: the type used for the constraint is sealed, which means the constraint could only be satisfied by at most one solution
The problem is a limitation of the F# compiler. In this code, it will assume that 'A = 'B:
type T<'A, 'B when 'A :> 'B>() = class end
The work-around is to make the type parameter of TypeMap<'t> concrete. Unfortunately this requires lots of boiler-plate, but it is a solution I can live with:
type FooTypeMap =
private
| FooTypeMap of Map<ComparableType, Foo>
module FooTypeMap =
let private innerMap =
function
| FooTypeMap m -> m
// etc...
There is a request for change here: https://github.com/fsharp/fslang-suggestions/issues/255
See also: https://stackoverflow.com/a/64113104/1256041
I do not think F# can handle a generic constraint like that. Also, it wont let you do a coertion to an undetermined type. Your best bet is to use box v instead of (v :> 't)
Like this:
type ComparableType =
{
AssemblyQualifiedName : string
}
type TypeMap =
private
| TypeMap of Map<ComparableType, obj>
module TypeMap =
let private innerMap =
function
| TypeMap m -> m
let empty () =
TypeMap Map.empty
let inline add (v : 'v) (m : TypeMap) =
let t = typeof< 'v>
let k =
{
AssemblyQualifiedName = t.AssemblyQualifiedName
}
m
|> innerMap
|> Map.add k (box v)
|> TypeMap
let inline get< ^v> (m : TypeMap) : ^v =
let t = typeof<'v>
let k =
{
AssemblyQualifiedName = t.AssemblyQualifiedName
}
(innerMap m).[k]
|> unbox
How to implement a C# Action in F#?
I have the following code in C# code-behind:
public MainWindow()
{
InitializeComponent();
ViewModel = new ViewModel();
DataContext = ViewModel;
}
private void ListView_PreviewMouseLeftButtonUp(object _, MouseButtonEventArgs e)
{
_closeAdorner();
// listView here equals object _
var listView = (ListView)e.Source;
var grid = (Grid)listView.Parent;
var selecteditem = (InnerRow)listView.SelectedItem;
ViewModel.Visit = selecteditem;
ViewModel.LastName = selecteditem.LastName;
var adornerLayer = AdornerLayer.GetAdornerLayer(grid);
if (adornerLayer == null)
throw new ArgumentException("datagrid does not have have an adorner layer");
var adorner = new DataGridAnnotationAdorner(grid);
adornerLayer.Add(adorner);
_closeAdorner = () => adornerLayer.Remove(adorner);
}
I am attempting to translate this into F#:
let handlePreviewMouseLeftButtonUp (obj: obj) (a, c) =
let e = (obj :?> MouseButtonEventArgs)
let listView = e.Source :?> ListView // This is the ListView control that was clicked.
let grid = listView.Parent :?> Grid
let selectedItem = c.InnerRows |> List.filter (fun r -> Some r.Id = c.SelectedInnerRow) |> List.head
let adorner = DataGridAdorner(grid)
let installAdorner =
let adornerLayer = AdornerLayer.GetAdornerLayer(grid)
if (adornerLayer.GetAdorners = []) then adornerLayer.Add(adorner) else adornerLayer.Remove(adorner)
The last line:
if (adornerLayer.GetAdorners = []) then adornerLayer.Add(adorner) else adornerLayer.Remove(adorner)
clearly does not compile and is not correct. How is the C# _closeAdorner written to have the same function in F#?
Thank you.
TIA
I am not sure what _closeAdorner, InnerRow, DataGridAdorner and other elements are. Anyway, here I fixed some (not all) of the syntax issues in your code:
let handlePreviewMouseLeftButtonUp(obj : obj) (e:MouseButtonEventArgs) =
let listView = e.Source :?> ListView // This is the ListView control that was clicked.
let grid = listView.Parent :?> Grid
let selectedItem = listView.SelectedItem :?> InnerRow// |> List.filter (fun r -> Some r.Id = c.SelectedInnerRow) |> List.head
let adorner = DataGridAdorner(grid)
let installAdorner =
let adornerLayer = AdornerLayer.GetAdornerLayer(grid)
if adornerLayer.GetAdorners(grid) = [||] then adornerLayer.Add(adorner) else adornerLayer.Remove(adorner)
()
In your constructor you can add the event handler like this:
listView.MouseUp.AddHandler(MouseButtonEventHandler(handlePreviewMouseLeftButtonUp))
You can also remove it:
listView.MouseUp.RemoveHandler(MouseButtonEventHandler(handlePreviewMouseLeftButtonUp))
To create generic Actions you do it like this:
let action = Action<_,_>(handlePreviewMouseLeftButtonUp)
Where the <_,_> corresponds to the number of parameters the action receives.
I am trying to find let bindings with a specific attribute and type, throughout a given assembly.
For instance, the following type and attribute:
type TargetType = { somedata: string }
type MarkingAttribute() = inherit System.Attribute()
Then I would like to find the value in the following module:
module SomeModule =
[<Marking>]
let valueIWantToFind = {somedata = "yoyo"}
So what I am looking for is a function with the following signature (assuming it is suitable for a generic function signature):
let valuesOfTypeWithAttribute<'t,'attr> (assembly: Assembly) : 't list = ...
My futile attempts seem to be blocked by my lack of understanding how F# modules are translated to CLR (CLI?) classes.
I have the following FSI snippet which unfortunately finds nothing:
open System.Reflection
let types = Assembly.GetExecutingAssembly().GetTypes()
let fiWithAttribute (attributeType: System.Type) (fi: FieldInfo) =
fi.CustomAttributes
|> Seq.exists (fun attr -> attr.AttributeType = attributeType)
let fields =
types
|> Array.collect (fun t -> t.GetFields())
|> Array.filter (fiWithAttribute typeof<MarkingAttribute>)
Any help or pointers will be greatly appreciated.
Modules are compiled as classes with static members. Load your assembly into a value called assembly, and start to investigate:
> let publicTypes = assembly.GetExportedTypes ();;
val publicTypes : System.Type [] =
[|Ploeh.StackOverflow.Q36245870.TargetType;
Ploeh.StackOverflow.Q36245870.MarkingAttribute;
Ploeh.StackOverflow.Q36245870.SomeModule|]
As you can tell, SomeModule is one of those types:
> let someModule =
publicTypes |> Array.find (fun t -> t.Name.EndsWith "SomeModule");;
val someModule : System.Type = Ploeh.StackOverflow.Q36245870.SomeModule
You can now get all members of the type:
> let members = someModule.GetMembers ();;
val members : MemberInfo [] =
[|Ploeh.StackOverflow.Q36245870.TargetType get_valueIWantToFind();
System.String ToString(); Boolean Equals(System.Object);
Int32 GetHashCode(); System.Type GetType();
Ploeh.StackOverflow.Q36245870.TargetType valueIWantToFind|]
This array includes the let-bound function valueIWantToFind, and it has the desired attribute:
> let attrs = members.[5].GetCustomAttributes ();;
val attrs : System.Collections.Generic.IEnumerable<System.Attribute> =
[|Ploeh.StackOverflow.Q36245870.MarkingAttribute;
Microsoft.FSharp.Core.CompilationMappingAttribute|]
Mark's response led me onto the path of success. The reflection does not work for modules defined entirely in FSI (at least not for me in my setup).
The function I came up with looks like this:
open Microsoft.FSharp.Reflection
let letBindingsWithTypeAndAttribute<'t,'attr> (assembly: Assembly) : 't array =
let publicTypes = assembly.GetExportedTypes ()
let modules = publicTypes |> Array.filter FSharpType.IsModule
let members = modules |> Array.collect (fun m -> m.GetMembers ())
let miHasAttribute (mi : MemberInfo) =
mi.GetCustomAttributes ()
|> Seq.exists (fun attr' -> attr'.GetType() = typeof<'attr>)
let withAttr =
members
|> Array.filter miHasAttribute
let valueOfBinding (mi : MemberInfo) =
let property = mi.Name
mi.DeclaringType.GetProperty(property).GetValue null
withAttr
|> Array.map valueOfBinding
|> Array.choose (fun o -> match o with
| :? 't as x -> Some x
| _ -> None)
Not sure if I got this right or whether there's a better way or an existing library solving this problem already.
In particular I'm not sure if the CAS would need a memory fence... I think not but better ask.
I also tried with an agent and mutable dictionary but my intuition that it would be slower was confirmed and the implementation was more involved.
module CAS =
open System.Threading
let create (value: 'T) =
let cell = ref value
let get () = !cell
let rec swap f =
let before = get()
let newValue = f before
match Interlocked.CompareExchange<'T>(cell, newValue, before) with
| result when obj.ReferenceEquals(before, result) ->
newValue
| _ ->
swap f
get, swap
module Memoization =
let timeToLive milis f =
let get, swap = CAS.create Map.empty
let evict key =
async {
do! Async.Sleep milis
swap (Map.remove key) |> ignore
} |> Async.Start
fun key ->
let data = get()
match data.TryFind key with
| Some v -> v
| None ->
let v = f key
swap (Map.add key v) |> ignore
evict key
v
If you are willing to limit what to memoize to functions that take a string input, you can reuse the functionality from System.Runtime.Caching.
This should be reasonably robust as part of the core library (you would hope...) but the string limitation is a pretty heavy one and you'd have to benchmark against your current implementation if you want to do a comparison on performance.
open System
open System.Runtime.Caching
type Cached<'a>(func : string -> 'a, cache : IDisposable) =
member x.Func : string -> 'a = func
interface IDisposable with
member x.Dispose () =
cache.Dispose ()
let cache timespan (func : string -> 'a) =
let cache = new MemoryCache(typeof<'a>.FullName)
let newFunc parameter =
match cache.Get(parameter) with
| null ->
let result = func parameter
let ci = CacheItem(parameter, result :> obj)
let cip = CacheItemPolicy()
cip.AbsoluteExpiration <- DateTimeOffset(DateTime.UtcNow + timespan)
cip.SlidingExpiration <- TimeSpan.Zero
cache.Add(ci, cip) |> ignore
result
| result ->
(result :?> 'a)
new Cached<'a>(newFunc, cache)
let cacheAsync timespan (func : string -> Async<'a>) =
let cache = new MemoryCache(typeof<'a>.FullName)
let newFunc parameter =
match cache.Get(parameter) with
| null ->
async {
let! result = func parameter
let ci = CacheItem(parameter, result :> obj)
let cip = CacheItemPolicy()
cip.AbsoluteExpiration <- DateTimeOffset(DateTime.UtcNow + timespan)
cip.SlidingExpiration <- TimeSpan.Zero
cache.Add(ci, cip) |> ignore
return result
}
| result ->
async { return (result :?> 'a) }
new Cached<Async<'a>>(newFunc, cache)
Usage:
let getStuff =
let cached = cacheAsync (TimeSpan(0, 0, 5)) uncachedGetStuff
// deal with the fact that the cache is IDisposable here
// however is appropriate...
cached.Func
If you're never interested in accessing the underlying cache directly you can obviously just return a new function with the same signature of the old - but given the cache is IDisposable, that seemed unwise.
I think in many ways I prefer your solution, but when I faced a similar problem I had a perverse thought that I should really use the built in stuff if I could.