Fork me on GitHub

MVC + Agents (MailboxProcessor) + Immutable Model

All

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
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
open System
open System.Drawing
open System.Windows.Forms

type Agent<'a> = MailboxProcessor<'a>

module Utils =
let doEvents () = Application.DoEvents()

module Model =
type ('a) Model = { state: 'a; events: 'a list }
// Add functions here to load/persist state and events

module View =
// Main form
let title = @"Time Traveling Debugger"
let width,height = 1024,768
let form =
new Form(
Visible=true, TopMost=true, ClientSize=Size(width,height),
MaximizeBox=false, FormBorderStyle=FormBorderStyle.FixedDialog,Text=title)
let canvas = new Rectangle(0, 0, width, height)
form.Paint.Add(fun e -> e.Graphics.FillRectangle(Brushes.Black, canvas))

// Time Traveling Debugger
let debug = new TrackBar()
debug.Location <- Point(0,height - 100)
debug.TickStyle <- TickStyle.Both
debug.AutoSize <- false
debug.Width <- width
debug.Height <- 100
debug.Minimum <- 0
debug.Maximum <- 0
debug.Value <- 0
form.Controls.Add(debug)

// Time Traveling Debugger info text
let debugText = new Label()
debugText.Location <- Point(0, 50)
debugText.Width <- width
debugText.TextAlign <- ContentAlignment.MiddleCenter
debug.Controls.Add(debugText)

// Update functions "hardcoded" to above formular and formular controls
let updateTitle point = form.Text <- sprintf "%s: %A" title point
let updateCanvas p1 p2 =
let prev = new Rectangle(fst p1, snd p1, 30, 30)
form.Paint.Add(fun e -> e.Graphics.FillRectangle(Brushes.Black, prev))
let next = new Rectangle(fst p2, snd p2, 30, 30)
form.Paint.Add(fun e -> e.Graphics.FillRectangle(Brushes.LimeGreen, next))
form.Invalidate(next)
form.Invalidate(prev)
let updateDebug n =
debug.Maximum <- n
debug.Value <- n
let updateDebugText n s p =
debugText.Text <- sprintf "Nr. events: %i\nDebug step: %i %A" (n+1) (s+1) p

module Controller =
open Model
open View

type Action = | Event of Event | Debug of Debug
and Event = int * int
and Debug = int

// By using Agents, the model stays inmutable
let agent = Agent.Start(fun inbox ->
let rec loop model = async {
let! msg = inbox.Receive()
match msg with
| Event(point) ->
let model' = { model with state = point; events = point::model.events }
let n = (model'.events |> List.length) - 1
updateTitle model'.state
updateCanvas model.state model'.state
updateDebug n
updateDebugText n n point
return! loop model'
| Debug(index) ->
let n = (model.events |> List.length) - 1
let point = model.events |> List.skip (n-index) |> List.head
let model' = { model with state = point }
updateTitle model'.state
updateCanvas model.state model'.state
updateDebugText n index point
return! loop model' }
loop { Model.state = (0,0); events = [] })

// Hook-up model events
form.MouseClick
|> Event.add (fun e -> agent.Post (Action.Event(e.X,e.Y)))

// Hook-up Time Traveling Debugger events
debug.Scroll
|> Event.add(fun _ -> agent.Post (Action.Debug(debug.Value)))

// Program event loop, not to use with F# Interactive (FsiAnyCpu)
open Utils
open View

let rec main = function | true -> doEvents(); main form.Created | false -> ()

main form.Created

Code output:

All

References:

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
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
75
76
77
#r "System.IdentityModel"
#r "System.ServiceModel"
#r "System.ServiceModel.Http"
#r "System.ServiceModel.Primitives"
#r "System.Runtime.Serialization"
#r "FSharp.Data.TypeProviders.dll"

open System
open System.IO
open System.Net
open System.Runtime.Serialization
open System.ServiceModel
open System.ServiceModel.Description
open System.ServiceModel.Dispatcher
open System.Text
open System.Web.Services.Protocols
open Microsoft.FSharp.Data.TypeProviders

type AuthorizationHeader(basicAuth) =
interface IClientMessageInspector with
member x.AfterReceiveReply(reply, correlationState) = ()
member x.BeforeSendRequest(request, channel) =
let prop = new Channels.HttpRequestMessageProperty()
prop.Headers.Add(name = "Authorization", value = basicAuth)
request.Properties.Add(Channels.HttpRequestMessageProperty.Name, prop) :> obj

type BasicAuthorization(usr : string, pwd : string) =
let bytes = Encoding.UTF8.GetBytes(usr + ":" + pwd)
let auth = "Basic " + Convert.ToBase64String(bytes)
interface IEndpointBehavior with
member x.Validate(endpoint) = ()
member x.AddBindingParameters(endpoint, bindingParameters) = ()
member x.ApplyDispatchBehavior(endpoint, endpointDispatcher) = ()
member x.ApplyClientBehavior(endpoint, clientRuntime) =
clientRuntime.ClientMessageInspectors.Add(new AuthorizationHeader(auth))

[<Literal>]
let baseurl = "https://DOMAIN_GOES_HERE.flexnetoperations.com/flexnet/services/"

[<Literal>]
let fnauth = baseurl + "FlexnetAuthentication?wsdl"

[<Literal>]
let userorghierarchy = baseurl + "UserOrgHierarchyService?wsdl"

type FlexnetAuthentication = WsdlService< ServiceUri=fnauth >
type UserOrgHierarchyService = WsdlService< ServiceUri=userorghierarchy >

let usr = "USERNAME_GOES_HERE"
let pwd = "PASSWORD_GOES_HERE"

/// Example 1: (require Basic Auth)
let user = new UserOrgHierarchyService.ServiceTypes.getUserPermissionsRequestType()
do user.userName <- "USERNAME_GOES_HER"
do user.domainName <- "FLEXnet"

let client1 = UserOrgHierarchyService.GetUserOrgHierarchyService()
do client1.DataContext.Endpoint.Behaviors.Add(new BasicAuthorization(usr, pwd))

let result1 = client1.getUserPermissions (user)

match result1.statusInfo.status with
| UserOrgHierarchyService.ServiceTypes.StatusType.SUCCESS ->
result1.responseData.permissions |> Array.iter (printfn "Permission: %s")
| _ -> printfn "%A" result1.statusInfo.status

/// Example 2: (doesn't requiere Basic Auth)
let auth = new FlexnetAuthentication.ServiceTypes.AuthenticateUserInputType()
do auth.userName <- usr
do auth.password <- pwd
do auth.domainName <- "FLEXnet"

let client2 = FlexnetAuthentication.GetFlexnetAuthentication()

let result2 = client2.authenticateUser (auth)

printfn "Access granted to %s: %b" usr result2.Success

References:

All

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
#nowarn "40"

open System

/// Types (alias types)
type Agent<'a> = MailboxProcessor<'a>

/// Domain agents
let print fn =
Agent.Start(fun inbox ->
let rec loop = async {
let! msg = inbox.Receive()
fn msg
return! loop }
loop)

let duplicate a1 a2 fn =
Agent.Start(fun inbox ->
let rec loop = async {
let! msg = inbox.Receive()
fn a1 a2 msg
return! loop }
loop)

let delay a fn =
Agent.Start(fun inbox ->
let rec loop = async {
let! msg = inbox.Receive()
fn a msg
return! loop }
loop)

let add a fn =
Agent.Start(fun inbox ->
let rec loop state = async {
let! msg = inbox.Receive()
state |> function | None -> () | Some v -> fn a (0I+v+msg);
return! loop (Some (msg))}
loop (None))

/// Domain functions
let out = lazy print (fun msg -> printfn "%A" msg)
let rec delta2int =
lazy
duplicate out (pairsInt:Lazy<Agent<bigint>>)
(fun a1 a2 msg -> a1.Value.Post msg; a2.Value.Post msg)
and prefixInt0 = lazy delay delta2int (fun a msg -> a.Value.Post msg)
and prefixInt1 = lazy delay prefixInt0 (fun a msg -> a.Value.Post msg)
and pairsInt = lazy add prefixInt1 (fun a msg -> a.Value.Post msg)

prefixInt0.Value.Post 0I
prefixInt1.Value.Post 1I

// Main (recursive loop)
let rec main () : unit = main ()
main ()

Code output:

type Agent<'a> = MailboxProcessor<'a>
val print : fn:('a -> unit) -> MailboxProcessor<'a>
val duplicate :
a1:'a -> a2:'b -> fn:('a -> 'b -> 'c -> unit) -> MailboxProcessor<'c>
val delay : a:'a -> fn:('a -> 'b -> unit) -> MailboxProcessor<'b>
val add :
a:'a ->
fn:('a -> Numerics.BigInteger -> unit) ->
MailboxProcessor<Numerics.BigInteger>
val out : Lazy<MailboxProcessor<bigint>> = Value is not created.
val delta2int : Lazy<MailboxProcessor<bigint>> = Value is not created.
val prefixInt0 : Lazy<MailboxProcessor<bigint>> = Value is not created.
val prefixInt1 : Lazy<MailboxProcessor<bigint>> = Value is not created.
val pairsInt : Lazy<Agent<bigint>> = Value is not created.
0
1
1
2
3
5
8
13
21
34
55
89
144
233
377
610
987
1597
2584
4181
6765
10946
17711
28657
46368
75025
121393
196418
317811
514229
832040
1346269
2178309
3524578
5702887
9227465
14930352
24157817
39088169
63245986
102334155
165580141
267914296
433494437
701408733
1134903170
1836311903
2971215073
4807526976
7778742049
12586269025
20365011074
32951280099
53316291173
86267571272
139583862445
225851433717
365435296162
591286729879
956722026041
1548008755920
2504730781961
4052739537881
6557470319842
10610209857723
17167680177565
27777890035288
44945570212853
72723460248141
117669030460994
190392490709135
308061521170129
498454011879264
806515533049393
1304969544928657
...

Error output (only on Mono):

Unhandled Exception:
System.NullReferenceException: Object reference not set to an instance of an object
at Microsoft.FSharp.Control.AsyncBuilderImpl+bindA@783[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Control.AsyncParams`1 args) [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Control.AsyncBuilderImpl+callA@805[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Control.AsyncParams`1 args) [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Control.AsyncBuilderImpl+tryWithA@839[Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Control.AsyncParams`1 args) [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Control.AsyncBuilderImpl+callA@805[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Control.AsyncParams`1 args) [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Control.AsyncBuilderImpl+queueAsync@727[Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Core.Unit unitVar0) [0x00000] in <filename unknown>:0
at <StartupCode$FSharp-Core>.$Control.loop@426-40 (Microsoft.FSharp.Control.Trampoline this, Microsoft.FSharp.Core.FSharpFunc`2 action) [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Control.Trampoline.ExecuteAction (Microsoft.FSharp.Core.FSharpFunc`2 firstAction) [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Control.TrampolineHolder.Protect (Microsoft.FSharp.Core.FSharpFunc`2 firstAction) [0x00000] in <filename unknown>:0
at <StartupCode$FSharp-Core>.$Control+-ctor@512-1.Invoke (System.Object state) [0x00000] in <filename unknown>:0
Mono JIT compiler version 4.0.0 ((detached/d136b79 Mon Apr 13 14:40:59 EDT 2015)
Copyright (C) 2002-2014 Novell, Inc, Xamarin Inc and Contributors. www.mono-project.com
TLS: normal
SIGSEGV: altstack
Notification: kqueue
Architecture: x86
Disabled: none
Misc: softdebug
LLVM: yes(3.6.0svn-mono-(detached/a173357)
GC: sgen

References:

Code Snippet:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#load @"Utils/ListLazy.fs"

open Stermon.Research.Utils

let corruptStartPoint l =
let rec loopStart = function
| Cons(h1,t1),Cons(h2,t2) -> (h1 = h2) |> function
| true -> Some h1
| false ->
loopStart (t1.Force(),t2.Force())
| _,_ -> None
let rec meetPoint = function
| Cons(h1,t1),Cons(h2,t2) -> (h1 = h2) |> function
| true -> loopStart (l,t2.Force())
| false ->
meetPoint (t1.Force(),(t2.Force() |> List.Lazy.skip 1I))
| _,_ -> None
meetPoint (l,(l |> List.Lazy.skip 1I))

Code output:

[Loading Utils/ListLazy.fs]

namespace FSI_0002.Stermon.Research.Utils
type 'a ListLazy =
| Cons of 'a * Lazy<'a ListLazy>
| Nil
module Lazy = begin
val single : h:'a -> 'a ListLazy
val cons : h:'a -> l:'a ListLazy -> 'a ListLazy
val head : _arg1:'a ListLazy -> 'a
val tail : _arg1:'a ListLazy -> 'a ListLazy
val iter : f:('a -> unit) -> _arg1:'a ListLazy -> unit
val map : f:('a -> 'b) -> _arg1:'a ListLazy -> 'b ListLazy
val fold : f:('a -> 'b -> 'a) -> init:'a -> _arg1:'b ListLazy -> 'a
val foldBack :
f:('a -> Lazy<'b> -> 'b) -> init:'b -> _arg1:'a ListLazy -> 'b
val unfold : f:('a -> ('b * 'a) option) -> init:'a -> 'b ListLazy
val reduce : f:('a -> 'a -> 'a) -> _arg1:'a ListLazy -> 'a
val reduceBack : f:('a -> Lazy<'a> -> 'a) -> _arg1:'a ListLazy -> 'a
val skip :
n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
val take :
n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
val append : l1:'a ListLazy -> l2:'a ListLazy -> 'a ListLazy
val concat : _arg1:'a ListLazy ListLazy -> 'a ListLazy
val ofList : _arg1:'a list -> 'a ListLazy
val toList : l:'a ListLazy -> 'a list
end

val corruptStartPoint :
l:'a Stermon.Research.Utils.ListLazy -> 'a option when 'a : equality

Non corrupt linked list

All

1
2
3
4
5
6
let example1 = List.Lazy.unfold(fun s -> Some(s,s+1)) 0 |> List.Lazy.take 26I

example1
|> List.Lazy.iter(printf "%i ")

corruptStartPoint example1
> val example1 : int ListLazy = Cons (0,Value is not created.)
> 0 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 val it : unit = ()
> val it : int option = None

Corrupt linked list

All

1
2
3
4
5
6
7
8
9
10
11
12
13
let corruptGenerator n =
List.Lazy.unfold(
fun s -> (s < n) |> function
| false -> Some((s % n) + n,s+1)
| true -> Some(s,s+1)) 0

let example2 = corruptGenerator 7

example2
|> List.Lazy.take 28I
|> List.Lazy.iter(printf "%i ")

corruptStartPoint example2
> val corruptGenerator : n:int -> int ListLazy
> val example2 : int ListLazy = Cons (0,Value is not created.)
> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 7 8 9 10 11 12 13 7 8 9 10 11 12 13 val it : unit = ()
> val it : int option = Some 7

References:

All

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
40
41
type 'a ListLazy = Cons of 'a * 'a ListLazy Lazy | Nil

module List =
module Lazy =
let single h = Cons(h, lazy (Nil))
let cons h l = Cons(h, lazy (l))
let head = function | Nil -> failwith "empty list" | Cons(h,_) -> h
let tail = function | Nil -> failwith "empty list" | Cons(_,t) -> t.Force()
let rec iter f = function
| Nil -> () | Cons(h,t) -> f h; iter f (t.Force())
let rec map f = function
| Nil -> Nil | Cons(h,t) -> Cons(f h, lazy (map f (t.Force())))
let rec fold f init = function
| Nil -> init | Cons(h,t) -> fold f (f init h) (t.Force())
let rec foldBack f init = function
| Nil -> init | Cons(h,t) -> f h (lazy (foldBack f init (t.Force())))
let rec unfold f init = f init |> function
| None -> Nil | Some(a,s) -> Cons (a, lazy (unfold f s))
let rec reduce f = function
| Nil -> failwith "empty list" | Cons(h,t) -> fold f h (t.Force())
let rec reduceBack f = function
| Nil -> failwith "empty list" | Cons(h,t) -> foldBack f h (t.Force())
let rec skip n = function
| Nil -> Nil | Cons(h,t) -> (n = 0I) |> function
| true -> cons h (t.Force())
| false -> skip (n-1I) (t.Force())
let rec take n = function
| Nil -> Nil | Cons(h,t) -> (n = 0I) |> function
| true -> Nil
| false -> Cons(h, lazy (take (n-1I) (t.Force())))
let rec append l1 l2 = l1 |> function
| Nil -> l2 | Cons(h,t) -> Cons(h, lazy (append (t.Force()) l2))
let rec concat = function
| Nil -> Nil | Cons(h,t) -> append h (concat (t.Force()))
let rec ofList = function
| [] -> Nil | h :: t -> cons h (ofList t)
let toList l =
let rec toList' acc = function
| Nil -> List.rev acc
| Cons(h,t) -> toList' (h::acc) (t.Force())
toList' [] l

Code output:

> 
type 'a ListLazy =
| Cons of 'a * Lazy<'a ListLazy>
| Nil
module List = begin
module Lazy = begin
val single : h:'a -> 'a ListLazy
val cons : h:'a -> l:'a ListLazy -> 'a ListLazy
val head : _arg1:'a ListLazy -> 'a
val tail : _arg1:'a ListLazy -> 'a ListLazy
val iter : f:('a -> unit) -> _arg1:'a ListLazy -> unit
val map : f:('a -> 'b) -> _arg1:'a ListLazy -> 'b ListLazy
val fold : f:('a -> 'b -> 'a) -> init:'a -> _arg1:'b ListLazy -> 'a
val foldBack :
f:('a -> Lazy<'b> -> 'b) -> init:'b -> _arg1:'a ListLazy -> 'b
val unfold : f:('a -> ('b * 'a) option) -> init:'a -> 'b ListLazy
val reduce : f:('a -> 'a -> 'a) -> _arg1:'a ListLazy -> 'a
val reduceBack : f:('a -> Lazy<'a> -> 'a) -> _arg1:'a ListLazy -> 'a
val skip :
n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
val take :
n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
val append : l1:'a ListLazy -> l2:'a ListLazy -> 'a ListLazy
val concat : _arg1:'a ListLazy ListLazy -> 'a ListLazy
val ofList : _arg1:'a list -> 'a ListLazy
val toList : l:'a ListLazy -> 'a list
end
end

Infinite Fibonacci (and squared) sequence

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
let fib =
(List.Lazy.single 0I,
List.Lazy.unfold(fun (a1,a2) -> Some(a1+a2,(a2,a1+a2))) (1I,0I))
||> List.Lazy.append

let fibSquared =
fib |> List.Lazy.foldBack(fun x l -> Cons(x*x,l)) Nil

fib
|> List.Lazy.take 10I
|> List.Lazy.iter(printf "%A ")

fibSquared
|> List.Lazy.take 10I
|> List.Lazy.iter(printf "%A ")
> 
val fib : System.Numerics.BigInteger ListLazy = Cons (0,Value is not created.)
val fibSquared : System.Numerics.BigInteger ListLazy =
Cons (0,Value is not created.)

> 0 1 1 2 3 5 8 13 21 34 val it : unit = ()
> 0 1 1 4 9 25 64 169 441 1156 val it : unit = ()

Runtime errors when skipping/taking on empty sequences (F# Seq)

1
2
3
4
5
6
fib
|> List.Lazy.take 10I
|> List.Lazy.toList
|> List.toSeq
|> Seq.skip 20
|> Seq.iter(printf "%A ")
> val it : seq<System.Numerics.BigInteger> =
Error: The input sequence has an insufficient number of elements.
1
2
3
4
5
6
fib
|> List.Lazy.take 10I
|> List.Lazy.toList
|> List.toSeq
|> Seq.take 20
|> Seq.iter(printf "%A ")
> 0 1 1 2 3 5 8 13 21 34 System.InvalidOperationException: The input sequence has an insufficient number of elements.
at Microsoft.FSharp.Collections.SeqModule+Take@999[System.Numerics.BigInteger].GenerateNext (IEnumerable`1& next) [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Core.CompilerServices.GeneratedSequenceBase`1[System.Numerics.BigInteger].MoveNextImpl () [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Core.CompilerServices.GeneratedSequenceBase`1[System.Numerics.BigInteger].System-Collections-IEnumerator-MoveNext () [0x00000] in <filename unknown>:0
at Microsoft.FSharp.Collections.SeqModule.Iterate[BigInteger] (Microsoft.FSharp.Core.FSharpFunc`2 action, IEnumerable`1 source) [0x00000] in <filename unknown>:0
at <StartupCode$FSI_0047>.$FSI_0047.main@ () [0x00000] in <filename unknown>:0
at (wrapper managed-to-native) System.Reflection.MonoMethod:InternalInvoke (System.Reflection.MonoMethod,object,object[],System.Exception&)
at System.Reflection.MonoMethod.Invoke (System.Object obj, BindingFlags invokeAttr, System.Reflection.Binder binder, System.Object[] parameters, System.Globalization.CultureInfo culture) [0x00000] in <filename unknown>:0
Stopped due to error

No runtime errors when skipping/taking on empty lists

1
2
3
4
5
6
7
8
9
fib
|> List.Lazy.take 10I
|> List.Lazy.skip 20I // Behave as C# Linq.Enumerable.Skip
|> List.Lazy.iter(printf "%A ")

fib
|> List.Lazy.take 10I
|> List.Lazy.take 20I // Behave as C# Linq.Enumerable.Take (or F# Seq.truncate)
|> List.Lazy.iter(printf "%A ")
> val it : unit = ()
> 0 1 1 2 3 5 8 13 21 34 val it : unit = ()

References: