Fork me on GitHub

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:

1
2
3
4
5
6
7
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:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
> 
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:

1
2
3
4
5
6
7
> 
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:

Code Snippet: index.html

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
<!DOCTYPE html>
<html>
  <head>
    <meta charset="UTF-8">
    <title>Main</title>
    <style>
      html,head,body { padding:0; margin:0; }
      body { font-family: calibri, helvetica, arial, sans-serif; }
    </style>
    <script src="elm.min.js" type="text/javascript">
    </script>
  </head>
  <body>
    <script type="text/javascript">
      Elm.fullscreen(
        Elm.Main,
        { queryString: window.location.search });
    </script>
  </body>
</html>

Code Snippet: Main.elm

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
module Main (..) where

import Html exposing (text)
import ParseModel exposing (Model,parse,update, view)
import Html exposing (Html)
import StartApp.Simple exposing (start)

main : Signal Html.Html
main =
 start
 { model = parse queryString -- 0
 , update = update
 , view = view
 }

port queryString : String

Code Snippet: src/ParseModel.elm

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
module ParseModel where

import List exposing (filter,head)
import Maybe exposing (withDefault)
import String exposing (dropLeft,split,startsWith,toInt)

import Html exposing (..)
import Html.Attributes exposing (href,style)
import Html.Events exposing (onClick)
import Http exposing (url)

-- MODEL
type alias Model = Int

-- UPDATE
type Action = Increment | Decrement
update : Action -> Model -> Model
update action model =
  case action of
    Increment ->
      model + 1
    Decrement ->
      model - 1

-- VIEW
view : Signal.Address Action -> Model -> Html
view address model =
  div []
    [ button [ onClick address Decrement ] [ text "-" ]
    , state model
    , button [ onClick address Increment ] [ text "+" ]
    ]

-- INITIAL STATE
query2model : String -> String
query2model s =
  withDefault "?foo=" (Just s)
    |> dropLeft 1 -- drop '?'
    |> split "&"
    |> filter (\term -> startsWith "foo=" term)
    |> head
    |> withDefault "foo=0"
    |> dropLeft 4 -- drop 'foo='
       
parse : String -> Int
parse s =
  case query2model s |> toInt of
    Err msg -> Debug.crash msg
    Ok  val -> val
  
-- SAVE STATE
linkToApp model =
  a [ "/assets/apps/elm/counterState/index.html?foo=" ++ (toString model) |> href ]
    [ toString model |> text ]

content link =
  div [ ]
    [ text ""
    , link
    ]

state model =
  div [countStyle] [ linkToApp model |> content ]

-- CSS
countStyle : Attribute
countStyle =
  style
    [ ("font-size", "20px")
    , ("font-family", "monospace")
    , ("display", "inline-block")
    , ("width", "50px")
    , ("text-align", "center")
    ]

Build Snippet: build.bash

#!/bin/bash

# ensure latest packages are downloaded
elm-package install --yes

# only create the .js as we will rely on a custom html file (port)
elm-make Main.elm --output elm.js --yes

# make elm js as small as possible
./.misc/jsmin/jsmin < elm.js > elm.min.js

Code output:

References: