Update to Elmish 4

sample/App.fs

@@ -1,7 +1,7 @@
 module Sample.App
 
 open Elmish
-open Elmish.HMR
+// open Elmish.HMR
 open Lit
 open Lit.Elmish
 open Components

sample/Sample.fsproj

@@ -15,7 +15,7 @@
   <ItemGroup>
     <!-- <PackageReference Include="Fable.Lit.Elmish" Version="1.0.0-rc-001" /> -->
     <!-- <PackageReference Include="Fable.Lit.React" Version="1.0.0-rc-001" /> -->
-    <PackageReference Include="Fable.Elmish.HMR" Version="4.3.1" />
+    <!-- <PackageReference Include="Fable.Elmish.HMR" Version="4.3.1" /> -->
     <PackageReference Include="Feliz" Version="1.52.0" />
   </ItemGroup>
 </Project>

src/Lit.Elmish/Lit.Elmish.fs

@@ -6,6 +6,14 @@ open Browser.Types
 open Elmish
 open Lit
 
+type State<'model> =
+    | Active of 'model
+    | Inactive
+
+type Msg<'msg> =
+    | UserMsg of 'msg
+    | Stop
+
 [<RequireQualifiedAccess>]
 module Program =
     /// Creates an elmish program without a view function.
@@ -36,6 +44,33 @@ module Program =
 
         withLitOnElement el program
 
