Skip to content

Commit

Permalink
Remove custom Elmish implementation
Browse files Browse the repository at this point in the history
  • Loading branch information
@alfonsogarciacaro
alfonsogarciacaro committed Oct 7, 2021
1 parent e5f24e2 commit b31a5ed
Show file tree
Hide file tree
Showing 3 changed files with 78 additions and 163 deletions.
1 change: 1 addition & 0 deletions sample/Clock.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@ open Fable.Core
open Browser.Types
open Elmish
open Lit
open Lit.Elmish

module Helpers =
let hmr = HMR.createToken()
Expand Down
102 changes: 77 additions & 25 deletions src/Lit.Elmish/Lit.Elmish.fs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
namespace Lit.Elmish

open System
open Browser
open Browser.Types
open Elmish
Expand Down Expand Up @@ -35,35 +36,86 @@ module Program =

withLitOnElement el program


[<AutoOpen>]
module LitElmishExtensions =
module LitElmishExtensionsUtil =
let useElmish(ctx: HookContext, program: unit -> Program<unit, 'State, 'Msg, unit>) =
ctx.useElmish(fun () ->
let mutable init = Unchecked.defaultof<_>
let mutable update = Unchecked.defaultof<_>
let mutable subscribe = Unchecked.defaultof<_>

// Poor man's way of accessing program's functions
program() |> Program.map
(fun _init -> init <- _init; _init)
(fun _update -> update <- _update; _update)
id // view
id // setState
(fun _subscribe -> subscribe <- _subscribe; _subscribe)
|> ignore

let init() =
let model, cmd1 = init()
let cmd2 = subscribe model
model, cmd1 @ cmd2

init, update)

open LitElmishExtensionsUtil
type ElmishObservable<'State, 'Msg>() =
let mutable state: 'State option = None
let mutable listener: ('State -> unit) option = None
let mutable dispatcher: ('Msg -> unit) option = None

member _.Value = state

member _.SetState (model: 'State) (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

let useElmish(ctx: HookContext, program: unit -> Program<unit, 'State, 'Msg, unit>) =
let obs = ctx.useMemo(fun () -> ElmishObservable())

let state, setState = ctx.useState(fun () ->
program()
|> Program.withSetState obs.SetState
|> Program.run

match obs.Value with
| None -> failwith "Elmish program has not initialized"
| Some v -> v)

ctx.useEffectOnce(fun () ->
Hook.createDisposable(fun () ->
match box state with
| :? System.IDisposable as disp -> disp.Dispose()
| _ -> ()))

obs.Subscribe(setState)
state, obs.Dispatch

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: unit -> ('State * Cmd<'Msg>), update: 'Msg -> 'State -> ('State * Cmd<'Msg>)): 'State * ('Msg -> unit) =
useElmish(Hook.getContext(), fun () -> Program.mkHidden init update)

static member inline useElmish(program: Program<unit, 'State, 'Msg, unit>): 'State * ('Msg -> unit) =
useElmish(Hook.getContext(), fun () -> program)

Expand Down
138 changes: 0 additions & 138 deletions src/Lit/Hook.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,51 +42,6 @@ module internal HookUtil =
| OnConnected of (unit -> IDisposable)
| OnRender of (unit -> unit)

[<Struct>]
type RingState<'item> =
| Writable of wx: 'item array * ix: int
| ReadWritable of rw: 'item array * wix: int * rix: int

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

type RenderFn = obj[] -> TemplateResult

open HookUtil
Expand Down Expand Up @@ -256,64 +211,6 @@ type HookContext(host: HookContextHost) =
member this.useEffectOnce(effect) : unit =
this.setEffect(Effect.OnConnected effect)

member this.useElmish(mkProgram): 'State * ('Msg -> unit) =
if _firstRun then
// TODO: Error handling? (also when running update)
let exec dispatch cmd =
cmd |> List.iter (fun call -> call dispatch)

let init, update = mkProgram()
let (model, cmd) = init ()
let index, (model, _) = this.addState (model, null)

let setState (model: 'State) (dispatch: 'Msg -> unit) =
this.setState (
index,
(model, dispatch),
equals = fun (oldModel, _) (newModel, _) -> (box oldModel).Equals(newModel)
)

let rb = RingBuffer 10
let mutable reentered = false
let mutable state = model

let rec dispatch msg =
if reentered then
rb.Push msg
else
reentered <- true
let mutable nextMsg = Some msg

while Option.isSome nextMsg do
let msg = nextMsg.Value
let (model', cmd') = update msg state
setState model' dispatch
cmd' |> exec dispatch
state <- model'
nextMsg <- rb.Pop()

reentered <- false

_effects.Add(
Effect.OnConnected
(fun () ->
cmd |> exec dispatch

{ new IDisposable with
member _.Dispose() =
let (state, _) = _states.[index] :?> _

match box state with
| :? IDisposable as disp -> disp.Dispose()
| _ -> () })
)

_states.[index] <- (state, dispatch)
state, dispatch
else
_effectIndex <- _effectIndex + 1
this.getState () |> snd

[<AllowNullLiteral>]
type IHookProvider =
abstract hooks: HookContext
Expand All @@ -337,9 +234,6 @@ module HookExtensions =
member ctx.useMemo(init: unit -> 'Value): 'Value =
ctx.useRef(init).Value

member ctx.useElmish(init, update): 'model * ('msg -> unit) =
ctx.useElmish(fun () -> (init, update))

member ctx.useEffectOnce(effect: (unit -> unit)) =
ctx.useEffectOnce(fun () ->
effect()
Expand Down Expand Up @@ -573,38 +467,6 @@ type Hook() =
static member inline useEffectOnChange(value: 'T, effect: 'T -> unit): unit =
Hook.getContext().useEffectOnChange(value, effect)

/// <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, update): 'State * ('Msg -> unit) =
Hook.getContext().useElmish(fun () -> (init, update))

/// <summary>
/// Helper to implement CSS transitions in your component.
/// </summary>
Expand Down

0 comments on commit b31a5ed

Please sign in to comment.