Slides And Samples

Presentation and code samples from my recent talk on FSUG meeting.

• Presentation
• RxJs
• WebExcel

WebSharper, part 2: WebExcel

Well, after the long pause, I came back to blogging and today out test pet once again will be WebSharper. However now we’ll make pure client-side application so it can reveal all (or mostly all) positive sides of WS.

Today’s demo project will be modestly codenamed WebExcel – simple spreadsheet with support of formulae.

All major components of our system and relations between them are shown on the diagram below:

• EvalResult – in fact it is discriminated union that represents current runtime cell value: it can be either Ok of obj – value, or Error of string – failure with description.
• Presenter – This component handles all user input, invokes some functions from Model part and updates UI – MVP presenter.
• CellDataStorage – simple container for cell values.
• CellFormulaStorage – facade for formulae related functionality. Stores mapping from cell reference to parsed formula.
• Parser – converts text representation for formula to parsed expression – instance of Expr type.
• Expr – represents parsed formulae. Contains the following case constructors:
  • Value – literal value
  • Ref – reference to another cell
  • Operation – function that accepts list of Expr and produces EvalResult. Operation function accepts context argument that is used during expression evaluation to resolve Ref into value.
• TopoSort – helps to build formula evaluation order according to dependencies between them.

Common workflow of handling UI events is roughly following:

Now, enough pictures, lets turn to the code.

EvalResult type

[<JavaScriptType>]
type EvalResult = Ok of obj | Error of string

Ast module

module Ast =
    open System.Collections.Generic

    [<JavaScriptType>]
    type Context = string -> EvalResult option
    
    [<JavaScriptType>]
    type Expr = 
        | Value of obj
        | Ref of string
        | Operation of (Context -> list<Expr>  -> EvalResult) * list<Expr>

    [<JavaScript>]
    let eval (ctx : Context) = function 
        | Value o -> Ok o
        | Ref name -> 
            match ctx name with
            | Some r -> r
            | None -> Error("Name " + name + " not found")
        | Operation (f, args) -> f ctx args

    [<JavaScript>]
    let bind ctx f e =
        match eval ctx e with
        | Ok v -> f v
        | e -> e

    [<JavaScript>]
    let bindList ctx f args =
        let rec impl l acc = 
            match l with
            | [] -> f (List.rev acc)
            | x::xs -> x |> bind ctx (fun o -> impl xs (o::acc))
        impl args []

    [<JavaScript>]
    let getReferences e =
        let rec impl (acc : Set<_>) = function
            | Value _ -> acc
            | Ref v -> acc.Add v
            | Operation(_, l) -> (acc, l) ||> Seq.fold impl
        impl Set.empty e

Ast contains definition of Expr type and some auxiliary functions:

• eval – name is self descriptive – evaluates expression in a given context
• bind – helper for chaining subsequent evaluations, returns on first occurance of Error
• bindList – similar to bind but works for the list of expressions
• getReferences – traverses given Expr and collects references to other cells

Operations module

module Operations = 
    
    open Ast

    [<JavaScript>]
    let adapt f ctx args = 
        try
            match args with
            | [e1; e2] ->
                e1 |> bind ctx (fun v1 -> 
                    e2 |> bind ctx (fun v2 ->
                        Ok(f (unbox<double> v1) (unbox<double> v2))
                    )
                )
            | _ -> Error("Incorrect number of arguments")
        with
            e -> e.Message |> Error

    [<JavaScript>]
    let add = adapt (+)
        
    [<JavaScript>]
    let sub = adapt (-)

    [<JavaScript>]
    let mul = adapt (*)

    [<JavaScript>]
    let div = adapt (/)

    [<JavaScript>]
    let gt = adapt (>)

    [<JavaScript>]
    let ge = adapt (>=)

    [<JavaScript>]
    let lt = adapt (<)

    [<JavaScript>]
    let le = adapt (<=)

    [<JavaScript>]
    let eq = adapt (=)

    [<JavaScript>]
    let neq = adapt (<>)

    [<JavaScript>]
    let iif ctx args =
        try
            match args with
            | [c; ifTrue; ifFalse] ->
                c |> bind ctx (fun cond ->
                    if (unbox<bool> cond) then eval ctx ifTrue
                    else eval ctx ifFalse
                )
            | _ -> Error "Invalid number of arguments"
        with
            e -> Error e.Message
    
    [<JavaScript>]
    let average ctx args = 
        try
            args |> bindList ctx (fun objs ->
                objs 
                    |> List.map unbox<double>
                    |> List.average
                    |> (box >> Ok)
            )
        with
            e -> Error e.Message
    
    [<JavaScript>]
    let operations = 
        [
        "IF", iif
        "AVERAGE", average
        ] |> Map.ofSeq

Operations module stores all functions that will be accessible from formulae: common infix operators and external ones. Our definitions of Expr.Operation as function that accepts not values but thunks gives us capability to define functions like IF: evaluate first argument and after that evaluate second or third.

Parser module

module Parser = 

    open Ast

    [<JavaScript>]
    let some v (rest : string) = Some(v, rest)

    [<JavaScript>]
    let capture pattern text = 
        let regex = JRegExp("^(" + pattern + ")(.*)")
        if regex.Test(text)
        then regex.Exec(text)  |> Option.bind (fun v -> some v.[1] v.[2])
        else None

    [<JavaScript>]
    let matchValue pattern = (capture @"\s*") >> (Option.bind (snd >> capture pattern))
    [<JavaScript>]
    let matchSymbol pattern = (matchValue pattern) >> (Option.bind (snd >> Some))

    [<JavaScript>]
    let (|NUMBER|_|) = matchValue @"-?\d+\.?\d*"
    [<JavaScript>]
    let (|IDENTIFIER|_|) = matchValue @"[A-Za-z]\w*"
    [<JavaScript>]
    let (|LPAREN|_|) = matchSymbol @"\("
    [<JavaScript>]
    let (|RPAREN|_|) = matchSymbol @"\)"
    [<JavaScript>]
    let (|PLUS|_|) = matchSymbol @"\+"
    [<JavaScript>]
    let (|MINUS|_|) = matchSymbol @"-"

    [<JavaScript>]
    let (|GT|_|) = matchSymbol @">"
    [<JavaScript>]
    let (|GE|_|) = matchSymbol @">="
    [<JavaScript>]
    let (|LT|_|) = matchSymbol @"<"
    [<JavaScript>]
    let (|LE|_|) = matchSymbol @"<="
    [<JavaScript>]
    let (|EQ|_|) = matchSymbol @"="
    [<JavaScript>]
    let (|NEQ|_|) = matchSymbol @"<>"

    [<JavaScript>]
    let (|MUL|_|) = matchSymbol @"\*"
    [<JavaScript>]
    let (|DIV|_|) = matchSymbol @"/"
    [<JavaScript>]
    let (|COMMA|_|) = matchSymbol @","

    [<JavaScript>]
    let operation op args rest = some (Operation(op, args)) rest

    // error handling in case of unknown operation is omitted
    let rec [<JavaScript>] (|Factor|_|) = function
        | IDENTIFIER(id, r) ->
            match r with
            | LPAREN (ArgList (args, RPAREN r)) -> operation (Operations.operations.[id]) args r
            | _ -> some(Ref id) r
        | NUMBER (v, r) -> some (Value (System.Double.Parse v)) r
        | LPAREN(Logical (e, RPAREN r)) -> some e r
        | _ -> None

    and [<JavaScript>] (|ArgList|_|) = function
        | Logical(e, r) ->
            match r with
            | COMMA (ArgList(t, r1)) -> some (e::t) r1
            | _ -> some [e] r
        | rest -> some [] rest

    and [<JavaScript>] (|Term|_|) = function
        | Factor(e, r) ->
            match r with
            | MUL (Term(r, rest)) -> operation Operations.mul [e; r] rest
            | DIV (Term(r, rest)) -> operation Operations.div [e; r] rest
            | _ -> some e r
        | _ -> None

    and [<JavaScript>] (|Expr|_|) = function 
        | Term(e, r) ->
            match r with
            | PLUS (Expr(r, rest)) -> operation Operations.add [e; r] rest
            | MINUS (Expr(r, rest)) -> operation Operations.sub [e; r] rest
            | _ -> some e r
        | _ -> None

    and [<JavaScript>] (|Logical|_|) = function 
        | Expr(l, r) ->
            match r with
            | GE (Logical(r, rest)) -> operation Operations.ge [l; r] rest
            | GT (Logical(r, rest)) -> operation Operations.gt [l; r] rest
            | LE (Logical(r, rest)) -> operation Operations.le [l; r] rest
            | LT (Logical(r, rest)) -> operation Operations.lt [l; r] rest
            | EQ (Logical(r, rest)) -> operation Operations.eq [l; r] rest
            | NEQ (Logical(r, rest)) -> operation Operations.neq [l; r] rest
            | _ -> some l r
        | _ -> None

    and [<JavaScript>] (|Formula|_|) (s : string) =
        if s.StartsWith("=") then
            match s.Substring(1) with
            | Logical(l, t) when System.String.IsNullOrEmpty(t) -> Some l
            | _ -> None
        else None

