How to implement Props.Create using F# - f#

I attempted to port a working C# sample to an OOP version of F#.
Remote actors (on a separate process) are not receiving messages.
I receive the following error:
[ERROR][3/23/2017 4:39:10 PM][Thread 0008][[akka://system2/system/endpointManage
r/reliableEndpointWriter-akka.tcp%3A%2F%2Fsystem1%40localhost%3A8090-1/endpointW
riter#1919547364]] AssociationError [akka.tcp://system2#localhost:8080] <- akka.
tcp://system1#localhost:8090: Error [Object reference not set to an instance of
an object.] [ at Akka.Serialization.Serialization.FindSerializerForType(Type o
bjectType)
at Akka.Remote.Serialization.DaemonMsgCreateSerializer.GetArgs(DaemonMsgCreat
eData proto)
at Akka.Remote.Serialization.DaemonMsgCreateSerializer.FromBinary(Byte[] byte
s, Type type)
at Akka.Serialization.Serialization.Deserialize(Byte[] bytes, Int32 serialize
rId, String manifest)
Here's the working C# version:
using (var system = ActorSystem.Create("system1", config))
{
var reply = system.ActorOf<ReplyActor>("reply");
//create a remote deployed actor
var remote1 = system.ActorOf(Props.Create(() => new SomeActor()).WithRouter(FromConfig.Instance), "remoteactor1");
var remote2 = system.ActorOf(Props.Create(() => new SomeActor()).WithRouter(FromConfig.Instance), "remoteactor2");
var remote3 = system.ActorOf(Props.Create(() => new SomeActor()).WithRouter(FromConfig.Instance), "remoteactor3");
var hashGroup = system.ActorOf(Props.Empty.WithRouter(new ConsistentHashingGroup(config)));
Task.Delay(500).Wait();
var routee1 = Routee.FromActorRef(remote1);
hashGroup.Tell(new AddRoutee(routee1));
var routee2 = Routee.FromActorRef(remote2);
hashGroup.Tell(new AddRoutee(routee2));
var routee3 = Routee.FromActorRef(remote3);
hashGroup.Tell(new AddRoutee(routee3));
Task.Delay(500).Wait();
for (var i = 0; i < 5; i++)
{
for (var j = 0; j < 7; j++)
{
var message = new SomeMessage(j, $"remote message: {j}");
hashGroup.Tell(message, reply);
}
}
Console.ReadLine();
}
Here's the port to F# using OOP:
use system = ActorSystem.Create("system1", config)
let reply = system.ActorOf<ReplyActor>("reply")
let props1 = Props.Create(fun () -> SomeActor() :> obj)
let props2 = Props.Create(fun () -> SomeActor() :> obj)
let props3 = Props.Create(fun () -> SomeActor() :> obj)
let remote1 = system.ActorOf(props1.WithRouter(FromConfig.Instance), "remoteactor1")
let remote2 = system.ActorOf(props2.WithRouter(FromConfig.Instance), "remoteactor2")
let remote3 = system.ActorOf(props3.WithRouter(FromConfig.Instance), "remoteactor3")
let hashGroup = system.ActorOf(Props.Empty.WithRouter(ConsistentHashingGroup(config)))
Task.Delay(500).Wait();
let routee1 = Routee.FromActorRef(remote1);
hashGroup.Tell(new AddRoutee(routee1));
let routee2 = Routee.FromActorRef(remote2);
hashGroup.Tell(new AddRoutee(routee2));
let routee3 = Routee.FromActorRef(remote3);
hashGroup.Tell(new AddRoutee(routee3));
Task.Delay(500).Wait();
for i = 0 to 5 do
for j = 0 to 7 do
let message = new HashMessage(j, sprintf "remote message: %i" j);
hashGroup.Tell(message, reply);
Console.ReadLine() |> ignore
Question:
Am I suppose to upcast SomeActor to the object type when invoking the Props.Create method?
let props1 = Props.Create(fun () -> SomeActor() :> obj)
let props2 = Props.Create(fun () -> SomeActor() :> obj)
let props3 = Props.Create(fun () -> SomeActor() :> obj)
The code above is the only difference that I'm aware of.
The only other difference is the tcp path.
C#'s TCP:
remote {
dot-netty.tcp {
port = 8090
hostname = localhost
}
F#'s TCP:
remote {
helios.tcp {
port = 8090
hostname = localhost
}

Props object is a descriptor for the creation process of target actor. Moreover, it must be serializable, as sometimes it may get included on messages passed through the network.
In order to work this way Props internally describes actor construction in form of (actor-type, actor-constructor-arguments). Props.Create(() => new Actor()) is only a helper here: what it actually does, is deconstruct the constructor expression into type info with arguments. This is why it works only with new Actor() expressions.
The problem with your F# code is that you're defining actor creation as a F# function, which props deconstructor doesn't know how to handle. You may still want create your actors using:
Props.Create(typeof<Actor>, [| arg1; arg2 |])
but then you need to keep the correctness of the constructor params by yourself. You can also use i.e. Akkling with it's typed version of props.

Related

how can I combine / compose computation expressions, in F#?

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
}

How is the C# Delegate Action written in F#?

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.

F# SqlProvider fails to update changes in a dBase DBF file with ODBC connection

I have the following F# code
open FSharp.Data.Sql
open FSharp.Data.Sql.Runtime
open System.IO
[<Literal>]
let private schemaConn = #"Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=C:\Citect\User\NPM;"
type private schema = SqlDataProvider<Common.DatabaseProviderTypes.ODBC, schemaConn>
let private connStringFormat = Printf.StringFormat<string->string>(#"Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=%s;")
type internal Project = {
name : string
path : string
dcx : schema.dataContext
}
[<Literal>]
let private cUserPath = #"C:\Citect\User"
let private findPath projectName =
Directory.GetDirectories(cUserPath, projectName, SearchOption.AllDirectories)
|> Array.find (fun d -> d.Contains("web") |> not)
let internal connect projectName =
let path' = findPath projectName
let connString = sprintf connStringFormat path'
let dcx' = schema.GetDataContext(connString)
{ name = projectName; path = path'; dcx = dcx' }
let internal updVariable (project : Project) variable =
let dcx = project.dcx
let q = query {
for v in dcx.Dbo.Variable do
where (v.Addr = "%MW217.0")
select v
exactlyOne
}
q.Addr <- "QQQ"
dcx.SubmitUpdates() //error
let internal prj = connect "NPMUG_SCC35"
updVariable prj ()
Connection and query work as expected, but when I try to update the data source I get the following error coming from the odbc driver:
Message -> ERROR [HY092] [Microsoft][ODBC dBase Driver]Invalid
attribute/option identifier Source -> odbcjt32.dll
Is there a way to get it working or do I need to give up the type provider and resort back to OleDb?
UPDATE
Disabling transactions makes things a little better, now the error is due to the missing primary key in the dbf files I have to work with.
The only code changed is getting the data context
let dcx = schema.GetDataContext( { Timeout = TimeSpan.MaxValue; IsolationLevel = Transactions.IsolationLevel.DontCreateTransaction } : FSharp.Data.Sql.Transactions.TransactionOptions)
And the new error is:
System.Exception: Error - you cannot update an entity that does not
have a primary key. (dbo.variable) at
FSharp.Data.Sql.Providers.OdbcProvider.createUpdateCommand(IDbConnection
con, StringBuilder sb, SqlEntity entity, FSharpList`1 changedColumns)
at .$Providers.Odbc.FSharp-Data-Sql-Common-ISqlProvider-ProcessUpdates#648-4.Invoke(SqlEntity
e) at
Microsoft.FSharp.Collections.SeqModule.Iterate[T](FSharpFunc2 action,
IEnumerable1 source) at
FSharp.Data.Sql.Providers.OdbcProvider.FSharp-Data-Sql-Common-ISqlProvider-ProcessUpdates(IDbConnection
con, ConcurrentDictionary2 entities, TransactionOptions
transactionOptions, FSharpOption1 timeout) at
.$SqlRuntime.DataContext.f#1-69(SqlDataContext
__, IDbConnection con, Unit unitVar0) at FSharp.Data.Sql.Runtime.SqlDataContext.FSharp-Data-Sql-Common-ISqlDataContext-SubmitPendingChanges()
Any idea on how to deal with this probem?
I found a tricky/dirty way that I would classify more as a workaround than a real solution, but it works in my case; so I am going to use it unless/until someone else suggests a conclusive one.
To get the type provider working I need to do 2 things not in the usual workflow:
The data context needs to be retrieved with transactions disabled
Before performing changing operations on a DBF, I create a primary
key on that DBF using a lower level SQL statement
Here the working code
[<Literal>]
let private schemaConn = #"Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=C:\Citect\User\NPM;READONLY=FALSE"
type private schema = SqlDataProvider<Common.DatabaseProviderTypes.ODBC, schemaConn>
let private connStringFormat = Printf.StringFormat<string->string>(#"Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=%s;READONLY=FALSE")
type internal Project = {
name : string
path : string
dcx : schema.dataContext
}
[<Literal>]
let private cUserPath = #"C:\Citect\User"
let private findPath projectName =
Directory.GetDirectories(cUserPath, projectName, SearchOption.AllDirectories)
|> Array.find (fun d -> d.Contains("web") |> not)
let private createPK (cn : IDbConnection) =
let cm = cn.CreateCommand()
cm.CommandText <- "ALTER TABLE Variable ADD PRIMARY KEY (Name)"
try
cn.Open()
cm.ExecuteNonQuery() |> ignore
finally cn.Close()
let internal connect projectName =
let path' = findPath projectName
let connString = sprintf connStringFormat path'
let transOptions = { Timeout = TimeSpan.FromSeconds(3.0); IsolationLevel = Transactions.IsolationLevel.DontCreateTransaction }
let dcx' = schema.GetDataContext(connectionString = connString, transactionOptions = transOptions)
dcx'.CreateConnection() |> createPK
{ name = projectName; path = path'; dcx = dcx' }
let internal updVariable (project : Project) variable =
let dcx = project.dcx
let q = query {
for v in dcx.Dbo.Variable do
where (v.Addr = "%MW217.0")
select v
exactlyOne
}
q.Addr <- "QQQ"
dcx.SubmitUpdates()
let internal prj = connect "NPMUG_SCC35"
updVariable prj ()

Assigning Property values using System.Reflection in F#

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))

Time to live memoization in F#

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.

Resources