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

master
Philippe Pittoli 10 months ago
parent e1d49f1048
commit 618998cd68

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

Loading…
Cancel
Save