Concept of implementing parser using active patterns I've shamelessly stolen from excellent article by Adam Granicz.

Model module

module Model = 

    open System
    open System.Collections.Generic
    
    [<JavaScript>]
    let private toString o = o.ToString()

    [<JavaScript>]
    let private concat lines = 
        let delimiter = ", "
        if Seq.isEmpty lines 
        then ""
        else lines |> Seq.reduce(fun a b -> a + delimiter + b)

    [<JavaScript>]
    let rows = [1..20] |> List.map toString
    [<JavaScript>]
    let private rowsSet = Set.ofSeq rows
    
    [<JavaScript>]
    let cols = [int 'A'..int 'H'] |> List.map (char >> toString)
    [<JavaScript>]
    let colSet = Set.ofSeq cols


    [<JavaScript>]
    let private isReference (s : string) = 
        if System.String.IsNullOrEmpty s || s.Length < 2 then false
        else
            let col = toString s.[0]
            let row = s.Substring(1)
            rowsSet.Contains row && colSet.Contains col

    [<JavaScriptType>]
    type ICellDataStorage =
        abstract member GetValue : string -> EvalResult option
        abstract member SetValue : cell : string * value : EvalResult -> unit

    [<JavaScriptType>]
    type CellDataStorage [<JavaScript>] () = 
        let results = new System.Collections.Generic.Dictionary<string, EvalResult>()

        [<JavaScript>]
        let setValue cell value = results.[cell] <- value 

        [<JavaScript>]
        member this.SetValue(cell, value) =        
            if System.String.IsNullOrEmpty value
            then
                this.DeleteValue(cell)
                true
            else
                let (v, ok) = try Ok (box (float value)), true with _ -> Error "Not a number", false
                setValue cell v
                ok

        [<JavaScript>]
        member this.DeleteValue(cell) =
            if results.ContainsKey cell then
                results.Remove cell |> ignore

        [<JavaScript>]
        member this.GetValue(cell) = 
            if results.ContainsKey cell 
            then results.[cell] |> Some
            else None

        interface ICellDataStorage with
            [<JavaScript>]
            member this.GetValue(cell) = this.GetValue(cell)
            [<JavaScript>]
            member this.SetValue(cell, value) = setValue cell value

    [<JavaScriptType>]
    type TopoSort [<JavaScript>] () = 
        let map = new System.Collections.Generic.Dictionary<string, Set<_>>()
        
        [<JavaScript>]
        member this.Insert(cell, parents) = 
            for p in parents do
                let s = if map.ContainsKey(p) then map.[p] else Set.empty
                map.[p] <- s.Add cell
            try
                this.GetDependents(cell) |> ignore
            with
                _ -> 
                this.Delete(cell, parents)
                reraise()

        [<JavaScript>]
        member this.Delete(cell, parents) = 
            for p in parents do
                let s = map.[p]
                map.[p] <- s.Remove cell

        [<JavaScript>]
        member this.GetDependents(s) = 
            let visited = ref Set.empty
            let rec impl ((order, cycles) as state) s =
                if Set.contains s cycles then failwith ("Cycle detected:" + (concat cycles))
                if Set.contains s !visited 
                then state
                else
                    visited := Set.add s !visited
                    if map.ContainsKey s 
                    then
                        let children = map.[s]
                        ((order, Set.add s cycles), children) 
                            ||> Seq.fold impl 
                            |> (fun (l, cycle) -> List.Cons(s, l), Set.remove s cycles)
                    else
                        s::order, cycles

            impl ([], Set.empty) s |> fst     

    [<JavaScriptType>]
    type CellFormulaStorage [<JavaScript>](dataStorage : ICellDataStorage) = 
        let map = new System.Collections.Generic.Dictionary<string, Ast.Expr>()
        let toposort = new TopoSort()

        [<JavaScript>]  
        let getValue cell = 
            match dataStorage.GetValue cell with
            | None -> Some(Ok 0.0)
            | x -> x

        [<JavaScript>]                
        member this.HasFormula(cell) = map.ContainsKey cell 

        [<JavaScript>]                
        member this.DeleteFormula(cell) =         
            if map.ContainsKey cell then
                let oldExpr = map.[cell]
                let parents = Ast.getReferences oldExpr
                toposort.Delete(cell, parents)
                map.Remove(cell) |> ignore


        [<JavaScript>]                
        member this.SetFormula(cell, text) = 
            match text with
            | Parser.Formula(f) ->
                let invalidReferences = 
                    Ast.getReferences f
                    |> Seq.filter (not << isReference)
                    |> Seq.toList
                if List.isEmpty invalidReferences 
                then
                    let parents = Ast.getReferences f

                    try
                        toposort.Insert(cell, parents)
                        map.[cell] <- f 
                              
                        this.Evaluate(cell)           
                    with 
                        e -> dataStorage.SetValue(cell, Error(e.ToString()))
                             [cell]
                else
                    dataStorage.SetValue(cell, Error ("Formula contains invalid references: " + (concat invalidReferences))) 
                    [cell]
            | _ ->
                dataStorage.SetValue(cell, Error ("Invalid formula text:" + text))
                [cell]
            

        [<JavaScript>]   
        member this.Evaluate(cell) = 
            let dependencies = toposort.GetDependents(cell)
            for d in dependencies do
                if map.ContainsKey(d) then 
                    let e = map.[d]
                    let res = Ast.eval getValue e
                    dataStorage.SetValue (d, res)
            dependencies

