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