Merge pull request #424 from krymtkts/feature/dev-server

Refactor dev server live reload to use SSE instead of WebSockets

Author: krymtkts

src/App.fsproj

@@ -17,7 +17,6 @@
   </ItemGroup>
   <ItemGroup>
     <PackageReference Include="Fable.Browser.Dom" Version="2.20.0" />
-    <PackageReference Include="Fable.Browser.WebSocket" Version="1.4.0" />
     <PackageReference Include="Fable.Browser.WebStorage" Version="1.3.0" />
     <PackageReference Include="Fable.Core" Version="4.5.0" />
     <PackageReference Include="Fable.Promise" Version="3.2.0" />

src/Dev.fs

@@ -1,17 +1,36 @@
 module Dev
 
 open Browser.Dom
-open Browser.WebSocket
+open Fable.Core
 
-let private initLiveReloading _ =
-    // NOTE: don't use string interpolation here, it will break the code because of importing String module.
-    let ws = WebSocket.Create <| "ws://" + window.location.host + "/websocket"
+[<Emit("typeof EventSource !== 'undefined'")>]
+let private hasEventSource: bool = jsNative
+
+[<AllowNullLiteral>]
+type private IEventSource =
+    abstract addEventListener: string * (obj -> unit) -> unit
+    abstract close: unit -> unit
+    abstract onmessage: (obj -> unit) with get, set
+
+[<Emit("new EventSource($0)")>]
+let private createEventSource (_url: string) : IEventSource = jsNative
+
+let private initLiveReloadingViaSse () =
+    let es = createEventSource "/sse"
 
-    ws.onmessage <-
-        fun _ ->
-            ws.close (1000, "reload")
-            window.location.reload ()
+    let reload (_: obj) =
+        es.close ()
+        window.location.reload ()
 
-    window.addEventListener ("beforeunload", (fun _ -> ws.close ()))
+    es.addEventListener ("refresh", reload)
+    es.onmessage <- reload
+
+    window.addEventListener ("beforeunload", (fun _ -> es.close ()))
+
+let private initLiveReloading _ =
+    // SSE only.
+    // If the browser doesn't support EventSource, do nothing.
+    if hasEventSource then
+        initLiveReloadingViaSse ()
 
 window.addEventListener ("load", initLiveReloading)

test/DevServer.fs

@@ -8,12 +8,11 @@ open Suave
 open Suave.Filters
 open Suave.Operators
 open Suave.Sockets
-open Suave.Sockets.Control
-open Suave.Utils
-open Suave.WebSocket
 open System
 open System.Net
+open System.Net.Sockets
 open System.Threading
+open System.Threading.Tasks
 
 let port =
     let rec findPort port =
@@ -25,14 +24,16 @@ let port =
 
     findPort 8080us
 
+[<RequireQualifiedAccess>]
+[<Struct>]
 type BuildEvent =
     | BuildFable
     | BuildMd
     | BuildStyle
     | Noop
 
-let (handleWatcherEvents: FileChange seq -> unit), socketHandler =
-    let refreshEvent = new Event<_>()
+let (handleWatcherEvents: FileChange seq -> unit), sseHandler =
+    let refreshEvent = new Event<unit>()
 
     let buildFable () =
         let cmd = "fable src"
@@ -59,24 +60,26 @@ let (handleWatcherEvents: FileChange seq -> unit), socketHandler =
             |> Seq.map (fun e ->
                 let fi = FileInfo.ofPath e.FullPath
 
-                Trace.traceImportant $"%s{fi.FullName} was changed."
+                Trace.traceImportant $"%s{fi.FullName} was changed. ext: %s{fi.Extension}"
 
-                match fi.FullName with
-                | x when x.EndsWith(".fs") -> BuildFable
-                | x when x.EndsWith(".md") || x.EndsWith(".yml") || x.EndsWith(".yaml") -> BuildMd
-                | x when x.EndsWith(".scss") -> BuildStyle
-                | _ -> Noop)
+                match fi.Extension with
+                | ".fs" -> BuildEvent.BuildFable
+                | ".md"
+                | ".yml"
+                | ".yaml" -> BuildEvent.BuildMd
+                | ".scss" -> BuildEvent.BuildStyle
+                | _ -> BuildEvent.Noop)
             |> Set.ofSeq
 
         let fableOrMd =
-            match [ BuildFable; BuildMd ] |> List.map es.Contains with
+            match [ BuildEvent.BuildFable; BuildEvent.BuildMd ] |> List.map es.Contains with
             | [ true; true ] -> buildFable ()
             | [ _; true ] -> buildMd ()
             | [ true; _ ] -> buildFable ()
             | _ -> Ok false
 
         let style =
-            match es |> Set.contains BuildStyle with
+            match es |> Set.contains BuildEvent.BuildStyle with
             | true -> buildStyle ()
             | _ -> Ok false
 
@@ -87,39 +90,33 @@ let (handleWatcherEvents: FileChange seq -> unit), socketHandler =
             printfn "refresh event is triggered."
         | _ -> printfn "refresh event not triggered."
 
-    let socketHandler (ws: WebSocket) _ =
-        let rec refreshLoop (ct: CancellationToken) =
-            task {
-                ct.ThrowIfCancellationRequested()
-                do! refreshEvent.Publish |> Async.AwaitEvent
-
-                printfn "refresh client."
-                let seg = ASCII.bytes "refreshed" |> ByteSegment
-                let! _ = ws.send Text seg true
-
-                return! refreshLoop ct
-            }
-
-        let rec mainLoop (cts: CancellationTokenSource) =
-            socket {
-                let! msg = ws.read ()
-
-                match msg with
-                | Close, _, _ ->
-                    // use _ = cts
-                    cts.Cancel()
-
-                    let emptyResponse = [||] |> ByteSegment
-                    do! ws.send Close emptyResponse true
-                    printfn "WebSocket connection closed gracefully."
-                | _ -> return! mainLoop cts
-            }
-
-        let cts = new CancellationTokenSource()
-        refreshLoop cts.Token |> ignore
-        mainLoop cts
-
-    handleWatcherEvents, socketHandler
+    let sseHandler (conn: Connection) : Task<unit> =
+        task {
+            try
+                // NOTE: Tell the browser how long to wait before retrying the connection.
+                do! EventSource.retry conn 1000u
+
+                // NOTE: Initial event so the client can confirm it is connected.
+                do! EventSource.eventType conn "connected"
+                do! EventSource.data conn "ok"
+                do! EventSource.dispatch conn
+
+                while true do
+                    do!
+                        Async.StartAsTask(
+                            refreshEvent.Publish |> Async.AwaitEvent,
+                            cancellationToken = CancellationToken.None
+                        )
+
+                    do! EventSource.eventType conn "refresh"
+                    do! EventSource.data conn "refreshed"
+                    do! EventSource.dispatch conn
+            with
+            | :? OperationCanceledException -> ()
+            | :? SocketException -> ()
+        }
+
+    handleWatcherEvents, sseHandler
 
 let suaveConfig (home: string) (ct: CancellationToken) =
     let home = IO.Path.GetFullPath home
@@ -149,7 +146,7 @@ let webpart (root: string) : WebPart =
 
     choose [
 
-        path "/websocket" >=> handShake socketHandler
+        path "/sse" >=> EventSource.handShake sseHandler
 
         GET
         >=> Writers.setHeader "Cache-Control" "no-cache, no-store, must-revalidate"