F# Implementation of The Elm Architecture

This is a prototype implementation of The Elm Architecture in F#. This post covers the UI implementation and a follow up post covers using it with WPF and Xamarin.

The Elm Architecture is a simple pattern for creating functional UIs. Due to its modularity and composability it makes UI code easier to write, understand, test and reuse.

The UI implementation is a complete representation of the native UI. A minimal list of UI updates is calculated from the current and future UI. This is then used to update the native UI with as little interaction as possible. This means the native UI renders faster and is more responsive. It also means multiple native UI platforms can be targeted with the same application code.

UI events are implemented using simple functions that are mapped and combined up to the top level message event. At the primitive UI component level events are implemented using a double ref . This is so the native UI events only have to be hooked up once. The events can be redirected quickly as the UI changes without the potential memory leak that arises from a single ref implementation.

/// Message event used on the primitive UI components. type ' msg Event = ( ' msg -> unit ) ref ref /// Layout for a section of UI components. type Layout = Horizontal | Vertical /// Primitive UI components. type UI = | Text of string | Input of string * string Event | Button of string * unit Event | Div of Layout * UI list /// UI component update and event redirection. type UIUpdate = | InsertUI of int list * UI | UpdateUI of int list * UI | ReplaceUI of int list * UI | RemoveUI of int list | EventUI of ( unit -> unit ) /// UI component including a message event. type ' msg UI = { UI : UI ; mutable Event : ' msg -> unit } /// UI application. type App < ' msg , ' model > = { Model : ' model : ' msg -> ' model -> ' model : ' model -> ' msg UI } /// Native UI interface. type INativeUI = abstract member : UIUpdate list -> unit

The UI rendering can be made even faster by using the memoize function in larger views. This stores a weak reference to a model and its view output. It makes the view and diff functions quicker and can remove unnecessary UI updates.

