Parse errors are now taken into account.
parent
c94a509f0d
commit
ca93e11fb4
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
Loading…
Reference in New Issue