From 618998cd680fb587e3dc9cfc0700e106c0cadec2 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Fri, 19 May 2023 23:43:44 +0200 Subject: [PATCH] IPC: new version, currently not compiling (WIP). --- src/App/IPC.purs | 75 +++++++++++++++++++++++++++++++----------------- 1 file changed, 48 insertions(+), 27 deletions(-) diff --git a/src/App/IPC.purs b/src/App/IPC.purs index 8f91f6a..b2cca76 100644 --- a/src/App/IPC.purs +++ b/src/App/IPC.purs @@ -9,48 +9,69 @@ import Effect.Class.Console as Console import Data.Maybe import Data.UInt (UInt, fromInt, toInt) import Data.Array (drop, cons) +import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer import Data.ArrayBuffer.Types (DataView, ArrayBuffer(..)) import Data.ArrayBuffer.Typed (buffer) import Data.ArrayBuffer.ArrayBuffer as AB -import Data.ArrayBuffer.Builder (PutM, putArrayBuffer, execPut, putUint32be) +import Data.ArrayBuffer.Builder as Builder + +import Data.ArrayBuffer.Cast as Cast + +import Control.Monad.Trans.Class (lift) +import Data.ArrayBuffer.Typed as Typed +import Data.ArrayBuffer.DataView as DataView +import Parsing.DataView as Parsing.DataView +import Parsing (ParserT(..), ParseError(..), runParserT) import Data.String.CodeUnits as CU -import Web.Encoding.TextEncoder (new, TextEncoder, encode) -import Web.Encoding.TextDecoder as TD +import Web.Encoding.TextEncoder as TextEncoder +import Web.Encoding.TextDecoder as TextDecoder +import Web.Encoding.UtfLabel as UtfLabel import Data.Char (fromCharCode) import Data.ArrayBuffer.DataView as DV import Effect.Unsafe +import Data.Either (Either(Left, Right), either, note, hush) -putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit -putStringUtf8 s = do - textEncoder <- liftEffect new - let stringbuf = buffer $ encode s textEncoder +utf8ToArrayBuffer :: String -> Effect ArrayBuffer +utf8ToArrayBuffer s = Builder.execPutM do + textEncoder <- liftEffect TextEncoder.new + let stringbuf = Typed.buffer $ TextEncoder.encode s textEncoder -- Put a 32-bit big-endian length for the utf8 string, in bytes. - putUint32be $ fromInt $ AB.byteLength stringbuf - putArrayBuffer stringbuf + Builder.putUint32be $ fromInt $ ArrayBuffer.byteLength stringbuf + Builder.putArrayBuffer stringbuf toIPC :: String -> Effect ArrayBuffer -toIPC s = execPut $ putStringUtf8 s - --- TODO: fix this implementation. Use an actual text decoder. -arraybufferToString :: ArrayBuffer -> Effect String -arraybufferToString arraybuffer - = case (AB.byteLength arraybuffer) of - 0 -> pure "" - _ -> do - maybeFirstByte <- DV.getUint8 (DV.whole arraybuffer) 0 - rest <- arraybufferToString $ AB.slice 1 (AB.byteLength arraybuffer) arraybuffer - pure $ (CU.singleton $ firstChar maybeFirstByte) <> rest - where - firstChar :: Maybe UInt -> Char - firstChar byte = fromMaybe '\n' (fromCharCode (toInt (fromMaybe (fromInt 10) byte))) - -dataviewToString :: DataView -> Effect String -dataviewToString dataview = arraybufferToString $ DV.buffer dataview +toIPC = utf8ToArrayBuffer -- TODO: make sure the String length is correct. fromIPC :: ArrayBuffer -> Effect String -fromIPC ab = arraybufferToString (AB.slice 4 (AB.byteLength ab) ab) +fromIPC ab = arrayBufferToUtf8 ab >>= case _ of + Left parseError -> do + pure parseError + Right string -> do + pure string + +arrayBufferToUtf8 :: ArrayBuffer -> Effect (Either ParseError String) +arrayBufferToUtf8 arrayBuffer = do + textDecoder <- TextDecoder.new UtfLabel.utf8 + let dataView = DataView.whole arrayBuffer + runParserT dataView do + -- First parse a 32-bit big-endian length prefix for the length + -- of the UTF-8 string in bytes. + length <- Parsing.DataView.anyInt32be + stringview <- Parsing.DataView.takeN length + stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview + hoistEffectParserT $ TextDecoder.decode stringarray textDecoder + +hoistEffectParserT + :: forall a + . Effect a + -> ParserT DataView Effect a +hoistEffectParserT + = Exception.try + >>> ExceptT + >>> withExceptT Exception.message + >>> Parsing.liftExceptT