├── .gitignore
├── Elmish.Xamarin.Forms.fsproj
├── Extensions
    └── Seq.fs
├── LICENSE
├── README.md
├── Xamarin
    ├── App.fs
    ├── Attributes.fs
    ├── Create.fs
    ├── Event.fs
    ├── Update.fs
    └── VirtualDOM.fs
├── cmd.fs
└── program.fs


/.gitignore:
--------------------------------------------------------------------------------
1 | bin
2 | obj
3 | 


--------------------------------------------------------------------------------
/Elmish.Xamarin.Forms.fsproj:
--------------------------------------------------------------------------------
 1 | <Project Sdk="Microsoft.NET.Sdk">
 2 |   <PropertyGroup>
 3 |     <TargetFramework>netstandard2.0</TargetFramework>
 4 |   </PropertyGroup>
 5 |   <ItemGroup>
 6 |     <Folder Include="Xamarin\" />
 7 |     <Folder Include="Extensions\" />
 8 |   </ItemGroup>
 9 |   <ItemGroup>
10 |     <Compile Include="cmd.fs" />
11 |     <Compile Include="program.fs" />
12 |     <Compile Include="Extensions\Seq.fs" />
13 |     <Compile Include="Xamarin\Event.fs" />
14 |     <Compile Include="Xamarin\VirtualDOM.fs" />
15 |     <Compile Include="Xamarin\Attributes.fs" />
16 |     <Compile Include="Xamarin\Create.fs" />
17 |     <Compile Include="Xamarin\Update.fs" />
18 |     <Compile Include="Xamarin\App.fs" />
19 |   </ItemGroup>
20 |   <ItemGroup>
21 |     <PackageReference Include="Xamarin.Forms" Version="2.4.0.282" />
22 |   </ItemGroup>
23 | </Project>


--------------------------------------------------------------------------------
/Extensions/Seq.fs:
--------------------------------------------------------------------------------
 1 | module internal Elmish.Extensions.Seq
 2 | 
 3 | let bindOption mapper sequence =
 4 |     seq {
 5 |         for v in sequence do
 6 |             match mapper v with
 7 |             | Some r -> yield r
 8 |             | None -> ()
 9 |     }
10 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 |    Copyright 2017 elmish-xamarin-forms contributors
 2 | 
 3 |    Licensed under the Apache License, Version 2.0 (the "License");
 4 |    you may not use this file except in compliance with the License.
 5 |    You may obtain a copy of the License at
 6 | 
 7 |        http://www.apache.org/licenses/LICENSE-2.0
 8 | 
 9 |    Unless required by applicable law or agreed to in writing, software
10 |    distributed under the License is distributed on an "AS IS" BASIS,
11 |    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 |    See the License for the specific language governing permissions and
13 |    limitations under the License.
14 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # Elmish.Xamarin.Forms
 2 | Elmish architecture for Xamarin.Forms
 3 | 
 4 | ## WARNING
 5 | This should very much be considered a draft and at the PoC stage. It is not ready for production yet. The DSL is likely to change substantially. Actual performance at scale is unknown.
 6 | 
 7 | ## Obvious issues
 8 | **No structural equality for events**. When an event handler is present in the tree, it is always considered changed, as there's no structural equality for functions. This means pretty much the whole tree is traversed on every update, even when not strictly necessary. There needs to be a way to determine whether an event handler has changed.
 9 | 
10 | **Hacky setting of events**. Setting an event on the Xanarin.Forms object is extremely hacky as there's no way for a client to clear the collection of subscribed listeners. Plus it is probably pretty slow, but is easily fixed with memoization.
11 | 
12 | **DSL is clunky.** Specifying callbacks is ugly. Due to many views having properties with the same name, it is often necessary to qualify with the discriminated union's name.
13 | 
14 | **Writing bindings is repetitive and tedious**. An obvious next step is auto-generating bindings from the Xamarin.Forms assembly. This would facilitate a better DSL and it would be much easier to keep up with Xamarin.Forms features.


--------------------------------------------------------------------------------
/Xamarin/App.fs:
--------------------------------------------------------------------------------
 1 | module Elmish.Xamarin.Forms.Application
 2 |     
 3 | open Elmish.Extensions
 4 | open Elmish
 5 | open Elmish.Xamarin.Forms.Update
 6 | 
 7 | 
 8 | type internal App<'model, 'msg>(program: Program<unit, 'model, 'msg, VirtualDOM.Page>) as this =
 9 |     inherit Xamarin.Forms.Application()
10 | 
11 |     // Requires App to be instantiated on the main thread to work.
12 |     // This is happily the case.
13 |     let mainThread = System.Threading.Thread.CurrentThread
14 | 
15 |     let isOnMainThread () = System.Object.ReferenceEquals(mainThread, System.Threading.Thread.CurrentThread)
16 | 
17 |     let mutable optLastView = None
18 | 
19 |     let program' = { program with setState = this.setState program }
20 | 
21 |     let updateViews view =
22 |         match optLastView with
23 |         | Some lastView ->
24 |             Update.page view lastView this.MainPage
25 |             |> Option.iter (fun page -> this.MainPage <- page)
26 |         | None ->
27 |             this.MainPage <- Create.page view
28 |         optLastView <- Some view
29 | 
30 |     let runOnMainThread action =
31 |         if isOnMainThread () then
32 |             action ()
33 |         else
34 |             Xamarin.Forms.Device.BeginInvokeOnMainThread(fun () -> action())
35 | 
36 |     do Program.run program'
37 | 
38 |     member this.setState (program: Program<unit, 'model, 'msg, VirtualDOM.Page>) model dispatch =
39 |         let view = program.view model dispatch
40 | 
41 |         runOnMainThread (fun () -> updateViews view)
42 | 
43 | 
44 | let asApplication<'model, 'msg> (program: Program<unit, 'model, 'msg, VirtualDOM.Page>) =
45 |     new App<'model, 'msg>(program) :> Xamarin.Forms.Application
46 | 
47 | 
48 | 