ICellDataStorage interface is used only during formula evaluation: for the simplicity we make assumption that values obtained as evaluation results are correct and do not require validation.

UI module

open IntelliFactory.WebSharper.Html

[<Require(typeof<Styles.Table>)>]
module UI = 
    
    open System
    open System.Collections.Generic

    [<JavaScriptType>]
    type Presenter [<JavaScript>] () = 

        let dataStorage = new Model.CellDataStorage()
        let formulaStorage = new Model.CellFormulaStorage(dataStorage)
        
        let userInput = new Dictionary<_, _>()
        
        let map = new Dictionary<_, _>()

        [<JavaScript>]
        let onFocus (cell : Element) =
            cell.AddClass("editing")
            cell.Value <- if userInput.ContainsKey cell.Id then userInput.[cell.Id] else ""
        
        [<JavaScript>]
        let onBlur (cell : Element) =
            cell.RemoveClass("editing")
            userInput.[cell.Id] <- cell.Value
            formulaStorage.DeleteFormula(cell.Id)

            cell.RemoveClass("error")
            cell.RemoveClass("formula")
            try
                let dependencies = 
                    if cell.Value.StartsWith("=") 
                    then
                        formulaStorage.SetFormula(cell.Id, cell.Value)
                    else    
                        let ok = dataStorage.SetValue(cell.Id, cell.Value)
                        if ok 
                        then formulaStorage.Evaluate(cell.Id)
                        else [cell.Id]

                for dep in dependencies do
                    let el : Element = map.[dep]
                    match dataStorage.GetValue(el.Id) with
                    | Some (Ok v) ->
                        el.RemoveAttribute("title")
                        if formulaStorage.HasFormula el.Id then
                            el.AddClass("formula")
                            el.SetAttribute("title", userInput.[el.Id])  
                        el.Value <- v.ToString()
                    | Some (Error msg) -> 
                        el.SetAttribute("title", msg)
                        el.AddClass("error")
                        el.Value <- "#ERROR"
                    | None -> 
                        el.RemoveAttribute("title")
                        el.Value <- ""
            with
                e ->
                Window.Alert(e.ToString())

        [<JavaScript>]
        member this.CreateCell(name) = 
            let cell = 
                Input [Id name] 
                |>! OnFocus(fun e _ -> onFocus e)
                |>! OnBlur(fun e _ -> onBlur e)
            map.Add(name, cell)
            cell

    [<JavaScript>]
    let main =

        let presenter = new Presenter()

        Table [] -< [
            yield TR [
                yield TD [Class "specialCell firstColumn"]; 
                for col in Model.cols do yield TD [Class "specialCell"] -< [Text col]]
            for row in Model.rows do
                yield TR [ 
                    yield TD [Class "specialCell firstColumn"] -< [ Text row ]; 
                    for col in Model.cols do yield TD [presenter.CreateCell (col + row)]
                    ]
        ]

