Merge pull request #567 from nghamilton/fix/incomplete-patterns

Fix/incomplete patterns
digitallyinduced · Nov 23, 2020 · 2979243 · 2979243
2 parents a34f734 + ec49d94
commit 2979243
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 6 deletions.
diff --git a/IHP/AutoRefresh.hs b/IHP/AutoRefresh.hs
@@ -56,12 +56,12 @@ autoRefresh runAction = do
             id <- UUID.nextRandom
             let controllerContext = ?context
             let renderView = \requestContext -> let ?context = controllerContext { requestContext } in action ?theAction
-            
+
             putContext (AutoRefreshEnabled id)
-            
+
             -- We save the allowed session ids to the session cookie to only grant a client access
             -- to sessions it initially opened itself
-            -- 
+            --
             -- Otherwise you might try to guess session UUIDs to access other peoples auto refresh sessions
             setSession "autoRefreshSessions" (map UUID.toText (id:availableSessions) |> Text.intercalate "")
 
@@ -77,9 +77,10 @@ autoRefresh runAction = do
                             async (gcSessions autoRefreshServer)
 
                             registerNotificationTrigger ?touchedTables autoRefreshServer
-                            
+
                             throw exception
-
+                        _   -> error "Unimplemented WAI response type."
+
                 runAction `Exception.catch` handleResponse
         AutoRefreshEnabled {} -> do
             -- When this function calls the 'action ?theAction' in the other case
@@ -109,6 +110,7 @@ instance WSApp AutoRefreshWSApp where
                         when (html /= lastResponse) do
                             updateSession sessionId (\session -> session { lastResponse = html })
                             sendTextData html
+                    _   -> error "Unimplemented WAI response type."
 
             async $ forever do
                 MVar.takeMVar event
@@ -139,7 +141,7 @@ registerNotificationTrigger :: (?modelContext :: ModelContext) => IORef (Set Tex
 registerNotificationTrigger touchedTablesVar autoRefreshServer = do
     touchedTables <- Set.toList <$> readIORef touchedTablesVar
     subscribedTables <- (get #subscribedTables) <$> (autoRefreshServer |> readIORef)
-    
+
     let subscriptionRequired = touchedTables |> filter (\table -> subscribedTables |> Set.notMember table)
     modifyIORef autoRefreshServer (\server -> server { subscribedTables = get #subscribedTables server <> Set.fromList subscriptionRequired })
     forEach subscriptionRequired \table -> do

diff --git a/IHP/WebSocket.hs b/IHP/WebSocket.hs
@@ -48,6 +48,7 @@ startWSApp connection = do
     let
         handleException Websocket.ConnectionClosed = onClose @state
         handleException (Websocket.CloseRequest {}) = onClose @state
+        handleException e = error ("Unhandled Websocket exception: " <> show e)
     result <- Exception.try ((Websocket.withPingThread connection 30 (onPing @state) (run @state)) `Exception.catch` handleException)
     case result of
         Left (Exception.SomeException e) -> putStrLn (tshow e)