--------------------------------------------------------------------------------
/Xamarin/Attributes.fs:
--------------------------------------------------------------------------------
  1 | module Elmish.Xamarin.Forms.Attributes
  2 | 
  3 | open VirtualDOM
  4 | 
  5 | let loadImage name =
  6 |     Xamarin.Forms.ImageSource.FromFile name :?> Xamarin.Forms.FileImageSource
  7 | 
  8 | let contentPage (view : Xamarin.Forms.ContentPage) = function
  9 |     | Icon name ->
 10 |         view.Icon <- loadImage name
 11 |     | Title title ->
 12 |         view.Title <- title
 13 | 
 14 | let masterDetailPage (view : Xamarin.Forms.MasterDetailPage) = function
 15 |     | IsGestureEnabled isGestureEnabled ->
 16 |         view.IsGestureEnabled <- isGestureEnabled
 17 |     | IsPresented isPresented ->
 18 |         view.IsPresented <- isPresented
 19 |     | MasterBehavior masterBehavior ->
 20 |         view.MasterBehavior <- masterBehavior
 21 |     | OnIsPresentedChanged (BoolEvent.Event boolEvent) ->
 22 |         Event.clear "IsPresentedChanged" view
 23 |         view.IsPresentedChanged.Add (fun _ -> boolEvent view.IsPresented)
 24 | 
 25 | let stackLayout (view : Xamarin.Forms.StackLayout) = function
 26 |     | Orientation orientation ->
 27 |         view.Orientation <- orientation
 28 |     | Spacing spacing ->
 29 |         view.Spacing <- spacing
 30 |     | StackLayoutAttribute.HorizontalOptions options ->
 31 |         view.HorizontalOptions <- options
 32 |     | StackLayoutAttribute.VerticalOptions options ->
 33 |         view.VerticalOptions <- options
 34 | 
 35 | let label (view : Xamarin.Forms.Label) = function
 36 |     | LabelAttribute.HorizontalOptions options ->
 37 |         view.HorizontalOptions <- options
 38 |     | LabelAttribute.VerticalOptions options ->
 39 |         view.VerticalOptions <- options
 40 |     | LabelAttribute.HorizontalTextAlignment align ->
 41 |         view.HorizontalTextAlignment <- align
 42 |     | LabelAttribute.Text text ->
 43 |         view.Text <- text
 44 | 
 45 | let button (view : Xamarin.Forms.Button) = function
 46 |     | ButtonAttribute.HorizontalOptions options ->
 47 |         view.HorizontalOptions <- options
 48 |     | ButtonAttribute.VerticalOptions options ->
 49 |         view.VerticalOptions <- options
 50 |     | BorderColor color ->
 51 |         view.BorderColor <- color
 52 |     | BorderRadius radius ->
 53 |         view.BorderRadius <- radius
 54 |     | BorderWidth width ->
 55 |         view.BorderWidth <- width
 56 |     | ButtonAttribute.FontAttributes attributes ->
 57 |         view.FontAttributes <- attributes
 58 |     | ButtonAttribute.FontFamily family ->
 59 |         view.FontFamily <- family
 60 |     | ButtonAttribute.FontSize size ->
 61 |         view.FontSize <- size
 62 |     | Image name -> 
 63 |         view.Image <- loadImage name
 64 |     | ButtonAttribute.Text text ->
 65 |         view.Text <- text
 66 |     | ButtonAttribute.TextColor color ->
 67 |         view.TextColor <- color
 68 |     | OnClicked (UnitEvent.Event fn) ->
 69 |         Event.clear "Clicked" view
 70 |         view.Clicked.Add (fun _ -> fn ())
 71 | 
 72 | let entry (view : Xamarin.Forms.Entry) = function
 73 |     | EntryAttribute.HorizontalOptions options ->
 74 |         view.HorizontalOptions <- options
 75 |     | EntryAttribute.Margin thickness ->
 76 |         view.Margin <- thickness
 77 |     | EntryAttribute.VerticalOptions options ->
 78 |         view.VerticalOptions <- options
 79 |     | FontAttributes fontAttributes ->
 80 |         view.FontAttributes <- fontAttributes
 81 |     | FontFamily family ->
 82 |         view.FontFamily <- family
 83 |     | FontSize size ->
 84 |         view.FontSize <- size
 85 |     | HorizontalTextAlignment textAlignment ->
 86 |         view.HorizontalTextAlignment <- textAlignment
 87 |     | IsPassword isPassword ->
 88 |         view.IsPassword <- isPassword
 89 |     | Placeholder placeholder ->
 90 |         view.Placeholder <- placeholder
 91 |     | PlaceholderColor color ->
 92 |         view.PlaceholderColor <- color
 93 |     | Text text ->
 94 |         view.Text <- text
 95 |     | TextColor color ->
 96 |         view.TextColor <- color
 97 |     | OnCompleted (UnitEvent.Event fn) ->
 98 |         Event.clear "Completed" view
 99 |         view.Completed.Add (ignore >> fn)
