Is it possible to split state?

[Arshia001]

The sample uses one model object, one message type and one update function. Even with the sample, simple as it is, it's easy to see how quickly this approach gets out of hand.

I took the sample and split it into 3 separate pages, and tried to split the model and messages into different types as well. I can do something like this at the top level:

type Message = CounterMessage of CounterMessage | DataMessage of DataMessage
type Model = { counterModel: CounterModel; dataModel: DataModel }

but doing this every time results in lots of boilerplate and much room for error, so I'm working on a solution to automatically manage the composition of many such "stateful" components. I expect the end result to look like redux's "reducer combination", but it'll split messages and models up as well. I expect to have the code ready in a short while, and I'll post it here when it is.

In the meantime, is something like this already available and I just missed it? Or is it even the right thing to do?

[Arshia001]

I just read up on Elmish components. They seem to do a different thing; allowing one to create a reusable component that can be instantiated into the render tree many times. This means that the parent has to feed them state and translate their dispatches manually into a "higher-level" dispatch. What I'm looking for is a way to make the parent component oblivious of the inner component, not as a code reuse strategy, but as a way to break very large state into smaller chunks at the top level.

[Arshia001]

This is what I ended up with:

module MVU

open Bolero
open Elmish

type MvuModel = private MvuModel of Map<string, obj>
type MvuMessage = private MvuMessage of string * obj

type private IMvuComponent =
    abstract Update: (obj -> MvuMessage) -> obj -> obj -> obj * Cmd<MvuMessage>

type MvuComponent<'model, 'message> = 
    {
        initState: 'model * Cmd<'message>
        update: 'message -> 'model -> 'model * Cmd<'message>
        view: 'model -> ('message -> unit) -> Node
    }
    interface IMvuComponent with
        member me.Update convertMessage message model = 
            let m, c = me.update (message :?> 'message) (model :?> 'model)
            upcast m, c |> Cmd.map (fun c -> c |> convertMessage)

type private IMvuConnectedComponent =
    abstract ConvertMessage: obj -> MvuMessage

type MvuConnectedComponent<'model, 'message> =
    {
        convertMessage: 'message -> MvuMessage
        getModel: MvuModel -> 'model
        view: MvuModel -> (MvuMessage -> unit) -> Node
    }
    interface IMvuConnectedComponent with
        member me.ConvertMessage message = me.convertMessage (message :?> 'message)

type MvuComponentList = private MvuComponentList of Map<string, (IMvuComponent * IMvuConnectedComponent)>

type MvuComposedComponent = 
    {
        components: MvuComponentList
        initModel: MvuModel
        initMessages: Cmd<MvuMessage>
        update: MvuMessage -> MvuModel -> MvuModel * Cmd<MvuMessage>
    }

let private addComponentImpl<'model, 'message> composedComp (comp: MvuComponent<'model, 'message>) key =
    let getModel = fun (MvuModel map) -> map.[key] :?> 'model
    let convertMessage = fun (msg: 'message) -> MvuMessage (key, msg :> obj)
    let connected = {
        convertMessage = convertMessage
        getModel = getModel
        view = fun model dispatch -> comp.view (getModel model) (fun msg -> convertMessage msg |> dispatch)
        }

    let (model, cmd) = comp.initState
    let initModel = match composedComp.initModel with MvuModel initModel -> initModel |> Map.add key (model :> obj)
    let initMessages = (cmd |> Cmd.map convertMessage) @ composedComp.initMessages

    let components = match composedComp.components with MvuComponentList comps -> comps |> Map.add key (upcast comp, upcast connected)

    let update = fun (MvuMessage (name, message)) (MvuModel modelMap) ->
        let comp, connectedComp = components.[name]
        let model = modelMap.[name]
        let model, cmd = comp.Update (connectedComp.ConvertMessage) message model
        (modelMap |> Map.add name model |> MvuModel, cmd)

    (
        {
            components = MvuComponentList components
            initModel = MvuModel initModel
            initMessages = initMessages
            update = update
        },
        connected
    )

let initComposedComponent<'model, 'message> () =
    { 
        components = MvuComponentList Map.empty
        initModel = MvuModel Map.empty
        initMessages = Cmd.none
        update = fun _ model -> model, Cmd.none 
    }

let addComposedComponent<'model, 'message> composedComp (comp: MvuComponent<'model, 'message>) =
    let key = match composedComp.components with MvuComponentList comps -> comps |> Map.count |> string
    addComponentImpl composedComp comp key

type ModelWithParts<'TSelf> =
    {
        ownModel: 'TSelf
        composedModel: MvuModel
    }

type MessageWithParts<'TSelf> =
    | Self of 'TSelf
    | Composed of MvuMessage

let updateWithParts updateSelf composed message model =
    match message with
    | Self msg -> 
        let m, c = updateSelf msg model.ownModel
        { model with ownModel = m }, c |> Cmd.map (fun c -> Self c)
    | Composed msg ->
        let m, c = composed.update msg model.composedModel
        { model with composedModel = m }, c |> Cmd.map (fun c -> Composed c)

let viewWithParts view model dispatch =
    let self = model.ownModel
    let selfDispatch = fun cmd -> dispatch (Self cmd)
    let composedModel = model.composedModel
    let composedDispatch = fun cmd -> dispatch (Composed cmd)
    view self selfDispatch composedModel composedDispatch

let composeComponent composed initModel initMessages update view =
    {
        initState = { ownModel = initModel; composedModel = composed.initModel }, (initMessages |> Cmd.map (fun c -> Self c)) @ (composed.initMessages |> Cmd.map (fun c -> Composed c))
        update = updateWithParts update composed
        view = viewWithParts view
    }

Forgive my lack of naming sense. It lets you define top-level components with isolated state, and instantiate all of those into another, larger component. I'm not sure how useful this may be in the general case, but it certainly helped me... Anyway, to use it, you first need to define each component:

module CounterPage

open Elmish
open Bolero.Html
open MVU

type CounterModel = private { counter: int }

type CounterMessage =
    | Increment
    | Decrement
    | SetCounter of int

let private updateCounter message model =
    match message with
    | Increment ->
        { model with counter = model.counter + 1 }, Cmd.none
    | Decrement ->
        { model with counter = model.counter - 1 }, Cmd.none
    | SetCounter value ->
        { model with counter = value }, Cmd.none

let private counterPage model dispatch =
    div [] [
        h1 [attr.``class`` "title"] [
            text("A simple counter")
        ]
        p [] [
            button [on.click (fun _ -> dispatch Decrement); attr.``class`` "button"] [text("-")]
            input [attr.``type`` "number"; attr.id "counter"; attr.``class`` "input"; bind.inputInt model.counter (fun v -> dispatch (SetCounter v))]
            button [on.click (fun _ -> dispatch Increment); attr.``class`` "button"] [text("+")]
        ]
    ]

let initComponent () = 
    {
        initState = ({ counter = 0 }, Cmd.none)
        update = updateCounter
        view = counterPage
    }

Strongly typed, as you can see. Note the last function, where each component gets to define an initial state, initial commands, an update function and a view function. Then, you take a bunch of these, and compose them in a parent component:

type Page =
    | [<EndPoint "/">] Home
    | [<EndPoint "/counter">] Counter
    | [<EndPoint "/data">] Data
    | [<EndPoint "/calc">] Calculator

type OwnModel = { page: Page }

type OwnMessage = SetPage of Page

let initModel = { page = Home }

let updateSelf (SetPage page) model = { model with page = page }, Cmd.none

let router = Router.infer (fun p -> SetPage p |> Self) (fun model -> model.ownModel.page)

let menuItem (model: OwnModel) (page: Page) (text: string) =
    Main.MenuItem()
        .Active(if model.page = page then "is-active" else "")
        .Url(router.Link page)
        .Text(text)
        .Elt()

let initComponent bookService =
    let composed = initComposedComponent ()
    let composed, counter = addComposedComponent composed (CounterPage.initComponent ())
    let composed, books = addComposedComponent composed (BooksPage.initComponent bookService)
    let composed, calc = addComposedComponent composed (CalculatorPage.initComponent ())

    let view ownModel _ composedModel composedDispatch =
        Main()
            .Menu(concat [
                menuItem ownModel Home "Home"
                menuItem ownModel Page.Counter "Counter"
                menuItem ownModel Data "Download data"
                menuItem ownModel Calculator "Calculator"
            ])
            .Body(
                cond ownModel.page <| function
                | Home -> homePage ()
                | Page.Counter -> counter.view composedModel composedDispatch
                | Data -> books.view composedModel composedDispatch
                | Calculator -> calc.view composedModel composedDispatch
            )
            .Error(
                cond (books.getModel composedModel).error <| function
                | None -> empty
                | Some err ->
                    Main.ErrorNotification()
                        .Text(err)
                        .Hide(fun _ -> composedDispatch (books.convertMessage ClearError))
                        .Elt()
            )
            .Elt()

    composeComponent composed initModel Cmd.none updateSelf view

type MyApp() =
    inherit ProgramComponent<ModelWithParts<OwnModel>, MessageWithParts<OwnMessage>>()

    override this.Program =
        let bookService = this.Remote<BookService>()
        let comp = initComponent bookService
        Program.mkProgram (fun _ -> comp.initState) comp.update comp.view
        |> Program.withRouter router
#if DEBUG
        |> Program.withHotReloading
#endif

Again, strongly typed. Only the inner workings of the composition module aren't typed, which shouldn't pose a problem.