Fable Elmish url change events management without hashbang

Question

Give the following very basic Fable.Lit elmish application

module App
open Elmish
open Elmish.Navigation
open Lit

type Route =
    | Contract
    | Product
    | Chart

type Model = {
    Route_ : Route option }

type Msg = ...

let init route_ = {Route_ = route_}, Cmd.none

let update msg model = ...

let view (model:Model) dispatch = 
    match model.Route_ with
    | None -> ...
    | Some Contract -> ...
    | Some Product -> ...
    | Some Chart -> ...

open Lit.Elmish
open Elmish.UrlParser

let route = oneOf [ 
    map Product (s "product")
    map Contract (s "contract")
    map Chart (s "chart") ]

let urlUpdate (route_: Option<Route>) model = 
    printf "urlUpdate"
    model, Cmd.none

Program.mkProgram init update view
// |> Program.toNavigable (parseHash route) urlUpdate
|> Program.toNavigable (parsePath route) urlUpdate
|> Program.withLit "my-app"
|> Program.run

No problems With parseHash. Whenever I change the url in the browser url, for example 'http://host/#product' (including the # character) and press Enter, urlUpdate is called ('urlUpdate' gets printed in the dev tools console).

I would expect that with parsePath urlUpdate gets called with every change in the url bar. Instead, if the changed url doesn't contain '#', a page reload occurs and urlUpdate is never called.

Which is the correct way to capture any url change (either manual or programmatic)?

Answer 1

This example of routing works well without #

module Types

[<RequireQualifiedAccess>]
type Route =
    | Home
    
module Route =
    open Elmish.UrlParser
    **let route: Parser<Route -> Route, Route> = oneOf [ map Route.Home top ]**
    let parser location = parsePath route location

---

module App

[<RequireQualifiedAccess>]
type Page =
    | HomePage of HomePage.Types.HomePage

[<RequireQualifiedAccess>]
type Msg =
    | Nothing
    | HomePageMsg of HomePage.Types.HomePageMsg

type AppModel = {
    CurrentPage: Page
}

let urlUpdate (_route_: Route option) (model: AppModel) : AppModel * Cmd<Msg> =
    match _route_ with
    | Some Route.Home ->
        ...
        ( appModel, Cmd.none)
    | _ -> failwith "no route"

let init (_router_: Route option) : AppModel * Cmd<Msg>  =
    let homePageModel, homePageCmd = HomePage.init
    let homePage = Page.HomePage homePageModel
    let appModel = { CurrentPage = homePage }
    urlUpdate _router_ appModel

let update (msg: Msg) (model: AppModel) =
    match msg with
    | Msg.Nothing ->
       (model, Cmd.none)
    | Msg.HomePageMsg homePageMsg ->
        match model.CurrentPage with
        | Page.HomePage homePageModel ->
            let homePageModel', homePageCmd = HomePage.update homePageMsg homePageModel
            let homePage = Page.HomePage homePageModel'
            let cmd = Cmd.map Msg.HomePageMsg homePageCmd
            let model' = { model with CurrentPage = homePage }
            (model', cmd)
        | _ -> (model, Cmd.none)

let view (model:AppModel) dispatch =
    let pageView =
      match model.CurrentPage with
      | Page.HomePage homePage ->
          HomePage.view homePage (Msg.HomePageMsg >> dispatch)
    pageView

---

module Main

open Elmish
open Elmish.React
open Elmish.Navigation

Program.mkProgram App.init App.update App.view
|> Program.toNavigable **Types.Route.parser** App.urlUpdate
|> Program.withReactSynchronous "root"
|> Program.run