server: websocket for updates & auto-reload

todo: find a better solution than writing javascript in haskell strings. SERIOUSLY.

1 files changed, 9 insertions, 6 deletions

diff --git a/server/Main.hs b/server/Main.hs
index 7109583..60098b6 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -20,8 +20,8 @@ import qualified Data.Text                            as T
 import           Fmt                                  ((+|), (|+))
 import           Handlers                             (AdminOverview (AdminOverview),
                                                        MapService (MapService),
-                                                       relintImpl, stateImpl,
-                                                       statusImpl)
+                                                       realtimeImpl, relintImpl,
+                                                       stateImpl, statusImpl)
 import           HtmlOrphans                          ()
 import           Network.HTTP.Client                  (defaultManagerSettings,
                                                        newManager)
@@ -50,6 +50,7 @@ import           Worker                               (Job (Job), linterThread)
 import           Control.Monad.Logger                 (logInfoN,
                                                        runStdoutLoggingT)
 import           Servant.API                          (Header)
+import           Servant.API.WebSocket                (WebSocketPending)
 import           Servant.Client                       (ClientM, client,
                                                        mkClientEnv, runClientM)
 
@@ -67,11 +68,12 @@ type MapServiceAPI method =
 type API format =
        "status" :> Capture "org" Text :> Capture "jobid" Sha1 :> Get '[format] JobStatus
   :<|> "status" :> Capture "org" Text :> Capture "jobid" Sha1 :> "relint" :> Post '[format] Text
+  :<|> "status" :> Capture "org" Text :> Capture "jobid" Sha1 :> "realtime" :> WebSocketPending
   :<|> "admin" :> "overview" :> Get '[format] AdminOverview
 
 -- | actual set of routes: api for json & html + static pages from disk
-type Routes = "api" :> API JSON
-         :<|> MapServiceAPI Get
+type Routes = -- "api" :> API JSON
+         MapServiceAPI Get
          :<|> API HTML -- websites mirror the API exactly
          :<|> Raw
 
@@ -79,12 +81,13 @@ type Routes = "api" :> API JSON
 jsonAPI :: forall format. TQueue Job -> MVar ServerState -> Server (API format)
 jsonAPI queue state = statusImpl state
            :<|> relintImpl queue state
+           :<|> realtimeImpl state
            :<|> stateImpl @AdminOverview state
 
 -- | Complete set of routes: API + HTML sites
 server :: TQueue Job -> MVar ServerState -> Server Routes
-server queue state = jsonAPI @JSON queue state
-          :<|> stateImpl @MapService state
+server queue state = -- jsonAPI @JSON queue state
+           stateImpl @MapService state
           :<|> jsonAPI @HTML queue state
           :<|> serveDirectoryWebApp "./static"