[< CompilationRepresentation ( CompilationRepresentationFlags . ModuleSuffix ) >] module UI = /// Memoize view generation from model object references. let < ' model , ' msg when ' model : not struct and ' msg : not struct > = let d = ConditionalWeakTable < ' model , ' msg UI > ( ) fun model -> match . TryGetValue model with | true , ui -> ui | false , _ -> let ui = model . Add ( model , ui ) ui /// Returns a Text display UI component. let text = { UI = Text text ; Event = } /// Returns a text Input UI component. let text = let ev = |> let ui = { UI = Input ( text , ev ) ; Event = } let a = ui . Event a ( ! ev ) := ui /// Returns a Button UI component. let text msg = let ev = |> let ui = { UI = Button ( text , ev ) ; Event = } ( ! ev ) := fun ( ) -> ui . Event msg ui /// Returns a section of UI components given a layout. /// The name div comes from HTML and represents a division (or section) of the UI. let layout list = let ui = { UI = Div ( layout , List . map ( fun ui -> ui . UI ) list ) ; Event = } let a = ui . Event a List . iter ( fun i -> i . Event <- ) list ui /// Returns a new UI component mapping the message event using the given function. let rec ui = let ui2 = { UI = ui . UI ; Event = } let e = e |> ui2 . Event ui . Event <- ui2 /// Returns a list of UI updates from two UI components. let ui1 ui2 = let inline e1 e2 = fun ( ) -> let ev = ! e1 in ev := ! ( ! e2 ) ; e2 := ev let rec ui1 ui2 path index diffs = match ui1 , ui2 with | _ when LanguagePrimitives . PhysicalEquality ui1 ui2 -> diffs | Text t1 , Text t2 -> if t1 = t2 then diffs else UpdateUI ( path , ui2 ) :: diffs | Button ( t1 , e1 ) , Button ( t2 , e2 ) -> if t1 = t2 then EventUI ( e1 e2 ) :: diffs else EventUI ( e1 e2 ) :: UpdateUI ( path , ui2 ) :: diffs | Input ( t1 , e1 ) , Input ( t2 , e2 ) -> if t1 = t2 then EventUI ( e1 e2 ) :: diffs else EventUI ( e1 e2 ) :: UpdateUI ( path , ui2 ) :: diffs | Button _ , Button _ | Input _ , Input _ -> UpdateUI ( path , ui2 ) :: diffs | Div ( l1 , _ ) , Div ( l2 , _ ) when l1 <> l2 -> ReplaceUI ( path , ui2 ) :: diffs | Div ( _ , [ ] ) , Div ( _ , [ ] ) -> diffs | Div ( _ , [ ] ) , Div ( _ , l ) -> List . fold ( fun ( i , diffs ) ui -> i + 1 , InsertUI ( i :: path , ui ) :: diffs ) ( index , diffs ) l |> | Div ( _ , l ) , Div ( _ , [ ] ) -> List . fold ( fun ( i , diffs ) _ -> i + 1 , RemoveUI ( i :: path ) :: diffs ) ( index , diffs ) l |> | Div ( l , ( h1 :: t1 ) ) , Div ( _ , ( h2 :: t2 ) ) when LanguagePrimitives . PhysicalEquality h1 h2 -> ( Div ( l , t1 ) ) ( Div ( l , t2 ) ) path ( index + 1 ) diffs | Div ( l , ( h1 :: t1 ) ) , Div ( _ , ( h2 :: h3 :: t2 ) ) when LanguagePrimitives . PhysicalEquality h1 h3 -> ( Div ( l , t1 ) ) ( Div ( l , t2 ) ) path ( index + 1 ) ( InsertUI ( index :: path , h2 ) :: diffs ) | Div ( l , ( _ :: h2 :: t1 ) ) , Div ( _ , ( h3 :: t2 ) ) when LanguagePrimitives . PhysicalEquality h2 h3 -> ( Div ( l , t1 ) ) ( Div ( l , t2 ) ) path ( index + 1 ) ( RemoveUI ( index :: path ) :: diffs ) | Div ( l , ( h1 :: t1 ) ) , Div ( _ , ( h2 :: t2 ) ) -> h1 h2 ( index :: path ) 0 diffs |> ( Div ( l , t1 ) ) ( Div ( l , t2 ) ) path ( index + 1 ) | _ -> ReplaceUI ( path , ui2 ) :: diffs ui1 . UI ui2 . UI [ ] 0 [ ] /// Returns a UI application from a UI model, update and view. let model = { Model = model ; = ; = } /// Runs a UI application given a native UI. let ( nativeUI : INativeUI ) app = let rec model ui msg = let newModel = . Update msg model let newUI = . View newModel newUI . Event <- newModel newUI let diff = ui newUI List . iter ( function | EventUI -> ( ) | _ -> ( ) ) diff . Send diff let ui = . View app . Model ui . Event <- app . Model ui . Send [ InsertUI ( [ ] , ui . UI ) ]

The UI application pattern has four main parts:

Model - the state of the application. Msg - an update message. Update - a function that updates the state. View - a function that views state as a UI.

module Counter = type Model = int let i : Model = i type Msg = Increment | Decrement let msg model = match msg with | Increment -> model + 1 | Decrement -> model - 1 let model = UI . div Horizontal [ UI . button "+" Increment UI . button "-" Decrement UI . text ( model ) ] let i = UI . app ( i ) module CounterPair = type Model = { Top : Counter . Model ; Bottom : Counter . Model } let top bottom = { Top = Counter . init top ; Bottom = Counter . init bottom } type Msg = | Reset | Top of Counter . Msg | Bottom of Counter . Msg let msg model = match msg with | Reset -> 0 0 | Top msg -> { model with Top = Counter . update msg model . Top } | Bottom msg -> { model with Bottom = Counter . update msg model . Bottom } let model = UI . div Vertical [ Counter . view model . Top |> UI . map Top Counter . view model . Bottom |> UI . map Bottom ] let top bottom = UI . app ( top bottom ) module CounterList = type Model = { Counters : Counter . Model list } let init = { Counters = [ ] } type Msg = | Insert | Remove | Modify of int * Counter . Msg let msg model = match msg with | Insert -> { model with Counters = Counter . init 0 :: model . Counters } | Remove -> { model with Counters = List . tail model . Counters } | Modify ( i , msg ) -> { model with Counters = List . mapAt i ( Counter . update msg ) model . Counters } let model = UI . button "Add" Insert :: UI . button "Remove" Remove :: List . mapi ( fun i c -> Counter . view c |> UI . map ( fun v -> Modify ( i , v ) ) ) model . Counters |> UI . div Vertical let app = UI . app init

