Fable MVU reducer

useUpdate.fs

module Util.MVU

open Fable.Core
open Fable.React

type Dispatch<'msg> = 'msg -> unit

type Sub<'msg> = Dispatch<'msg> -> unit

type Cmd<'msg> = Sub<'msg> list

module Cmd =
  let fromAsync (operation: Async<'msg>): Cmd<'msg> =
    let delayedCmd (dispatch: Dispatch<'msg>) =
      let delayedDispatch =
        async {
          let! msg = operation
          dispatch msg
        }

      Async.StartImmediate delayedDispatch

    [ delayedCmd ]

  let none: Cmd<'msg> = []

  let log value: Cmd<'msg> =
    [ fun (dispatch: 'msg -> unit) -> JS.console.log value ]

  let ofMsg msg: Cmd<'msg> =
    [ fun (dispatch: Dispatch<'msg>) -> dispatch msg ]

(*
  React hook that allows using MVU inside of a functional React component.
  It takes a typical MVU update function which maps a message + previous state
  to a next state * command tuple.
*)

let useUpdate
    (update: 'msg -> 'state -> ('state * Cmd<'msg>))
    ((initialState, initialCmd): 'state * Cmd<'msg>)
  =
  let state = Hooks.useState initialState
  // JS.console.log ("initialState:", initialState, state.current)
  let stateRef = Hooks.useRef JS.undefined
  stateRef.current <- state.current

  let queue = Hooks.useRef<'msg array> [||]
  let flushTimeout = Hooks.useRef<int> JS.undefined

  let rec runCmd cmd =
    cmd |> List.iter (fun sub -> sub dispatch)

  // flush all msg in the queue, update state
  // and issue commands
  and flushQueue () =
    // JS.console.log "----flushing----------------------------------------"
    let mutable curState = stateRef.current

    for msg in queue.current do
      let nextState, cmd = update msg curState
      curState <- nextState
      runCmd cmd

    queue.current <- [||]
    //JS.console.log ("curState:", curState)
    //JS.console.log "----flushed----------------------------------------"
    state.update curState

  and dispatch (msg: 'msg) =
    // add msg to the queue
    queue.current <- Array.append queue.current [| msg |]

    // debounce the flush timeout
    JS.clearTimeout flushTimeout.current

    // schedule queue flush
    flushTimeout.current <- JS.setTimeout flushQueue 0

  // run initial cmd
  Hooks.useEffect ((fun () -> runCmd initialCmd), [||])

  state.current, dispatch