Movatterモバイル変換


[0]ホーム

URL:


TP

Write your own Excel in 100 lines of F#

I've been teaching F# for over seven years now, both in the public F# FastTrack course that we runat SkillsMatter in London and in various custom trainings for private companies. Every time I teachthe F# FastTrack course, I modify the material in one way or another. I wrote about some of thisinteresting historylast year in an fsharpWorks article. The course now has a stable half-dayintroduction to the language and a stable focus on the ideas behind functional-first programming,but there are always new examples and applications that illustrate this style of programming.

When we started, we mostly focused on teaching functional programming concepts that might be usefuleven if you use C# and on building analytical components that your could integrate into a larger.NET solution. Since then, the F# community has matured, established theF# Software Foundation,but also built a number of mature end-to-end ecosystems that you can rely on such asFable,the F# to JavaScript compiler, andSAFE Stack for full-stack web development.

For the upcoming December course in London, I added a number of demos and hands-on tasks builtusing Fable, partly because running F# in a browser is an easy way to illustrate many conceptsand partly because Fable has some amazing functional-first libraries.

If you are interested in learning F# and attending our course, the nextF# FastTracktakes place on6-7 December in London at SkillsMatter. We also offer customon-site trainings. Get in touch at@tomaspetricekor emailtomas@tomasp.net for a 10% discount for the course.

One of the new samples I want to show, which I alsolive coded at NDC 2018,is building a simple web-based Excel-like spreadsheet application. The spreadsheet demonstratesall the great F# features such as domain modeling with types, the power of compositionalityand also how functional-first approach can be amazingly powerful for building user interfaces.

What is a spreadsheet?

The sample compiles to JavaScript, so the best way of explaining what we want to build isto give you a live demo you can play with! Since this is a blog post about functional programming,I already implemented both Fibonacci numbers (column B) and factorial (column D) in the spreadsheet for you!

You can click on any cell to edit the cells. To confirm your edit, just click on any other cell.You can enter numbers such as1 (in cell B1) or formulas such as=B1+B2 in cell B3. Formulassupport parentheses and four standard numerical operators. When you make an edit, the spreadsheetautomatically updates. If you make a syntax error, reference empty cell or create a recursivereference, the spreadsheet will show#ERR.

Full source code is available in myelmish-spreadsheet repository on GitHub(as a hands-on exercise inmaster branch and fully working in thecompleted branch), but youcan also play with it in theFable REPL (see Samples, Elmish, Spreadsheet),which lets you edit and run F# in the browser.

Defining the domain model

Following the typical F# type-driven development style, the first thing we need to think aboutis the domain model. Our types should capture what we work with in a spreadsheet application.In our case, we have positions such asA5 orC10, expressions such as=A1+3 and the sheetitself which has user input in some of the cells. To model these, we define types forPosition,Expr andSheet:

1:2:3:4:5:6:7:8:
typePosition=char*inttypeExpr=|Numberofint|ReferenceofPosition|BinaryofExpr*char*ExprtypeSheet=Map<Position,string>

APosition is simply a pair of column name and a number. An expression is more interesting,because it is recursive. For example,A1+3 is an application of a binary operator on sub-expressionsA1, which is a reference and3 which is a numerical constant. In F#, we capture this nicelyusing a discriminated union. In theBinary case, the left and right sub-expressions are themselvesvalues of theExpr type, so ourExpr type is recursive.

The typeSheet is a map from positions to raw user inputs. We could also store parsed expressions oreven evaluated results, but we always need the original input so that the user can edit it. To makethings simple, we'll just store the original input and parse it each time we need to evaluate thevalue of a cell. To do the parsing and evaluation, we'll later define two functions:

1:2:
valparse:string->Exproptionvalevaluate:Expr*Sheet->intoption

We will talk about these later when we discuss the logic behind our spreadsheet, but writing thetype down early is useful. Given these types, we can already see how everything fits together.Given a position, we can do a lookup intoSheet to find the entered text, then we can parse itusingparse to getExpr and, finally, pass the expression toevaluate to get the resultingvalue. We also see that bothparse andevaluate might fail. The first one will fail if theinput is not a valid formula and the second might fail if you reference an empty cell.

