понедельник, 30 августа 2010 г.

F#: Building compiler from sources.

I think every curious person couldn’t resist from peeking when he met folder named Source inside F# installation directory. And what can be funnier that browsing through the source code of real-world compiler? Of course, compiling them sources and observing all internal compiler activities, so to say “in action’.

You need F# 2.0 and F#PowerPack to be installed. Additionaly we’ll build a few necessary utilities from PowerPack sources (in fact we can build entire PowerPack from scratch, but to save time we’ll take prepared binaries).

Initial ingredients:

So, let’s start:

  1. Create new folder (denoted below as $ROOT)
  2. Copy F# sources into $ROOT\source
  3. Copy PowerPack sources into $ROOT\powerpack
  4. Create auxiliary directory $ROOT\lkg\FSharp-2.0.50726.900\bin\. Copy files listed below to newly created folder
    • From PowerPack installation folder
      • FSharp.PowerPack.targets
      • FSharp.PowerPack.Build.Tasks.dll
      • Fslex.exe
      • Fsyacc.exe
    • From F# installation folder
      • Fsc.exe
      • FSharp.Core.dll
      • FSharp.Core.optdata
      • FSharpCore.sigdata
  5. Briefly about remaining steps: build FsSrGen utility from PowerPack, build proto compiler and finally build result compiler with proto (obtained on step 2). To automate the build process you can use script given below (copy it to $ROOT folder)
    set MSB35="c:\WINDOWS\Microsoft.NET\Framework\v3.5\MSBuild.exe"

    SET ROOT=%cd%

    @rem Delete previous build results
    rmdir %ROOT%\powerpack\head\Debug /S /Q

    @rem Build FsResGen
    cd %ROOT%\powerpack\head\workyard\FsSrGen\FsSrGen
    %MSB35% FsSrGen.fsproj

    @rem Build FsResGen task
    cd %ROOT%\powerpack\head\workyard\FsSrGen\FSharp.SRGen.Build.Tasks
    %MSB35% FSharp.SRGen.Build.Tasks.fsproj

    @rem Copy build results
    copy %ROOT%\powerpack\head\Debug\bin\*.* %ROOT%\lkg\FSharp-2.0.50726.900\bin\ /Y

    rem proto
    cd %ROOT%\source
    %MSB35% /p:TargetFrameworkVersion=v3.5 fsharp-proto-build.proj
    %MSB35% /p:TargetFrameworkVersion=v3.5 fsharp-compiler-build.proj

    cd %ROOT%\source\Debug\bin\

Overall compilation time will be something about 20 min.

Testing the result

For the test we’'ll take well-known sample with async downloading of web pages, but this time it will be examined from the inside.

open System.IO
open System.Net

let downloadPage (uri : string) = async {
let request = WebRequest.Create(uri)
let! response = request.AsyncGetResponse()
use stream = response.GetResponseStream()
use reader = new StreamReader(stream)
return reader.ReadLine()
}

let content = Async.RunSynchronously <| downloadPage "http://microsoft.com"
printfn "%d" content.Length

 

Create new C# ConsoleApplication project in VS, open Project Properties –> Debug page and select Start external program.

1. set path

External program here: out freshly built fsc.

Save settings, press F10 and behold… you are debugging the compiler

debugging the compiler  parsing in progress

After compiler finish its job modify Project Properties and replace external program file from  fsc.exe to the name of new executable file.

main

Start debugging and set breakpoint inside downloadPage function.

debug 3

Press F11 several times and you step into source code of FSharp.Core

debug 4

Having your own tamed version of the compiler is pretty convinient, you can not only browse static source code but also inspect behavior dynamically. Imagination is the only limitation, enjoy :).

суббота, 14 августа 2010 г.

INotifyPropertyChanged strikes back

This short post was inspired by this question on StackOverflow. Questioner asks for some language-specific features that can simplify tracking of changes in objects. This task can be perfectly solved by language that supports compile-time metaprogramming, unfortunately F# doesn’t have such features… maybe only in some distant future. Let’s demonstrate the solution using language that already has such capabilities – Nemerle.

Macros in Nemerle are programs that are executed in compile-time, consumes and produces AST.

Macro code

using Nemerle;
using Nemerle.Assertions;
using Nemerle.Collections;
using Nemerle.Compiler;
using Nemerle.Compiler.Parsetree;
using Nemerle.Compiler.Typedtree;
using Nemerle.Text;
using Nemerle.Utility;

using System;
using SCG = System.Collections.Generic;
using System.Linq;
using System.ComponentModel;