The Elm Architecture pattern is very promising. It produces type safe UIs that are highly composable. Performance should be great even for large UIs while at the same time being able to target multiple UI frameworks.

UPDATED:

namespace System

namespace System.Runtime

namespace System.Runtime.CompilerServices

Multiple items

module List



from Microsoft.FSharp.Collections



--------------------

type List<'T> =

| ( [] )

| ( :: ) of Head: 'T * Tail: 'T list

interface IReadOnlyList<'T>

interface IReadOnlyCollection<'T>

interface IEnumerable

interface IEnumerable<'T>

member GetSlice : startIndex:int option * endIndex:int option -> 'T list

member Head : 'T

member IsEmpty : bool

member Item : index:int -> 'T with get

member Length : int

member Tail : 'T list

...

val remove : n:int -> l:'a list -> 'a list * 'a list

val n : int

val l : 'a list

val pop : (int -> 'b list -> 'b list -> 'b list * 'b list)

val l : 'b list

val p : 'b list

val x : 'b

val xs : 'b list

val add : p:'a list -> l:'a list -> 'a list

val p : 'a list

val x : 'a

val xs : 'a list

val mapAt : i:int -> mapping:('a -> 'a) -> list:'a list -> 'a list

val i : int

val mapping : ('a -> 'a)

Multiple items

val list : 'a list



--------------------

type 'T list = List<'T>

val removed : 'a list

val tail : 'a list

val head : list:'T list -> 'T

val tail : list:'T list -> 'T list

Multiple items

module Event



from Microsoft.FSharp.Control



--------------------

type 'msg Event = ('msg -> unit) ref ref





Message event used on the primitive UI components.



--------------------

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<'Delegate,'Args>

type unit = Unit

Multiple items

val ref : value:'T -> 'T ref



--------------------

type 'T ref = Ref<'T>

type Layout =

| Horizontal

| Vertical





Layout for a section of UI components.

union case Layout.Horizontal: Layout

union case Layout.Vertical: Layout

type UI =

| Text of string

| Input of string * string Event

| Button of string * unit Event

| Div of Layout * UI list





Primitive UI components.

union case UI.Text: string -> UI

Multiple items

val string : value:'T -> string



--------------------

type string = System.String

union case UI.Input: string * string Event -> UI

union case UI.Button: string * unit Event -> UI

union case UI.Div: Layout * UI list -> UI

type 'T list = List<'T>

type UIUpdate =

| InsertUI of int list * UI

| UpdateUI of int list * UI

| ReplaceUI of int list * UI

| RemoveUI of int list

| EventUI of (unit -> unit)





UI component update and event redirection.

union case UIUpdate.InsertUI: int list * UI -> UIUpdate

Multiple items

val int : value:'T -> int (requires member op_Explicit)



--------------------

type int = int32



--------------------

type int<'Measure> = int

union case UIUpdate.UpdateUI: int list * UI -> UIUpdate

union case UIUpdate.ReplaceUI: int list * UI -> UIUpdate

union case UIUpdate.RemoveUI: int list -> UIUpdate

union case UIUpdate.EventUI: (unit -> unit) -> UIUpdate

Multiple items

type UI =

| Text of string

| Input of string * string Event

| Button of string * unit Event

| Div of Layout * UI list





Primitive UI components.



--------------------

type 'msg UI =