+    /// Adds a cumulative termination handler, doesn't affect the termination criteria
+    let addTerminationHandler (handler: 'model -> unit) (program: Program<'arg, 'model, 'msg, 'view>): Program<'arg, 'model, 'msg, 'view> =
+        program
+        |> Program.mapTermination (fun (criteria, handler') ->
+            criteria, fun model -> handler' model; handler model)
+
+    /// Adds a cumulative subscription
+    let addSubscription (subscribe: 'model -> Cmd<'msg>) (program: Program<'arg, 'model, 'msg, 'view>): Program<'arg, 'model, 'msg, 'view> =
+        program
+        |> Program.mapSubscription (fun subscribe' model ->
+            Cmd.batch [
+                subscribe' model
+                subscribe model
+            ])
+
+    /// Adds a cumulative subscription that will be disposed on termination
+    let addDisposableSubscription (subscribe: 'model -> Dispatch<'msg> -> IDisposable) (program: Program<'arg, 'model, 'msg, 'view>): Program<'arg, 'model, 'msg, 'view> =
+        let mutable disp: IDisposable option = None
+        program
+        |> addSubscription (fun model ->
+            Cmd.ofSub (fun dispatch ->
+                disp <- subscribe model dispatch |> Some
+            )
+        )
+        |> addTerminationHandler (fun _ ->
+            disp |> Option.iter (fun d -> d.Dispose()))
+
 [<AutoOpen>]
 module LitElmishExtensions =
     type ElmishObservable<'State, 'Msg>() =
@@ -62,62 +97,73 @@ module LitElmishExtensions =
             | Some _ -> ()
             | None -> listener <- Some f
 
-    let useElmish(ctx: HookContext, program: unit -> Program<unit, 'State, 'Msg, unit>) =
-        let obs = ctx.useMemo(fun () -> ElmishObservable())
+    type HookContext with
+        member ctx.useElmish(program: unit -> Program<'arg, 'State, 'Msg, unit>, arg: 'arg) =
+            let obs = ctx.useMemo(fun () -> ElmishObservable())
+
+            let state, setState = ctx.useState(fun () ->
+                let mapInit init arg =
+                    let model, cmd = init arg
+                    Active model, Cmd.map UserMsg cmd
+
+                let mapUpdate update msg model =
+                    match msg, model with
+                    | Stop, _ | _, Inactive -> Inactive, Cmd.none
+                    | UserMsg msg, Active model ->
+                        let model, cmd = update msg model
+                        Active model, Cmd.map UserMsg cmd
+
+                let mapView _view = fun _model _dispatch -> ()
+
+                let mapSetState _setState = obs.SetState
 
-        let state, setState = ctx.useState(fun () ->
-            program()
-            |> Program.withSetState obs.SetState
-            |> Program.run
+                let mapSubscribe subscribe model =
+                    match model with
+                    | Active model -> subscribe model |> Cmd.map UserMsg
+                    | Inactive -> Cmd.none
 
-            match obs.Value with
-            | None -> failwith "Elmish program has not initialized"
-            | Some v -> v)
+                let mapTermination (criteria, handler) =
+                    (function Stop -> true | UserMsg msg -> criteria msg),
+                    (function
+                        | Inactive -> ()
+                        | Active model ->
+                            handler model
+                            // Support "legacy" method of disposing model
+                            match box model with
+                            | :? System.IDisposable as disp -> disp.Dispose()
+                            | _ -> ())
 
-        ctx.useEffectOnce(fun () ->
-            Hook.createDisposable(fun () ->
-                match box state with
-                | :? System.IDisposable as disp -> disp.Dispose()
-                | _ -> ()))
+                program()
+                |> Program.map mapInit mapUpdate mapView mapSetState mapSubscribe mapTermination
+                |> Program.runWith arg
 
-        obs.Subscribe(setState)
-        state, obs.Dispatch
+                match obs.Value with
+                | None | Some Inactive -> failwith "unexpected"
+                | Some(Active v) -> v)
+
+            ctx.useEffectOnce(fun () ->
+                Hook.createDisposable(fun () ->
+                    obs.Dispatch(Stop)))
+
+            obs.Subscribe(function Inactive -> () | Active state -> setState state)
+            state, (UserMsg >> obs.Dispatch)
+
+        member ctx.useElmish(program: unit -> Program<unit, 'State, 'Msg, unit>) =
+            ctx.useElmish(program, ())
 
     type Hook with
-        /// <summary>
         /// Start an [Elmish](https://elmish.github.io/elmish/) model-view-update loop.
-        /// </summary>
-        /// <example>
-        ///      type State = { counter: int }
-        ///
-        ///      type Msg = Increment | Decrement
-        ///
-        ///      let init () = { counter = 0 }
-        ///
-        ///      let update msg state =
-        ///          match msg with
-        ///          | Increment -&gt; { state with counter = state.counter + 1 }
-        ///          | Decrement -&gt; { state with counter = state.counter - 1 }
-        ///
-        ///      [&lt;HookComponent>]
-        ///      let app () =
-        ///          let state, dispatch = Hook.useElmish(init, update)
-        ///         html $"""
-        ///               &lt;header>Click the counter&lt;/header>
-        ///               &lt;div id="count">{state.counter}&lt;/div>
-        ///               &lt;button type="button" @click=${fun _ -> dispatch Increment}>
-        ///                 Increment
-        ///               &lt;/button>
-        ///               &lt;button type="button" @click=${fun _ -> dispatch Decrement}>
-        ///                   Decrement
-        ///                &lt;/button>
-        ///              """
-        /// </example>
+        static member inline useElmish(init: 'arg -> ('State * Cmd<'Msg>), update: 'Msg -> 'State -> ('State * Cmd<'Msg>), arg: 'arg): 'State * ('Msg -> unit) =
+            Hook.getContext().useElmish((fun () -> Program.mkHidden init update), arg)
+
+        /// Start an [Elmish](https://elmish.github.io/elmish/) model-view-update loop.
         static member inline useElmish(init: unit -> ('State * Cmd<'Msg>), update: 'Msg -> 'State -> ('State * Cmd<'Msg>)): 'State * ('Msg -> unit) =
-            useElmish(Hook.getContext(), fun () -> Program.mkHidden init update)
+            Hook.getContext().useElmish(fun () -> Program.mkHidden init update)
 
-        static member inline useElmish(program: Program<unit, 'State, 'Msg, unit>): 'State * ('Msg -> unit) =
-            useElmish(Hook.getContext(), fun () -> program)
+        /// Start an [Elmish](https://elmish.github.io/elmish/) model-view-update loop.
+        static member inline useElmish(program: unit -> Program<'arg, 'State, 'Msg, unit>, arg: 'arg): 'State * ('Msg -> unit) =
+            Hook.getContext().useElmish(program, arg)
 