100 |     | OnTextChanged (StringEvent.Event fn) ->
101 |         Event.clear "TextChanged" view
102 |         view.TextChanged.Add (fun ev -> fn ev.NewTextValue)
103 | 
104 | let tableSection (view : Xamarin.Forms.TableSection) = function
105 |     | TableSectionAttribute.Title title ->
106 |         view.Title <- title
107 | 
108 | let tableView (view : Xamarin.Forms.TableView) = function
109 |     | TableViewAttribute.HasUnevenRows hasUnevenRows ->
110 |         view.HasUnevenRows <- hasUnevenRows
111 |     | Intent intent ->
112 |         view.Intent <- intent
113 |     | RowHeight rowHeight ->
114 |         view.RowHeight <- rowHeight
115 | 
116 | let textCell (view : Xamarin.Forms.TextCell) = function
117 |     | TextCellAttribute.Text text ->
118 |         view.Text <- text
119 |     | TextCellAttribute.TextColor textColor ->
120 |         view.TextColor <- textColor
121 |     | Detail detail ->
122 |         view.Detail <- detail
123 |     | DetailColor detailColor ->
124 |         view.DetailColor <- detailColor
125 |     | OnTapped (UnitEvent.Event event) ->
126 |         Event.clear "Tapped" view
127 |         view.Tapped.Add (ignore >> event)
128 | 
129 | let updateAll updateFn attributes view =
130 |     attributes |> Seq.iter (updateFn view)
131 | 
132 | let setUpdated updateFn viewAttributes lastViewAttributes viewRoot =
133 |     let updatedAttributes =
134 |         Seq.zip viewAttributes lastViewAttributes
135 |         |> Seq.filter (fun (v, l) -> v <> l)
136 |         |> Seq.map fst
137 |     updateAll updateFn updatedAttributes viewRoot
138 | 
139 | 
140 | 


--------------------------------------------------------------------------------
/Xamarin/Create.fs:
--------------------------------------------------------------------------------
 1 | module Elmish.Xamarin.Forms.Create
 2 | 
 3 | open Elmish.Xamarin.Forms.VirtualDOM
 4 | open Elmish.Xamarin.Forms
 5 | 
 6 | 
 7 | let cell = function
 8 |     | TextCell attributes -> 
 9 |         let cell = Xamarin.Forms.TextCell ()
10 |         Attributes.updateAll Attributes.textCell attributes cell
11 |         cell :> Xamarin.Forms.Cell
12 | 
13 |     | CellExtension ext -> ext.create ()
14 | 
15 | let section = function
16 |     | TableSection (attributes, cells) ->
17 |         let section = new Xamarin.Forms.TableSection ()
18 |         Attributes.updateAll Attributes.tableSection attributes section
19 | 
20 |         section.Add (cells |> Seq.map cell)
21 |         section
22 | 
23 | let tableRoot sections =
24 |     let root = new Xamarin.Forms.TableRoot()
25 |     root.Add (sections |> Seq.map section)
26 |     root
27 | 
28 | let inline createView<'t, 'a when 't : (new : unit -> 't) and 't :> Xamarin.Forms.View> (updateFn : 't -> 'a -> unit) (attributes : 'a seq) =
29 |     let v = new 't ()
30 |     Attributes.updateAll updateFn attributes v
31 |     v :> Xamarin.Forms.View
32 | 
33 | let rec view = function
34 |     | Button attributes ->
35 |         createView<Xamarin.Forms.Button,ButtonAttribute> Attributes.button attributes 
36 | 
37 |     | Entry attributes ->
38 |         createView<Xamarin.Forms.Entry,EntryAttribute> Attributes.entry attributes 
39 | 
40 |     | Label attributes ->
41 |         createView<Xamarin.Forms.Label,LabelAttribute> Attributes.label attributes 
42 | 
43 |     | StackLayout (attributes, children) ->
44 |         let stack = Xamarin.Forms.StackLayout ()
45 |         Attributes.updateAll Attributes.stackLayout attributes stack
46 | 
47 |         children
48 |         |> Seq.map view
49 |         |> Seq.iter stack.Children.Add
50 | 
51 |         stack :> Xamarin.Forms.View
52 | 
53 |     | TableView (attributes, sections) ->
54 |         let root = tableRoot sections
55 |         let tableView = Xamarin.Forms.TableView ()
56 |         Attributes.updateAll Attributes.tableView attributes tableView
57 | 
58 |         tableView.Root <- root
59 |         tableView :> Xamarin.Forms.View
60 | 
61 |     | ViewExtension ext ->
62 |         ext.create ()
63 | 
64 | 
65 | let rec page = function
66 |     | ContentPage (attributes, content) ->
67 |         let page = Xamarin.Forms.ContentPage(Content = view content)
68 |         Attributes.updateAll Attributes.contentPage attributes page
69 |         page :> Xamarin.Forms.Page
70 | 
71 |     | MasterDetailPage (attributes, master, detail) ->
72 |         let page = Xamarin.Forms.MasterDetailPage(Master = page master, Detail = page detail)
73 |         Attributes.updateAll Attributes.masterDetailPage attributes page
74 |         page :> Xamarin.Forms.Page
75 | 
76 |     | NavigationPage content ->
77 |         let navigationPage = new Xamarin.Forms.NavigationPage()
78 |         content
79 |         |> Seq.map page
80 |         |> Seq.rev
81 |         |> Seq.iter (fun p -> navigationPage.PushAsync(p) |> ignore)
82 | 
83 |         navigationPage :> Xamarin.Forms.Page
84 | 
85 | 


