@@ -5,14 +5,20 @@ import Prelude
55import Control.Monad.Writer.Trans (tell)
66import Data.Array (foldRecM)
77import Data.Array as Array
8−import Data.ArrayBuffer.Builder (Builder, DataBuff(..), PutM, execPut, putInt16be, putInt32le, putInt8, subBuilder)
8+import Data.ArrayBuffer.ArrayBuffer (byteLength)
9+import Data.ArrayBuffer.Builder (Builder, DataBuff(..), PutM, execPut, putArrayBuffer, putInt16be, putInt32be, putInt32le, putInt8, subBuilder)
910import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
1011import Data.ArrayBuffer.DataView as DV
12+import Data.ArrayBuffer.Typed (buffer)
1113import Data.ArrayBuffer.Typed as AT
12−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
14+import Data.ArrayBuffer.Typed as AV
15+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
1316import Data.UInt as UInt
1417import Effect (Effect)
18+import Effect.Class (class MonadEffect, liftEffect)
1519import Test.Assert (assertEqual')
20+import Web.Encoding.TextEncoder (encode)
21+import Web.Encoding.TextEncoder as TextEncoder
1622
1723asBytes :: ArrayBuffer -> Effect (Array Int)
1824asBytes x = do
@@ -22,48 +28,48 @@ asBytes x = do
2228putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
2329putTest label expected put = do
2430 actual <- asBytes =<< execPut put
25− assertEqual' label {actual,expected}
31+ assertEqual' label { actual, expected }
2632
2733buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
2834buildTest label expected bldr = do
2935 actual <- asBytes =<< execBuilder =<< bldr
30− assertEqual' label {actual,expected}
36+ assertEqual' label { actual, expected }
3137
3238main :: Effect Unit
3339main = do
34− putTest "Test 0" [6,7,8] do
40+ putTest "Test 0" [ 6, 7, 8 ] do
3541 putInt8 6
3642 putInt8 7
3743 putInt8 8
3844
39− putTest "Test 1" [255,254] do
45+ putTest "Test 1" [ 255, 254 ] do
4046 putInt16be (-2)
4147
42− putTest "Test 3" [3,0,0,0] do
48+ putTest "Test 3" [ 3, 0, 0, 0 ] do
4349 putInt32le 3
4450
45− buildTest "Test 4" [1,2,3,4] do
51+ buildTest "Test 4" [ 1, 2, 3, 4 ] do
4652 b1 <- Buff <$> encodeInt8 1
4753 b2 <- Buff <$> encodeInt8 2
4854 b3 <- Buff <$> encodeInt8 3
4955 b4 <- Buff <$> encodeInt8 4
5056 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
5157
52− buildTest "Test 5" [1,2,3,4] do
58+ buildTest "Test 5" [ 1, 2, 3, 4 ] do
5359 b1 <- Buff <$> encodeInt8 1
5460 b2 <- Buff <$> encodeInt8 2
5561 b3 <- Buff <$> encodeInt8 3
5662 b4 <- Buff <$> encodeInt8 4
5763 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
5864
59− buildTest "Test 6" [1,2,3,4] do
65+ buildTest "Test 6" [ 1, 2, 3, 4 ] do
6066 b1 <- Buff <$> encodeInt8 1
6167 b2 <- Buff <$> encodeInt8 2
6268 b3 <- Buff <$> encodeInt8 3
6369 b4 <- Buff <$> encodeInt8 4
6470 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
6571
66− buildTest "Test 6" [1,2,3,4,5,6,7,8] do
72+ buildTest "Test 6" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
6773 b1 <- Buff <$> encodeInt8 1
6874 b2 <- Buff <$> encodeInt8 2
6975 b3 <- Buff <$> encodeInt8 3
@@ -73,9 +79,11 @@ main = do
7379 b7 <- Buff <$> encodeInt8 7
7480 b8 <- Buff <$> encodeInt8 8
7581 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
76− <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
82+ <> singleton b5
83+ <> (singleton b6 <> singleton b7)
84+ <> singleton b8
7785
78− buildTest "Test 7" [1,2,3,4,5,6,7,8] do
86+ buildTest "Test 7" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
7987 b1 <- Buff <$> encodeInt8 1
8088 b2 <- Buff <$> encodeInt8 2
8189 b3 <- Buff <$> encodeInt8 3
@@ -85,16 +93,16 @@ main = do
8593 b7 <- Buff <$> encodeInt8 7
8694 b8 <- Buff <$> encodeInt8 8
8795 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
88− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
96+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
8997
90− buildTest "Test 8" [1,2,3,4] do
98+ buildTest "Test 8" [ 1, 2, 3, 4 ] do
9199 b1 <- Buff <$> encodeInt8 1
92100 b2 <- Buff <$> encodeInt8 2
93101 b3 <- Buff <$> encodeInt8 3
94102 b4 <- Buff <$> encodeInt8 4
95103 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
96104
97− putTest "Test 9" [1,2,2,3,4] do
105+ putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
98106 x <- subBuilder do
99107 putInt8 3
100108 putInt8 4
@@ -103,7 +111,7 @@ main = do
103111 putInt8 $ length x
104112 tell x
105113
106− buildTest "Test 10" [1,2,3,4,5,6,7,8] do
114+ buildTest "Test 10" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
107115 b1 <- View <$> DV.whole <$> encodeInt8 1
108116 b2 <- View <$> DV.whole <$> encodeInt8 2
109117 b3 <- View <$> DV.whole <$> encodeInt8 3
@@ -113,8 +121,26 @@ main = do
113121 b7 <- View <$> DV.whole <$> encodeInt8 7
114122 b8 <- View <$> DV.whole <$> encodeInt8 8
115123 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
116− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
124+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
117125
118126 let stackblower = Array.replicate 20000 2
119127 putTest "Stack test" stackblower do
120128 foldRecM (\_ x -> putInt8 x) unit stackblower
129+
130+ do
131+ let
132+ putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit
133+ putStringUtf8 s = do
134+ textEncoder <- liftEffect TextEncoder.new
135+ let stringbuf = buffer $ encode s textEncoder
136+ -- Put a 32-bit big-endian length prefix for the length of the utf8 string, in bytes.
137+ putInt32be $ byteLength stringbuf
138+ putArrayBuffer stringbuf
139+
140+ arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
141+ view :: Int8Array <- AV.whole arraybuffer
142+ viewarray <- AV.toArray view
143+ assertEqual' "utf-8 test"
144+ { actual: viewarray
145+ , expected: [ 0, 0, 0, 4, -16, -97, -90, -99 ]
146+ }