[<JavaScriptType>]
type ExcelControl() = 
    inherit Web.Control()

    [<JavaScript>]
    override this.Body = UI.main

Presenter stores all values (even incorrect) so user can resume editing from the same point in case of incorrect input.

Final result with some CSS tweaks.

Let’s make some tests…

Create formula with incorrect reference

and behold… error notification.

Fix formula: =A1 * 10 + 2

Implicitly absence of value = 0

Create 3 linked formulae: A1 <- =A2 * 2, A2 <- =A1 + 10, A3 <- =B1 * 3

Change value in A2 and observe chain reevaluation

Create formula cycle: A2 <- C1

Use IF and AVERAGE formulae: A2 <- AVERAGE(A1, B1, C1), A3 <- IF (A2 > B2, 10, -10)

Project source code can be downloaded here.

Playing with WebSharper

I’ve decided to make post about WebSharper long time ago…and finally time has come :).

The idea behind the WebSharper is not new, compilers that translate some source language to JavaScript already exists (for example GWT). Main distinguished feature of WS is using F# as a source language: built-in metaprogramming capabilities, type inference, succinct and expressive syntax, seamless integration with .NET platform makes it a very good choice both server (F# itself)and client side (translated JavaScript). Besides JavaScript translation WS provides statically-typed wrappers for existing JavaScript libraries (like JQuery), HTML combinators for defining content of pages, formlets and many other interesting things.

As a sample we’ll make simple StickyNotes application. Web design is not my primary and favorite skill, so I'll omit cross-browser compatibility and bind all styles to Firefox. For a start server-side part will be trivial: storing all notes data in application state. Later (in forthcoming posts) it will be extended with specific user notes, registration routine (with formlets), persisting data in database etc…

Server part

module State = 
    
    type Note = 
        { X : int
          Y : int
          Content : string }

    let private key = "StickyNotesState"    
    let private doSave (notes : Note list) = 
        HttpContext.Current.Application.Set(key, notes)
        notes

    let private doLoad () = 
        match HttpContext.Current.Application.Get(key) with
        | :? list<Note> as v -> v
        | _ -> doSave []

    let private lockObj = obj()

    let save notes = lock lockObj (fun () -> doSave notes)
    let load () = lock lockObj doLoad

Type Note stores basic note information (coordinates and content).Remaining part of the module just store/load functionality with HttpApplicationState on backend. This code has no WS specific features, just pure F#.

Client/Server communucations

module Rpc = 
    [<Rpc>]
    let loadNotes () = 
        State.load ()
    
    [<Rpc>]
    let saveNotes notes = 
        State.save notes

Client will make server calls througn invoking methods annotated with Rpc attribute.

Client side.

