Rx Live Morse Code Translation

open System

open System.Threading

open System.Threading.Tasks

open System.Reactive.Linq

open System.Reactive.Threading

open System.Reactive.Concurrency

open System.Reactive.Subjects

module Observable =

  let observeOn (scheduler:IScheduler) (xs:IObservable<'a>) =

    Observable.ObserveOn(xs, scheduler)

  let subscribeOn (scheduler:IScheduler) (xs:IObservable<'a>) =

    Observable.SubscribeOn(xs, scheduler)

  let window (f: Unit -> IObservable<'b>) (xs:IObservable<'a>)  =

    Observable.Window(xs, new Func<IObservable<'b>>(f))

  let subscribe' f g (xs:IObservable<'a>) =

    ObservableExtensions.Subscribe(xs, new Action<'a>(f), new Action(g))

let splitBy separator (xs:IObservable<'a>) =

    xs |> Observable.window (fun () -> xs |> Observable.filter (fun x -> x = separator))

       |> Observable.map (Observable.filter (fun y -> y <> separator))         

type MorseCode = Node of string * MorseCode * MorseCode

               | Leaf of string 

               | Empty

let morseCodeTree =

            let zeroNode =  Leaf("0")

            let nineNode =  Leaf("9")

            let dashNode =  Node("", zeroNode, nineNode)

            let nullLeaf =  Empty

            let eightNode =  Leaf("8")

            let dotNode =  Node("", nullLeaf, eightNode)

            let oNode =  Node("O", dashNode, dotNode)

            let qNode =  Node("Q", nullLeaf, nullLeaf)

            let sevenNode =  Leaf("7")

            let zNode =  Node("Z", nullLeaf, sevenNode)

            let gNode =  Node("G", qNode, zNode)

            let mNode =  Node("M", oNode, gNode)

            let yNode =  Leaf("Y")

            let cNode =  Leaf("C")

            let kNode =  Node("K", yNode, cNode)

            let xNode =  Leaf("X")

            let sixNode =  Leaf("6")

            let bNode =  Node("B", nullLeaf, sixNode)

            let dNode =  Node("D", xNode, bNode)

            let nNode =  Node("N", kNode, dNode)

            let tNode =  Node("T", mNode, nNode)

            let oneNode =  Leaf("1")

            let jNode =  Node("J", oneNode, nullLeaf)

            let pNode =  Leaf("P")

            let wNode =  Node("W", jNode, pNode)

            let lNode =  Leaf("L")

            let rNode =  Node("R", nullLeaf, lNode)

            let aNode =  Node("A", wNode, rNode)

            let twoNode =  Leaf("2")

            let udNode =  Node("", twoNode, nullLeaf)

            let fNode =  Leaf("F")

            let uNode =  Node("U", udNode, fNode)

            let threeNode =  Leaf("3")

            let vNode =  Node("V", threeNode, nullLeaf)

            let fourNode =  Leaf("4")

            let fiveNode =  Leaf("5")

            let hNode =  Node("H", fourNode, fiveNode)

            let sNode =  Node("S", vNode, hNode)

            let iNode =  Node("I", uNode, sNode)

            let eNode =  Node("E", aNode, iNode)

            Node("", tNode, eNode)

let extractChar n = match n with

                    | Node (ch, _, _) -> ch

                    | Leaf ch -> ch

                    | Empty -> ""

let processChar acc ch = match (ch, acc) with

                         | '-', Node (_, dash, _) -> dash

                         | '.', Node (_, _, dot) -> dot

                         | _ -> Empty

let translateMorseCode xs = 

              xs |> splitBy ' '

                 |> Observable.map(Observable.scan processChar morseCodeTree >> Observable.map extractChar)

let processKeyPress(subject:ISubject<char>) =       

              let mutable info:ConsoleKeyInfo option = None

              while (info.IsNone || info.Value.Key <> ConsoleKey.Enter) do                            

                       info <- Some (Console.ReadKey())

                       subject.OnNext info.Value.KeyChar                            

              Environment.Exit(0)

let getKeyPresses =       

            let subject = new Subject<char>()

            Task.Run(fun () -> processKeyPress(subject)) |> ignore

            subject |> Observable.observeOn(CurrentThreadScheduler.Instance)

       

let mutable index = 0

let writeCode (x:string) =

    let oldpos = Console.CursorLeft

    Console.SetCursorPosition (index, 1)

    Console.Write x

    Console.SetCursorPosition (oldpos, 0)

getKeyPresses |> translateMorseCode

              |> Observable.subscribe(Observable.subscribe' writeCode  (fun () -> index <- index + 1) >> ignore)

              |> ignore

Thread.Sleep -1

Functional IoC Container Example

open System

type StateMonad() =

    member this.ReturnFrom x = x

    member this.Return x s = (x, s)

    member this.Bind (m, f) s = let (x, s1) = m s

                                in (f x) s1

let state = new StateMonad()

type IEnvironment =

    abstract member UserName : string with get

type ILogger =

    abstract member Log : string -> unit

type Container = { Environment : IEnvironment

                   Logger : ILogger }

let getContainer = fun f -> (f(), f)

let run ctx m = m (fun () -> ctx) |> fst

let rec fac n acc  = state { let! container = getContainer

                             container.Logger.Log (sprintf "%d" acc)

                             if (n = 0) then return acc

                             else return! fac (n - 1) (n * acc) }

let compute n = state { let! container = getContainer                       

                        container.Logger.Log (sprintf "Begin fac %d" n)

                        let! result = fac n 1                                      

                        container.Logger.Log (sprintf "End fac %d" n)

                        let userName = container.Environment.UserName

                        container.Logger.Log (sprintf "Computed by %s" userName)

                        return result }

let prodContainer =

    { Environment = { new IEnvironment with                         

                          member this.UserName

                                  with get () =

                                       Environment.UserName }

      Logger = { new ILogger with

                    member this.Log s =

                        Console.WriteLine ("{0} : {1}", (DateTime.Now), s) } }

let testContainer =

    { Environment = { new IEnvironment with                         

                          member this.UserName

                                  with get () =

                                       "John Doe" }

      Logger = { new ILogger with

                    member this.Log s = Console.WriteLine (" {0} ",  s) } }

printfn "Result %A" (run prodContainer (compute 10))

printfn "Result %A" (run testContainer (compute 10))

Functional WPF Part Five (Simple example of how to use it)

// Example using the Functional WPF DSL

// View Model

type Person (firstName, lastName, age) =

    static member New (firstName, lastName, age) =

            new Person(firstName, lastName, age)

    member this.LastName

                with get () = lastName

                and set (value : string) = ()

    member this.FirstName

                with get () = firstName

                and set (value : string) = ()

    member this.Age

                with get () = age

                and set (value : int) = ()

let dataContext = [("Homer", "Simpson", 46)

                   ("Marge", "Simpson", 42)

                   ("Lisa", "Simpson", 9)

                   ("Bart", "Simpson", 12) ] |> List.map (Person.New)

// Header

let header = [ label [width 100] "First Name"

               label [width 100] "Last Name"

               label [width 50] "Age" ] |> stackpanel [] Horizontal

// Row

let row = [ textbox [width 100] <@@ fun (x:Person) -> x.FirstName @@>

            textbox [width 100] <@@ fun (x:Person) -> x.LastName @@>

            textbox [width 50] <@@ fun (x:Person) -> x.Age @@> ]

            |> stackpanel [] Horizontal

// Data Template

let sampleTemplate = datatemplate row

// Final composition

let sampleGrid = [ header

                   itemscontrol sampleTemplate

                   button "submit" ] |> stackpanel [width 250] Vertical

                                     |> border Blue

// Main Window

let mainWindow = window [width 400; height 200] sampleGrid

             

// Application                                

let sampleApplication = application mainWindow

// Run the app with the given dataContext                                                               

[<STAThread()>]

do run sampleApplication dataContext