Skip to content

Instantly share code, notes, and snippets.

@kspeakman
Created October 27, 2022 00:45
Show Gist options
  • Save kspeakman/d3cd32032968f36a10bfec11eb4fcb40 to your computer and use it in GitHub Desktop.
Save kspeakman/d3cd32032968f36a10bfec11eb4fcb40 to your computer and use it in GitHub Desktop.
Update Model Perform (UMP) -- MVU for back-end
namespace Utilities
(*
UMP (Update Model Perform) is a reformulation of MVU (Model View Update).
Here are the differences:
* `Cmd<Msg>` is replaced by a user-defined `Effect` (list) and a `perform` function
- allows testing that the correct side effects were chosen, using simple value equality (`=`)
- `Effect` is a DU, each case represents a side effect and its required data
- `perform` executes the `Effect`, returns a `Msg`
- without Cmd, all types are user-defined, so UMP code doesn't depend on UMP lib
- UMP dependency needed in fewer places, generally at wiring/infrastructure level
- less dependency usage = less dependency churn
* `init` returns a `Msg` instead of a `Cmd` (now `Effect list`)
- `init` had 2 jobs, now has 1: isolating the caller from the inner workings of `update`
- `init` exchanges `initArg` for data required by `update`: a `Model` and `Msg`
- the startup logic becomes just another `Msg` case, handled in `update`
- all decision logic can now be found in `update`
* `update` argument order is swapped; now `Model -> Msg -> Model * Effect list`
- makes input symmetric with output
- note: `Effect` becomes `Async<Msg>` when executed
- old pattern requires callers to flip the order for chaining or folding
- a subtle detail all callers are required to implement
- the reason for the original order has to do with Haskell peculiarities
- due to language philosophy and special features of right vs left fold
- these reasons don't apply in F# or in general
*)
module Ump =
/// Ump type represents the minumum functionality for a runnable program.
/// You probably want to use SingleRunUmp or ResumableUmp instead of this.
[<Struct>]
type Ump<'Model, 'Msg, 'Effect> = {
/// Updates the model and requests effects in response to messages.
/// This is where all the state-machine style logic should go.
Update: 'Model -> 'Msg -> 'Model * 'Effect list
/// Executes the requested side effect.
/// The current model is provided for consultation.
/// The optional returned Async will be run and its message passed to Update.
/// This is the only function that should perform side effects.
Perform: 'Model -> 'Effect -> Async<'Msg>
}
/// SingleRunUmp is for a program that runs from start to finish each time.
type SingleRunUmp<'initArg, 'Model, 'Msg, 'Effect, 'output> = {
/// Constructs an initial model and starting message.
/// For multiple initial arguments, use a tuple or record.
Init: 'initArg -> 'Model * 'Msg
/// Updates the model and requests effects in response to messages.
Update: 'Model -> 'Msg -> 'Model * 'Effect list
/// Executes the requested side effect.
/// The current model is provided for consultation.
/// The optional returned Async will be run and its message passed to Update.
/// This is the only function that should perform side effects.
Perform: 'Model -> 'Effect -> Async<'Msg>
/// Converts the model to the output type.
Output: 'Model -> 'output
}
/// ResumableUmp is for a program that is meant to be resumed from its previous state.
type ResumableUmp<'initArg, 'Model, 'Msg, 'Effect, 'resumeArg> = {
/// Constructs an initial model and starting message.
/// For multiple initial arguments, use a tuple or record.
Init: 'initArg -> 'Model * 'Msg
/// Updates the model and requests effects in response to messages.
Update: 'Model -> 'Msg -> 'Model * 'Effect list
/// Executes the requested side effect.
/// The current model is provided for consultation.
/// The optional returned Async will be run and its message passed to Update.
/// This is the only function that should perform side effects.
Perform: 'Model -> 'Effect -> Async<'Msg>
/// Construct a resume message.
/// For multiple resume arguments, use a tuple or record.
Resume: 'resumeArg -> 'Msg
}
module Ump =
/// Test a UMP program.
/// Provide the model (program state) and messages (side effect results) to replay.
/// Returns the final model and all generated side effects.
let test (ump: Ump<'Model, 'Msg, 'Effect>)
(model: 'Model)
(msgs: 'Msg list)
: 'Model * 'Effect list =
let init = (model, [])
let update (model, effects) msg =
let (model, newEffects) = ump.Update model msg
(model, List.append effects newEffects)
List.fold update init msgs
// Note: the `test` fn could also be called `batchUpdate`.
// It processes multiple msgs and collects their requested side effects.
// It is called `test` for unit testing, but also used internally for batch update.
[<AutoOpen>]
module Internal =
[<Struct>]
type RunState<'Model, 'Msg, 'Effect> = {
Model: 'Model
Msgs: 'Msg list
Effects: 'Effect list
}
let rec runLoop ump state =
// process all msgs
let model, effects =
match state.Msgs with
| [] -> (state.Model, state.Effects)
| _ -> test ump state.Model state.Msgs
match effects with
| [] -> async.Return model
| _ ->
// run all effects in parallel
// When sequencing matters Ump.Update will return
// one Effect at a time for control flow anyway
async {
let! msgArr = effects |> List.map (ump.Perform model) |> Async.Parallel
let state = {
Model = model
Msgs = List.ofArray msgArr
Effects = []
}
return! runLoop ump state
}
/// Runs or resumes a UMP program using a message and model (program state).
/// The returned model can be used to resume the UMP with a resume message.
/// Infinite loops are possible when Update generates Effects on every Msg.
/// This allows the program to support interactive applications, for example.
let run (ump: Ump<'Model, 'Msg, 'Effect>)
(model: 'Model)
(msg: 'Msg)
: Async<'Model> =
let state = { Model = model; Msgs = [ msg ]; Effects = [] }
runLoop ump state
module SingleRunUmp =
/// Test a single run UMP program.
/// Provide the initial argument and messages (side effect results) to replay.
/// Returns the final output and all generated side effects.
/// Note: The init message will be processed before the provided messages.
let test (ump: SingleRunUmp<'initArg, 'Model, 'Msg, 'Effect, 'output>)
(initArg: 'initArg)
(msgs: 'Msg list)
: 'output * 'Effect list =
let (model, msg) = ump.Init initArg
let ump_ = { Update = ump.Update; Perform = ump.Perform }
let (model, effects) = Ump.test ump_ model (msg :: msgs)
(ump.Output model, effects)
/// Runs the UMP program from an initial argument.
/// Infinite loops are possible when Update generates Effects on every Msg.
/// This allows the program to support interactive applications, for example.
/// Note: If you partially apply the UMP, this returns a new fn `'initArg -> Async<'output>` which does not depend on UMP.
let run (ump: SingleRunUmp<'initArg, 'Model, 'Msg, 'Effect, 'output>)
(arg: 'initArg)
: Async<'output> =
let (model, msg) = ump.Init arg
let ump_ = { Update = ump.Update; Perform = ump.Perform }
async {
let! model = Ump.run ump_ model msg
return ump.Output model
}
module ResumableUmp =
/// Test a Resumable UMP program.
/// Provide the initial argument and messages (side effect results) to replay.
/// To test resumption, include resume messages in the message list.
/// Returns the final model and all generated side effects.
/// Note: The init message will be processed before the provided messages.
let test (ump: ResumableUmp<'initArg, 'Model, 'Msg, 'Effect, 'resumeArg>)
(initArg: 'initArg)
(msgs: 'Msg list)
: 'Model * 'Effect list =
let (model, msg) = ump.Init initArg
let ump_ = { Update = ump.Update; Perform = ump.Perform }
Ump.test ump_ model (msg :: msgs)
/// Starts the UMP from an initial argument.
/// Runs to completion, returning the final state of the program.
/// To resume, provide this state to the `resume` function.
let start (ump: ResumableUmp<'initArg, 'Model, 'Msg, 'Effect, 'resumeArg>)
(arg: 'initArg)
: Async<'Model> =
let (model, msg) = ump.Init arg
let ump_ = { Update = ump.Update; Perform = ump.Perform }
Ump.run ump_ model msg
/// Resumes the UMP from a model and resume message argument.
let resume (ump: ResumableUmp<'initArg, 'Model, 'Msg, 'Effect, 'resumeArg>)
(model: 'Model)
(arg: 'resumeArg)
: Async<'Model> =
let msg = ump.Resume arg
let ump_ = { Update = ump.Update; Perform = ump.Perform }
Ump.run ump_ model msg
module Result =
/// A helper for UMP programs which use a `Result`-based model.
/// Your `update` function is provided the Ok value instead of a Result.
/// It is not called when the model is `Error`.
/// usage:
/// `let update okValue msg : Result< ... > * Effect list = ...`
///
/// `let ump = { Update = Result.bindUpdate update; ... }`
let bindUpdate updatef modelResult msg =
match modelResult with
| Ok ok ->
updatef ok msg
| Error err ->
Error err, []
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment