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