--------------------------------------------------------------------------------
/Xamarin/Event.fs:
--------------------------------------------------------------------------------
 1 | module Elmish.Xamarin.Forms.Event
 2 | 
 3 | open System.Reflection
 4 | open System
 5 | 
 6 | // This is a fairly hacky solution to clearing all registered listeners from an event,
 7 | // based on this answer on Stack Overflow
 8 | // https://stackoverflow.com/a/8108103/619821
 9 | 
10 | 
11 | // Find events defined as field
12 | let private getFieldEvent eventName (typ : Type) =
13 |     typ.GetField(eventName, BindingFlags.Static ||| BindingFlags.Instance ||| BindingFlags.NonPublic)
14 |     |> Option.ofObj
15 | 
16 | // Find events defined as property { add; remove; }
17 | let private getPropertyEvent (eventName : string) (typ : Type) =
18 |     typ.GetField("EVENT_" + eventName.ToUpper(), BindingFlags.Static ||| BindingFlags.Instance ||| BindingFlags.NonPublic)
19 |     |> Option.ofObj
20 | 
21 | let rec private getEventField eventName (typ : Type) =
22 |     match getFieldEvent eventName typ with
23 |     | Some field as optField when field.FieldType = typeof<MulticastDelegate> || field.FieldType.IsSubclassOf(typeof<MulticastDelegate>) ->
24 |         optField
25 |     | _ ->
26 |         match getPropertyEvent eventName typ with
27 |         | Some _ as optField -> optField
28 |         | _ -> getEventField eventName typ.BaseType
29 | 
30 | let clear eventName object =
31 |     getEventField eventName (object.GetType())
32 |     |> Option.iter (fun fi -> fi.SetValue(object, null))
33 | 
34 | 


