Nested Program Component

[nickcorlett]

@Tarmil I was reading through this post that you did for the F# advent calendar a while back and was just wondering whether the idea of a NestedProgramComponent was still something you endorsed?

The concept seems to fit a use case I am working on at the moment but I noticed that a NestedProgramComponent (or something similar) has not been added into Bolero so I was wondering if there were any issues with using this approach?

[xperiandri]

I've made it work. Remoting works too, hot reload tries to work but crashes

1. You need to copy ProgramRun as it is internal
2. Components.fs (just a cut version of the regular component without router)

// $begin{copyright}
//
// This file is part of Bolero
//
// Copyright (c) 2018 IntelliFactory and contributors
//
// Licensed under the Apache License, Version 2.0 (the "License"); you
// may not use this file except in compliance with the License.  You may
// obtain a copy of the License at
//
//     http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
// implied.  See the License for the specific language governing
// permissions and limitations under the License.
//
// $end{copyright}

namespace Bolero

open System
open System.Threading.Tasks
open Microsoft.AspNetCore.Components
open Microsoft.AspNetCore.Components.Routing
open Microsoft.Extensions.Logging
open Microsoft.JSInterop
open Elmish

/// <exclude />
type PageProgram<'model, 'msg> = Program<PageComponent<'model, 'msg>, 'model, 'msg, Node>

/// <summary>Base class for components that run an Elmish program.</summary>
/// <category>Components</category>
and [<AbstractClass>]
    PageComponent<'model, 'msg>() =
    inherit Component<'model>()

    let mutable oldModel = None
    let mutable view = Node.Empty()
    let mutable runProgramLoop = fun () -> ()
    let mutable dispatch = ignore<'msg>
    let mutable program = Unchecked.defaultof<PageProgram<'model, 'msg>>
    let mutable setState = fun model dispatch ->
        view <- Program.view program model dispatch
        oldModel <- Some model

    /// <exclude />
    [<Inject>]
    member val NavigationManager = Unchecked.defaultof<NavigationManager> with get, set
    /// <exclude />
    [<Inject>]
    member val Services = Unchecked.defaultof<IServiceProvider> with get, set
    /// <summary>The JavaScript interoperation runtime. Provided by dependency injection.</summary>
    [<Inject>]
    member val JSRuntime = Unchecked.defaultof<IJSRuntime> with get, set
    /// <exclude />
    [<Inject>]
    member val NavigationInterception = Unchecked.defaultof<INavigationInterception> with get, set
    [<Inject>]
    member val private Log = Unchecked.defaultof<ILogger<PageComponent<'model, 'msg>>> with get, set

    /// <summary>
    /// The component's dispatch method.
    /// This property is initialized during the component's OnInitialized phase.
    /// </summary>
    member _.Dispatch = dispatch

    /// <summary>The Elmish program to run.</summary>
    abstract Program : PageProgram<'model, 'msg>

    interface IProgramComponent with
        member this.Services = this.Services

    member internal this.GetCurrentUri() =
        let uri = this.NavigationManager.Uri
        this.NavigationManager.ToBaseRelativePath(uri)

    member internal _.StateHasChanged() =
        base.StateHasChanged()

    member private this.ForceSetState(model, dispatch) =
        view <- Program.view program model dispatch
        oldModel <- Some model
        this.InvokeAsync(this.StateHasChanged) |> ignore

    override this.OnInitialized() =
        base.OnInitialized()
        let setDispatch d =
            dispatch <- d
        program <-
            this.Program
            |> Program.map
                (fun init arg ->
                    let model, cmd = init arg
                    model, setDispatch :: cmd)
                id id
                (fun _ model dispatch -> setState model dispatch)
                id id
        runProgramLoop <- Program'.runFirstRender this program
        setState <- fun model dispatch ->
            match oldModel with
            | Some oldModel when this.ShouldRender(oldModel, model) -> this.ForceSetState(model, dispatch)
            | _ -> ()

    member internal this.InitRouter
        (
            r: IRouter<'model, 'msg>,
            update: 'msg -> 'model -> 'model * Cmd<'msg>,
            initModel: 'model
        ) =
        match r.SetRoute (this.GetCurrentUri()) with
        | Some msg ->
            update msg initModel
        | None ->
            initModel, []

    override this.OnAfterRenderAsync(firstRender) =
        if firstRender then runProgramLoop()
        Task.CompletedTask

    override this.Render() =
        view

    member this.Rerender() =
        match oldModel with
        | None -> ()
        | Some model ->
            oldModel <- None
            this.ForceSetState(model, dispatch)

3. Program.fs

// $begin{copyright}
//
// This file is part of Bolero
//
// Copyright (c) 2018 IntelliFactory and contributors
//
// Licensed under the Apache License, Version 2.0 (the "License"); you
// may not use this file except in compliance with the License.  You may
// obtain a copy of the License at
//
//     http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
// implied.  See the License for the specific language governing
// permissions and limitations under the License.
//
// $end{copyright}

/// <summary>Functions to enable the router in an Elmish program.</summary>
/// <category>Elmish</category>
module Bolero.Program

open System.Reflection
open Elmish

