From 618998cd680fb587e3dc9cfc0700e106c0cadec2 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
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