Now, all we have to do is to keep writing the rest of Excel until the type checker is happy!

Creating user interface using Elmish

I'm going to start by discussing the user interface and then get back to implementing the parsingand evaluation logic. For creating user interfaces, Fable comes with a great library calledElmish. Elmish implements a functional-first user interfacearchitecture popularized by the Elm language, which is also known asmodel view update.

The idea of the architecture is extremely simple. You just need the following two types andtwo functions:

1:2:3:4:5:
typeState=(Record capturing the state)typeEvent=(Union listing possible events)valupdate:State->Event->Statevalview:State->(Event->unit)->Html

The two types and two functions define the user interface as follows:

Conceptually, you can think that the application starts with an initial state, renders a page and,when some action happens and event is triggered, updates the state usingupdate and re-rendersthe page usingview. The key trick that makes this work is that Elmish does not replace thewhole DOM, but diffs the new document with the last one and only updates DOM elements that havechanged.

What state and events are there in our spreadsheet? As with the whole spreadsheet application,the first step in implementing the user interface is to define a few types:

1:2:3:4:5:6:7:8:9:
typeEvent=|UpdateValueofPosition*string|StartEditofPositiontypeState={Rows:intlistCols:charlistActive:PositionoptionCells:Sheet}

In the state, we keep a list of row and column keys (this typically starts fromA1, butwe do not require that), currently selected cell (this can beNone if no cell is selected)and, finally, the cells of the spreadsheet. There are two events that can happen.TheUpdateValue event happens when you change the text in the current cell; theStartEditevent happens when you click on some other cell to start editing it.

Updating the spreadsheet after event

Writing theupdate function is quite easy - as with the main spreadsheet logic, we just needto write code until the type checker is happy!

In Elmish, theupdate function is a little bit more complicated than I said above. Inaddition to returning new state, we can also return a list ofcommands. The commands areused to tell the system that it should start some action after updating the state. This canbe things such as starting a HTTP web request to fetch some information from the server.In our case, we do not need any commands, so we just returnCmd.none:

1:2:3:4:5:6:7:8:
letupdatemsgstate=matchmsgwith|StartEdit(pos)->{statewithActive=Somepos},Cmd.none|UpdateValue(pos,value)->letnewCells=Map.addposvaluestate.Cells{statewithCells=newCells},Cmd.none

The implementation uses thewith construct, which creates a clone of thestate recordand updates some of its fields. In the case ofStartEdit, we set the active cell to thenewly selected one. In the case ofUpdateValue, we first add the new value to the sheet(theMap.add function replaces existing value if there is one already) and then set theCells of the spreadsheet.

Rendering the spreadsheet

To construct the HTML document, Elmish comes with a lightweight wrapper built on top ofReact (although you can use other virtual DOM libraries too). The wrapper defines typedfunctions for creating HTML elements and specifying their attributes.

We'll first implement the mainview function which generates the spreadsheet grid andthen discuss therenderCell helper which renders an individual cell.

 1: 2: 3: 4: 5: 6: 7: 8: 9:10:11:12:13:14:15:
letviewstatetrigger=table[][thead[][tr[][yieldth[][]forcolinstate.Cols->th[][str(stringcol)]]]tbody[][forrowinstate.Rows->tr[][yieldth[][str(stringrow)]forcolinstate.Cols->renderCelltrigger(col,row)state]]]

Here, we're using F# list comprehensions to generate the HTML document. For example, thelines 4-7 generate the header of the table. We create atr element with no attributes(the first argument) containing a couple ofth elements (the second argument). We'reusingyield to generate the elements - first, we create the emptyth element in theleft top corner and then we iterate over all the columns and produce a header for each ofthe columns. Thecol variable is a character, so we first turn it into a string usingstring before turning it into HTML content usingstr function provided by Elmish.

The nice thing about writing your HTML rendering in this way is that it is composable.We do not have to put everything inside one massive function. Here, we callrenderCell(line 12) to render the contents of a cell.

Rendering spreadsheet cell

