From ca93e11fb43e62851dabdee73bdf48c2b09763e4 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Sat, 20 May 2023 00:31:01 +0200
Subject: [PATCH] Parse errors are now taken into account.

---
 src/App/IPC.purs | 10 +++-------
 src/Main.purs    | 31 ++++++++++++++++---------------
 2 files changed, 19 insertions(+), 22 deletions(-)

diff --git a/src/App/IPC.purs b/src/App/IPC.purs
index 0598e4c..52514c2 100644
--- a/src/App/IPC.purs
+++ b/src/App/IPC.purs
@@ -49,13 +49,9 @@ utf8ToArrayBuffer s = Builder.execPutM do
 toIPC :: String -> Effect ArrayBuffer
 toIPC = utf8ToArrayBuffer
 
--- TODO: make sure the String length is correct.
-fromIPC :: ArrayBuffer -> Effect String
-fromIPC ab = arrayBufferToUtf8 ab >>= case _ of
-    Left parseError -> do
-      pure $ show parseError
-    Right string -> do
-      pure string
+-- TODO: this code shouldn't handle parse errors.
+fromIPC :: ArrayBuffer -> Effect (Either ParseError String)
+fromIPC = arrayBufferToUtf8
 
 arrayBufferToUtf8 :: ArrayBuffer -> Effect (Either ParseError String)
 arrayBufferToUtf8 arrayBuffer = do
diff --git a/src/Main.purs b/src/Main.purs
index eed05b7..0388129 100644
--- a/src/Main.purs
+++ b/src/Main.purs
@@ -4,16 +4,12 @@ import Prelude
 
 import Control.Monad.Except (runExcept)
 import Control.Monad.State (class MonadState)
-import Data.Argonaut.Core as AC
-import Data.Argonaut.Parser as AP
 import Data.Array as A
 import Data.Bifunctor (lmap)
 -- import Data.Codec.Argonaut (JsonCodec, JsonDecodeError)
 -- import Data.Codec.Argonaut as CA
 import Data.Const (Const)
 import Data.Either (Either(..))
-import Data.List.NonEmpty (NonEmptyList)
-import Data.List.NonEmpty as NEL
 import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
 import Data.String as String
 import Effect (Effect)
@@ -41,7 +37,6 @@ import Web.Socket.BinaryType (BinaryType(ArrayBuffer))
 
 import App.IPC (toIPC, fromIPC)
 
-
 --------------------------------------------------------------------------------
 -- WebSocketEvent type
 --------------------------------------------------------------------------------
@@ -106,6 +101,7 @@ decodeMessageEvent = \msgEvent -> do
 ---------------------------
 -- Errors
 ---------------------------
+
 data ErrorType
   = MessageIsServerAdvertisement String
   | UnknownError String
@@ -121,8 +117,9 @@ renderError = case _ of
     "Unknown 'error' event has been fired by WebSocket event listener"
 
 --------------------------------------------------------------------------------
--- Example `Main` module
+-- `Main` function
 --------------------------------------------------------------------------------
+
 main :: Effect Unit
 main = do
   HA.runHalogenAff do
@@ -137,14 +134,17 @@ main = do
 type WebSocketMessageType = ArrayBuffer
 
 --------------------------------------------------------------------------------
--- Example root component module
+-- Root component module
 --------------------------------------------------------------------------------
+
+type Query :: forall k. k -> Type
 type Query = Const Void
 type Input = String
 type Output = Void
 
 data Action
   = Initialize
+  | WebSocketParseError String
   | ConnectWebSocket
   | HandleInputUpdate String
   | SendMessage Event
@@ -255,6 +255,9 @@ handleAction = case _ of
   Initialize ->
     handleAction ConnectWebSocket
 
+  WebSocketParseError error ->
+    systemMessage $ renderError (UnknownError error)
+
   ConnectWebSocket -> do
     { wsUrl } <- H.get
     systemMessage ("Connecting to \"" <> wsUrl <>  "\"...")
@@ -298,8 +301,6 @@ handleAction = case _ of
                 H.liftEffect $ WS.close webSocket
                 systemMessageReset $ "You have requested to disconnect from the server"
               otherMessage -> do
-                -- H.liftEffect $ WS.sendString webSocket (AC.stringify $ CA.encode exampleMessageCodec otherMessage)
-                -- TODO: send binary data.
                 H.liftEffect $ do
                   ab <- toIPC otherMessage
                   sendArrayBuffer webSocket ab
@@ -308,8 +309,12 @@ handleAction = case _ of
   HandleWebSocket wsEvent ->
     case wsEvent of
       WebSocketMessage messageEvent -> do
-        str <- H.liftEffect $ fromIPC messageEvent.message
-        appendMessage $ "[😈] Server sent: " <> str
+        receivedMessage <- H.liftEffect $ fromIPC messageEvent.message
+        case receivedMessage of
+            Left parseError -> do
+              handleAction $ WebSocketParseError $ show parseError
+            Right string -> do
+              appendMessage $ "[😈] Server: " <> string
 
       WebSocketOpen -> do
         { wsUrl } <- H.get
@@ -402,7 +407,3 @@ foreignToArrayBuffer
   renderForeignErrors :: F.MultipleErrors -> String
   renderForeignErrors =
     String.joinWith "; " <<< A.fromFoldable <<< map F.renderForeignError
-
----- Get any Foreign value to either a String 
---foreignToDataView :: Foreign -> Either String DataView
---foreignToDataView = map arrayBufferToDataView <<< foreignToArrayBuffer