[<Require(typeof<Styles.StickyNotes>)>]
module Notes = 
    
    // client-side storage for notes
    [<JavaScript>]
    let notes = System.Collections.Generic.Dictionary<_, _>()        

    // configuration data for JQuery.animate function
    type AnimateConfiguration = { opacity : float }

    [<JavaScript>]
    let main () =         
        
        // moves specified element to the top in z-order 
        let maxZ = ref 0
        let bringToTop (e : Element) = 
            incr maxZ
            e.Css("z-index", string (!maxZ))


        let body = Div []

        // create 'Note' visual component and append it to body
        // if state is defined then it contains previousy stored state
        let noteId = ref 0
        let createNote (state : option<Note>)  =
            let currentId = !noteId
            incr noteId

            let edit = Div [ Class "edit"; Html5.Attr.ContentEditable "true"]
            let close = Div [Class "closebutton"] 
            let rec note = 
                Div [Class "note"] -< [ 
                    Div [Class "header"] |>! OnMouseDown (fun _ _ -> bringToTop note)
                    close
                    edit 
                    ]

            close |> OnClick(fun _ _ ->
                    note.JQuery.Animate({opacity=0.3}, 300.0, "linear", (fun () -> 
                        notes.Remove(currentId) |> ignore
                        note.Remove()
                        )) |> ignore
                )

            // make element draggable
            JQueryUI.Draggable.New(note, JQueryUI.DraggableConfiguration(Handle = ".header")) |> ignore
            notes.Add(currentId, (note, edit))
                        
            match state with
            | Some(n) ->
                edit.Append n.Content
                note.Css("left", string n.X + "px")
                note.Css("top", string n.Y + "px")

            | _ -> 
                ()
                            
            body.Append(note)
        
        // saves current snapshot of notes in server storage
        let saveNotes (el : Element) (_ : JQueryEvent) = 
            el.SetAttribute("disabled", "true") 
            el.Text <- "Saving..."

            notes
                |> Seq.map(fun kv  -> 
                        let n,e = kv.Value
                        let pos =  n.JQuery.Position()
                        { X = pos.Left; Y = pos.Top; Content = e.Html }
                    )
                |> Seq.toList
                |> Rpc.saveNotes

            el.Text <- "Save"
            el.RemoveAttribute("disabled")


        // restore previous state
        let notes = Rpc.loadNotes()
        for n in notes do
            createNote (Some n)
        
        Table [
            TR [
                TD [ Width "30"] -< [Button [Text "Create"] |>! OnClick(fun _ _ -> createNote None) ] 
                TD [ Button [Text "Save" ] |>! OnClick saveNotes ] 
               ]
            TR [TD [ColSpan "2" ] -< [body] ]
        ]


[<JavaScriptType>]
type Body() = 
    inherit Web.Control()
    [<JavaScript>]
    override this.Body = Notes.main () 

Notes:

1. Javascript attribute marks items that should be compiled into JavaScript
2. AnimateConfiguration type is static wrapper for calling .animate function. WebSharper JavaScript translator converts F# record types into JavaScript objects with matching fields. We need to pass fixed number of parameters so solution with record will be shorted than common approach from section 7.
3. Element.Css function sets style property to given object via calling .css()
4. Page structure is defined with handy HTML combinators(Div, Table etc…)
5. -< combinator appends one sequence to another. It is basically used to create element both with attributes and child elements.
6. |>! combinator allows attaching event handlers to elements in a composable way. Its definition is simple:

   let (|>!) x f = f x; x 

7. JQueryUI.Draggable is a typed wrapper to  JQuery draggable plugin. It accepts parameters in form of DraggableConfiguration object: type with fields having DefaultValueAttibute attached. This is common convention for passing objects with optional fields to JavaScript code.
8. When F# to JavaScript translator meets type annotated with JavaScriptTypeAttribute, it generates not only data fields but also class representation.

Also you’ve noticed Require attribute atop of Notes module. This attribute is utilized by WebSharper resource control system that tracks all necessary dependencies(css or js files) and orders them properly – all these activities are based on declarative information provided by developer. First of al you need to define a resource, in our sample it will be external css file.

module Styles = 
    type StickyNotes() = 
        interface IResource with
            member this.Render(r, w) = 
                let u = r.GetWebResourceUrl(typeof<StickyNotes>, "StickyNotes.css")
                Resource.RenderCss u w

Resource is type that has default constructor and implements interface IResource.

After than annotate all types that depends on this resource with Require attribute (you can also apply RequireAssembly to assembly). WebSharper will build directed graph and use for resource management. ScriptManager control that should be embedded in the head section emits all necessary page resources preserving correct order.

Entire VS2010 solution with this sample can be found here, it already contains WebSharper JQueryUI extension but you also need WebSharper to be installed, so you can build and run the application.

Demonstration:

1. I’ve opened Firefox and created two notes

2. One note is closed (it’s a pity, but I wasn’t able to capture fancy semi-transparent note when it dissapears)

3. I saved the state and opened the same page in Chrome (on the right).

Stay tuned!