Fork me on GitHub

Background

As I usually do every Sunday, I skim through Sergeys F# Weekly just to see if there are anything interesting happening in the F# Community.

This week I found Lucas Reis’ blog post really well written, educational and didactic, specially the visualization of final state machine representation.

What seem to tingle a bit my OCD was the implementation of the EventStore:

1
2
3
4
5
6
7
8
9
type EventStore() =
    let eventList =
        new ResizeArray<String * ScoutEvent>()
            
    member this.Save(name, events) =
        events |> List.iter (fun e -> eventList.Add(name, e))
                        
    member this.Get() =
        eventList

Problem by introducing OO data structures into F# (or OCaml)

As Lucas mention, you can just declare a type with () and define it’s members, and then you have a new data structure in F#. As with Lucas EventStore, I will point out the main issue by taking this approach. If we look into MSDN, we can see that ResizeArray is just a type abbreviation for a generic .NET list:

type ResizeArray<'T> = System.Collections.Generic.List<'T>

So my example will also made by using the built-in ResizeArray data structure:

1
2
3
4
let xs = new ResizeArray<int>()
    
Array.Parallel.init 1000 (fun i -> xs.Add i) |> ignore
xs |> Seq.reduce(fun x y -> x + y)

We can see that the final reduced sum is a non-deterministic as well as incorrect result:

> val it : int = 991456
> val it : int = 1490956
> val it : int = 1990456

So why is this happening? Well if you are used to work with the .NET platform, you might as well (if you actually read the documentation on MSDN) have seen the following text on the bottom of almost every Class definition, under the Thread Safety sections:

Public static (Shared in Visual Basic) members of this type are thread safe. Any instance members are not guaranteed to be thread safe.

The main point here is that .NET collections are not immutable and therefore don’t fit well with the functional paradigm that F# is mainly built-on, even though it has support for other paradigms as imperative and OO.

Build your data structures the right way

Is there a way to solve this self inflicted problem? Yes, we can create constrained types in F#, see Scott Wlaschin Gist in the References below for more information, where you can avoid exposing types from a module. They are accessible from inside the module, but not from code importing the module.

With this in mind, I will create an immutable array like this:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
module Immutable =
    type 'a iarray = private | T of 'a array with
        override ia.ToString() =
            ia |> function | T xs -> xs |> sprintf "%A"
            
    module Array =
        let init n f =
            Array.Parallel.init n f |> T
        let map f (T xs) =
            xs |> Array.Parallel.map f |> T
        let iter f (T xs) =
            xs |> Array.iter f
        let reduce f (T xs) =
            xs |> Array.reduce f
        let fold init f (T xs) =
            xs |> Array.fold f init
        let length (T xs) = xs |> Array.length
        let at i (T xs as ixs) =
            if i < 0 || i >= (length ixs) then
                failwith (sprintf "index: %i is out of boundries." i)
            else
                xs.[i]
        let append (T xs) (T ys) =
            Array.append xs ys |> T
                
        module Extra =
            let add x (T xs) =
                Array.append xs [| x |] |> T
            let pop (T xs as ixs) = length ixs |> function
                | 0 -> failwith "the array is empty."
                | 1 -> [|         |] |> T
                | n -> xs.[0 .. n-2] |> T

where the 'a iarray is visible from outside, while the single-case union constructor T is marked as private | T of 'a array therefore it can only be accessed from inside the module (and sub modules).

As you can see in the sub (and sub sub) modules, I’m just extracting the standard (and mutable) array type from the single-case union constructor and then using the built-in functions to perform the desired logic.

If you look carefully, I’m never exposing the underlying and mutable array, therefore, as I don’t allow any external piece of code to instantiate my type iarray unless it’s by using the init function, I can therefore argue that my data structure is sound to be used as an immutable F# data structure as the native built-in would be used.

ResizeArray vs iarray

Snippets:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
let foobar =
    Array.Parallel.init 1000 id
    |> Array.reduce(fun x y -> x + y)

let foo =
    let xs = new ResizeArray<int>()
    
    Array.Parallel.init 1000 (fun i -> xs.Add i) |> ignore
    xs |> Seq.reduce(fun x y -> x + y)