{UI: UI;

mutable Event: 'msg -> unit;}





UI component including a message event.

Multiple items

UI.UI: UI



--------------------

type UI =

| Text of string

| Input of string * string Event

| Button of string * unit Event

| Div of Layout * UI list





Primitive UI components.



--------------------

type 'msg UI =

{UI: UI;

mutable Event: 'msg -> unit;}





UI component including a message event.

Multiple items

UI.Event: 'msg -> unit



--------------------

module Event



from Microsoft.FSharp.Control



--------------------

type 'msg Event = ('msg -> unit) ref ref





Message event used on the primitive UI components.



--------------------

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<'Delegate,'Args>

type App<'msg,'model> =

{Model: 'model;

Update: 'msg -> 'model -> 'model;

View: 'model -> 'msg UI;}





UI application.

App.Model: 'model

App.Update: 'msg -> 'model -> 'model

App.View: 'model -> 'msg UI

type INativeUI =

interface

abstract member Send : UIUpdate list -> unit

end





Native UI interface.

Multiple items

type CompilationRepresentationAttribute =

inherit Attribute

new : flags:CompilationRepresentationFlags -> CompilationRepresentationAttribute

member Flags : CompilationRepresentationFlags



--------------------

new : flags:CompilationRepresentationFlags -> CompilationRepresentationAttribute

type CompilationRepresentationFlags =

| None = 0

| Static = 1

| Instance = 2

| ModuleSuffix = 4

| UseNullAsTrueValue = 8

| Event = 16

CompilationRepresentationFlags.ModuleSuffix: CompilationRepresentationFlags = 4

val memoize<'model,'msg (requires reference type and reference type)> : (('model -> 'msg UI) -> 'model -> 'msg UI) (requires reference type and reference type)





Memoize view generation from model object references.

val not : value:bool -> bool

val d : ConditionalWeakTable<'model,'msg UI> (requires reference type and reference type)

Multiple items

type ConditionalWeakTable<'TKey,'TValue (requires reference type and reference type)> =

new : unit -> ConditionalWeakTable<'TKey, 'TValue>

member Add : key:'TKey * value:'TValue -> unit

member GetOrCreateValue : key:'TKey -> 'TValue

member GetValue : key:'TKey * createValueCallback:CreateValueCallback<'TKey, 'TValue> -> 'TValue

member Remove : key:'TKey -> bool

member TryGetValue : key:'TKey * value:'TValue -> bool

nested type CreateValueCallback



--------------------

ConditionalWeakTable() : ConditionalWeakTable<'TKey,'TValue>

val view : ('model -> 'msg UI) (requires reference type and reference type)

val model : 'model (requires reference type)

ConditionalWeakTable.TryGetValue(key: 'model, value: byref<'msg UI>) : bool

val ui : 'msg UI (requires reference type)

ConditionalWeakTable.Add(key: 'model, value: 'msg UI) : unit

val text : text:string -> 'a UI





Returns a Text display UI component.

val text : string

val ignore : value:'T -> unit

val input : text:string -> string UI





Returns a text Input UI component.

val ev : (string -> unit) ref ref

val ui : string UI

val raise : (string -> unit)

val a : string

UI.Event: string -> unit

val button : text:string -> msg:'a -> 'a UI





Returns a Button UI component.

val msg : 'a

val ev : (unit -> unit) ref ref

val ui : 'a UI

UI.Event: 'a -> unit

val div : layout:Layout -> list:'a UI list -> 'a UI





Returns a section of UI components given a layout.

The name div comes from HTML and represents a division (or section) of the UI.

val layout : Layout

Multiple items

val list : 'a UI list



--------------------

type 'T list = List<'T>

Multiple items

module List



from Main



--------------------

module List



from Microsoft.FSharp.Collections



--------------------

type List<'T> =

| ( [] )

| ( :: ) of Head: 'T * Tail: 'T list

interface IReadOnlyList<'T>

interface IReadOnlyCollection<'T>

interface IEnumerable

interface IEnumerable<'T>

member GetSlice : startIndex:int option * endIndex:int option -> 'T list

member Head : 'T

member IsEmpty : bool

member Item : index:int -> 'T with get

member Length : int

member Tail : 'T list

...

val map : mapping:('T -> 'U) -> list:'T list -> 'U list

UI.UI: UI

val raise : ('a -> unit)

val a : 'a

val iter : action:('T -> unit) -> list:'T list -> unit

val i : 'a UI

val map : f:('a -> 'b) -> ui:'a UI -> 'b UI





Returns a new UI component mapping the message event using the given function.

val f : ('a -> 'b)

val ui2 : 'b UI

val e : 'a

UI.Event: 'b -> unit

val diff : ui1:'a UI -> ui2:'b UI -> UIUpdate list





Returns a list of UI updates from two UI components.

val ui1 : 'a UI

val update : ('c ref ref -> 'c ref ref -> unit -> unit)

val e1 : 'c ref ref

val e2 : 'c ref ref

val ev : 'c ref

val diff : (UI -> UI -> int list -> int -> UIUpdate list -> UIUpdate list)

val ui1 : UI

val ui2 : UI

val path : int list

val index : int

val diffs : UIUpdate list

module LanguagePrimitives



from Microsoft.FSharp.Core

val PhysicalEquality : e1:'T -> e2:'T -> bool (requires reference type)

val t1 : string

val t2 : string

val e1 : unit Event

val e2 : unit Event

val e1 : string Event

val e2 : string Event

val l1 : Layout

val l2 : Layout

val l : UI list

val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

val ui : UI

val snd : tuple:('T1 * 'T2) -> 'T2

val l : Layout

val h1 : UI

val t1 : UI list

val h2 : UI

val t2 : UI list

val h3 : UI

val app : model:'a -> update:('b -> 'a -> 'a) -> view:('a -> 'b UI) -> App<'b,'a>





Returns a UI application from a UI model, update and view.

val model : 'a

val update : ('b -> 'a -> 'a)

val view : ('a -> 'b UI)

val run : nativeUI:INativeUI -> app:App<'a,'b> -> unit





Runs a UI application given a native UI.

val nativeUI : INativeUI

val app : App<'a,'b>

val handle : ('b -> 'a UI -> 'a -> unit)

val model : 'b

val newModel : 'b

App.Update: 'a -> 'b -> 'b

val newUI : 'a UI

App.View: 'b -> 'a UI

val diff : UIUpdate list

val f : (unit -> unit)

abstract member INativeUI.Send : UIUpdate list -> unit

App.Model: 'b

type Model = int

val init : i:Model -> Model

val i : Model

type Msg =

| Increment

| Decrement

union case Msg.Increment: Msg

union case Msg.Decrement: Msg

val update : msg:Msg -> model:int -> int

val msg : Msg

val model : int

val view : model:Model -> Msg UI

val model : Model

Multiple items

module UI



from Main



--------------------

type UI =

| Text of string

| Input of string * string Event

| Button of string * unit Event

| Div of Layout * UI list





Primitive UI components.



--------------------

type 'msg UI =

{UI: UI;

mutable Event: 'msg -> unit;}





UI component including a message event.

val app : i:Model -> App<Msg,Model>

type Model =

{Top: Model;

Bottom: Model;}

Model.Top: Counter.Model

module Counter



from Main

Model.Bottom: Counter.Model

val init : top:Counter.Model -> bottom:Counter.Model -> Model

val top : Counter.Model

val bottom : Counter.Model

val init : i:Counter.Model -> Counter.Model

type Msg =

| Reset

| Top of Msg

| Bottom of Msg

union case Msg.Reset: Msg

union case Msg.Top: Counter.Msg -> Msg

union case Msg.Bottom: Counter.Msg -> Msg

val update : msg:Msg -> model:Model -> Model

val msg : Counter.Msg

val update : msg:Counter.Msg -> model:int -> int

val view : model:Counter.Model -> Counter.Msg UI

val app : top:Counter.Model -> bottom:Counter.Model -> App<Msg,Model>

module CounterList



from Main

type Model =

{Counters: Model list;}

Model.Counters: Counter.Model list

val init : Model

type Msg =

| Insert

| Remove

| Modify of int * Msg

union case Msg.Insert: Msg

union case Msg.Remove: Msg

union case Msg.Modify: int * Counter.Msg -> Msg

val mapi : mapping:(int -> 'T -> 'U) -> list:'T list -> 'U list

val c : Counter.Model

val v : Counter.Msg

val app : App<Msg,Model>