/// <summary>
/// Attach `router` to `program` when it is run as the `Program` of a `ProgramComponent`.
/// </summary>
/// <param name="router">The router.</param>
/// <param name="program">The Elmish program.</param>
/// <returns>The Elmish program configured with routing.</returns>
let mapInit (program: PageProgram<'model, 'msg>) =
    program
    |> Program.map
        (fun init comp ->
            let model, initCmd = init comp
            model, initCmd)
        id id id id id

open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging
open TemplatingInternals
open Bolero.Templating
open Bolero.Templating.Client

let private registerClient (comp: PageComponent<_, _>) : IClient =
    let settings =
        let s = comp.Services.GetService<HotReloadSettings>()
        if obj.ReferenceEquals(s, null) then HotReloadSettings.Default else s
    let logger =
        let loggerFactory = comp.Services.GetService<ILoggerFactory>()
        loggerFactory.CreateLogger<SignalRClient>()
    let client = new SignalRClient(settings, comp.NavigationManager, logger)
    TemplateCache.client <- client
    client

let withPageHotReload (program: Program<PageComponent<'model, 'msg>, 'model, 'msg, Node>) =
    program
    |> Program.map
        (fun init (comp: PageComponent<'model, 'msg>) ->
            let client =
                // In server mode, the IClient service is set by services.AddHotReload().
                // In client mode, it is not set, so we create it here.
                match comp.Services.GetService<IClient>() with
                | null -> registerClient comp
                | client -> client
            client.SetOnChange(comp.Rerender)
            init comp)
        id id id id id

4. fsproj

<Project Sdk="Microsoft.NET.Sdk.Razor">

  <PropertyGroup>
    <TargetFramework>net7.0</TargetFramework>
    <GenerateDocumentationFile>true</GenerateDocumentationFile>
    <OutputType>Library</OutputType>
  </PropertyGroup>

  <ItemGroup>
    <SupportedPlatform Include="browser" />
  </ItemGroup>

  <ItemGroup>
    <Compile Include="ProgramRun.fs" />
    <Compile Include="Components.fs" />
    <Compile Include="Program.fs" />
    <Compile Include="Options.fs" />
    <Compile Include="URLs.fs" />
    <Compile Include="CreateAccountPage.fs" />
    <Compile Include="SubscribePage.fs" />
  </ItemGroup>

  <ItemGroup>
    <PackageReference Include="Bolero" />
    <PackageReference Include="Bolero.Build" />
    <PackageReference Include="Bolero.HotReload" />
    <PackageReference Include="Microsoft.AspNetCore.Components.Authorization" />
    <PackageReference Include="Microsoft.AspNetCore.Components.Web" />
    <PackageReference Include="Microsoft.Extensions.Configuration.Binder" />
  </ItemGroup>

</Project>

5. App.razor (AdditionalAssemblies)

    <Router AppAssembly="@typeof(App).Assembly"
            AdditionalAssemblies="new[] { typeof(Urls).Assembly }">

6. Page

module SkillGro.Marketplace.Client.CreateAccount

open Elmish
open Bolero
open Bolero.Html
open Bolero.Remoting
open Bolero.Remoting.Client
open Bolero.Templating.Client

open SkillGro.Marketplace

type Model = { Token: string }

type Message =
    | Resolve
    | Create
    | Created

type CreateAccountError =
   | Error1

type AccountService = {
    CheckAccountExistsAsync: unit -> Async<bool>
    CreateAccountAsync: unit -> Async<Result<unit, CreateAccountError>>
}
with
    interface IRemoteService with
        member _.BasePath = Paths.Account

let init token =
    { Token = token }, Cmd.ofMsg Resolve

type CrateAccount = Template<"wwwroot/create-account.html">

let view model dispatch =
    CrateAccount()
        .Submit(fun _ -> dispatch Create)
        //.AccountsCount(model.Accounts)
        .Elt()

open System.Threading.Tasks
open Microsoft.AspNetCore.Authorization
open Microsoft.AspNetCore.Components
open Microsoft.AspNetCore.Components.Authorization

[<Route(Urls.CreateAccount)>]
[<Authorize>]
[<CompiledName "CreateAccountPage">]
type CreateAccountPage() as page =
    inherit PageComponent<Model, Message>()

    let update account msg model =
        match msg with
        | Resolve ->
            model, Cmd.none
        | Create ->
            model, Cmd.OfAsync.perform (fun _ -> account.CreateAccountAsync()) () (fun _ -> Created)
        | Created ->
            page.NavigationManager.NavigateTo(Urls.Subscribe)
            model, Cmd.none

    [<Parameter>]
    [<SupplyParameterFromQuery(Name = "token")>]
    member val Token = Unchecked.defaultof<System.String> with get, set

    [<CascadingParameter>]
    member val AuthenticationStateTask = Unchecked.defaultof<Task<AuthenticationState>> with get, set

    override page.Program =
        let accountService = page.Remote<AccountService>()
        let update = update accountService
        Program.mkProgram (fun _ -> init page.Token) update view
        |> Program.mapInit
#if DEBUG
        |> Program.withPageHotReload
#endif

[xperiandri]

@Tarmil can you bring this into Bolero? Is it possible to fix the hot reload for such components?

[Tarmil]

@xperiandri I think this is different from what was asked in the issue, but it's interesting too, I'll have a look!

[xperiandri]

Sample app