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 = 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

View File

@ -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