+        /// Start an [Elmish](https://elmish.github.io/elmish/) model-view-update loop.
         static member inline useElmish(program: unit -> Program<unit, 'State, 'Msg, unit>): 'State * ('Msg -> unit) =
-            useElmish(Hook.getContext(), program)
+            Hook.getContext().useElmish(program, ())

src/Lit.Elmish/Lit.Elmish.fsproj

@@ -14,7 +14,7 @@
     <Content Include="*.fsproj; *.fs" PackagePath="fable\" />
   </ItemGroup>
   <ItemGroup>
-    <PackageReference Include="Fable.Elmish" Version="3.1.0" />
+    <PackageReference Include="Fable.Elmish" Version="4.0.0-beta-3" />
   </ItemGroup>
   <ItemGroup>
     <ProjectReference Include="..\Lit\Lit.fsproj" />

test/HookTest.fs

@@ -94,17 +94,14 @@ let Disposable (r: ref<int>) =
     """
 
 [<HookComponent>]
-let DisposableContainer (r: ref<int>) =
+let DisposableContainer (inner: 'arg -> TemplateResult, arg: 'arg) =
     let disposed, setDisposed = Hook.useState false
 
     html
         $"""
       <div>
-        <button @click={Ev(fun _ -> setDisposed true)}>Dispose!</button>
-        {if not disposed then
-             Disposable(r)
-         else
-             Lit.nothing}
+        <button id="dispose-btn" @click={Ev(fun _ -> setDisposed true)}>Dispose!</button>
+        {if not disposed then inner(arg) else Lit.nothing}
       </div>
     """
 
@@ -254,6 +251,15 @@ let ElmishComponentW () =
             </div>
           """
 
+[<HookComponent>]
+let ElmishTermination (disp: System.IDisposable) =
+    let _ = Hook.useElmish(fun () ->
+        Program.mkHidden init update
+        |> Program.addTerminationHandler (fun _ -> disp.Dispose())
+    )
+
+    html $"<p>Waiting for termination...</p>"
+
 [<HookComponent>]
 let ScopedCss () =
     let className = Hook.use_scoped_css """
@@ -329,7 +335,7 @@ describe "Hook" <| fun () ->
 
     it "useEffectOnce runs on mount/dismount" <| fun () -> promise {
         let aRef = ref 8
-        use! el = DisposableContainer(aRef) |> render
+        use! el = DisposableContainer(Disposable, aRef) |> render
         let el = el.El
         el.getByText("value") |> Expect.innerText "Value: 5"
 
@@ -492,6 +498,19 @@ describe "Hook" <| fun () ->
         el.getSelector("#count") |> Expect.innerText "0"
     }
 
+    it "useElmish is terminated" <| fun () -> promise {
+        let mutable terminated = false
+        let disp = Hook.createDisposable(fun () -> terminated <- true)
+        use! el = DisposableContainer(ElmishTermination, disp) |> render
+        let el = el.El
+        // Not sure why but if we remove this line the test fails sometimes
+        // (even if Lit.Test.render already awaits for the update)
+        do! elementUpdated el
+        terminated |> Expect.equal false
+        do! click el <| el.querySelector("#dispose-btn").asButton
+        terminated |> Expect.equal true
+    }
+
     it "Scoped CSS works" <| fun () -> promise {
         use! _container =
             html $"""

test/Test.fsproj

@@ -15,7 +15,7 @@
     <ProjectReference Include="..\src\Lit.Test\Lit.Test.fsproj" />
   </ItemGroup>
   <ItemGroup>
-    <PackageReference Include="Fable.Elmish" Version="3.1.0" />
+    <PackageReference Include="Fable.Elmish" Version="4.0.0-beta-3" />
     <!-- <PackageReference Include="Fable.Lit.Test" Version="1.0.0-rc-001" /> -->
   </ItemGroup>
 </Project>