Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use Elmish.Program in useElmish #414

Merged
merged 4 commits into from
Nov 5, 2021
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion Feliz.UseElmish/Feliz.UseElmish.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -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>
147 changes: 47 additions & 100 deletions Feliz.UseElmish/UseElmish.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2,117 +2,64 @@ 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 private ElmishObservable<'State, 'Msg>() =
let mutable state: 'State option = None
let mutable listener: ('State -> unit) option = None
let mutable dispatcher: ('Msg -> unit) option = None

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
member _.Value = state

let mutable state : 'item RingState =
Writable (Array.zeroCreate (max size 10), 0)
member _.SetState (model: 'State) (dispatch: 'Msg -> unit) =
state <- Some model
dispatcher <- Some dispatch
match listener with
| None -> ()
| Some listener -> listener model

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 _.Dispatch(msg) =
match dispatcher with
| None -> () // Error?
| Some dispatch -> dispatch msg

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)
member _.Subscribe(f) =
match listener with
| Some _ -> ()
| None -> listener <- Some f

[<AutoOpen>]
module UseElmishExtensions =
let inline internal getDisposable (record: 'State) =
match box record with
| :? System.IDisposable as disposable -> Some disposable
| _ -> None

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
static member useElmish(program: unit -> Program<unit, 'State, 'Msg, unit>) =
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we avoid forcing the 'arg type to unit?

Some program can use another parameter than unit for their initial arguments.

Elmish Program definition: type Program<'arg, 'model, 'msg, 'view>

For the view, I suppose you made it unit because we are inside of a hooks and so don't have a view to render in this context?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah, yes. That makes sense, I was mainly thinking in the case when you pass the init and update function, but it should be no problem to accept other args than unit.

About it he view, yes. The view code comes after the hooks, so it doesn't make sense at this point and this is why it's set to unit. Incidentally, this should also make it easier to reuse Elmish programs with different renderers like React or Lit.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@MangelMaxime I've made the changes to accept an arg other than unit. You're right this is probably useful to have an init function that depends on props passed to the component.

About view, it would be possible to have an overload useElmishthat accepts a Program with a view function (or alsouseElmish(init, update, view)) and returns directly a ReactElement. However when designing something similar for useLit` @Zaid-Ajaj commented that a helper returning ReactElement is not actually a hook, so not sure if it can create an issue with React tooling.

// Don't use useMemo here because React doesn't guarantee it won't recreate it again
let obs, _ = React.useState(fun () -> ElmishObservable())

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 state, setState = React.useState(fun () ->
program()
|> Program.withSetState obs.SetState
|> Program.run

let dispatch = React.useCallbackRef(dispatch)
match obs.Value with
| None -> failwith "Elmish program has not initialized"
| Some v -> v)

React.useEffect((fun () ->
React.useEffectOnce(fun () ->
React.createDisposable(fun () ->
getDisposable state.current
|> Option.iter (fun o -> o.Dispose())
)
), dependencies)

React.useEffect((fun () ->
state.current <- fst init
setChildState()

snd init
|> List.iter (fun sub -> sub dispatch)
), dependencies)

React.useEffect(fun () -> ring.current.Pop() |> Option.iter dispatch)

(childState, dispatch)

[<Hook>]
static member inline useElmish<'State,'Msg> (init: 'State * Cmd<'Msg>, update: 'Msg -> 'State -> 'State * Cmd<'Msg>) =
React.useElmish(init, update, [||])

[<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)

React.useElmish(init, update, dependencies)

[<Hook>]
static member inline useElmish<'State,'Msg> (init: unit -> 'State * Cmd<'Msg>, update: 'Msg -> 'State -> 'State * Cmd<'Msg>) =
React.useElmish(init, update, [||])
match box state with
| :? System.IDisposable as disp -> disp.Dispose()
| _ -> ()))

obs.Subscribe(setState)
state, obs.Dispatch

static member useElmish(init, update, ?dependencies: obj array) =
React.useElmish(fun () ->
let view _ _ = ()
Program.mkProgram init update view)

static member useElmish(initial, update, ?dependencies: obj array) =
React.useElmish(fun () ->
let view _ _ = ()
let init () = initial
Program.mkProgram init update view)
1 change: 1 addition & 0 deletions paket.dependencies
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
3 changes: 3 additions & 0 deletions paket.lock
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions tests/paket.references
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
Fable.Browser.Dom
Fable.Mocha
FSharp.Core
Fable.Promise