@@ -1,16 +1,24 @@
11module Test.Main where
22
3−import Data.ArrayBuffer.Builder
3+import Prelude
44
55import Control.Monad.Writer.Trans (tell)
6−import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, singleton_, (<>>))
6+import Data.Array (foldRecM)
7+import 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)
10+import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
711import Data.ArrayBuffer.DataView as DV
12+import Data.ArrayBuffer.Typed (buffer)
813import Data.ArrayBuffer.Typed as AT
9−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
14+import Data.ArrayBuffer.Typed as AV
15+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
1016import Data.UInt as UInt
1117import Effect (Effect)
12−import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
18+import Effect.Class (class MonadEffect, liftEffect)
1319import Test.Assert (assertEqual')
20+import Web.Encoding.TextEncoder (encode)
21+import Web.Encoding.TextEncoder as TextEncoder
1422
1523asBytes :: ArrayBuffer -> Effect (Array Int)
1624asBytes x = do
@@ -20,80 +28,82 @@ asBytes x = do
2028putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
2129putTest label expected put = do
2230 actual <- asBytes =<< execPut put
23− assertEqual' label {actual,expected}
31+ assertEqual' label { actual, expected }
2432
2533buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
2634buildTest label expected bldr = do
2735 actual <- asBytes =<< execBuilder =<< bldr
28− assertEqual' label {actual,expected}
36+ assertEqual' label { actual, expected }
2937
3038main :: Effect Unit
3139main = do
32− putTest "Test 0" [6,7,8] $ do
40+ putTest "Test 0" [ 6, 7, 8 ] do
3341 putInt8 6
3442 putInt8 7
3543 putInt8 8
3644
37− putTest "Test 1" [255,254] $ do
45+ putTest "Test 1" [ 255, 254 ] do
3846 putInt16be (-2)
3947
40− putTest "Test 3" [3,0,0,0] $ do
48+ putTest "Test 3" [ 3, 0, 0, 0 ] do
4149 putInt32le 3
4250
43− buildTest "Test 4" [1,2,3,4] $ do
44− b1 <- encodeInt8 1
45− b2 <- encodeInt8 2
46− b3 <- encodeInt8 3
47− b4 <- encodeInt8 4
51+ buildTest "Test 4" [ 1, 2, 3, 4 ] do
52+ b1 <- Buff <$> encodeInt8 1
53+ b2 <- Buff <$> encodeInt8 2
54+ b3 <- Buff <$> encodeInt8 3
55+ b4 <- Buff <$> encodeInt8 4
4856 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
4957
50− buildTest "Test 5" [1,2,3,4] $ do
51− b1 <- encodeInt8 1
52− b2 <- encodeInt8 2
53− b3 <- encodeInt8 3
54− b4 <- encodeInt8 4
58+ buildTest "Test 5" [ 1, 2, 3, 4 ] do
59+ b1 <- Buff <$> encodeInt8 1
60+ b2 <- Buff <$> encodeInt8 2
61+ b3 <- Buff <$> encodeInt8 3
62+ b4 <- Buff <$> encodeInt8 4
5563 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
5664
57− buildTest "Test 6" [1,2,3,4] $ do
58− b1 <- encodeInt8 1
59− b2 <- encodeInt8 2
60− b3 <- encodeInt8 3
61− b4 <- encodeInt8 4
65+ buildTest "Test 6" [ 1, 2, 3, 4 ] do
66+ b1 <- Buff <$> encodeInt8 1
67+ b2 <- Buff <$> encodeInt8 2
68+ b3 <- Buff <$> encodeInt8 3
69+ b4 <- Buff <$> encodeInt8 4
6270 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
6371
64− buildTest "Test 6" [1,2,3,4,5,6,7,8] $ do
65− b1 <- encodeInt8 1
66− b2 <- encodeInt8 2
67− b3 <- encodeInt8 3
68− b4 <- encodeInt8 4
69− b5 <- encodeInt8 5
70− b6 <- encodeInt8 6
71− b7 <- encodeInt8 7
72− b8 <- encodeInt8 8
72+ buildTest "Test 6" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
73+ b1 <- Buff <$> encodeInt8 1
74+ b2 <- Buff <$> encodeInt8 2
75+ b3 <- Buff <$> encodeInt8 3
76+ b4 <- Buff <$> encodeInt8 4
77+ b5 <- Buff <$> encodeInt8 5
78+ b6 <- Buff <$> encodeInt8 6
79+ b7 <- Buff <$> encodeInt8 7
80+ b8 <- Buff <$> encodeInt8 8
7381 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
74− <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
75−
76− buildTest "Test 7" [1,2,3,4,5,6,7,8] $ do
77− b1 <- encodeInt8 1
78− b2 <- encodeInt8 2
79− b3 <- encodeInt8 3
80− b4 <- encodeInt8 4
81− b5 <- encodeInt8 5
82− b6 <- encodeInt8 6
83− b7 <- encodeInt8 7
84− b8 <- encodeInt8 8
82+ <> singleton b5
83+ <> (singleton b6 <> singleton b7)
84+ <> singleton b8
85+
86+ buildTest "Test 7" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
87+ b1 <- Buff <$> encodeInt8 1
88+ b2 <- Buff <$> encodeInt8 2
89+ b3 <- Buff <$> encodeInt8 3
90+ b4 <- Buff <$> encodeInt8 4
91+ b5 <- Buff <$> encodeInt8 5
92+ b6 <- Buff <$> encodeInt8 6
93+ b7 <- Buff <$> encodeInt8 7
94+ b8 <- Buff <$> encodeInt8 8
8595 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
86− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
96+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
8797
88− buildTest "Test 8" [1,2,3,4] $ do
89− b1 <- encodeInt8 1
90− b2 <- encodeInt8 2
91− b3 <- encodeInt8 3
92− b4 <- encodeInt8 4
98+ buildTest "Test 8" [ 1, 2, 3, 4 ] do
99+ b1 <- Buff <$> encodeInt8 1
100+ b2 <- Buff <$> encodeInt8 2
101+ b3 <- Buff <$> encodeInt8 3
102+ b4 <- Buff <$> encodeInt8 4
93103 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
94104
95− putTest "Test 9" [1,2,2,3,4] $ do
96− x <- subBuilder $ do
105+ putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
106+ x <- subBuilder do
97107 putInt8 3
98108 putInt8 4
99109 putInt8 1
@@ -101,15 +111,36 @@ main = do
101111 putInt8 $ length x
102112 tell x
103113
104− buildTest "Test 10" [1,2,3,4,5,6,7,8] $ do
105− b1 <- DV.whole <$> encodeInt8 1
106− b2 <- DV.whole <$> encodeInt8 2
107− b3 <- DV.whole <$> encodeInt8 3
108− b4 <- DV.whole <$> encodeInt8 4
109− b5 <- DV.whole <$> encodeInt8 5
110− b6 <- DV.whole <$> encodeInt8 6
111− b7 <- DV.whole <$> encodeInt8 7
112− b8 <- DV.whole <$> encodeInt8 8
113− pure $ ((singleton_ b1 <> singleton_ b2) <> (singleton_ b3 <> singleton_ b4))
114− <> ((singleton_ b5 <> singleton_ b6) <> (singleton_ b7 <> singleton_ b8))
115−
114+ buildTest "Test 10" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
115+ b1 <- View <$> DV.whole <$> encodeInt8 1
116+ b2 <- View <$> DV.whole <$> encodeInt8 2
117+ b3 <- View <$> DV.whole <$> encodeInt8 3
118+ b4 <- View <$> DV.whole <$> encodeInt8 4
119+ b5 <- View <$> DV.whole <$> encodeInt8 5
120+ b6 <- View <$> DV.whole <$> encodeInt8 6
121+ b7 <- View <$> DV.whole <$> encodeInt8 7
122+ b8 <- View <$> DV.whole <$> encodeInt8 8
123+ pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
124+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
125+
126+ let stackblower = Array.replicate 20000 2
127+ putTest "Stack test" stackblower do
128+ 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+ }