Elmish dispatch on Fable React stateful component - f#

I need to use Fable-React stateful component with elmish dispatch. I can not figure out how to create it.
I am using this project template: https://github.com/fable-elmish/templates
here is model:
module Home.Types
[<Pojo>]
type Model = {
isLoading: bool
}
here is the component:
type Documentation(props) as this =
inherit Component<Documentation.Types.Model,obj>(props)
do
()
override this.componentWillMount () =
printfn "componentWillMount"
**RequestProcessDocumentation |> dispatch <-- this is what I need**
override this.render() =
printfn "render"
let (?) = Fable.Core.JsInterop.(?)
div []
[
p [] [str(this.props.isLoading.ToString())]
button [ OnClick (fun _ -> RequestProcessDocumentation |> dispatch ) ] [str("Click me")]
]
how can I create it using ofType function, so then I can use it like this:
let pageHtml =
function
| Home -> Home.View.root model.home (HomeMsg >> dispatch)
| Documentation -> documentation (DocumentationMsg >>

I added the dispatch function to props:
[<Pojo>]
type Model = {
isLoading: bool
processDocumentation: ProcessDocumentationDto
valuesForFilterDropdown: DropdownFilterValues
scopeOfFilter: ScopeOfFilter
expandedMenuItemsIds: string list
}
[<Pojo>]
type DocumentationProps = {
model: Model
dispatch: Msg -> unit
}
create the view:
let root model dispatch =
let inline documentation props = ofType<Documentation,_,_> props []
let pageHtml =
function
| Home -> Home.View.root model.home (HomeMsg >> dispatch)
| Documentation -> documentation { model.documentation with dispatch = (DocumentationMsg >> dispatch)}
and then I call it this way:
RequestProcessDocumentation |> this.props.dispatch

Related

Updating ProgressBar.Value in FsXaml and ElmishWPF

I am trying to update ProgressBar.Value in FsXaml. In C#, I used the below-mentioned code. I haven't tried to implement the C# approach in F# as using a public field (myCaller) does not seem to me as being a functional approach (let alone the fact that I do not know if it is at all possible to use this C# approach in F#).
//C# code
namespace Special_technical_dictionary_CSharp_4._011
{
//...some usings
class ExcelData
{
//...some code
public void WritingIntoDat()
{
//...some code
using (bw = new BinaryWriter(new FileStream(...some params...)))
{
while ((currrowIndex < (lastrowIndex + 1)))
{
//...some code
Form1.myCaller.updateProgressBarValue(100 * currrowIndex);
currrowIndex += 1;
}
bw.Close();
}
//...some code
}
}
}
namespace Special_technical_dictionary_CSharp_4._011
{
//...some usings
public partial class Form1 : Form
{
//...some code
public static Form1 myCaller;
public Form1()
{
InitializeComponent();
myCaller = this;
}
//...some code
public void updateProgressBarValue(int valueV)
=> progressBar.Value = (progressBar.Value == progressBar.Maximum) ? valueV : 0;
//...some code
}
}
My question is: What is the best (or at least good) functional approach in F# (FsXaml/code behind) for updating ProgressBar.Value?
EDIT1:
Irrelevant code and text deleted. Those not interested in Elmish.WPF please wait until an answer related to FsXaml appears.
EDIT2:
Elmish.WPF
I tried to deal with the ProgressBar issue using Bent Tranberg's comments & answer and his excellent example code. My adaptation works for a for-loop, but not for List.map(i)/iter(i), which are collection functions I actually need the progress bar for. Here is the simplified code:
File: MainWindow.fs
//F# code
module Elmish.MainWindow
type ProgressIndicator = Idle | InProgress of percent: int
type Model =
{
ProgressIndicatorLeft: ProgressIndicator
ProgressIndicatorRight: ProgressIndicator
}
let initialModel =
{
ProgressIndicatorLeft = Idle
ProgressIndicatorRight = Idle
}
let init() = initialModel, Cmd.none
type Msg =
| UpdateStatusLeft of progress: int
| WorkIsCompleteLeft
| UpdateStatusRight of progress: int
| WorkIsCompleteRight
| TestButtonLeftEvent
| TestButtonRightEvent
// FOR TESTING PURPOSES ONLY
let private longRunningOperationLeft dispatch = //simulating long running operation
async
{
for i in 1..100 do
do! Async.Sleep 20
dispatch (UpdateStatusLeft i) //THIS WORKS
dispatch WorkIsCompleteLeft
}
// FOR TESTING PURPOSES ONLY
let private longRunningOperationRight dispatch = //simulating long running operation
async //NOT WORKING
{
[1..10000]
|> List.mapi(fun i item ->
[1..100] |> List.reduce (*) |> ignore
dispatch(UpdateStatusRight i)
)
dispatch WorkIsCompleteRight
}
let update (msg: Msg) (m: Model) : Model * Cmd<Msg> =
match msg with
| UpdateStatusLeft progress -> { m with ProgressIndicatorLeft = InProgress progress; ProgressBackgroundLeft = Brushes.White }, Cmd.none
| WorkIsCompleteLeft -> { m with ProgressIndicatorLeft = Idle; ProgressBackgroundLeft = Brushes.LightSkyBlue }, Cmd.none
| UpdateStatusRight progress -> { m with ProgressIndicatorRight = InProgress progress; ProgressBackgroundRight = Brushes.White }, Cmd.none
| WorkIsCompleteRight -> { m with ProgressIndicatorRight = Idle; ProgressBackgroundRight = Brushes.LightSkyBlue }, Cmd.none
| TestButtonLeftEvent ->
let incrementDelayedCmd (dispatch: Msg -> unit) : unit = //THIS WORKS
let delayedDispatch = longRunningOperationLeft dispatch
Async.StartImmediate delayedDispatch
{ m with ProgressIndicatorLeft = InProgress 0 }, Cmd.ofSub incrementDelayedCmd
| TestButtonRightEvent ->
let incrementDelayedCmd (dispatch: Msg -> unit) : unit = //NOT WORKING
let delayedDispatch = longRunningOperationRight dispatch
Async.StartImmediate delayedDispatch
{ m with ProgressIndicatorRight = InProgress 0 }, Cmd.ofSub incrementDelayedCmd
let bindings(): Binding<Model,Msg> list =
[
"ProgressLeftBackg" |> Binding.oneWay(fun m -> m.ProgressBackgroundLeft)
"ProgressRightBackg" |> Binding.oneWay(fun m -> m.ProgressBackgroundRight)
"ProgressLeft" |> Binding.oneWay(fun m -> match m.ProgressIndicatorLeft with Idle -> 0.0 | InProgress v -> float v)
"ProgressRight" |> Binding.oneWay(fun m -> match m.ProgressIndicatorRight with Idle -> 0.0 | InProgress v -> float v)
"TestButtonLeft" |> Binding.cmdIf(TestButtonLeftEvent, fun m -> match m.ProgressIndicatorLeft with Idle -> true | _ -> false)
"TestButtonRight" |> Binding.cmdIf(TestButtonRightEvent, fun m -> match m.ProgressIndicatorRight with Idle -> true | _ -> false)
]
Even if binding the "i" index with the progress bar value had worked for collection functions in the MainWindow, it won't solve the problem. In a real life situation, the collection functions intended to work with the progress bar value are in other files "above" the main window file. Like this:
file: MainLogicRight.fs
//F# code
module MainLogicRight
let textBoxString3 low high path =
//some code
let myArray() =
Directory.EnumerateDirectories(path, "*", SearchOption.TopDirectoryOnly)
|> Option.ofObj
|> optionToArraySort "..." "..."
|> Array.collect
(fun item ->
let arr =
let p = prefix + "*"
Directory.EnumerateDirectories(item, p)
|> Option.ofObj
|> optionToArraySort "..." "..."
|> Array.Parallel.mapi(fun i item ->
let arr = Directory.EnumerateFiles(item, "*.jpg", SearchOption.TopDirectoryOnly)
|> Option.ofObj
|> optionToArraySort "..." "..."
arr.Length
)
arr
)
I understand that it is (probably) not possible to bind the pb value with a non-indexed function such as Array.collect. But what is important - how to bind the pb value with the "i" index in List/Array.mapi/iteri (Array.Parallel.mapi in this case) ?
EDIT3:
Based on the last answer by Bent, the now-irrelevant texts and comments of mine were deleted.
An example based on the answers is here.
This answer explains how, in Elmish.WPF, progress updates to the user interface can be done from an async.
I have created an example on GitHub that demoes this. The example also demoes another way to call async functions and receive results. And it also demoes how to use mkProgram instead of mkSimple. The demo can be used as a starting template for your Elmish.WPF applications.
This snippet from the demo show the essential code involved in updating a user interface from an async.
Both techniques are based on code from the Elmish Book. You will find a lot of code there that is useful also in Elmish.WPF.
I haven't tried to update a progress bar here, only a status text box, but from this you'll very easily figure out what to do to update anything.
| UpdateStatusText statusText ->
{ m with StatusText = statusText }, Cmd.none
| RunWithProgress ->
let incrementDelayedCmd (dispatch: Msg -> unit) : unit =
let delayedDispatch = async {
do! Async.Sleep 1000
dispatch (UpdateStatusText "One")
do! Async.Sleep 1000
dispatch (UpdateStatusText "Two")
do! Async.Sleep 1000
dispatch (UpdateStatusText "Three")
}
Async.StartImmediate delayedDispatch
{ m with StatusText = "Started progress." }, Cmd.ofSub incrementDelayedCmd
UPDATE:
I have now updated the demo project on GitHub so that it demoes updates of a progress bar (and status text) from the async. These are snippets of the essential pieces.
Declaration of the two messages dispatched from the async.
| UpdateStatus of statusText:string * progress:int
| WorkIsComplete // This message could carry a result from the work done.
Handling of the two messages.
| UpdateStatus (statusText, progress) ->
{ m with StatusText = statusText; Progress = progress }, Cmd.none
| WorkIsComplete ->
{ m with StatusText = "Work was completed."; Progress = 0 }, Cmd.none
| RunWithProgress ->
let incrementDelayedCmd (dispatch: Msg -> unit) : unit =
let delayedDispatch = async {
do! Async.Sleep 1000
dispatch (UpdateStatus ("Early work", 30))
do! Async.Sleep 1000
dispatch (UpdateStatus ("Still working", 60))
do! Async.Sleep 1000
dispatch (UpdateStatus ("Late work", 90))
do! Async.Sleep 1000
dispatch WorkIsComplete
}
Async.StartImmediate delayedDispatch
{ m with StatusText = "Started progress." }, Cmd.ofSub incrementDelayedCmd
The field Progress is declared as an int.
Progress: int
The property Value of ProgressBar is a float, so a cast to float is needed in the binding.
"Progress" |> Binding.oneWay (fun m -> float m.Progress)
Of course we can declare Progress in the model as a float, but I wanted to take this opportunity to point out that the model doesn't have to align with the data types of the properties of the components. We can of course map in whatever way we want in the bindings.
One final note on the dispatcher. This is accessible through Cmd.ofSub, and also through WkProgram.Subscribe. More about that on another occasion maybe, but note this now: Sending messages with the dispatcher is thread safe. This means you can send progress messages (or any message) to the model also from async functions that run within your top level async function, or e.g. from a timer event, or anywhere really.
FINAL UPDATE : The demo on GitHub is now slightly more advanced than shown here, but the principle is still the same, so I won't bother to update the source in this answer. Anybody interested in this will most probably need the complete demo source anyway, unless you're already well into Elmish.WPF
The last part of the question, added later, is answered here.
When doing lengthy and/or CPU-intensive work, then this should be done as shown in the longRunningOperationLeft function below. This also shows how functions elsewhere, that should not be dependent on the GUI, can be written in such a way that progress updates can be sent to the GUI.
The longRunningOperationRight shown below is doing it the wrong way, blocking the GUI.
My expertise on async and task stuff is not very good, but I think the top-level async functions (such as longRunningOperationLeft) called from Elmish are running on the same thread as the Elmish loop, and this is why they should not be blocked with anything lengthy or CPU-intensive. Instead, that kind of blocking work needs to go into a child computation (such as workToDo). The role of longRunningOperationLeft is to await work, but not do work itself, lest it blocks the GUI.
I don't know whether List.mapi can have an async operation inside it. I suspect not. Anyhow, I suspect that won't be needed for your real-life case.
UPDATE by Mira: You are right. Not needed in my real-life case. Adding reportProgress i (like in your code) inside List/array.mapi is enough.
let private lengthyWork () =
[1..20_000_000] |> List.reduce ( * ) |> ignore
let private workToDo reportProgress = async {
reportProgress 0
lengthyWork ()
reportProgress 25
lengthyWork ()
reportProgress 50
lengthyWork ()
reportProgress 75
lengthyWork ()
reportProgress 100
return 7
}
// This is good.
let private longRunningOperationLeft dispatch = async {
let reportProgress progress = dispatch (UpdateStatusLeft progress)
let! hardWork = Async.StartChild (workToDo reportProgress)
do! Async.Sleep 1000 // Can do some async work here too, while waiting for hardWork to finish.
let! result = hardWork
dispatch WorkIsCompleteLeft
}
// This is not good. Blocking GUI.
let private longRunningOperationRight dispatch = async {
dispatch (UpdateStatusRight 0)
lengthyWork ()
dispatch (UpdateStatusRight 25)
lengthyWork ()
dispatch (UpdateStatusRight 50)
lengthyWork ()
dispatch (UpdateStatusRight 75)
lengthyWork ()
dispatch (UpdateStatusRight 100)
dispatch WorkIsCompleteRight
}

Managing HttpClient in a F# WebAssembly app

What is the best practice is to "register" the http client in one place, so it can be reused from this Elmish update function? Instead of having to create it for every request.
let update message model =
match message with
| SetMessage s -> { model with x = s }
| Loading -> { model with x = "Doing something long ..." }
let handleClick model dispatch _ =
dispatch Loading
async {
let url = Uri "https://api.github.com"
-- FIXME: too expensive to do this on per-update basis
use httpClient = new HttpClient(BaseAddress = url)
let! resp = httpClient.GetAsync "/users/srid" |> Async.AwaitTask
let! s = resp.Content.ReadAsStringAsync() |> Async.AwaitTask
dispatch (SetMessage s)
} |> Async.Start
I feel like this would normally go in Startup.fs. I use a client-only Bolero web app, so this would look like:
builder.Services.AddSingleton<HttpClient>(new HttpClient (BaseAddress=apiBase))
But then the question becomes ... how do I access it from my program in F#? What is the idiomatic way?
Probably the best way would either be to add HttpClient as another field in your model or as another parameter to your update function.
let update (client:HttpClient) message model = // Your code
let url = Uri "https://api.github.com"
let httpClient = new HttpClient(BaseAddress = url)
In general you shouldn't "do work" in your view and, by extension, event handlers. Instead, you should use the Elmish Cmd module something like this:
let update httpClient message model =
match message with
| SetMessage s ->
{ model with x = s }, Cmd.none
| GetMessageAsync ->
let cmd =
let getHttp () =
async {
let! resp = httpClient.GetAsync "/users/srid" |> Async.AwaitTask
return! resp.Content.ReadAsStringAsync() |> Async.AwaitTask
}
Cmd.OfAsync.perform getHttp () (fun s -> SetMessage s)
{ model with x = "Doing something long ..." }, cmd
let handleClick model dispatch _ =
dispatch GetMessageAsync

dispatch method in view for parent child composition

I am trying to understand the way fable is supposed to work with parent child composition. Things are quite easy when it comes to update method, init, and the definition of commands. But the view method and its dispatch method are tricky to find out
In my code, the child is:
module DeploymentView
type DeploymentTypeView =
| DeployContainerView
type Model = {
CurrentView : DeploymentTypeView option
}
type Msg =
| ShowDeployContainer
let init () : Model =
let initialModel = {
CurrentView = None
}
initialModel
let update (msg : Msg) (currentModel : Model) : Model * Cmd<Msg> =
match msg with
| ShowDeployContainer ->
let nextModel = {
currentModel with CurrentView = Some DeployContainerView
}
nextModel, Cmd.none
| _ -> currentModel, Cmd.none
let view (model : Model) (dispatch : Msg -> unit) =
[
Content.content [ Content.Modifiers [ Modifier.TextAlignment (Screen.All, TextAlignment.Left) ] ]
[
Heading.h3 [] [ str ("Deployments: ") ]
]
Columns.columns []
[
Column.column [] [ button "deploy container" (fun _ -> dispatch ShowDeployContainer) ]
]
]
And following this documentation about parent child processing I have define a parent like this one:
module Client
type PortalView =
| DeploymentView of DeploymentView.Model
| ProductAdministrationView
type Model = {
CurrentPortal : PortalView option
}
// The Msg type defines what events/actions can occur while the application is running
// the state of the application changes *only* in reaction to these events
type Msg =
| ShowDeployment
| ShowAdministration
| DeployContainerView of DeploymentView.Msg
// defines the initial state and initial command (= side-effect) of the application
let init () : Model * Cmd<Msg> =
let initialModel = {
CurrentPortal = None
}
initialModel, Cmd.none
let update (msg : Msg) (currentModel : Model) : Model * Cmd<Msg> =
match msg with
| ShowDeployment ->
let nextModel = {
currentModel with CurrentPortal = Some <| DeploymentView(DeploymentView.init())
}
nextModel, Cmd.none
| ShowAdministration ->
let nextModel = {
currentModel with CurrentPortal = Some ProductAdministrationView
}
nextModel, Cmd.none
| DeployContainerView msg' ->
let res, cmd =
match currentModel.CurrentPortal with
| Some(DeploymentView(m)) -> DeploymentView.update msg' m
| _ -> DeploymentView.init(), Cmd.none
{ currentModel with CurrentPortal = Some(DeploymentView(res)) }, Cmd.map DeployContainerView cmd
So far so good, my issue comes when it goes to the rendering of the view itself.
The client view uses a function as follows:
let view (model : Model) (dispatch : Msg -> unit)
where Msg is of type DeploymentView.Msg whereas in the parent view I have access to a dispatch of type Client.Msg -> unit. how can I decompose the parent dispatch to map it to the child dispatch signature?
You can very easily create a dispatch function that conforms to what the child expects by using the >> operator:
DeploymentView.view deploymentViewModel (DeployContainerView >> dispatch)
which is equivalent to doing:
DeploymentView.view deploymentViewModel (fun msg -> msg |> DeployContainerView |> dispatch)
That is, it wraps the child's message in DeployContainerView, then passes that to dispatch.
On another note, it is a common and good convention to use a Msg suffix on constructors used to wrap child msg types. You may want to consider renaming DeployContainerView to DeploymentContainerMsg.

Providing a function that is bound by 3rd party scipt

I am trying to write a riot tag in Fsharp but am unable to do so without changing riot.
In JavaScript I should provide a function like:
function(opts) {
this.on("update",function(opts){
this.opts = opts || this.opts;
});
}
riot will then call this function using Function.prototype.call:
if (impl.fn) { impl.fn.call(this, opts); }
In F# I tried the following:
[<Emit("this")>]
let isThis (x: 'a) : obj = jsNative
let bind fn =
fun o ->
fn (isThis 1) o
[<Emit("$0 === undefined")>]
let isUndefined (x: 'a) : bool = jsNative
bind
(
fun me opts ->
me?on(
"update"
,(
fun opts ->
if not (isUndefined opts) then
me?opts <- opts
()
)
)
)
However; the bind function is transpiled to:
export function bind(fn, o) {
return fn(this)(o);
}
Not currying when I would like it to curry, the output I was looking for is:
export function bind(fn) {
return function(o){
return fn(this)(o);
}
}
The only way I can get this to work is to change riot.js to:
if (impl.fn) { impl.fn(this)(opts); }
And provide my function in F# in the following way:
fun me opts ->
me?on(
"update"
,(
fun opts ->
if not (isUndefined opts) then
me?opts <- opts
()
)
)
Changing 3rd party libraries to satisfy transpiler generated code is not ideal. Is there a way for the transpiler to generate the output I'm looking for?
[update]
A better way to do this that doesn't require changing 3rd party code is to provide the bind function as 3rd party JavaScript:
Then import it and use bind in your template code file:
let JSI =
bind<(obj -> obj -> unit) -> obj>
"../../../js/3rd/JSI.js"
bind
(
fun me opts ->
me?on(
"update"
,(
fun opts ->
if not (isUndefined opts) then
me?opts <- opts
()
)
)
)
You are hitting up against Fable's automatic uncurrying. What you need to do is replace the F# functions with System.Func delegates to prevent Fable from uncurrying.
I was able to get pretty close with this:
[<Emit("this")>]
let jsThis : obj = jsNative
let bind (fn : Func<obj, (obj -> obj)>) =
Func<_, _> (fun o -> fn.Invoke(jsThis) o)
The generated JavaScript:
export function bind(fn) {
return (o) => fn(this)(o);
}

Avoiding nested pattern matching (possibly with maybe monad)

How could nested pattern matching, such as the following example, be re-written so that None is specified only once? I think the Maybe monad solves this problem. Is there something similar in the F# core library? Or, is there an alternative approach?
match a with
| Some b ->
let c = b.SomeProperty
match c with
| Some d ->
let e = d.SomeProperty
//and so on...
| None -> ()
| None -> ()
you can solve this using built-in capabilities: Option.bind
type A =
member this.X : B option = Unchecked.defaultof<_>
and B =
member this.Y : С option = Unchecked.defaultof<_>
and С =
member this.Z : string option = Unchecked.defaultof<_>
let a : A = Unchecked.defaultof<_>
let v =
match
a.X
|> Option.bind (fun v -> v.Y)
|> Option.bind (fun v -> v.Z) with
| Some s -> s
| None -> "<none>"
Frankly, I doubt that introducing full-fledged 'maybe' implementation (via computation expressions) here can shorten the code.
EDIT: Dream mode - on
I think that version with Option.bind can be made smaller if F# has more lightweight syntax for the special case: lambda that refer to some member of its argument:
"123" |> fun s -> s.Length // current version
"123" |> #.Length // hypothetical syntax
This is how the sample can be rewritten in Nemerle that already has such capabilities:
using System;
using Nemerle.Utility; // for Accessor macro : generates property for given field
variant Option[T]
{
| Some {value : T}
| None
}
module OptionExtensions
{
public Bind[T, U](this o : Option[T], f : T -> Option[U]) : Option[U]
{
match(o)
{
| Option.Some(value) => f(value)
| Option.None => Option.None()
}
}
}
[Record] // Record macro: checks existing fields and creates constructor for its initialization
class A
{
[Accessor]
value : Option[A];
}
def print(_)
{
// shortened syntax for functions with body -> match over arguments
| Option.Some(_) => Console.WriteLine("value");
| Option.None => Console.WriteLine("none");
}
def x = A(Option.Some(A(Option.Some(A(Option.None())))));
print(x.Value.Bind(_.Value)); // "value"
print(x.Value.Bind(_.Value).Bind(_.Value)); // "none"
I like desco's answer; one should always favor built-in constructs. But FWIW, here's what a workflow version might look like (if I understand the problem correctly):
type CE () =
member this.Bind (v,f) =
match v with
| Some(x) -> f x
| None -> None
member this.Return v = v
type A (p:A option) =
member this.P
with get() = p
let f (aIn:A option) = CE () {
let! a = aIn
let! b = a.P
let! c = b.P
return c.P }
let x = f (Some(A(None)))
let y = f (Some(A(Some(A(Some(A(Some(A(None)))))))))
printfn "Your breakpoint here."
I don't suggest this, but you can also solve it with exception handling:
try
<code that just keeps dotting into option.Value with impunity>
with
| :? System.NullReferenceException -> "None"
I just wanted to point out the rough equivalence of exception-handling to the Maybe/Either monads or Option.bind. Typically prefer one of them to throwing and catching exceptions.
Using Option.maybe from FSharpx:
open FSharpx
type Pet = { Name: string; PreviousOwner: option<string> }
type Person = { Name: string; Pet: option<Pet> }
let pers = { Name = "Bob"; Pet = Some {Name = "Mr Burns"; PreviousOwner = Some "Susan"} }
Option.maybe {
let! pet = pers.Pet
let! prevOwner = pet.PreviousOwner
do printfn "%s was the previous owner of %s." prevOwner pet.Name
}
Output:
Susan was the previous owner of Mr Burns.
But, e.g. with this person instead there is just no output:
let pers = { Name = "Bob"; Pet = None }

Resources