There are two different ways in which we render a cell. For the selected cell, we needto render an editor with an input box containing the original entered text. For all othercells, we need to parse the formula, evaluate it and display the result. TherenderCellfunction chooses the branch and, in the latter case, handles the evaluation:

 1: 2: 3: 4: 5: 6: 7: 8: 9:10:11:12:13:
letrenderCelltriggerposstate=ifstate.Active=Someposthenlettext=Map.tryFindposstate.CellsrenderEditortriggerpos(defaultArgtext"")elsematchMap.tryFindposstate.Cellswith|Someinput->letresult=parseinput|>Option.bind(evaluateSet.emptystate.Cells)|>Option.mapstringrenderViewtriggerposresult|_->renderViewtriggerpos(Some"")

We test whether the cell that is being rendered is the active one using thestate.Active = Some pos condition. Rather than comparing twoPosition values,we comparePosition option values and do not have to worry about the case whenstate.Active isNone.

If the current cell is active, we take the entered value or empty string and passit torenderEditor (defined next). If no, then we try to get the input - if there isno input, we callrenderView withSome "" to render valid but empty cell. Otherwise, weuse a sequence ofparse andevaluate to get the result. We will look at both of thesefunctions below, when discussing how the spreadsheet logic is implemented. Bothparse andevaluate may fail, so we use the option type to compose them.Option.bindrunsevaluate only whenparse succeeds; otherwise it propagates theNone result.We also useOption.map to transform the optional result of typeint into anoptional string which we then pass torenderView.

So far, we have not created any handlers that would trigger events when somethinghappens in the user interface. We're finally going to do this inrenderEditor andrenderView, which are both otherwise quite straightforward:

 1: 2: 3: 4: 5: 6: 7: 8: 9:10:11:12:13:14:
letrenderViewtriggerpos(value:option<_>)=letcolor=ifvalue.IsNonethen"#ffb0b0"else"white"td[Style[Backgroundcolor]OnClick(fun_->trigger(StartEdit(pos)))][str(defaultArgvalue"#ERR")]letrenderEditortriggerposvalue=td[Class"selected"][input[AutoFocustrueOnInput(fune->trigger(UpdateValue(pos,e.target?value)))Valuevalue]]

InrenderView, we create red background and use the#ERR string if the value to displayis empty (indicating an error). We also add anOnClick handler. When you click on the cell,we want to trigger theStartEdit event in order to move the editor to the current cell. Todo this, we specify theOnClick attribute and, when a click happens, trigger the event usingthetrigger function which we got as an input argument for theview function (and whichwe first passed torenderCell and then torenderView).

TherenderEditor function is similar. We specify theOnInput handler and, whenever the textin the input changes, trigger theUpdateValue event to update the value and recalculateeverything in the spreadsheet. We also specifyAutoFocus attribute which ensures that theelement is active immediately after it is created (when you click on a cell).

Putting it all together

Now we have all the four components we need to run our user interface. We have theState andEvent type definitions and we have theupdate andview functions. To put everything together,we need to define the initial state, specify the ID of the HTML element in which the applicationshould be rendered and start it.

 1: 2: 3: 4: 5: 6: 7: 8: 9:10:
letinitial()={Cols=['A'..'K']Rows=[1..15]Active=NoneCells=Map.empty},Cmd.EmptyProgram.mkPrograminitialupdateview|>Program.withReact"main"|>Program.run

The initial state defines the ranges of available rows and columns and specifies that thereare no values in any of the cells (the demo embedded above specifies the initial cells forcomputing factorial and Fibonacci here). Then we usemkProgram to compose all thecomponents together, we specify React as our execution engine and we start the Elmish application!

Implementing spreadsheet logic

So far, we defined the domain model which specifies what a spreadsheet is using F# types andwe implemented the user interface using Elmish. The only thing we skipped so far is thespreadsheet logic - that is, parsing of formulas and evaluation. Completing these two is going tobe easier than you might expect!

Evaluating spreadsheet formulas

First, let's have a look at how to evaluate formulas. In the beginning, we defined theExprtype as a discriminated union with three cases:Number,Binary andReference. Toevaluate an expression, we need to write a recursive function that uses pattern matching andappropriately handles each case. We'll start with a simple version that does not handle errorsand does not check for recursive formulas:

 1: 2: 3: 4: 5: 6: 7: 8: 9:10:11:12:13:
