Add action history to UI

RaftFable/src/App.fs

@@ -11,35 +11,62 @@ module App =
 
     let ui = Ui.initialise document
 
-    let rec fullyRerender<'a> (cluster : Cluster<'a>) (network : Network<'a>) : Promise<unit> =
-        let prefs = Ui.getUserPrefs ui
+    let rec fullyRerender<'a>
+        (parse : string -> Result<'a, string>)
+        (userPrefs : UserPreferences<'a> ref)
+        (cluster : Cluster<'a>)
+        (network : Network<'a>)
+        : Promise<unit>
+        =
+        userPrefs.Value <- Ui.getUserPrefs<'a> parse cluster.ClusterSize ui
 
         Ui.freezeState cluster network
         |> Async.StartAsPromise
         |> fun p ->
             p.``then`` (fun clusterState ->
-                Ui.render
-                    (perform cluster network)
+                Ui.render<'a>
+                    (perform<'a> parse userPrefs cluster network)
                     document
                     ui
                     {
-                        UserPreferences = prefs
+                        UserPreferences = userPrefs.Value
                         ClusterState = clusterState
                     }
             )
 
-    and perform (cluster : Cluster<'a>) (network : Network<'a>) (action : NetworkAction<'a>) : Promise<unit> =
+    and perform<'a>
+        (parse : string -> Result<'a, string>)
+        (userPrefs : UserPreferences<'a> ref)
+        (cluster : Cluster<'a>)
+        (network : Network<'a>)
+        (action : NetworkAction<'a>)
+        : Promise<unit>
+        =
         NetworkAction.perform cluster network action
-        fullyRerender cluster network
 
-    let cluster, network = InMemoryCluster.make<byte> clusterSize
+        userPrefs.Value <-
+            { userPrefs.Value with
+                ActionHistory = action :: userPrefs.Value.ActionHistory
+            }
+
+        fullyRerender parse userPrefs cluster network
+
+    let parseByte (s : string) =
+        match System.Byte.TryParse s with
+        | false, _ -> Error (sprintf "Expected byte, got '%s'" s)
+        | true, v -> Ok v
+
+    let userPrefs : UserPreferences<byte> ref =
+        ref (Ui.getUserPrefs parseByte clusterSize ui)
+
+    let mutable cluster, network = InMemoryCluster.make<byte> clusterSize
 
     let leaderStateButton =
         document.querySelector ".leader-select-button" :?> Browser.Types.HTMLButtonElement
 
-    leaderStateButton.onclick <- fun _ -> fullyRerender cluster network
+    leaderStateButton.onclick <- fun _ -> fullyRerender parseByte userPrefs cluster network
 
-    let startupSequence =
+    let startupActions : NetworkAction<byte> list =
         [
             NetworkAction.InactivityTimeout 0<ServerId>
             NetworkAction.InactivityTimeout 1<ServerId>
@@ -70,54 +97,65 @@ module App =
             NetworkAction.NetworkMessage (0<ServerId>, 2)
             NetworkAction.NetworkMessage (1<ServerId>, 6)
         ]
-        |> List.truncate 0
-        |> fun s -> (fullyRerender cluster network, s)
+
+    ui.ActionHistory.textContent <- startupActions |> Seq.map NetworkAction.toString |> String.concat "\n"
+
+    let reloadActions () =
+        let newCluster, newNetwork = InMemoryCluster.make<byte> clusterSize
+        cluster <- newCluster
+        network <- newNetwork
+
+        userPrefs.Value <- Ui.getUserPrefs parseByte clusterSize ui
+
+        startupActions
+        |> fun s -> (fullyRerender parseByte userPrefs cluster network, s)
         ||> List.fold (fun (inPromise : Promise<unit>) action ->
             promise {
                 let! _ = inPromise
-                return! perform cluster network action
+                return! perform parseByte userPrefs cluster network action
             }
         )
 
+    let reloadActionsButton =
+        document.querySelector ".reload-actions" :?> Browser.Types.HTMLButtonElement
+
+    reloadActionsButton.onclick <- fun _evt -> reloadActions ()
+
+    reloadActions () |> ignore
+
     let timeoutButton =
         document.querySelector ".timeout-button" :?> Browser.Types.HTMLButtonElement
 
     timeoutButton.onclick <-
         fun _event ->
-            startupSequence.``then`` (fun () ->
-                ui.TimeoutField.valueAsNumber
-                |> int
-                |> fun i -> i * 1<ServerId>
-                |> InactivityTimeout
-                |> perform cluster network
-            )
+            ui.TimeoutField.valueAsNumber
+            |> int
+            |> fun i -> i * 1<ServerId>
+            |> InactivityTimeout
+            |> perform parseByte userPrefs cluster network
 
     let heartbeatButton =
         document.querySelector ".heartbeat-button" :?> Browser.Types.HTMLButtonElement
 
     heartbeatButton.onclick <-
         fun _event ->
-            startupSequence.``then`` (fun () ->
-                ui.HeartbeatField.valueAsNumber
-                |> int
-                |> fun i -> i * 1<ServerId>
-                |> Heartbeat
-                |> perform cluster network
-            )
+            ui.HeartbeatField.valueAsNumber
+            |> int
+            |> fun i -> i * 1<ServerId>
+            |> Heartbeat
+            |> perform parseByte userPrefs cluster network
 
     let clientDataSubmitButton =
         document.querySelector ".client-data-submit" :?> Browser.Types.HTMLButtonElement
 
     clientDataSubmitButton.onclick <-
         fun _event ->
-            startupSequence.``then`` (fun () ->
-                let server =
-                    ui.ClientDataServerField.valueAsNumber |> int |> (fun i -> i * 1<ServerId>)
+            let server =
+                ui.ClientDataServerField.valueAsNumber |> int |> (fun i -> i * 1<ServerId>)
 
-                let data = ui.ClientDataField.valueAsNumber |> byte
+            let data = ui.ClientDataField.valueAsNumber |> byte
 
-                NetworkAction.ClientRequest (server, data, printfn "%O")
-                |> perform cluster network
-            )
+            NetworkAction.ClientRequest (server, data)
+            |> perform parseByte userPrefs cluster network
 
-    ui.ShowConsumedMessages.onchange <- fun _event -> fullyRerender cluster network
+    ui.ShowConsumedMessages.onchange <- fun _event -> fullyRerender parseByte userPrefs cluster network

RaftFable/src/RaftFable.fsproj

@@ -6,6 +6,7 @@
   <ItemGroup>
     <Compile Include="Table.fs" />
     <Compile Include="Button.fs" />
+    <Compile Include="Result.fs" />
     <Compile Include="Ui.fs" />
     <Compile Include="App.fs" />
   </ItemGroup>

RaftFable/src/Result.fs

@@ -0,0 +1,30 @@
+namespace RaftFable
+
+open System.Collections.Generic
+
+[<RequireQualifiedAccess>]
+module Result =
+
+    let allOkOrError<'a, 'err>
+        (results : Result<'a, 'err> seq)
+        : Result<'a IReadOnlyList, 'a IReadOnlyList * 'err IReadOnlyList>
+        =
+        let okResults = ResizeArray ()
+        let errResults = ResizeArray ()
+
+        for r in results do
+            match r with
+            | Error e -> errResults.Add e
+            | Ok o -> okResults.Add o
+
+        let okResults = okResults :> IReadOnlyList<_>
+
+        if errResults.Count = 0 then
+            Ok okResults
+        else
+            Error (okResults, errResults :> IReadOnlyList<_>)
+
+    let get<'a, 'err> (r : Result<'a, 'err>) : 'a =
+        match r with
+        | Ok o -> o
+        | Error e -> failwithf "Tried to unwrap an error (%+A)" e

RaftFable/src/Ui.fs

@@ -11,16 +11,17 @@ type ClusterState<'a> =
         UndeliveredMessages : (int * Message<'a>) list array
     }
 
-type UserPreferences =
+type UserPreferences<'a> =
     {
         LeaderUnderConsideration : int<ServerId>
         ShowConsumedMessages : bool
+        ActionHistory : NetworkAction<'a> list
     }
 
 type UiBackingState<'a> =
     {
         ClusterState : ClusterState<'a>
-        UserPreferences : UserPreferences
+        UserPreferences : UserPreferences<'a>
     }
 
 type UiElements =
@@ -36,6 +37,7 @@ type UiElements =
         HeartbeatField : Browser.Types.HTMLInputElement
         SelectedLeaderId : Browser.Types.HTMLInputElement
         ShowConsumedMessages : Browser.Types.HTMLInputElement
+        ActionHistory : Browser.Types.HTMLTextAreaElement
     }
 
 type RequiresPopulation =
@@ -76,6 +78,9 @@ module Ui =
         let showConsumed =
             document.querySelector ".show-consumed" :?> Browser.Types.HTMLInputElement
 
+        let actionHistory =
+            document.querySelector ".action-history" :?> Browser.Types.HTMLTextAreaElement
+
         {
             Document = document
             ServerStatusTable = serverStatuses
@@ -88,6 +93,7 @@ module Ui =
             HeartbeatField = heartbeatField
             SelectedLeaderId = selectedLeaderId
             ShowConsumedMessages = showConsumed
+            ActionHistory = actionHistory
         }
 
     let reset (clusterSize : int) (ui : UiElements) : RequiresPopulation =
@@ -319,8 +325,22 @@ module Ui =
                 }
         }
 
-    let getUserPrefs (ui : UiElements) : UserPreferences =
+    let getUserPrefs<'a>
+        (parse : string -> Result<'a, string>)
+        (clusterSize : int)
+        (ui : UiElements)
+        : UserPreferences<'a>
+        =
         {
             LeaderUnderConsideration = ui.SelectedLeaderId.valueAsNumber |> int |> (fun i -> i * 1<ServerId>)
             ShowConsumedMessages = ui.ShowConsumedMessages.``checked``
+            ActionHistory =
+                // TODO write these back out again, and give a button to Load
+                ui.ActionHistory.textContent.Split "\n"
+                |> Seq.filter (not << System.String.IsNullOrEmpty)
+                |> Seq.map (NetworkAction.tryParse<'a> parse None clusterSize)
+                |> Result.allOkOrError
+                // TODO handle this
+                |> Result.get
+                |> List.ofSeq
         }