Parse errors are now taken into account.

master
Philippe Pittoli 2023-05-20 00:31:01 +02:00
parent c94a509f0d
commit ca93e11fb4
2 changed files with 19 additions and 22 deletions

View File

@ -49,13 +49,9 @@ utf8ToArrayBuffer s = Builder.execPutM do
toIPC :: String -> Effect ArrayBuffer toIPC :: String -> Effect ArrayBuffer
toIPC = utf8ToArrayBuffer toIPC = utf8ToArrayBuffer
-- TODO: make sure the String length is correct. -- TODO: this code shouldn't handle parse errors.
fromIPC :: ArrayBuffer -> Effect String fromIPC :: ArrayBuffer -> Effect (Either ParseError String)
fromIPC ab = arrayBufferToUtf8 ab >>= case _ of fromIPC = arrayBufferToUtf8
Left parseError -> do
pure $ show parseError
Right string -> do
pure string
arrayBufferToUtf8 :: ArrayBuffer -> Effect (Either ParseError String) arrayBufferToUtf8 :: ArrayBuffer -> Effect (Either ParseError String)
arrayBufferToUtf8 arrayBuffer = do arrayBufferToUtf8 arrayBuffer = do

View File

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