--------------------------------------------------------------------------------
/Xamarin/Update.fs:
--------------------------------------------------------------------------------
  1 | module Elmish.Xamarin.Forms.Update
  2 | 
  3 | open Elmish.Extensions
  4 | open Elmish.Xamarin.Forms.VirtualDOM
  5 | 
  6 | let updateChildren createFn updateFn viewChildren lastViewChildren (collection : System.Collections.Generic.IList<'a>) =
  7 |     let viewsToUpdate =
  8 |         Seq.zip3 viewChildren lastViewChildren collection
  9 |         |> Seq.mapi (fun i t -> i, (t |||> updateFn))
 10 |         |> Seq.bindOption (fun (i, optView) -> optView |> Option.map (fun view -> i, view))
 11 |         |> Seq.toArray // make collection eager
 12 | 
 13 |     viewsToUpdate |> Seq.iter (fun (i, view) -> collection.[i] <- view)
 14 | 
 15 |     let totalViews = viewChildren |> Seq.length
 16 |     if totalViews > collection.Count then
 17 |         viewChildren
 18 |         |> Seq.skip collection.Count
 19 |         |> Seq.iter (createFn >> collection.Add)
 20 |     else if totalViews < collection.Count then
 21 |         for i in collection.Count - 1 .. -1 .. totalViews  do
 22 |             collection.RemoveAt i
 23 | 
 24 | let rec cell newView lastView (root : Xamarin.Forms.Cell) : Xamarin.Forms.Cell option =
 25 |     if newView = lastView then
 26 |         None
 27 |     else
 28 |         match newView, lastView, root with
 29 |         | TextCell viewAttributes, TextCell lastViewAttributes, (:? Xamarin.Forms.TextCell as viewRoot) ->
 30 |             Attributes.setUpdated Attributes.textCell viewAttributes lastViewAttributes viewRoot
 31 |             None
 32 |         | CellExtension ext, CellExtension lastExt, _ ->
 33 |             ext.update lastExt root
 34 | 
 35 | and section newView lastView (viewRoot : Xamarin.Forms.TableSection) : Xamarin.Forms.TableSection option =
 36 |     if newView = lastView then
 37 |         None
 38 |     else
 39 |         match newView, lastView with
 40 |         | TableSection (viewAttributes, viewChildren), TableSection (lastViewAttributes, lastViewChildren) ->
 41 |             updateChildren Create.cell cell viewChildren lastViewChildren viewRoot
 42 |             Attributes.setUpdated Attributes.tableSection viewAttributes lastViewAttributes viewRoot
 43 |             None
 44 | 
 45 | and view newView lastView (root : Xamarin.Forms.View) : Xamarin.Forms.View option =
 46 |     if newView = lastView then
 47 |         None
 48 |     else
 49 |         match newView, lastView, root with
 50 |         | Button viewAttributes, Button lastViewAttributes, (:? Xamarin.Forms.Button as viewRoot) ->
 51 |             Attributes.setUpdated Attributes.button viewAttributes lastViewAttributes viewRoot
 52 |             None
 53 | 
 54 |         | Entry viewAttributes, Entry lastViewAttributes, (:? Xamarin.Forms.Entry as viewRoot) ->
 55 |             Attributes.setUpdated Attributes.entry viewAttributes lastViewAttributes viewRoot
 56 |             None
 57 | 
 58 |         | Label viewAttributes, Label lastViewAttributes, (:? Xamarin.Forms.Label as viewRoot) ->
 59 |             Attributes.setUpdated Attributes.label viewAttributes lastViewAttributes viewRoot
 60 |             None
 61 | 
 62 |         | StackLayout (viewAttributes, viewChildren), StackLayout (lastViewAttributes, lastViewChildren), (:? Xamarin.Forms.StackLayout as viewRoot) ->
 63 |             updateChildren Create.view view viewChildren lastViewChildren viewRoot.Children
 64 |             Attributes.setUpdated Attributes.stackLayout viewAttributes lastViewAttributes viewRoot
 65 |             None
 66 |         
 67 |         | TableView (viewAttributes, viewSections), TableView (lastViewAttributes, lastViewSections), (:? Xamarin.Forms.TableView as viewRoot) ->
 68 |             updateChildren Create.section section viewSections lastViewSections viewRoot.Root
 69 |             Attributes.setUpdated Attributes.tableView viewAttributes lastViewAttributes viewRoot
 70 |             None
 71 | 
 72 |         | ViewExtension viewExtension, ViewExtension lastViewExtension, _ ->
 73 |             viewExtension.update lastViewExtension root
 74 | 
 75 |         | _ ->
 76 |             Create.view newView |> Some
 77 | 
 78 | 
 79 | let rec page newView lastView (root : Xamarin.Forms.Page) : Xamarin.Forms.Page option =
 80 |     if newView = lastView then
 81 |         None
 82 |     else
 83 |         match newView, lastView, root with
 84 |         | NavigationPage viewPages, NavigationPage lastViewPages, (:? Xamarin.Forms.NavigationPage as viewRoot) ->
 85 |             let stack = viewRoot.Navigation.NavigationStack |> Seq.rev |> Seq.toArray
 86 |             let updatedPages = Seq.zip3 viewPages lastViewPages stack |> Seq.map (fun t -> t |||> page) |> Seq.toArray
 87 |             if updatedPages |> Seq.exists (fun v -> v <> None) then
 88 |                 viewRoot.PopToRootAsync(false) |> ignore
 89 |                 Seq.zip stack updatedPages 
 90 |                 |> Seq.map (fun (v, vopt) -> defaultArg vopt v)
 91 |                 |> Seq.rev
 92 |                 |> Seq.iter (fun v -> viewRoot.PushAsync(v) |> ignore)
 93 |             None
 94 | 
 95 |         | MasterDetailPage (viewAttributes, viewMaster, viewDetail), MasterDetailPage (lastViewAttributes, lastViewMaster, lastViewDetail), (:? Xamarin.Forms.MasterDetailPage as viewRoot) ->
 96 |             Attributes.setUpdated Attributes.masterDetailPage viewAttributes lastViewAttributes viewRoot
 97 | 
 98 |             page viewMaster lastViewMaster viewRoot.Master
 99 |             |> Option.iter (fun page -> viewRoot.Master <- page)
100 | 
101 |             page viewDetail lastViewDetail viewRoot.Detail
102 |             |> Option.iter (fun page -> viewRoot.Detail <- page)
103 | 
104 |             None
105 | 
106 |         | ContentPage (viewAttributes, viewContent), ContentPage (lastViewAttributes, lastViewContent), (:? Xamarin.Forms.ContentPage as viewRoot) ->
107 |             view viewContent lastViewContent viewRoot.Content
108 |             |> Option.iter (fun view -> viewRoot.Content <- view)
109 | 
110 |             Attributes.setUpdated Attributes.contentPage viewAttributes lastViewAttributes viewRoot
111 |             None
112 | 


--------------------------------------------------------------------------------
/Xamarin/VirtualDOM.fs:
--------------------------------------------------------------------------------
  1 | module Elmish.Xamarin.Forms.VirtualDOM
  2 | 
  3 | type Extension<'x> =
  4 |     abstract member create: unit -> 'x
  5 |     abstract member update: Extension<'x> -> 'x -> 'x option
  6 | 
  7 | (* Event signatures *)
  8 | 
  9 | [<CustomEquality; NoComparison>]
 10 | type Event<'t> =
 11 |     | Event of ('t -> unit)
 12 |     override this.Equals(that) = System.Object.ReferenceEquals(this, that)
 13 |     override this.GetHashCode() = 0
 14 | 
 15 | type UnitEvent = Event<unit>
 16 | type BoolEvent = Event<bool>
 17 | type StringEvent = Event<string>
 18 | 
 19 | 
 20 | (* Cells *)
 21 | 
 22 | type TextCellAttribute =
 23 |     | Text of string
 24 |     | TextColor of Xamarin.Forms.Color
 25 |     | Detail of string
 26 |     | DetailColor of Xamarin.Forms.Color
 27 |     | OnTapped of UnitEvent
 28 | 
 29 | type Cell =
 30 |     | TextCell of TextCellAttribute list
 31 |     | CellExtension of (Extension<Xamarin.Forms.Cell>)
 32 | 
 33 | let textCell attributes = TextCell attributes
 34 | 
 35 | 
 36 | (* Tables *)
 37 | 
 38 | type TableSectionAttribute =
 39 |     | Title of string
 40 | 
 41 | type TableSection =
 42 |     | TableSection of TableSectionAttribute list * Cell list
 43 | 
 44 | let tableSection attributes children = TableSection (attributes, children)
 45 | 
 46 | 
 47 | (* Views *)
 48 | 
 49 | type StackLayoutAttribute =
 50 |     | Orientation of Xamarin.Forms.StackOrientation
 51 |     | Spacing of float
 52 |     | HorizontalOptions of Xamarin.Forms.LayoutOptions
 53 |     | VerticalOptions of Xamarin.Forms.LayoutOptions
 54 | 
 55 | type LabelAttribute =
 56 |     | HorizontalOptions of Xamarin.Forms.LayoutOptions
 57 |     | VerticalOptions of Xamarin.Forms.LayoutOptions
 58 |     | HorizontalTextAlignment of Xamarin.Forms.TextAlignment
 59 |     | Text of string
 60 | 
 61 | type TableViewAttribute =
 62 |     | HasUnevenRows of bool
 63 |     | Intent of Xamarin.Forms.TableIntent
 64 |     | RowHeight of int
 65 | 
 66 | type ButtonAttribute =
 67 |     | HorizontalOptions of Xamarin.Forms.LayoutOptions
 68 |     | VerticalOptions of Xamarin.Forms.LayoutOptions
 69 |     | BorderColor of Xamarin.Forms.Color
 70 |     | BorderRadius of int
 71 |     | BorderWidth of float
 72 |     | FontAttributes of Xamarin.Forms.FontAttributes
 73 |     | FontFamily of string
 74 |     | FontSize of float
 75 |     | Image of string
 76 |     | Text of string
 77 |     | TextColor of Xamarin.Forms.Color
 78 |     | OnClicked of UnitEvent
 79 | 
 80 | type EntryAttribute =
 81 |     | HorizontalOptions of Xamarin.Forms.LayoutOptions
 82 |     | Margin of Xamarin.Forms.Thickness
 83 |     | VerticalOptions of Xamarin.Forms.LayoutOptions
 84 |     | FontAttributes of Xamarin.Forms.FontAttributes
 85 |     | FontFamily of string
 86 |     | FontSize of float
 87 |     | HorizontalTextAlignment of Xamarin.Forms.TextAlignment
 88 |     | IsPassword of bool
 89 |     | Placeholder of string
 90 |     | PlaceholderColor of Xamarin.Forms.Color
 91 |     | Text of string
 92 |     | TextColor of Xamarin.Forms.Color
 93 |     | OnCompleted of UnitEvent
 94 |     | OnTextChanged of StringEvent
 95 | 
 96 | type View =
 97 |     | Button of ButtonAttribute list
 98 |     | Entry of EntryAttribute list
 99 |     | Label of LabelAttribute list
100 |     | StackLayout of StackLayoutAttribute list * View list
101 |     | TableView of TableViewAttribute list * TableSection list
102 |     | ViewExtension of Extension<Xamarin.Forms.View>
103 | 
104 | 
105 | let button attributes = Button attributes
106 | 
107 | let entry attributes = Entry attributes
108 | 
109 | let label attributes = Label attributes
110 | 
111 | let stackLayout attributes children = StackLayout (attributes, children)
112 | 
113 | let tableView attributes children = TableView (attributes, children)
114 | 
115 | 
116 | 
117 | (* Pages *)
118 | 
119 | type ContentPageAttribute =
120 |     | Icon of string
121 |     | Title of string
122 | 
123 | type MasterDetailPageAttribute =
124 |     | IsGestureEnabled of bool
125 |     | IsPresented of bool
126 |     | MasterBehavior of Xamarin.Forms.MasterBehavior
127 |     | OnIsPresentedChanged of BoolEvent
128 | 
129 | type Page =
130 |     | ContentPage of ContentPageAttribute list * View
131 |     | MasterDetailPage of MasterDetailPageAttribute list * Page * Page
132 |     | NavigationPage of Page list
133 | 
134 | 
135 | let contentPage attributes content = ContentPage (attributes, content)
136 | 
137 | let masterDetailPage attributes master detail = MasterDetailPage (attributes, master, detail)
138 | 
139 | let navigationPage content = NavigationPage content
140 | 
141 | 
142 | 


--------------------------------------------------------------------------------
/cmd.fs:
--------------------------------------------------------------------------------
  1 | (*
  2 | Copyright 2016 fable-elmish contributors
  3 | 
  4 | Licensed under the Apache License, Version 2.0 (the "License"); you may not
  5 | use this file except in compliance with the License. You may obtain a copy of
  6 | the License at
  7 | 
  8 | http://www.apache.org/licenses/LICENSE-2.0
  9 | 
 10 | Unless required by applicable law or agreed to in writing, software
 11 | distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
 12 | WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
 13 | License for the specific language governing permissions and limitations under
 14 | the License.
 15 | *)
 16 | 
 17 | (*
 18 | In accordance with the Apache License, Version 2.0, section 4, this is a
 19 | notice to inform the recipient that this file has been modified by the
 20 | elmish-xamarin-forms contributors.
 21 | *)
 22 | 
 23 | (**
 24 | Cmd
 25 | ---------
 26 | Core abstractions for dispatching messages in Elmish.
 27 | 
 28 | *)
 29 | 
 30 | namespace Elmish
 31 | 
 32 | open System
 33 | 
 34 | /// Dispatch - feed new message into the processing loop
 35 | type Dispatch<'msg> = 'msg -> unit
 36 | 
 37 | /// Subscription - return immediately, but may schedule dispatch of a message at any time
 38 | type Sub<'msg> = Dispatch<'msg> -> unit
 39 | 
 40 | /// Cmd - container for subscriptions that may produce messages
 41 | type Cmd<'msg> = Sub<'msg> list
 42 | 
 43 | /// Cmd module for creating and manipulating commands
 44 | [<RequireQualifiedAccess>]
 45 | module Cmd =
 46 |     /// None - no commands, also known as `[]`
 47 |     let none : Cmd<'msg> =
 48 |         []
 49 | 
 50 |     /// Command to issue a specific message
 51 |     let ofMsg (msg:'msg) : Cmd<'msg> =
 52 |         [fun dispatch -> dispatch msg]
 53 | 
 54 |     /// When emitting the message, map to another type
 55 |     let map (f: 'a -> 'msg) (cmd: Cmd<'a>) : Cmd<'msg> =
 56 |         cmd |> List.map (fun g -> (fun dispatch -> f >> dispatch) >> g)
 57 | 
 58 |     /// Aggregate multiple commands
 59 |     let batch (cmds: #seq<Cmd<'msg>>) : Cmd<'msg> =
 60 |         cmds |> List.concat
 61 | 
 62 |     /// Command that will evaluate an async block and map the result
 63 |     /// into success or error (of exception)
 64 |     let ofAsync (task: 'a -> Async<_>) 
 65 |                 (arg: 'a) 
 66 |                 (ofSuccess: _ -> 'msg) 
 67 |                 (ofError: _ -> 'msg) : Cmd<'msg> =
 68 |         let bind dispatch =
 69 |             async {
 70 |                 let! r = task arg |> Async.Catch
 71 |                 dispatch (match r with
 72 |                          | Choice1Of2 x -> ofSuccess x
 73 |                          | Choice2Of2 x -> ofError x)
 74 |             }
 75 |         [bind >> Async.StartImmediate]
 76 | 
 77 |     /// Command to evaluate a simple function and map the result
 78 |     /// into success or error (of exception)
 79 |     let ofFunc (task: 'a -> _) (arg: 'a) (ofSuccess: _ -> 'msg) (ofError: _ -> 'msg) : Cmd<'msg> =
 80 |         let bind dispatch =
 81 |             try
 82 |                 task arg
 83 |                 |> (ofSuccess >> dispatch)
 84 |             with x ->
 85 |                 x |> (ofError >> dispatch)
 86 |         [bind]
 87 | 
 88 |     /// Command to evaluate a simple function and map the success to a message
 89 |     /// discarding any possible error
 90 |     let performFunc (task: 'a -> _) (arg: 'a) (ofSuccess: _ -> 'msg) : Cmd<'msg> =
 91 |         let bind dispatch =
 92 |             try
 93 |                 task arg
 94 |                 |> (ofSuccess >> dispatch)
 95 |             with x ->
 96 |                 ()
 97 |         [bind]
 98 | 
 99 |     /// Command to evaluate a simple function and map the error (in case of exception)
100 |     let attemptFunc (task: 'a -> unit) (arg: 'a) (ofError: _ -> 'msg) : Cmd<'msg> =
101 |         let bind dispatch =
102 |             try
103 |                 task arg
104 |             with x ->
105 |                 x |> (ofError >> dispatch)
106 |         [bind]
107 | 
108 |     /// Command to call the subscriber
109 |     let ofSub (sub: Sub<'msg>) : Cmd<'msg> =
110 |         [sub]
111 | 
112 | 


--------------------------------------------------------------------------------
/program.fs:
--------------------------------------------------------------------------------
  1 | (*
  2 | Copyright 2016 fable-elmish contributors
  3 | 
  4 | Licensed under the Apache License, Version 2.0 (the "License"); you may not
  5 | use this file except in compliance with the License. You may obtain a copy of
  6 | the License at
  7 | 
  8 | http://www.apache.org/licenses/LICENSE-2.0
  9 | 
 10 | Unless required by applicable law or agreed to in writing, software
 11 | distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
 12 | WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
 13 | License for the specific language governing permissions and limitations under
 14 | the License.
 15 | *)
 16 | 
 17 | (*
 18 | In accordance with the Apache License, Version 2.0, section 4, this is a
 19 | notice to inform the recipient that this file has been modified by the
 20 | elmish-xamarin-forms contributors.
 21 | *)
 22 | 
 23 | (**
 24 | Program
 25 | ---------
 26 | Core abstractions for creating and running the dispatch loop.
 27 | 
 28 | *)
 29 | 
 30 | namespace Elmish
 31 | 
 32 | open System
 33 | 
 34 | /// Program type captures various aspects of program behavior
 35 | type Program<'arg, 'model, 'msg, 'view> = {
 36 |     init : 'arg -> 'model * Cmd<'msg>
 37 |     update : 'msg -> 'model -> 'model * Cmd<'msg>
 38 |     subscribe : 'model -> Cmd<'msg>
 39 |     view : 'model -> Dispatch<'msg> -> 'view
 40 |     setState : 'model -> Dispatch<'msg> -> unit
 41 |     onError : (string*exn) -> unit
 42 | }
 43 | 
 44 | /// Program module - functions to manipulate program instances
 45 | [<RequireQualifiedAccess>]
 46 | [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 47 | module Program =
 48 |     let internal onError (text: string, ex: exn) =
 49 |         System.Console.Error.WriteLine (sprintf "%s: %A" text ex)
 50 | 
 51 |     /// Typical program, new commands are produced by `init` and `update` along with the new state.
 52 |     let mkProgram 
 53 |         (init : 'arg -> 'model * Cmd<'msg>) 
 54 |         (update : 'msg -> 'model -> 'model * Cmd<'msg>)
 55 |         (view : 'model -> Dispatch<'msg> -> 'view) =
 56 |         { init = init
 57 |           update = update
 58 |           view = view
 59 |           setState = fun model -> view model >> ignore
 60 |           subscribe = fun _ -> Cmd.none
 61 |           onError = onError }
 62 | 
 63 |     /// Simple program that produces only new state with `init` and `update`.
 64 |     let mkSimple 
 65 |         (init : 'arg -> 'model) 
 66 |         (update : 'msg -> 'model -> 'model)
 67 |         (view : 'model -> Dispatch<'msg> -> 'view) =
 68 |         { init = init >> fun state -> state,Cmd.none
 69 |           update = fun msg -> update msg >> fun state -> state,Cmd.none
 70 |           view = view
 71 |           setState = fun model -> view model >> ignore
 72 |           subscribe = fun _ -> Cmd.none
 73 |           onError = onError }
 74 | 
 75 |     /// Subscribe to external source of events.
 76 |     /// The subscription is called once - with the initial model, but can dispatch new messages at any time.
 77 |     let withSubscription (subscribe : 'model -> Cmd<'msg>) (program: Program<'arg, 'model, 'msg, 'view>) =
 78 |         let sub model =
 79 |             Cmd.batch [ program.subscribe model
 80 |                         subscribe model ]
 81 |         { program with subscribe = sub }
 82 | 
 83 |     /// Trace all the updates to the console
 84 |     let withConsoleTrace (program: Program<'arg, 'model, 'msg, 'view>) =
 85 |         let traceInit (arg:'arg) =
 86 |             let initModel,cmd = program.init arg
 87 |             System.Console.Out.WriteLine (sprintf "Initial state: %A" initModel)
 88 |             initModel,cmd
 89 | 
 90 |         let traceUpdate msg model =
 91 |             System.Console.Out.WriteLine (sprintf "New message: %A" msg)
 92 |             let newModel,cmd = program.update msg model
 93 |             System.Console.Out.WriteLine (sprintf "Updated state: %A" newModel)
 94 |             newModel,cmd
 95 | 
 96 |         { program with
 97 |             init = traceInit 
 98 |             update = traceUpdate }
 99 | 
100 |     /// Trace all the messages as they update the model
101 |     let withTrace trace (program: Program<'arg, 'model, 'msg, 'view>) =
102 |         { program
103 |             with update = fun msg model -> trace msg model; program.update msg model}
104 | 
105 |     /// Handle dispatch loop exceptions
106 |     let withErrorHandler onError (program: Program<'arg, 'model, 'msg, 'view>) =
107 |         { program
108 |             with onError = onError }
109 | 
110 |     /// Start the program loop.
111 |     /// arg: argument to pass to the init() function.
112 |     /// program: program created with 'mkSimple' or 'mkProgram'.
113 |     let runWith (arg: 'arg) (program: Program<'arg, 'model, 'msg, 'view>) =
114 |         let (model,cmd) = program.init arg
115 |         let inbox = MailboxProcessor.Start(fun (mb:MailboxProcessor<'msg>) ->
116 |             let rec loop (state:'model) =
117 |                 async {
118 |                     let! msg = mb.Receive()
119 |                     try
120 |                         let (model',cmd') = program.update msg state
121 |                         program.setState model' mb.Post
122 |                         cmd' |> List.iter (fun sub -> sub mb.Post)
123 |                         return! loop model'
124 |                     with ex ->
125 |                         program.onError ("Unable to process a message:", ex)
126 |                         return! loop state
127 |                 }
128 |             loop model
129 |         )
130 |         program.setState model inbox.Post
131 |         program.subscribe model
132 |         @ cmd |> List.iter (fun sub -> sub inbox.Post)
133 | 
134 |     /// Start the dispatch loop with `unit` for the init() function.
135 |     let run (program: Program<unit, 'model, 'msg, 'view>) = runWith () program
136 | 
137 | 


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