IPC: new version, currently not compiling (WIP).

master
Philippe Pittoli 2023-05-19 23:43:44 +02:00
parent e1d49f1048
commit 618998cd68
1 changed files with 48 additions and 27 deletions

View File

@ -9,48 +9,69 @@ import Effect.Class.Console as Console
import Data.Maybe import Data.Maybe
import Data.UInt (UInt, fromInt, toInt) import Data.UInt (UInt, fromInt, toInt)
import Data.Array (drop, cons) import Data.Array (drop, cons)
import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer
import Data.ArrayBuffer.Types (DataView, ArrayBuffer(..)) import Data.ArrayBuffer.Types (DataView, ArrayBuffer(..))
import Data.ArrayBuffer.Typed (buffer) import Data.ArrayBuffer.Typed (buffer)
import Data.ArrayBuffer.ArrayBuffer as AB 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 Data.String.CodeUnits as CU
import Web.Encoding.TextEncoder (new, TextEncoder, encode) import Web.Encoding.TextEncoder as TextEncoder
import Web.Encoding.TextDecoder as TD import Web.Encoding.TextDecoder as TextDecoder
import Web.Encoding.UtfLabel as UtfLabel
import Data.Char (fromCharCode) import Data.Char (fromCharCode)
import Data.ArrayBuffer.DataView as DV import Data.ArrayBuffer.DataView as DV
import Effect.Unsafe import Effect.Unsafe
import Data.Either (Either(Left, Right), either, note, hush)
putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit utf8ToArrayBuffer :: String -> Effect ArrayBuffer
putStringUtf8 s = do utf8ToArrayBuffer s = Builder.execPutM do
textEncoder <- liftEffect new textEncoder <- liftEffect TextEncoder.new
let stringbuf = buffer $ encode s textEncoder let stringbuf = Typed.buffer $ TextEncoder.encode s textEncoder
-- Put a 32-bit big-endian length for the utf8 string, in bytes. -- Put a 32-bit big-endian length for the utf8 string, in bytes.
putUint32be $ fromInt $ AB.byteLength stringbuf Builder.putUint32be $ fromInt $ ArrayBuffer.byteLength stringbuf
putArrayBuffer stringbuf Builder.putArrayBuffer stringbuf
toIPC :: String -> Effect ArrayBuffer toIPC :: String -> Effect ArrayBuffer
toIPC s = execPut $ putStringUtf8 s toIPC = utf8ToArrayBuffer
-- 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
-- TODO: make sure the String length is correct. -- TODO: make sure the String length is correct.
fromIPC :: ArrayBuffer -> Effect String 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