let bar =
    let xs = Immutable.Array.init 0 id
    
    Array.Parallel.init 1000 (fun i -> xs |> Immutable.Array.Extra.add i)
    |> Array.reduce(fun x y -> Immutable.Array.append x y)
    |> Immutable.Array.reduce (fun x y -> x + y)

Output:

>
val foobar : int = 499500
val foo : int = 304641
val bar : int = 499500

Functor modules as in OCaml

In my current implementation of iarray my additions to the array are in linear time, as a new array +1 needs to be allocated on another spot in memory, while my indexed access still is in constant time. So in the case that I was using this data structure for a lot of reads but very few inserts, it would be ideal, but what about if I had a lot of inserts but very few reads? Or what if I had more or less fifty/fifty on reads and writes? Well, in the case that I had a lot of writes and few reads, I would have used a standard built in list as the underlying data structure due to constant addition and linear reads while in the case where I had fifty/fifty reads and writes I would probably go for a balanced tree, logarithmic reads and writes. In all these cases, I would actually have to create new and separated modules for each of the approaches I mention.

Therefore it would be really nice if F# could port the Functor modules from OCaml as it would allow us to change the underlying datastructures inside a module.

I’ve POC an approach where I used records as modules, as you can see in the References, but it’s very hackerish and doesn’t really gets the job done …

Conclusion:

I think it’s a change of the mindset that you need to do when your are coding with functional programming languages that are multi-paradigm, as you will be able to do things the way you are used to do, in an OO way, but that might not always be the appropriate approach.

References:

F* Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
module FstarList (* Don't use Fstar as module name *)

(* If used in type refinements, you must specify return effects, Ex: "Tot".
  But always use the most precise type as it possible *)
val length : xs:list 'a -> Tot (r:int{r >= 0})
let rec length xs = match xs with
  | [   ] -> 0
  | x::xs -> 1 + length xs

(* Only two branches in pattern matching are needed. _,[] and [],_
  are not neccesary *)
val zip : 
    xs:list 'a -> 
    ys:list 'b {length xs = length ys} -> 
    Tot (r:list ('a * 'b) {length r = length xs && length r = length ys})
let rec zip xs ys = match xs,ys with
  | [   ],[   ] -> []
  | x::xs,y::ys -> (x,y) :: zip xs ys

F* Code output:

Verifying module: FStar.FunctionalExtensionality
Verifying module: FStar.Set 
Verifying module: FStar.Heap 
Verifying module: FStar.ST 
Verifying module: FStar.All 
Verifying module: Welcome 
All verification conditions discharged successfully

F# Code Snippet

1
2
3
4
5
6
7
8
9
let rec zip xs ys = (xs,ys) |> function
  | [   ],[   ] -> []
  | _____,[   ] -> failwith "xs and ys aren't of same length"
  | [   ],_____ -> failwith "xs and ys aren't of same length"
  | x::xs,y::ys -> (x,y) :: zip xs ys

(* Note: | _____,[   ] | [   ],_____ -> failwith "..." isn't supported *)

let r = zip [1 .. 10] ['a' .. 'z']

F# Code output:

> 
System.Exception: xs and ys aren't of same length
  at Microsoft.FSharp.Core.Operators.FailWith[T](String message)
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at FSI_0004.zip[a,b](FSharpList`1 xs, FSharpList`1 ys) in C:\tmp\zip.fsx:line 5
  at <StartupCode$FSI_0005>.$FSI_0005.main@() in C:\tmp\zip.fsx:line 9
Stopped due to error

References:

Background

This is the second part on how to delete accounts. In this blog post we will explain why we also exposed CRUD request on our CrmData module.

We also moved the repetitive code (Client SDK and Proxy) to a Helper script file DG.Delegate.HowToDaxif.DataManagement.Helper.fsx

Delete all accounts

As mentioned above, we just moved a few function to another file and created a prime version of the script we used in the previous blog post DG.Delegate.HowToDaxif.DataManagement.Prime.fsx.

It’s only the second step that we changed:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
// 2) Delete all entities from query (with ExecuteMultiple and parallelism)
accounts ()
|> hlp.Seq.split (10*1000)
|> Seq.iter(fun xs -> 
  printfn "- Chunks of 10.000"
  xs 
  |> Array.Parallel.map(fun e -> CRUD.deleteReq e.LogicalName e.Id)
  |> Array.toSeq
  // ExecuteMultiple - Run-time limitations:
  // https://msdn.microsoft.com/en-us/library/jj863631.aspx#limitations
  |> hlp.Seq.split 1000 
  |> Seq.toArray
  |> Array.Parallel.map (fun dreqs ->
      let orc = new OrganizationRequestCollection()

      dreqs // OrganizationRequestCollection is not thread-safe
      |> Array.iter (fun x -> orc.Add(x))

      let emreqs = new ExecuteMultipleRequest()
      emreqs.Settings <- new ExecuteMultipleSettings()
      emreqs.Settings.ContinueOnError <- true
      emreqs.Settings.ReturnResponses <- true
      emreqs.Requests <- orc
      emreqs, dreqs)
  |> Array.Parallel.map (fun (emreqs, dreqs) -> 
      try 
        (hlp.proxy().Execute(emreqs) :?> ExecuteMultipleResponse, dreqs) |> Some
      with ex -> 
        Console.Error.WriteLine(sprintf "* Proxy execute: %s" ex.Message); None)
  |> Array.Parallel.choose (id)
  |> Array.Parallel.iter (fun (emresps, _) -> 
      emresps.Responses
      |> Seq.toArray
      |> Array.Parallel.iter(fun kv ->
        match kv.Fault with
          | null -> ()
          | fault ->
            Console.Error.WriteLine(
              sprintf "  --Execute multiple: %s" fault.Message))))

If we now run the two deletion script for comparison, we can see that they have similar performance, due to the size of data:

Note: There is a limitations on MS CRM Online (only two ExecuteMultiple can be executed at the same time.

Output from evaluating script from part 1:

> #time;;

--> Timing now on

> 
Chunks of 1000
Chunks of 1000
Real: 00:00:57.960, CPU: 00:00:08.109, GC gen0: 2, gen1: 0, gen2: 0
val it : unit = ()
> 

Output from evaluating script from part 2:

> #time;;

--> Timing now on

> 
- Chunks of 10.000
Real: 00:00:55.922, CPU: 00:00:00.187, GC gen0: 0, gen1: 0, gen2: 0
val it : unit = ()
> 

Bonus

While I was writing this blogpost, we got the following question: “We have a question about timezones. It seems like there is no way to set up a default timezone that will be used when new users are added to CRM. Do you know of a way that we can set up a timezone that gets used for each user without having to edit them individually?

We provided the following answers:

  • Post plug-in added on the SystemUser Create event: You can hook up an event that sets the time zone when a new users is added (you will have to find the related UserSettings created by the kernel). Downside is that this approach only work with new created SystemUsers.

  • As Microsoft have bought AdxStudio, they are slowly moving all the fancy PowerShell scripts from their ALM Toolkit to Microsoft Xrm Data Powershell library (which is nice). Here is an example on how to update a System Users settings: UpdateCrmUsersSettings.ps1

  • Last but not least, you could use Daxif (now it’s open source) and run the following F# script when a user is created and also on some time frequency, to ensure that users are using the time zone that you specify:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
let timeZoneCode () =
  CRUD.retrieve 
    (hlp.proxy())
    target.Metadata.TimeZoneDefinition.``(LogicalName)``
    target.Records.TimeZoneDefinition.``(GMT+01:00) Brussels, Copenhagen, Madrid, Paris``
  |> fun e -> e.Attributes.[target.Metadata.TimeZoneDefinition.TimeZoneCode]

target.Records.SystemUser.``(All Records)``
|> Array.filter(fun guid -> guid <> target.Records.SystemUser.SYSTEM)
|> Array.filter(fun guid -> guid <> target.Records.SystemUser.INTEGRATION)
|> Array.Parallel.map(
  fun guid ->
    try
      let e = new Entity(entityName = target.Metadata.UserSettings.``(LogicalName)``)
      e.Id <- guid
      e.Attributes.Add(target.Metadata.UserSettings.TimeZoneCode,timeZoneCode())
      CRUD.update (hlp.proxy()) e |> Choice1Of2
    with ex -> ex |> Choice2Of2)

(semi-type safe approach which is readable and generic for all MS CRM instances)

More info:

References:

Updated

Based on feedback from Joakim, fellow co-founder of the F#unctional Copenhageners Meetup Group - MF#K, in order to be a functor it must define a map function with the follwoing signature map: (‘a -> ‘b) -> ‘a t -> ‘b t. For more info, see References Defining Functors in Scala.

Code Snippet:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
type ('a,'b) Set =
  private
    { empty: 'a t
      add: 'a -> 'a t -> 'a t
      exists: 'a -> 'a t -> bool
      map: ('a -> 'b) -> 'a t -> 'b t }
  member x.Empty = x.empty
  member x.Add y ys = x.add y ys
  member x.Exists y ys = x.exists y ys
  member x.Map f ys = x.map f ys
  static member Functor (orderType) : Set<'a,'b> =
    { empty = { t = Nil }
      add = fun x xs ->
        let rec add y = function
        | Nil         -> Cons(y,Nil)
        | Cons(hd,tl) ->
          match orderType.compare y hd with
          | Less -> Cons(x,xs.t)
          | Equal -> xs.t
          | Greater -> Cons(hd,add y tl)
        { t = add x xs.t }
      exists = fun x xs ->
        let rec exists y = function
        | Nil -> false
        | Cons(hd,tl) ->
          match orderType.compare y hd with
          | Less -> false
          | Equal -> true
          | Greater -> exists y tl
        exists x xs.t
      map = fun f xs -> 
        let rec map = function
        | Nil -> Nil
        | Cons(hd,tl) -> Cons(f hd, map tl)
        { t = map xs.t } }
and ('a) t = private { t : 'a s }
and ('a) s = private Cons of 'a * 'a s | Nil
and ('a) OrderType = { compare: 'a -> 'a -> Comparison }
and Comparison = Less | Equal | Greater

Code output:

> 
type ('a,'b) Set =
  private {empty: 'a t;
           add: 'a -> 'a t -> 'a t;
           exists: 'a -> 'a t -> bool;
           map: ('a -> 'b) -> 'a t -> 'b t;}
  with
    member Add : y:'a -> ys:'a t -> 'a t
    member Exists : y:'a -> ys:'a t -> bool
    member Map : f:('a -> 'b) -> ys:'a t -> 'b t
    member Empty : 'a t
    static member Functor : orderType:'a OrderType -> ('a,'b) Set
  end
and 'a t =
  private {t: 'a s;}
and 'a s =
  private | Cons of 'a * 'a s
          | Nil
and 'a OrderType =
  {compare: 'a -> 'a -> Comparison;}
and Comparison =
  | Less
  | Equal
  | Greater

Code Snippet:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
let set () =
  Set<_,_>.Functor
    { compare = fun x y ->
        if x = y then
          Equal
        else if x < y then
          Less
        else
          Greater }

let stringSet =
  set().Empty
  |> set().Add "42"
  |> set().Add "43"

stringSet |> set().Exists "42"
stringSet |> set().Exists "43"
stringSet |> set().Exists "84"
stringSet |> set().Exists "86"

let intSet =
  stringSet
  |> set().Map (fun x -> int x)
  |> set().Map (fun x -> x + x)

intSet |> set().Exists 42
intSet |> set().Exists 43
intSet |> set().Exists 84
intSet |> set().Exists 86

let floatSet =
  intSet
  |> set().Map (fun x -> float x)

floatSet |> set().Exists 42.
floatSet |> set().Exists 43.
floatSet |> set().Exists 84.
floatSet |> set().Exists 86.

Code output:

> 
val set : unit -> ('a,'b) Set when 'a : comparison

> 
val stringSet : string t

> val it : bool = true
> val it : bool = true
> val it : bool = false
> val it : bool = false
 
> 
val intSet : int t

> val it : bool = false
> val it : bool = false
> val it : bool = true
> val it : bool = true
 
> 
val floatSet : float t

> val it : bool = false
> val it : bool = false
> val it : bool = true
> val it : bool = true

References:

Code Snippet

1
2
3
4
5
6
7
8
9
10
11
let leftpad s n c =
  let l = s |> String.length // string length from O(N) to O(1)
  let c' = match c with | None -> "." | Some v -> v
  match l <= n with
    | true -> String.replicate (n-l) c' + s
    | false -> s

leftpad "foo" 6 None
leftpad "foo" 3 None
leftpad "fooBar" 3 None
leftpad "foo" 6 (Some "?")

Code output:

> 
val leftpad : s:string -> n:int -> c:string option -> string

> val it : string = "...foo"
> val it : string = "foo"
> val it : string = "fooBar"
> val it : string = "???foo"

References: