From a2e27b4908eb26fc31c3b0dd1e7b10f03dcdcd18 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Lo=C3=AFc=20Denuzi=C3=A8re?= <loic@denuziere.net>
Date: Thu, 23 May 2024 02:47:51 +0200
Subject: [PATCH] feat: Program functions for StreamRendering

---
 src/Bolero/Components.fs | 18 +++++++++++++++---
 src/Bolero/Program.fs    | 40 ++++++++++++++++++++++++++++++++++++++++
 src/Bolero/ProgramRun.fs | 11 ++++++++++-
 3 files changed, 65 insertions(+), 4 deletions(-)

diff --git a/src/Bolero/Components.fs b/src/Bolero/Components.fs
index 483fbcc0..9f262063 100644
--- a/src/Bolero/Components.fs
+++ b/src/Bolero/Components.fs
@@ -194,8 +194,7 @@ and [<AbstractClass>]
                 with _ -> () // fails if run in prerender
         )
 
-    override this.OnInitialized() =
-        base.OnInitialized()
+    override this.OnInitializedAsync() =
         let setDispatch d =
             dispatch <- d
         program <-
@@ -207,12 +206,25 @@ and [<AbstractClass>]
                 id id
                 (fun _ model dispatch -> setState model dispatch)
                 id id
-        runProgramLoop <- Program'.runFirstRender this program
+
+        let updateInitState, initModel, loop = Program'.runFirstRender this program
+        runProgramLoop <- loop
         setState <- fun model dispatch ->
             match oldModel with
             | Some oldModel when this.ShouldRender(oldModel, model) -> this.ForceSetState(model, dispatch)
             | _ -> ()
 
+        match this.StreamingInit with
+        | None ->
+            Task.CompletedTask
+        | Some init ->
+            task {
+                let! model, cmd = init initModel
+                updateInitState model cmd
+            }
+
+    member val internal StreamingInit : ('model -> Task<'model * Cmd<'msg>>) option = None with get, set
+
     member internal this.InitRouter
         (
             r: IRouter<'model, 'msg>,
diff --git a/src/Bolero/Program.fs b/src/Bolero/Program.fs
index 8c832433..eb4570b7 100644
--- a/src/Bolero/Program.fs
+++ b/src/Bolero/Program.fs
@@ -23,8 +23,48 @@
 module Bolero.Program
 
 open System.Reflection
+open System.Threading.Tasks
 open Elmish
 
+/// <summary>
+/// Create a simple program for a component that uses StreamRendering.
+/// </summary>
+/// <param name="initialModel">The model that is shown initially.</param>
+/// <param name="load">Load the model to be stream-rendered.</param>
+/// <param name="update">The Elmish update function.</param>
+/// <param name="view">The Elmish view function.</param>
+let mkSimpleStreamRendering
+        (initialModel: 'model)
+        (load: 'model -> Task<'model>)
+        (update: 'msg -> 'model -> 'model)
+        (view: 'model -> Dispatch<'msg> -> Node)
+        : Program<'model, 'msg> =
+    Program.mkSimple (fun (comp: ProgramComponent<'model, 'msg>) ->
+            comp.StreamingInit <- Some (fun x -> task {
+                let! model = load x
+                return model, Cmd.none
+            })
+            initialModel)
+        update view
+
+/// <summary>
+/// Create a program for a component that uses StreamRendering.
+/// </summary>
+/// <param name="initialModel">The model that is shown initially.</param>
+/// <param name="load">Load the model to be stream-rendered.</param>
+/// <param name="update">The Elmish update function.</param>
+/// <param name="view">The Elmish view function.</param>
+let mkStreamRendering
+        (initialModel: 'model)
+        (load: 'model -> Task<'model * Cmd<'msg>>)
+        (update: 'msg -> 'model -> 'model * Cmd<'msg>)
+        (view: 'model -> Dispatch<'msg> -> Node)
+        : Program<'model, 'msg>  =
+    Program.mkProgram (fun (comp: ProgramComponent<'model, 'msg>) ->
+            comp.StreamingInit <- Some load
+            initialModel, [])
+        update view
+
 /// <summary>
 /// Attach `router` to `program` when it is run as the `Program` of a `ProgramComponent`.
 /// </summary>
diff --git a/src/Bolero/ProgramRun.fs b/src/Bolero/ProgramRun.fs
index cc2c40b0..a84ad7a2 100644
--- a/src/Bolero/ProgramRun.fs
+++ b/src/Bolero/ProgramRun.fs
@@ -105,8 +105,17 @@ module internal Program' =
 
         reentered <- true
         setState model dispatch
-        fun () ->
+        let mutable cmd = cmd
+
+        let updateInitState m cmd' =
+            setState m dispatch
+            state <- m
+            cmd <- cmd @ cmd'
+
+        let run () =
             cmd |> Cmd.exec (fun ex -> onError ("Error intitializing:", ex)) dispatch
             activeSubs <- Subs.diff activeSubs sub |> Subs.Fx.change onError dispatch
             processMsgs ()
             reentered <- false
+
+        updateInitState, model, run