Use Elmish.Program in useElmish

Feliz.UseElmish/Feliz.UseElmish.fsproj

@@ -22,7 +22,6 @@
     </ItemGroup>
     <ItemGroup>
         <PackageReference Update="FSharp.Core" Version="4.7.2" />
-        <PackageReference Include="Fable.Promise" Version="2.0.0" />
         <PackageReference Include="Fable.Elmish" Version="3.0.6" />
     </ItemGroup>
 </Project>

Feliz.UseElmish/UseElmish.fs

@@ -2,117 +2,90 @@ namespace Feliz.UseElmish
 
 open Feliz
 open Elmish
-open Fable.Core
-
-[<Struct>]
-type internal RingState<'item> =
-    | Writable of wx:'item array * ix:int
-    | ReadWritable of rw:'item array * wix:int * rix:int
-
-type internal RingBuffer<'item>(size) =
-    let doubleSize ix (items: 'item array) =
-        seq { yield! items |> Seq.skip ix
-              yield! items |> Seq.take ix
-              for _ in 0..items.Length do
-                yield Unchecked.defaultof<'item> }
-        |> Array.ofSeq
-
-    let mutable state : 'item RingState =
-        Writable (Array.zeroCreate (max size 10), 0)
-
-    member _.Pop() =
-        match state with
-        | ReadWritable (items, wix, rix) ->
-            let rix' = (rix + 1) % items.Length
-            match rix' = wix with
-            | true ->
-                state <- Writable(items, wix)
-            | _ ->
-                state <- ReadWritable(items, wix, rix')
-            Some items.[rix]
-        | _ ->
-            None
-
-    member _.Push (item:'item) =
-        match state with
-        | Writable (items, ix) ->
-            items.[ix] <- item
-            let wix = (ix + 1) % items.Length
-            state <- ReadWritable(items, wix, ix)
-        | ReadWritable (items, wix, rix) ->
-            items.[wix] <- item
-            let wix' = (wix + 1) % items.Length
-            match wix' = rix with
-            | true ->
-                state <- ReadWritable(items |> doubleSize rix, items.Length, 0)
-            | _ ->
-                state <- ReadWritable(items, wix', rix)
 
 [<AutoOpen>]
 module UseElmishExtensions =
-    let inline internal getDisposable (record: 'State) =
-        match box record with
-        | :? System.IDisposable as disposable -> Some disposable
-        | _ -> None
+    type private ElmishObservable<'Model, 'Msg>() =
+        let mutable hasDisposedOnce = false
+        let mutable state: 'Model option = None
+        let mutable listener: ('Model -> unit) option = None
+        let mutable dispatcher: ('Msg -> unit) option = None
+
+        member _.Value = state
+        member _.HasDisposedOnce = hasDisposedOnce
+
+        member _.SetState (model: 'Model) (dispatch: 'Msg -> unit) =
+            state <- Some model
+            dispatcher <- Some dispatch
+            match listener with
+            | None -> ()
+            | Some listener -> listener model
+
+        member _.Dispatch(msg) =
+            match dispatcher with
+            | None -> () // Error?
+            | Some dispatch -> dispatch msg
+
+        member _.Subscribe(f) =
+            match listener with
+            | Some _ -> ()
+            | None -> listener <- Some f
+
+        /// Disposes state (and dispatcher) but keeps subscription
+        member _.DisposeState() =
+            match state with
+            | Some state ->
+                match box state with
+                | :? System.IDisposable as disp -> disp.Dispose()
+                | _ -> ()
+            | _ -> ()
+            dispatcher <- None
+            state <- None
+            hasDisposedOnce <- true
+
+    let private runProgram (program: unit -> Program<'Arg, 'Model, 'Msg, unit>) (arg: 'Arg) (obs: ElmishObservable<'Model, 'Msg>) () =
+        program()
+        |> Program.withSetState obs.SetState
+        |> Program.runWith arg
+
+        match obs.Value with
+        | None -> failwith "Elmish program has not initialized"
+        | Some v -> v        
+
+    let disposeState (state: obj) =
+        match box state with
+        | :? System.IDisposable as disp -> disp.Dispose()
+        | _ -> ()
 
     type React with
         [<Hook>]
-        static member useElmish<'State,'Msg> (init: 'State * Cmd<'Msg>, update: 'Msg -> 'State -> 'State * Cmd<'Msg>, dependencies: obj[]) =
-            let state = React.useRef(fst init)
-            let ring = React.useRef(RingBuffer(10))
-            let childState, setChildState = React.useState(fst init)
-            let token = React.useCancellationToken()
-            let setChildState () =
-                JS.setTimeout(fun () ->
-                    if not token.current.IsCancellationRequested then
-                        setChildState state.current
-                ) 0 |> ignore
-
-            let rec dispatch (msg: 'Msg) =
-                promise {
-                    let mutable nextMsg = Some msg
-
-                    while nextMsg.IsSome && not (token.current.IsCancellationRequested) do
-                        let msg = nextMsg.Value
-                        let (state', cmd') = update msg state.current
-                        cmd' |> List.iter (fun sub -> sub dispatch)
-                        nextMsg <- ring.current.Pop()
-                        state.current <- state'
-                        setChildState()
-                }
-                |> Promise.start
-
-            let dispatch = React.useCallbackRef(dispatch)
+        static member useElmish(program: unit -> Program<'Arg, 'Model, 'Msg, unit>, arg: 'Arg, ?dependencies: obj array) =
+            // Don't use useMemo here because React doesn't guarantee it won't recreate it again
+            let obs, _ = React.useState(fun () -> ElmishObservable<'Model, 'Msg>())
 
-            React.useEffect((fun () ->
-                React.createDisposable(fun () ->
-                    getDisposable state.current
-                    |> Option.iter (fun o -> o.Dispose())
-                )
-            ), dependencies)
+            let state, setState = React.useState(runProgram program arg obs)
 
             React.useEffect((fun () ->
-                state.current <- fst init
-                setChildState()
-
-                snd init
-                |> List.iter (fun sub -> sub dispatch)
-            ), dependencies)
+                if obs.HasDisposedOnce then
+                    runProgram program arg obs () |> setState
+                React.createDisposable(obs.DisposeState)
+            ), defaultArg dependencies [||])
 
-            React.useEffect(fun () -> ring.current.Pop() |> Option.iter dispatch)
-
-            (childState, dispatch)
+            obs.Subscribe(setState)
+            state, obs.Dispatch
 
         [<Hook>]
-        static member inline useElmish<'State,'Msg> (init: 'State * Cmd<'Msg>, update: 'Msg -> 'State -> 'State * Cmd<'Msg>) =
-            React.useElmish(init, update, [||])
+        static member useElmish(program: unit -> Program<unit, 'Model, 'Msg, unit>, ?dependencies: obj array) =
+            React.useElmish(program, (), ?dependencies=dependencies)
 
         [<Hook>]
-        static member useElmish<'State,'Msg> (init: unit -> 'State * Cmd<'Msg>, update: 'Msg -> 'State -> 'State * Cmd<'Msg>, dependencies: obj[]) =
-            let init = React.useMemo(init, dependencies)
+        static member useElmish(init: 'Arg -> 'Model * Cmd<'Msg>, update: 'Msg -> 'Model -> 'Model * Cmd<'Msg>, arg: 'Arg, ?dependencies: obj array) =
+            React.useElmish((fun () -> Program.mkProgram init update (fun _ _ -> ())), arg, ?dependencies=dependencies)
 
-            React.useElmish(init, update, dependencies)
+        [<Hook>]
+        static member useElmish(init: unit -> 'Model * Cmd<'Msg>, update: 'Msg -> 'Model -> 'Model * Cmd<'Msg>, ?dependencies: obj array) =
+            React.useElmish((fun () -> Program.mkProgram init update (fun _ _ -> ())), ?dependencies=dependencies)
 
         [<Hook>]
-        static member inline useElmish<'State,'Msg> (init: unit -> 'State * Cmd<'Msg>, update: 'Msg -> 'State -> 'State * Cmd<'Msg>) =
-            React.useElmish(init, update, [||])
+        static member useElmish(init: 'Model * Cmd<'Msg>, update: 'Msg -> 'Model -> 'Model * Cmd<'Msg>, ?dependencies: obj array) =
+            React.useElmish((fun () -> Program.mkProgram (fun () -> init) update (fun _ _ -> ())), ?dependencies=dependencies)

docs/paket.references

@@ -5,3 +5,4 @@ Fable.React
 Fable.SimpleHttp
 FSharp.Core
 Zanaptak.TypedCssClasses
+Fable.Promise

paket.dependencies

@@ -9,6 +9,7 @@ group Main
     nuget Fable.Mocha
     nuget Fable.React
     nuget Fable.SimpleHttp
+    nuget Fable.Promise >= 3.1
     nuget FSharp.Core ~> 4.7.2
     nuget Zanaptak.TypedCssClasses
 

paket.lock

@@ -36,6 +36,9 @@ NUGET
     Fable.Mocha (2.9.1)
       Fable.Core (>= 3.0) - restriction: >= netstandard2.0
       FSharp.Core (>= 4.7) - restriction: >= netstandard2.0
+    Fable.Promise (3.1)
+      Fable.Core (>= 3.1.5) - restriction: >= netstandard2.0
+      FSharp.Core (>= 4.7.2) - restriction: >= netstandard2.0
     Fable.React (7.4)
       Fable.Browser.Dom (>= 2.0.1) - restriction: >= netstandard2.0
       Fable.Core (>= 3.1.5) - restriction: >= netstandard2.0

tests/Tests.fs

@@ -561,27 +561,49 @@ module UseElmish =
 
     type Msg =
         | Increment
+        | IncrementAgain
 
     let init = 0, Cmd.none
 
     let update msg state =
         match msg with
         | Increment -> state + 1, Cmd.none
+        | IncrementAgain -> state + 1, Cmd.ofMsg Increment
 
-    let render = React.functionComponent(fun () ->
-        let state,dispatch = React.useElmish(init, update, [||])
+    let render = React.functionComponent(fun (props: {| subtitle: string |}) ->
+        let state, dispatch = React.useElmish(init, update, [|box props.subtitle|])
 
         Html.div [
             Html.h1 [
                 prop.testId "count"
                 prop.text state
             ]
 
+            Html.h2 props.subtitle
+
             Html.button [
                 prop.text "Increment"
                 prop.onClick (fun _ -> dispatch Increment)
                 prop.testId "increment"
             ]
+
+            Html.button [
+                prop.text "Increment again"
+                prop.onClick (fun _ -> dispatch IncrementAgain)
+                prop.testId "increment-again"
+            ]
+
+        ])
+
+    let wrapper = React.functionComponent(fun () ->
+        let count, setCount = React.useState 0
+        Html.div [
+            Html.button [
+                prop.text "Increment wrapper"
+                prop.onClick (fun _ -> count + 1 |> setCount)
+                prop.testId "increment-wrapper"
+            ]
+            render {| subtitle = if count < 2 then "foo" else "bar" |}
         ])
 
 let felizTests = testList "Feliz Tests" [
@@ -1101,7 +1123,7 @@ let felizTests = testList "Feliz Tests" [
     }
 
     testReactAsync "useElmish works" <| async {
-        let render = RTL.render(UseElmish.render())
+        let render = RTL.render(UseElmish.render {| subtitle = "foo" |})
 
         Expect.equal (render.getByTestId("count").innerText) "0" "Should be initial state"
 
@@ -1112,6 +1134,47 @@ let felizTests = testList "Feliz Tests" [
                 Expect.equal (render.getByTestId("count").innerText) "1" "Should have been incremented"
             |> Async.AwaitPromise
     }
+
+    // See https://github.com/fable-compiler/fable-promise/issues/24#issuecomment-934328900
+    testReactAsync "useElmish works with commands" <| async {
+        let render = RTL.render(UseElmish.render {| subtitle = "foo" |})
+
+        Expect.equal (render.getByTestId("count").innerText) "0" "Should be initial state"
+
+        render.getByTestId("increment-again").click()
+
+        do!
+            RTL.waitFor <| fun () ->
+                Expect.equal (render.getByTestId("count").innerText) "2" "Should have been incremented twice"
+            |> Async.AwaitPromise
+    }
+
+    testReactAsync "useElmish works with dependencies" <| async {
+        let render = RTL.render(UseElmish.wrapper())
+
+        Expect.equal (render.getByTestId("count").innerText) "0" "Should be initial state"
+
+        render.getByTestId("increment").click()
+
+        do!
+            RTL.waitFor <| fun () ->
+                Expect.equal (render.getByTestId("count").innerText) "1" "Should have been incremented"
+            |> Async.AwaitPromise
+
+        render.getByTestId("increment-wrapper").click()
+
+        do!
+            RTL.waitFor <| fun () ->
+                Expect.equal (render.getByTestId("count").innerText) "1" "State should be same because dependency hasn't changed"
+            |> Async.AwaitPromise
+
+        render.getByTestId("increment-wrapper").click()
+
+        do!
+            RTL.waitFor <| fun () ->
+                Expect.equal (render.getByTestId("count").innerText) "0" "State should have been reset because dependency has changed"
+            |> Async.AwaitPromise
+    }
 ]
 
 [<EntryPoint>]

tests/paket.references

@@ -1,3 +1,4 @@
 Fable.Browser.Dom
 Fable.Mocha
 FSharp.Core
+Fable.Promise