namespace ComponentModelHelpers
{
[MacroUsage(MacroPhase.BeforeInheritance, MacroTargets.Class, Inherited = false, AllowMultiple = false)]
public macro ImplementsNotifyPropertyChanged(tb : TypeBuilder)
{
NPCHelper.ImplementInterface(tb);
}

[MacroUsage(MacroPhase.WithTypedMembers, MacroTargets.Class, Inherited = false, AllowMultiple = false)]
public macro ImplementsNotifyPropertyChanged(tb : TypeBuilder)
{
NPCHelper.FixProperties(tb)
}

[MacroUsage(MacroPhase.BeforeInheritance, MacroTargets.Property, Inherited = false, AllowMultiple = false)]
public macro IgnoreProperty(tb : TypeBuilder, property : ParsedProperty)
{
NPCHelper.RegisterIgnored(tb, property)
}

module NPCHelper
{
private ignoredProperties : SCG.HashSet[TypeBuilder * string] = SCG.HashSet();

public RegisterIgnored(tb : TypeBuilder, property : ClassMember.Property) : void
{
ignore(ignoredProperties.Add(tb, property.Name));
}

public FixProperties(tb : TypeBuilder) : void
{
def properties = tb
.GetProperties()
.Filter(p => !ignoredProperties.Contains(tb, p.Name));

foreach(p is PropertyBuilder in properties)
{
def setter = (p.GetSetter() :> MethodBuilder);
when (setter != null)
{
setter.Body = <[
$(setter.Body);
RaisePropertyChanged($(p.Name : string));
]>;
}
}
}

public ImplementInterface(tb : TypeBuilder) : void
{
def handlerFieldName = Macros.NewSymbol("PropertyChanged");
def fieldDecl = <[ decl:
private mutable $(handlerFieldName.Id : usesite) : PropertyChangedEventHandler;
]>;

def modifyEvent(modifier)
{
<[
mutable tmp;
mutable h = $(handlerFieldName.Id : usesite);
do
{
tmp = h;
def newHandler = $(modifier)(tmp, value) :> PropertyChangedEventHandler;
h = System.Threading.Interlocked.CompareExchange(ref $(handlerFieldName.Id : usesite), newHandler, tmp);
} while(h != tmp);
]>
}
def eventDecl = <[decl:
public event PropertyChanged : PropertyChangedEventHandler
{
add { $(modifyEvent(<[ Delegate.Combine ]>)); }
remove { $(modifyEvent(<[ Delegate.Remove ]>)); }
}
]>;

def raisePropertyChangedMethodDecl = <[ decl:
protected RaisePropertyChanged(propertyName: string) : void
{
def h = $(handlerFieldName.Id : usesite);
when (h != null)
h(this, PropertyChangedEventArgs(propertyName));
}
]>;

tb.Define(fieldDecl);
tb.Define(eventDecl);
tb.Define(raisePropertyChangedMethodDecl);
tb.AddImplementedInterface(<[INotifyPropertyChanged]>);
}
}
}

Notes:

  • ImplementsNotifyPropertyChanged macro adds implementation of INotifiedPropertyChanged and patches properties so RaisePropertyChanged will be called in every setter
  • IgnoreProperty registers ignored property.
  • <[ ]> – denotes a quotation. Basically quotation produces PExpr (expression), so we need to mark explicitly if quotation contains declaration with decl: prefix
  • $(…) – splice in quotation
  • Macros in Nemerle are hygienic, so x variable introduced in macros won’t clash with the variable of the same name. If we need to suppress hygiene – this is done with :usesite directive.

Client code

using Nemerle.Collections;
using Nemerle.Text;
using Nemerle.Utility;

using System;
using System.Collections.Generic;
using System.Console;
using System.Linq;
using System.ComponentModel;

using ComponentModelHelpers;

module Program
{
Main() : void
{
def c = MegaComponent();
Test(c);
c.X = 100;
c.Y = "123";
}

Test(npc : INotifyPropertyChanged) : void
{
npc.PropertyChanged += (_, e) => WriteLine($"$(e.PropertyName) changed")
}
}

[ImplementsNotifyPropertyChanged]
class MegaComponent
{
private mutable y : string;

public X : int {get;set;};

[IgnoreProperty]
public Y : string
{
get { y }
set
{
y = value;
RaisePropertyChanged("Y");
}
}
}

/*
X changed
Y changed
*/

Notes:

  • Macro is made accessible in source code by opening containing namespace: ComponentModelHelpers
  • RaisePropertyChanged method is generated by macro so source code can use it

Decompiled class

internal class MegaComponent : INotifyPropertyChanged
{
// Fields
private PropertyChangedEventHandler _N_PropertyChanged_2784;
[CompilerGenerated, DebuggerBrowsable(DebuggerBrowsableState.Never)]
private int _N_X_3169;
private string y;

// Events
public event PropertyChangedEventHandler PropertyChanged
{
add
{
PropertyChangedEventHandler a = null;
PropertyChangedEventHandler handler2 = this._N_PropertyChanged_2784;
do
{
a = handler2;
PropertyChangedEventHandler handler3 = (PropertyChangedEventHandler) Delegate.Combine(a, value);
handler2 = Interlocked.CompareExchange<PropertyChangedEventHandler>(ref this._N_PropertyChanged_2784, handler3, a);
}
while (handler2 != a);
}
remove
{
PropertyChangedEventHandler source = null;
PropertyChangedEventHandler handler2 = this._N_PropertyChanged_2784;
do
{
source = handler2;
PropertyChangedEventHandler handler3 = (PropertyChangedEventHandler) Delegate.Remove(source, value);
handler2 = Interlocked.CompareExchange<PropertyChangedEventHandler>(ref this._N_PropertyChanged_2784, handler3, source);
}
while (handler2 != source);
}
}

// Methods
protected void RaisePropertyChanged(string propertyName)
{
PropertyChangedEventHandler handler = this._N_PropertyChanged_2784;
if (handler != null)
{
handler(this, new PropertyChangedEventArgs(propertyName));
}
}

// Properties
public int X
{
[CompilerGenerated]
get
{
return this._N_X_3169;
}
[CompilerGenerated]
set
{
this._N_X_3169 = value;
this.RaisePropertyChanged("X");
}
}

public string Y
{
get
{
return this.y;
}
set
{
this.y = value;
this.RaisePropertyChanged("Y");
}
}
}

понедельник, 9 августа 2010 г.

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:

diagram

  • 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:

workflow

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

1_incorrect input

and behold… error notification.

2_tooltip

Fix formula: =A1 * 10 + 2

3_formulatooltip

Implicitly absence of value = 0

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

4_formulachain

Change value in A2 and observe chain reevaluation

5_reevaluation

Create formula cycle: A2 <- C1

6_cycle

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

7_if

Project source code can be downloaded here.

 
GeekySpeaky: Submit Your Site!