Update Model Perform (UMP) -- MVU for back-end

Ump.fs

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, []