682eff0 · rowtype-yoga/purescript-arraybuffer-builder

git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder

on master help sign in

first draft

682eff0James Brock6 years ago

spago.dhall+1−4

compare with master

unifiedsplit

@@ -4,10 +4,7 @@ You can edit this file as you like.

4-}

5{ name = "purescript-easy-nix-example"

6, dependencies =

7− [ "console"

8− , "effect"

9− , "prelude"

7+ [ "prelude"

10− , "psci-support"

11 , "arraybuffer-types"

8 , "arraybuffer-types"

12 , "arraybuffer"

9 , "arraybuffer"

13 ]

10 ]

src/Data/ArrayBuffer/Builder.purs+149−32

@@ -1,9 +1,11 @@

1−-- | `ArrayBuffer` serialization primitives. (Not typeclass-based.)

1+-- | `ArrayBuffer` serialization primitives in the “builder monad” style.

2−-- |

2+-- | An API on top of

3−-- | Provides a `Builder` monoid which is roughly equivalent to the

3+-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)

4−-- |

5−-- | Provides a `PutM` monad which is roughly equivalent to `PutM` from the

4+-- | which provides a `Builder` monoid and a `PutM` monad which are roughly

6−-- | Haskell __binary__ library.

5+-- | equivalent to the Haskell

6+-- | [`Data.Binary.Put`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)

7+-- | module.

8+-- | This library defines no typeclasses.

7-- |

9-- |

8-- | See purescript-parsing-dataview for deserialization.

10-- | See purescript-parsing-dataview for deserialization.

9-- |

11-- |

@@ -13,35 +15,67 @@

13-- |

15-- |

14-- | ## Serialize an integer

16-- | ## Serialize an integer

15-- |

17-- |

16−-- | Create a two-byte `ArrayBuffer` which contains the number *-2* encoded as big-endian 16-bit two's-complement.

18+-- | Create a two-byte `buf :: ArrayBuffer` which contains the number *-2* encoded as big-endian 16-bit two’s-complement.

17-- | ```purescript

19-- | ```purescript

18-- | buf <- execPut $ putInt32be (-2)

20-- | buf <- execPut $ putInt32be (-2)

19-- | ```

21-- | ```

20-- |

22-- |

21−-- | ## Serialize a UTF8 string

23+-- | ## Serialize a `String` as UTF8

22-- |

24-- |

23−-- | Create an `ArrayBuffer` which contains a `String` encoded as UTF8 in a way that's compatible

25+-- | Create a `buf :: ArrayBuffer` which contains a `String` encoded as UTF8 with a length prefix in a

24−-- | with the

26+-- | way that's compatible with the

