Would it be possible for the Elmish hooks to cope with mkProgram changing the message type?

[marklam]

For some context, here's a sample where Program.withTimings can transparently wrap the Msg type to add a timestamp in TimedMsg, it's a simplified version of what I was really trying to achieve.

As it stands here, the Program uses ElmishWindow which:

• runs its UI from Counter.update and Counter.view.
• can be include or remove times by including or removing the |> Program.withTimings line (the times can be seen in the output from Program.withConsoleTrace).

If the app type is changed to the component / Elmish hook approach by switching .Configure<ComponentApp>() for .Configure<ElmishApp>()

• the app can run fine without the timings
• Program.withTimings cannot be passed to ctx.useElmish because the mapProgram parameter forces the input and output message types to be the same.

#r "nuget:Avalonia.Desktop"
#r "nuget:Avalonia.Themes.Fluent"
#r "nuget:Avalonia.FuncUI.Elmish"

open System
open System.Diagnostics
open Avalonia
open Avalonia.Controls
open Avalonia.Controls.ApplicationLifetimes
open Elmish
open Avalonia.FuncUI
open Avalonia.FuncUI.Hosts
open Avalonia.FuncUI.Elmish
open Avalonia.FuncUI.DSL
open Avalonia.FuncUI.Elmish.ElmishHook
open Avalonia.Themes.Fluent

type Msg = | Increment | Decrement | Reset

type TimedMsg = { Time: DateTime; Message: Msg } with
    static member message tm = tm.Message
    static member stamp m = { Time = DateTime.UtcNow; Message = m }

module Program =
    let withTimings (program: Program<'arg, 'model, Msg, 'view>) : Program<'arg, 'model, TimedMsg, 'view> =
        let mapSnd f (a,b) = (a, f b)

        let mapInit init =
            init >> mapSnd (Cmd.map TimedMsg.stamp)

        let mapUpdate update =
            fun msg model ->
                Trace.WriteLine $"{msg.Message} at {msg.Time}"
                update (TimedMsg.message msg) model |> mapSnd (Cmd.map TimedMsg.stamp)

        let mapView view =
            fun model dispatch ->
                view model (TimedMsg.stamp >> dispatch)

        let mapSetState setState =
            fun model dispatch ->
                setState model (TimedMsg.stamp >> dispatch)

        let mapSub sub =
            fun dispatch ->
                sub (TimedMsg.stamp >> dispatch)

        let mapSubscribe subscribe =
            fun model ->
                subscribe model |> List.map (mapSnd mapSub)

        let mapTermination (predicate, terminate) =
            TimedMsg.message >> predicate, terminate

        program |> Program.map mapInit mapUpdate mapView mapSetState mapSubscribe mapTermination

type State = { Value : int }

module Counter =
    let init () =
        { Value = 0 }, Cmd.none

    let update (msg: Msg) (state: State) : State*Cmd<Msg> =
        match msg with
        | Increment -> { state with Value = state.Value + 1 }, Cmd.none
        | Decrement -> { state with Value = state.Value - 1 }, Cmd.none
        | Reset -> { state with Value = 0 }, Cmd.none

    let view (state: State) (dispatch: Msg -> unit) =
        Grid.create [
            Grid.rowDefinitions "Auto,Auto,Auto,*"
            Grid.children [
                Button.create [
                    Grid.row 0
                    Button.content "+"
                    Button.onClick (fun _ -> dispatch Increment)
                ]
                Button.create [
                    Grid.row 1
                    Button.content "-"
                    Button.onClick (fun _ -> dispatch Decrement)
                ]
                Button.create [
                    Grid.row 2
                    Button.content "Reset"
                    Button.onClick (fun _ -> dispatch Reset)
                ]
                TextBlock.create [
                    Grid.row 3
                    TextBlock.text $"%d{state.Value}"
                ]
            ]
        ]

type ElmishWindow() as this =
    inherit HostWindow()

    do
        base.Title <- "Counter Example"
        base.Height <- 400.0
        base.Width <- 400.0

        Elmish.Program.mkProgram Counter.init Counter.update Counter.view
        |> Program.withTimings  // Can change the message type here
        |> Program.withHost this
        |> Program.withConsoleTrace
        |> Program.run

module CounterComponent =
    let create () =
        Component (
            fun ctx ->
                let initial,_ = Counter.init()
                let state = ctx.useState(initial)
                let _, dispatch = ctx.useElmish (state, Counter.update (*, Program.withTimings*)) // Can't change the message type here

                Counter.view state.Current dispatch
            )

type ComponentWindow() =
    inherit HostWindow()

    do
        base.Title <- "Counter Example"
        base.Height <- 400.0
        base.Width <- 400.0
        base.Content <- CounterComponent.create ()

type CounterApp(createView : unit -> Window) =
    inherit Application()

    override this.Initialize() =
        this.Styles.Add (new FluentTheme())

    override this.OnFrameworkInitializationCompleted() =
        match this.ApplicationLifetime with
        | :? IClassicDesktopStyleApplicationLifetime as desktopLifetime ->
            desktopLifetime.MainWindow <- createView()
        | _ -> ()

type ComponentApp() =
    inherit CounterApp(fun () -> ComponentWindow())

type ElmishApp() =
    inherit CounterApp(fun () -> ElmishWindow())

let args = [| |]
AppBuilder
    //.Configure<ComponentApp>()
    .Configure<ElmishApp>()
    .UsePlatformDetect()
    .UseSkia()
    .StartWithClassicDesktopLifetime(args)

I've tried making my own version of useElmish with 'msg and 'msg2' but it has some knock-on effects on ElmishState's Dispatch member.

Something like:

    type IComponentContext with

        /// Starts an Elmish loop with an existing IWritable.
        member this.useElmish<'model, 'msg, 'msg2>
            (
                writableModel: IWritable<'model>,
                update: 'msg -> 'model -> 'model * Cmd<'msg>,
                mapProgram: Program<unit, 'model, 'msg, unit> -> Program<unit, 'model, 'msg2, unit>
            ) : 'model*('msg -> unit) =

            let elmishState : IWritable<ElmishState<'model,'msg, unit> option> = this.useState(None, false)

            // Start Elmish loop
            this.useEffect(
                fun () ->
                    let mkProgram() =
                        let init() = writableModel.Current, Cmd.none
                        Program.mkProgram init update ignoreView
                        |> mapProgram

                    ElmishState(mkProgram, (), writableModel.Set)
                    |> Some
                    |> elmishState.Set
                , [ EffectTrigger.AfterInit ]
            )

            let dispatch map =
                elmishState.Current
                |> Option.iter (fun es -> es.Dispatch map)

            writableModel.Current, dispatch

Does anyone have any advice on how I could achieve this?

Thanks!

[JaggerJo]

@JordanMarr might know.