letrecevaluatecellsexpr=matchexprwith|Numbernum->num|Binary(l,op,r)->letops=dict['+',(+);'-',(-);'*',(*);'/',(/)]letl,r=evaluatecellsl,evaluatecellsrops.[op]lr|Referencepos->letparsed=parse(Map.findposcells)evaluatecells(Option.getparsed)

The function takes the spreadsheetcells as a first argument, because it may need to lookupvalues of cells referenced by the current expression. It also takes the expressionexpr andpattern matches on it. HandlingNumber is easy - we just return the number.

HandlingBinary is a bit more interesting, because we need to callevaluate recursivelyto evaluate the value of the left and right sub-expressions. Once we have them, we use a simpledictionary to map the operator to a function (written using standard F# operators) and run thefunction.

Finally, when handling aReference, we first get the input at the given cell, parse it andthen (again) recursively callevaluate. This can fail in many ways - the cell might be emptyor the parser could fail. We improve this in the next version of our evaluator where thefunction returnsint option rather thanint. The missing valueNone indicates thatsomething went wrong.

 1: 2: 3: 4: 5: 6: 7: 8: 9:10:11:12:13:14:15:16:17:18:
letrecevaluatevisitedcellsexpr=matchexprwith|Numbernum->Somenum|Binary(l,op,r)->letops=dict['+',(+);'-',(-);'*',(*);'/',(/)]evaluatevisitedcellsl|>Option.bind(funl->evaluatevisitedcellsr|>Option.map(funr->ops.[op]lr))|ReferenceposwhenSet.containsposvisited->None|Referencepos->Map.tryFindposcells|>Option.bind(funvalue->parsevalue|>Option.bind(funparsed->evaluate(Set.addposvisited)cellsparsed))

In case ofNumber, we now returnSome num. In this case, evaluation cannot fail.In case ofBinary, both recursive calls can fail and we get two option values. To handle this,we useOption.bind andOption.map - both of these will call the specified function only whenthe previous operation succeeded, otherwise, they immediately returnNone indicating a failure.If both the left and the right sub-expressions can be evaluated, we can then apply binary numericaloperator to their results. Handling ofReference is similar - we sequence a number of operationsthat may fail usingOption.bind.

Another interesting feature we added in this version is checking for recursive references. Todo this, theevaluate function now takes thevisited parameter which is a set of cells thatwere accessed during the evaluation. We add cells to the set usingSet.add pos visited online 18. When we find a reference to a cell that we already visited (line 12), then we immediatelyreturnNone, because this would lead to an infinite loop.

Parsing formulas

Finally, the last part of logic that we need to implement is the parsing of formulas entered bythe user into values of ourExpr type. For this, we're going to use a very simple parser combinatorlibrary (which you can find in thefull source code).There are four key concepts in the library:

1:2:3:4:5:
typeParser<'TChar,'TResult>='TCharlist->option<'TResult*'TCharlist>val(<*>):Parser<'T1>->Parser<'T2>->Parser<'T1*'T2>val(<|>):Parser<'T>->Parser<'T>->Parser<'T>valmap:('T->'R)->Parser<'T>->Parser<'R>

The following snippet shows how we use these three ideas to create simple parsers to recogniseoperators, references and numbers:

1:2:3:
letoperator=char'+'<|>char'-'<|>char'*'<|>char'/'letreference=letter<*>integer|>mapReferenceletnumber=integer|>mapNumber

Thechar function creates a parser that recognises only the given character (and then returns it as theresult). Thus, theoperator parser recognises the four standard numerical binary operators and acceptsno other characters. Thereference parser recognises a letter followed by a number. This returnsachar * int pair which we turn into theReference value ofExpr using themap function.Parsing a number is even easier - we just run the built-ininteger parser and wrap it inNumber.Note that the type ofreference andnumber is now the same -Parser<char, Expr>. This means thatwe can compose them using<|> to create parser that recognises either of the two expression types.

Finishing the rest of the parsing is a bit more work, because we need to handle parentheses as(1+2)*3 and also ignore whitespace, but the concepts are the same:

1:2:3:4:5:6:7:8:9:
letexprSetter,expr=slot()letbrack=char'('<*>>anySpace<*>>expr<<*>anySpace<<*>char')'letterm=number<|>reference<|>brackletbinary=term<<*>anySpace<*>operator<<*>anySpace<*>term|>map(fun((l,op),r)->Binary(l,op,r))letexprAux=binary<|>termexprSetter.SetexprAux

To deal with recursion, the library allows us to create a parser usingslot, use it, and then definewhat it is later usingexprSetter. In our case, we defineexpr on line 1, use it when definingbrack (line 3) and then define it on line 9. This is a recursive reference;exprAux canbebinary, which containsterm, which can bebrack and that, in turn, containsexpr.

The only other clever thing in the snippet are the<<*> and<*>> operators. Those behave like<*>, but return only the result from the parser on the left or right (wherever the double arrow points).This is useful, because we can writeanySpace <*>> expr <<*> anySpace to parser expression surroundedby whitespace, but get a parser that returns just the result ofexpr (we do not care what the whitespacewas).

Finally, we define a formula which is= followed by an expression and an equation - that is, the thingthat you can type in the spreadsheet - which is either a formula or a number.

1:2:3:
letformula=char'='<*>>anySpace<*>>exprletequation=anySpace<*>>(formula<|>number)<<*>anySpaceletparseinput=runequationinput

Theparse function defined on the last line lets us run the mainequation parser on a given input.It takes a sequence of characters and producesoption<Expr>, which is exactly what we've used earlierin the article.

Conclusions

In total, this article showed you some 125 lines of code. If we did not worry about nice formattingand skipped all the blank lines, we could have written a simple spreadsheet application in some 100lines of code! Aside from standard Fable libraries, the only thing I did not count is the parser combinatorlibrary. I wrote that on my own, but there are similar existing libraries that you could use (thoughyou'd need to find one that works with Fable).

The final spreadsheet application is quite simple, but it does a number of interesting things. Itruns in a web browser and you can scroll back to the start of the article to play with it again!On the technical side, it has a user interface where you can select and edit cells, it parses theformulas you enter and it also evaluates them, handling errors and recursive references.

If you enjoyed this post and want to learn more about F# and also Fable, joinourF# FastTrackcourse on6-7 December inLondon at SkillsMatter. We'll cover Fable, Elmish, butalso many other F# examples. Get in touch at@tomaspetricekor emailtomas@tomasp.net for a 10% discount for the course,or if you are interested in custom on-site training.

I like this example, because it shows how a number of nice aspects of the F# language and also theF# community can come together to provide a fantastic overall experience. In case of our spreadsheet,this includes:

If you want to have a look at the complete source code, you can find itin my elmish-spreadsheetrepository on GitHub. The repository is designedas a hands-on exercise where you can start with a template, complete a number of tasks and endup with a spreadsheet, but there is alsocompleted branch where you find the finished source code.You can also edit and run the code in your browser using theFable REPL(you'll find it under Samples, Elmish, Spreadsheet),

type Position = char * int
Multiple items
val char : value:'T -> char (requires member op_Explicit)

--------------------
type char = System.Char
Multiple items
val int : value:'T -> int (requires member op_Explicit)

--------------------
type int = int32

--------------------
type int<'Measure> = int
type Expr =
  | Number of int
  | Reference of Position
  | Binary of Expr * char * Expr
union case Expr.Number: int -> Expr
union case Expr.Reference: Position -> Expr
union case Expr.Binary: Expr * char * Expr -> Expr
type Sheet = Map<Position,string>
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IReadOnlyDictionary<'Key,'Value>
  interface IReadOnlyCollection<KeyValuePair<'Key,'Value>>
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  ...

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
Multiple items
val string : value:'T -> string

--------------------
type string = System.String
type 'T option = Option<'T>
module Parsec
val operator : Parser<char,char>
Multiple items
val char : tok:'a -> Parser<'a,'a> (requires equality)

--------------------
type char = System.Char
val reference : Parser<char,Expr>
val letter : Parser<char,char>
val integer : Parser<char,int>
val map : f:('a -> 'b) -> Parser<'c,'a> -> Parser<'c,'b>


 Transforms the result of the parser using the specified function
val number : Parser<char,Expr>
val exprSetter : ParserSetter<char,Expr>
val expr : Parser<char,Expr>
val slot : unit -> ParserSetter<'a,'b> * Parser<'a,'b>


 Creates a delayed parser whose actual parser is set later
val brack : Parser<char,Expr>
val anySpace : Parser<char,char list>
val term : Parser<char,Expr>
val binary : Parser<char,Expr>
val l : Expr
val op : char
val r : Expr
val exprAux : Parser<char,Expr>
ParserSetter.Set: Parser<char,Expr> -> unit
val formula : Parser<char,Expr>
val equation : Parser<char,Expr>
val parse : input:seq<char> -> Expr option
val input : seq<char>
val run : Parser<'a,'b> -> input:seq<'a> -> 'b option
val evaluate : cells:Map<Position,#seq<char>> -> expr:Expr -> int
val cells : Map<Position,#seq<char>>
val expr : Expr
val num : int
val ops : System.Collections.Generic.IDictionary<char,(int -> int -> int)>
val dict : keyValuePairs:seq<'Key * 'Value> -> System.Collections.Generic.IDictionary<'Key,'Value> (requires equality)
val l : int
val r : int
val pos : Position
val parsed : Expr option
val find : key:'Key -> table:Map<'Key,'T> -> 'T (requires comparison)
module Option

from Microsoft.FSharp.Core
val get : option:'T option -> 'T
val evaluate : visited:Set<Position> -> cells:Map<Position,#seq<char>> -> expr:Expr -> int option
val visited : Set<Position>
union case Option.Some: Value: 'T -> Option<'T>
val bind : binder:('T -> 'U option) -> option:'T option -> 'U option
val map : mapping:('T -> 'U) -> option:'T option -> 'U option
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IReadOnlyCollection<'T>
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  ...

--------------------
new : elements:seq<'T> -> Set<'T>
val contains : element:'T -> set:Set<'T> -> bool (requires comparison)
union case Option.None: Option<'T>
val tryFind : key:'Key -> table:Map<'Key,'T> -> 'T option (requires comparison)
val value : #seq<char>
val parsed : Expr
val add : value:'T -> set:Set<'T> -> Set<'T> (requires comparison)
namespace Elmish
namespace Elmish.React
namespace Fable
namespace Fable.Helpers
module React

from Fable.Helpers
module Props

from Fable.Helpers.React
namespace Fable.Core
module JsInterop

from Fable.Core
namespace Fable.Import
{ State : string }
Multiple items
module Event

from Microsoft.FSharp.Control

--------------------
type Event<'T> =
  new : unit -> Event<'T>
  member Trigger : arg:'T -> unit
  member Publish : IEvent<'T>

--------------------
type Event<'Delegate,'Args (requires delegate and 'Delegate :> Delegate)> =
  new : unit -> Event<'Delegate,'Args>
  member Trigger : sender:obj * args:'Args -> unit
  member Publish : IEvent<'Delegate,'Args>

--------------------
new : unit -> Event<'T>

--------------------
new : unit -> Event<'Delegate,'Args>
EventOne | EventTwo
type unit = Unit
Multiple items
module Event

from Microsoft.FSharp.Control

--------------------
type Event =
  | UpdateValue of Position * string
  | StartEdit of Position

--------------------
type Event<'T> =
  new : unit -> Event<'T>
  member Trigger : arg:'T -> unit
  member Publish : IEvent<'T>

--------------------
type Event<'Delegate,'Args (requires delegate and 'Delegate :> Delegate)> =
  new : unit -> Event<'Delegate,'Args>
  member Trigger : sender:obj * args:'Args -> unit
  member Publish : IEvent<'Delegate,'Args>

--------------------
new : unit -> Event<'T>

--------------------
new : unit -> Event<'Delegate,'Args>
union case Event.UpdateValue: Position * string -> Event
Multiple items
union case CSSProp.Position: obj -> CSSProp

--------------------
type Position = char * int
union case Event.StartEdit: Position -> Event
type State =
  {Rows: int list;
   Cols: char list;
   Active: Position option;
   Cells: Sheet;}
State.Rows: int list
type 'T list = List<'T>
State.Cols: char list
State.Active: Position option
Multiple items
val option : b:seq<IHTMLProp> -> c:seq<React.ReactElement> -> React.ReactElement

--------------------
type 'T option = Option<'T>
State.Cells: Sheet
val update : msg:Event -> state:State -> State * Cmd<'a>
val msg : Event
val state : State
Multiple items
module Cmd

from Elmish

--------------------
type Cmd<'msg> = Sub<'msg> list
val none : Cmd<'msg>
val value : string
val newCells : Map<Position,string>
val add : key:'Key -> value:'T -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)
val renderView : trigger:(Event -> unit) -> char * int -> value:string option -> React.ReactElement
val trigger : (Event -> unit)
val value : string option
val color : string
property Option.IsNone: bool
val td : b:seq<IHTMLProp> -> c:seq<React.ReactElement> -> React.ReactElement
union case HTMLAttr.Style: CSSProp list -> HTMLAttr
union case CSSProp.Background: obj -> CSSProp
union case DOMAttr.OnClick: (React.MouseEvent -> unit) -> DOMAttr
val str : s:string -> React.ReactElement
val defaultArg : arg:'T option -> defaultValue:'T -> 'T
val renderEditor : trigger:(Event -> unit) -> char * int -> value:string -> React.ReactElement
Multiple items
union case HTMLAttr.Class: string -> HTMLAttr

--------------------
type ClassAttribute =
  inherit Attribute
  new : unit -> ClassAttribute

--------------------
new : unit -> ClassAttribute
val input : b:seq<IHTMLProp> -> React.ReactElement
union case HTMLAttr.AutoFocus: bool -> HTMLAttr
union case DOMAttr.OnInput: (React.FormEvent -> unit) -> DOMAttr
val e : React.FormEvent
property React.SyntheticEvent.target: Browser.EventTarget
union case HTMLAttr.Value: string -> HTMLAttr
val renderCell : trigger:(Event -> unit) -> char * int -> state:State -> React.ReactElement
val text : string option
val input : string
val result : string option
val empty<'T (requires comparison)> : Set<'T> (requires comparison)
val view : state:State -> trigger:(Event -> unit) -> React.ReactElement
val table : b:seq<IHTMLProp> -> c:seq<React.ReactElement> -> React.ReactElement
val thead : b:seq<IHTMLProp> -> c:seq<React.ReactElement> -> React.ReactElement
val tr : b:seq<IHTMLProp> -> c:seq<React.ReactElement> -> React.ReactElement
val th : b:seq<IHTMLProp> -> c:seq<React.ReactElement> -> React.ReactElement
val col : char
val tbody : b:seq<IHTMLProp> -> c:seq<React.ReactElement> -> React.ReactElement
val row : int
val initial : unit -> State * Sub<'a> list
union case HTMLAttr.Cols: float -> HTMLAttr
union case HTMLAttr.Rows: float -> HTMLAttr
val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)
property List.Empty: Sub<'msg> list
Multiple items
module Program

from Elmish.React

--------------------
module Program

from Elmish

--------------------
type Program<'arg,'model,'msg,'view> =
  {init: 'arg -> 'model * Cmd<'msg>;
   update: 'msg -> 'model -> 'model * Cmd<'msg>;
   subscribe: 'model -> Cmd<'msg>;
   view: 'model -> Dispatch<'msg> -> 'view;
   setState: 'model -> Dispatch<'msg> -> unit;
   onError: string * exn -> unit;}
val mkProgram : init:('arg -> 'model * Cmd<'msg>) -> update:('msg -> 'model -> 'model * Cmd<'msg>) -> view:('model -> Dispatch<'msg> -> 'view) -> Program<'arg,'model,'msg,'view>
val withReact : placeholderId:string -> program:Program<'a,'b,'c,React.ReactElement> -> Program<'a,'b,'c,React.ReactElement>
val run : program:Program<unit,'model,'msg,'view> -> unit

Published: Monday, 12 November 2018, 1:58 PM
Author: Tomas Petricek
Typos:Send me a pull request!
Tags:f#,functional,training,fable


[8]ページ先頭

©2009-2025 Movatter.jp