@@ -1,24 +1,16 @@
11module Test.Main where
22
3−import Prelude
3+import Data.ArrayBuffer.Builder
44
55import Control.Monad.Writer.Trans (tell)
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, (<>>))
6+import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, singleton_, (<>>))
117import Data.ArrayBuffer.DataView as DV
12−import Data.ArrayBuffer.Typed (buffer)
138import Data.ArrayBuffer.Typed as AT
14−import Data.ArrayBuffer.Typed as AV
15−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
9+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
1610import Data.UInt as UInt
1711import Effect (Effect)
18−import Effect.Class (class MonadEffect, liftEffect)
12+import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
1913import Test.Assert (assertEqual')
20−import Web.Encoding.TextEncoder (encode)
21−import Web.Encoding.TextEncoder as TextEncoder
2214
2315asBytes :: ArrayBuffer -> Effect (Array Int)
2416asBytes x = do
@@ -28,82 +20,80 @@ asBytes x = do
2820putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
2921putTest label expected put = do
3022 actual <- asBytes =<< execPut put
31− assertEqual' label { actual, expected }
23+ assertEqual' label {actual,expected}
3224
3325buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
3426buildTest label expected bldr = do
3527 actual <- asBytes =<< execBuilder =<< bldr
36− assertEqual' label { actual, expected }
28+ assertEqual' label {actual,expected}
3729
3830main :: Effect Unit
3931main = do
40− putTest "Test 0" [ 6, 7, 8 ] do
32+ putTest "Test 0" [6,7,8] $ do
4133 putInt8 6
4234 putInt8 7
4335 putInt8 8
4436
45− putTest "Test 1" [ 255, 254 ] do
37+ putTest "Test 1" [255,254] $ do
4638 putInt16be (-2)
4739
48− putTest "Test 3" [ 3, 0, 0, 0 ] do
40+ putTest "Test 3" [3,0,0,0] $ do
4941 putInt32le 3
5042
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
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
5648 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
5749
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
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
6355 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
6456
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
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
7062 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
7163
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
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
8173 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
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
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
9585 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
96− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
86+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
9787
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
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
10393 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
10494
105− putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
106− x <- subBuilder do
95+ putTest "Test 9" [1,2,2,3,4] $ do
96+ x <- subBuilder $ do
10797 putInt8 3
10898 putInt8 4
10999 putInt8 1
@@ -111,36 +101,15 @@ main = do
111101 putInt8 $ length x
112102 tell x
113103
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− }
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+