25−-- | [`Binary.Put.putStringUtf8`](https://hackage.haskell.org/package/binary-0.8.7.0/docs/Data-Binary-Put.html#v:putStringUtf8)

27+-- | [`Binary.Put.putStringUtf8`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html#v:putStringUtf8)

26-- | function from the Haskell

28-- | function from the Haskell

27−-- | [__binary__](https://hackage.haskell.org/package/bytestring-0.10.10.0/docs/Data-ByteString-Builder-Prim.html#v:primMapListBounded)

29+-- | [__binary__](https://hackage.haskell.org/package/binary)

28-- | library.

30-- | library.

29−-- | Uses [`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/1.0.0/docs/Data.TextEncoding#v:encodeUtf8).

31+-- | Uses [`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/docs/Data.TextEncoding#v:encodeUtf8).

30-- | ```purescript

32-- | ```purescript

31-- | buf <- execPut $ do

33-- | buf <- execPut $ do

32−-- | stringbuf <- = Data.ArrayBuffer.Typed.buffer $ encodeUtf8 "ACAB"

34+-- | let stringbuf = Data.ArrayBuffer.Typed.buffer $ Data.TextEncoding.encodeUtf8 "Black Lives Matter"

33−-- | -- Adds a 64-bit length prefix for the length of the utf8 string, in bytes

35+-- | -- Put a 64-bit big-endian length prefix for the length of the utf8 string, in bytes.

34-- | putUint32be 0

36-- | putUint32be 0

35−-- | putUint32be $ Data.ArrayBuffer.byteLength stringbuf

37+-- | putUint32be $ Data.Uint.fromInt $ Data.ArrayBuffer.byteLength stringbuf

36-- | putArrayBuffer stringbuf

38-- | putArrayBuffer stringbuf

37-- | ```

39-- | ```

38−

40+-- |

41+-- | ## Serialize an `Array Int`

42+-- |

43+-- | Create a `buf :: ArrayBuffer` which encodes an `Array Int` with a length prefix in a

44+-- | way that's compatible with the

45+-- | [`Binary` instance for `[Int32]`](https://hackage.haskell.org/package/binary/docs/Data-Binary.html#t:Binary)

46+-- | from the Haskell

47+-- | [__binary__](https://hackage.haskell.org/package/binary)

48+-- | library.

49+-- | ```purescript

50+-- | let x = [1,2,3] :: Array Int

51+-- | buf <- execPut $

52+-- | -- Put a 64-bit big-endian length prefix for the length of the array, in bytes.

53+-- | putUint32be 0

54+-- | putUint32be $ Data.Uint.fromInt $ Data.Array.length x

55+-- | traverse_ putInt32be x

56+-- | ```

39module Build

57module Build

40( Builder

58( Builder

41, PutM

59, PutM

42, Put

60, Put

61+, execBuilder

43, execPutM

62, execPutM

44, execPut

63, execPut

64+, putArrayBuffer

65+, putUint8

66+, putInt8

67+, putUint16be

68+, putUint16le

69+, putInt16be

70+, putInt16le

71+, putUint32be

72+, putUint32le

73+, putInt32be

74+, putInt32le

75+, putFloat32be

76+, putFloat32le

77+, putFloat64be

78+, putFloat64le

45)

79)

46where

80where

@@ -49,6 +83,7 @@ import Prelude

49import Effect (Effect)

83import Effect (Effect)

50import Effect.Class (class MonadEffect, liftEffect)

84import Effect.Class (class MonadEffect, liftEffect)

51import Data.UInt (UInt)

85import Data.UInt (UInt)

86+import Data.Float32 (Float32)

52import Data.Maybe (Maybe(..))

87import Data.Maybe (Maybe(..))

53import Control.Monad.Writer.Trans (WriterT, execWriterT, tell)

88import Control.Monad.Writer.Trans (WriterT, execWriterT, tell)

@@ -92,7 +127,7 @@ type Put = PutM Effect

92-- |

127-- |

93-- |

128-- |

94-- | If a Builder is built entirely by `snoc`ing, it will look like a

129-- | If a Builder is built entirely by `snoc`ing, it will look like a

95−-- | left-only tree, a.k.a. a linked list.

130+-- | left-only binary tree, a.k.a. a linked list.

96-- |

131-- |

97-- | ```

132-- | ```

98-- | ⬤

133-- | ⬤

@@ -126,6 +161,21 @@ type Put = PutM Effect

126-- | leaves, and therefore I think has an *O(n log(n))* fold. This `Builder`

161-- | leaves, and therefore I think has an *O(n log(n))* fold. This `Builder`

127-- | has an *O(n)* fold.

162-- | has an *O(n)* fold.

128-- |

163-- |

164+-- | We hope that this implementation is fairly fast, but we

165+-- | haven't chosen this implementation because it's fast, we've chosen

166+-- | this implementation because it's simple. This library provides basic

167+-- | ArrayBuffer serialization with the familar “put monad” style.

168+-- | The only currently existing Purescript libary which does ArrayBuffer

169+-- | serialization is

170+-- | https://pursuit.purescript.org/packages/purescript-arraybuffer-class

171+-- | , and that library is heavily typeclass-based and designed

172+-- | for compatibility with the Haskell cereal library.

173+-- | If someone wants to create a fast Purescript ArrayBuffer serialization

174+-- | library, then they can benchmark against this one to prove that the new

175+-- | one is fast.

176+-- |

177+-- | One relatively cheap and simple performance improvement for this library would be to

178+-- | remove the Null constructor of Builder and instead use Javascript nulls.

129data Builder

179data Builder

130 = Node Builder ArrayBuffer Builder

180 = Node Builder ArrayBuffer Builder

131 | Null

181 | Null

@@ -150,7 +200,8 @@ foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b

150foldl f a Null = a

200foldl f a Null = a

151foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r

201foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r

152

202

153−-- | foldM : "Note this function is not generally stack-safe..." ???

203+-- | Monomorphic foldM copied from

204+-- | https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM

154foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b

205foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b

155foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)

206foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)

156

207

@@ -161,10 +212,9 @@ singleton buf = Node Null buf Null

161snoc :: Builder -> ArrayBuffer -> Builder

212snoc :: Builder -> ArrayBuffer -> Builder

162snoc bs x = Node bs x Null

213snoc bs x = Node bs x Null

163

214

164−-- | Run a computation to build an `ArrayBuffer` in any `MonadEffect`.

215+-- | Build a single `ArrayBuffer` from a `Builder`.

165−execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer

216+execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer

166−execPutM putmonad = do

217+execBuilder bldr = do

167− bldr <- execWriterT putmonad

168 let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr

218 let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr

169 -- Allocate the final ArrayBuffer

219 -- Allocate the final ArrayBuffer

170 buf <- liftEffect $ AB.empty buflen

220 buf <- liftEffect $ AB.empty buflen

@@ -173,15 +223,19 @@ execPutM putmonad = do

173 -- both ArrayBuffers as ArrayView (Typed Array).

223 -- both ArrayBuffers as ArrayView (Typed Array).

174 newview <- liftEffect (AT.whole buf :: Effect Uint8Array)

224 newview <- liftEffect (AT.whole buf :: Effect Uint8Array)

175 _ <- foldM

225 _ <- foldM

176− ( \offset a -> do

226+ ( \offset a -> do

177− let offset' = offset + AB.byteLength a

227+ let offset' = offset + AB.byteLength a

178− aview <- liftEffect (AT.whole a :: Effect Uint8Array)

228+ aview <- liftEffect (AT.whole a :: Effect Uint8Array)

179− _ <- liftEffect $ AT.setTyped newview (Just offset') aview

229+ _ <- liftEffect $ AT.setTyped newview (Just offset') aview

180− pure offset'

230+ pure offset'

181− ) 0 bldr

231+ ) 0 bldr

182 pure buf

232 pure buf

183

233

234+-- | Monad computation to build an `ArrayBuffer` in any `MonadEffect`.

235+execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer

236+execPutM = execBuilder <=< execWriterT

237+

184−-- | Run a computation to build an `ArrayBuffer` in the `Effect` monad.

238+-- | Monad computation to build an `ArrayBuffer` in the `Effect` monad.

185execPut :: Put Unit -> Effect ArrayBuffer

239execPut :: Put Unit -> Effect ArrayBuffer

186execPut = execPutM

240execPut = execPutM

187

241

@@ -196,6 +250,13 @@ putUint8 x = do

196 _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x

250 _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x

197 tell $ singleton buf

251 tell $ singleton buf

198

252

253+-- | Append an 8-bit two’s-complement signed integer (char) to the builder.

254+putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit

255+putInt8 x = do

256+ buf <- liftEffect $ AB.empty 1

257+ _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x

258+ tell $ singleton buf

259+

199-- | Append a 16-bit big-endian unsigned integer to the builder.

260-- | Append a 16-bit big-endian unsigned integer to the builder.

200putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit

261putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit

201putUint16be x = do

262putUint16be x = do

@@ -210,16 +271,72 @@ putUint16le x = do

210 _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x

271 _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x

211 tell $ singleton buf

272 tell $ singleton buf

212

273

213−-- | Append a 16-bit big-endian signed integer to the builder.

274+-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.

214putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit

275putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit

215putInt16be x = do

276putInt16be x = do

216 buf <- liftEffect $ AB.empty 2

277 buf <- liftEffect $ AB.empty 2

217 _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x

278 _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x

218 tell $ singleton buf

279 tell $ singleton buf

219

280

220−-- | Append a 16-bit little-endian signed integer to the builder.

281+-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.

221putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit

282putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit

222putInt16le x = do

283putInt16le x = do

223 buf <- liftEffect $ AB.empty 2

284 buf <- liftEffect $ AB.empty 2

224 _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x

285 _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x

286+ tell $ singleton buf

287+

288+-- | Append a 32-bit big-endian unsigned integer to the builder.

289+putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit

290+putUint32be x = do

291+ buf <- liftEffect $ AB.empty 4

292+ _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x

293+ tell $ singleton buf

294+

295+-- | Append a 32-bit little-endian unsigned integer to the builder.

296+putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit

297+putUint32le x = do

298+ buf <- liftEffect $ AB.empty 4

299+ _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x

300+ tell $ singleton buf

301+

302+-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.

303+putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit

304+putInt32be x = do

305+ buf <- liftEffect $ AB.empty 4

306+ _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x

307+ tell $ singleton buf

308+

309+-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.

310+putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit

311+putInt32le x = do

312+ buf <- liftEffect $ AB.empty 4

313+ _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x

314+ tell $ singleton buf

315+

316+-- | Append a 32-bit big-endian IEEE single-precision float to the builder.

317+putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit

318+putFloat32be x = do

319+ buf <- liftEffect $ AB.empty 4

320+ _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x

321+ tell $ singleton buf

322+

323+-- | Append a 32-bit little-endian IEEE single-precision float to the builder.

324+putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit

325+putFloat32le x = do

326+ buf <- liftEffect $ AB.empty 4

327+ _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x

328+ tell $ singleton buf

329+

330+-- | Append a 64-bit big-endian IEEE double-precision float to the builder.

331+putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit

332+putFloat64be x = do

333+ buf <- liftEffect $ AB.empty 8

334+ _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x

335+ tell $ singleton buf

336+

337+-- | Append a 64-bit little-endian IEEE double-precision float to the builder.

338+putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit

339+putFloat64le x = do

340+ buf <- liftEffect $ AB.empty 8

341+ _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x

225 tell $ singleton buf

342 tell $ singleton buf