@@ -5,20 +5,14 @@ import Prelude
5import Control.Monad.Writer.Trans (tell)
5import Control.Monad.Writer.Trans (tell)
6import Data.Array (foldRecM)
6import Data.Array (foldRecM)
7import Data.Array as Array
7import Data.Array as Array
8−import Data.ArrayBuffer.ArrayBuffer (byteLength)
9−import Data.ArrayBuffer.Builder (Builder, DataBuff(..), PutM, execPut, putArrayBuffer, putInt16be, putInt32be, putInt32le, putInt8, subBuilder)
8+import Data.ArrayBuffer.Builder (Builder, DataBuff(..), PutM, execPut, putInt16be, putInt32le, putInt8, subBuilder)
10import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
9import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
11import Data.ArrayBuffer.DataView as DV
10import Data.ArrayBuffer.DataView as DV
12−import Data.ArrayBuffer.Typed (buffer)
13import Data.ArrayBuffer.Typed as AT
11import Data.ArrayBuffer.Typed as AT
14−import Data.ArrayBuffer.Typed as AV
12+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
15−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
16import Data.UInt as UInt
13import Data.UInt as UInt
17import Effect (Effect)
14import Effect (Effect)
18−import Effect.Class (class MonadEffect, liftEffect)
19import Test.Assert (assertEqual')
15import Test.Assert (assertEqual')
20−import Web.Encoding.TextEncoder (encode)
21−import Web.Encoding.TextEncoder as TextEncoder
23asBytes :: ArrayBuffer -> Effect (Array Int)
17asBytes :: ArrayBuffer -> Effect (Array Int)
24asBytes x = do
18asBytes x = do
@@ -28,48 +22,48 @@ asBytes x = do
28putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
22putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
29putTest label expected put = do
23putTest label expected put = do
30 actual <- asBytes =<< execPut put
24 actual <- asBytes =<< execPut put
31− assertEqual' label { actual, expected }
25+ assertEqual' label {actual,expected}
33buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
27buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
34buildTest label expected bldr = do
28buildTest label expected bldr = do
35 actual <- asBytes =<< execBuilder =<< bldr
29 actual <- asBytes =<< execBuilder =<< bldr
36− assertEqual' label { actual, expected }
30+ assertEqual' label {actual,expected}
38main :: Effect Unit
32main :: Effect Unit
40− putTest "Test 0" [ 6, 7, 8 ] do
34+ putTest "Test 0" [6,7,8] do
45− putTest "Test 1" [ 255, 254 ] do
39+ putTest "Test 1" [255,254] do
46 putInt16be (-2)
40 putInt16be (-2)
48− putTest "Test 3" [ 3, 0, 0, 0 ] do
42+ putTest "Test 3" [3,0,0,0] do
49 putInt32le 3
43 putInt32le 3
51− buildTest "Test 4" [ 1, 2, 3, 4 ] do
45+ buildTest "Test 4" [1,2,3,4] do
52 b1 <- Buff <$> encodeInt8 1
46 b1 <- Buff <$> encodeInt8 1
53 b2 <- Buff <$> encodeInt8 2
47 b2 <- Buff <$> encodeInt8 2
54 b3 <- Buff <$> encodeInt8 3
48 b3 <- Buff <$> encodeInt8 3
55 b4 <- Buff <$> encodeInt8 4
49 b4 <- Buff <$> encodeInt8 4
56 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
50 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
58− buildTest "Test 5" [ 1, 2, 3, 4 ] do
52+ buildTest "Test 5" [1,2,3,4] do
59 b1 <- Buff <$> encodeInt8 1
53 b1 <- Buff <$> encodeInt8 1
60 b2 <- Buff <$> encodeInt8 2
54 b2 <- Buff <$> encodeInt8 2
61 b3 <- Buff <$> encodeInt8 3
55 b3 <- Buff <$> encodeInt8 3
62 b4 <- Buff <$> encodeInt8 4
56 b4 <- Buff <$> encodeInt8 4
63 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
57 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
65− buildTest "Test 6" [ 1, 2, 3, 4 ] do
59+ buildTest "Test 6" [1,2,3,4] do
66 b1 <- Buff <$> encodeInt8 1
60 b1 <- Buff <$> encodeInt8 1
67 b2 <- Buff <$> encodeInt8 2
61 b2 <- Buff <$> encodeInt8 2
68 b3 <- Buff <$> encodeInt8 3
62 b3 <- Buff <$> encodeInt8 3
69 b4 <- Buff <$> encodeInt8 4
63 b4 <- Buff <$> encodeInt8 4
70 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
64 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
72− buildTest "Test 6" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
66+ buildTest "Test 6" [1,2,3,4,5,6,7,8] do
73 b1 <- Buff <$> encodeInt8 1
67 b1 <- Buff <$> encodeInt8 1
74 b2 <- Buff <$> encodeInt8 2
68 b2 <- Buff <$> encodeInt8 2
75 b3 <- Buff <$> encodeInt8 3
69 b3 <- Buff <$> encodeInt8 3
@@ -79,11 +73,9 @@ main = do
79 b7 <- Buff <$> encodeInt8 7
73 b7 <- Buff <$> encodeInt8 7
80 b8 <- Buff <$> encodeInt8 8
74 b8 <- Buff <$> encodeInt8 8
81 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
75 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
83− <> (singleton b6 <> singleton b7)
76+ <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
86− buildTest "Test 7" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
78+ buildTest "Test 7" [1,2,3,4,5,6,7,8] do
87 b1 <- Buff <$> encodeInt8 1
79 b1 <- Buff <$> encodeInt8 1
88 b2 <- Buff <$> encodeInt8 2
80 b2 <- Buff <$> encodeInt8 2
89 b3 <- Buff <$> encodeInt8 3
81 b3 <- Buff <$> encodeInt8 3
@@ -93,16 +85,16 @@ main = do
93 b7 <- Buff <$> encodeInt8 7
85 b7 <- Buff <$> encodeInt8 7
94 b8 <- Buff <$> encodeInt8 8
86 b8 <- Buff <$> encodeInt8 8
95 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
87 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
96− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
88+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
98− buildTest "Test 8" [ 1, 2, 3, 4 ] do
90+ buildTest "Test 8" [1,2,3,4] do
99 b1 <- Buff <$> encodeInt8 1
91 b1 <- Buff <$> encodeInt8 1
100 b2 <- Buff <$> encodeInt8 2
92 b2 <- Buff <$> encodeInt8 2
101 b3 <- Buff <$> encodeInt8 3
93 b3 <- Buff <$> encodeInt8 3
102 b4 <- Buff <$> encodeInt8 4
94 b4 <- Buff <$> encodeInt8 4
103 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
95 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
105− putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
97+ putTest "Test 9" [1,2,2,3,4] do
106 x <- subBuilder do
98 x <- subBuilder do
107 putInt8 3
99 putInt8 3
108 putInt8 4
100 putInt8 4
@@ -111,7 +103,7 @@ main = do
111 putInt8 $ length x
103 putInt8 $ length x
114− buildTest "Test 10" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
106+ buildTest "Test 10" [1,2,3,4,5,6,7,8] do
115 b1 <- View <$> DV.whole <$> encodeInt8 1
107 b1 <- View <$> DV.whole <$> encodeInt8 1
116 b2 <- View <$> DV.whole <$> encodeInt8 2
108 b2 <- View <$> DV.whole <$> encodeInt8 2
117 b3 <- View <$> DV.whole <$> encodeInt8 3
109 b3 <- View <$> DV.whole <$> encodeInt8 3
@@ -121,26 +113,8 @@ main = do
121 b7 <- View <$> DV.whole <$> encodeInt8 7
113 b7 <- View <$> DV.whole <$> encodeInt8 7
122 b8 <- View <$> DV.whole <$> encodeInt8 8
114 b8 <- View <$> DV.whole <$> encodeInt8 8
123 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
115 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
124− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
116+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
126 let stackblower = Array.replicate 20000 2
118 let stackblower = Array.replicate 20000 2
127 putTest "Stack test" stackblower do
119 putTest "Stack test" stackblower do
128 foldRecM (\_ x -> putInt8 x) unit stackblower
120 foldRecM (\_ x -> putInt8 x) unit stackblower
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
140− arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
141− view :: Int8Array <- AV.whole arraybuffer
142− viewarray <- AV.toArray view
143− assertEqual' "utf-8 test"
145− , expected: [ 0, 0, 0, 4, -16, -97, -90, -99 ]