80d0b93 · rowtype-yoga/purescript-arraybuffer-builder

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

on master help sign in

Stack-safe foldl, foldM

80d0b93James Brock5 years ago

CHANGELOG.md+5−1

compare with master

unifiedsplit

@@ -1,8 +1,12 @@

1# Changelog

3−## v3.0.0 2022-04-13

3+## v3.0.0 2022-04-21

5Build for PureScript v0.15.

7+Added `MonadRec` constraint to `execPut`, `execPutM`, `foldl`, `foldM`,

8+they are now stack-safe.

6## v2.1.0 2021-07-22

10## v2.1.0 2021-07-22

8Renamed `Data.ArrayBuffer.Internal.Bytes` and exported

12Renamed `Data.ArrayBuffer.Internal.Bytes` and exported

README.md+40−21

@@ -3,25 +3,18 @@

3[![CI](https://github.com/jamesdbrock/purescript-arraybuffer-builder/workflows/CI/badge.svg?branch=master)](https://github.com/jamesdbrock/purescript-arraybuffer-builder/actions)

4[![Pursuit](http://pursuit.purescript.org/packages/purescript-arraybuffer-builder/badge)](http://pursuit.purescript.org/packages/purescript-arraybuffer-builder/)

7+[`ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)

6−`ArrayBuffer` serialization in the “builder monoid” and “builder monad” style.

8+serialization in the “builder monoid” and “builder monad” style.

7−In this style, we build up serialized data structures by `append`ing to

9+In this style, we build up serialized data structures by `tell`ing to

8−a monoid in a Writer monad with do-notation. This style of serialization

10+a `Writer` monad with `do`-notation. This style of serialization

9has been used for a long time and we [insist that it works really well](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design).

11has been used for a long time and we [insist that it works really well](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design).

11This package provides a `Builder` monoid and a `PutM` monad which are roughly

13This package provides a `Builder` monoid and a `PutM` monad which are roughly

12equivalent to types of the same name in the Haskell

14equivalent to types of the same name in the Haskell

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

15+[__Data.Binary.Put__](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)

14module.

16module.

16−This package defines

17−[no typeclasses](http://code.slipthrough.net/2018/03/13/thoughts-on-typeclass-codecs/).

18−Typeclass-based

19−serialization/deserialization generally assumes that we are round-tripping

20−some data structures out to storage and then back into our program.

21−This package is designed for the case in which we are serializing some data

22−to be sent to another program which expects a serialization format

23−that we don't control.

24−

25## Usage Examples

18## Usage Examples

27All `ArrayBuffer` building must occur in `Effect`.

20All `ArrayBuffer` building must occur in `Effect`.

@@ -45,7 +38,7 @@ IEEE-754 double-precision floats.

45import Data.ArrayBuffer.Builder (execPut, putFloat64be)

38import Data.ArrayBuffer.Builder (execPut, putFloat64be)

47do

40do

48− arraybuffer :: ArrayBuffer <- execPut $ do

41+ arraybuffer :: ArrayBuffer <- execPut do

49 putFloat64be 1.0

42 putFloat64be 1.0

50 putFloat64be 2.0

43 putFloat64be 2.0

51 putFloat64be 3.0

44 putFloat64be 3.0

@@ -65,7 +58,7 @@ import Data.ArrayBuffer.Typed (buffer)

65import Data.TextEncoding (encodeUtf8)

58import Data.TextEncoding (encodeUtf8)

66import Data.ArrayBuffer.ArrayBuffer (byteLength)

59import Data.ArrayBuffer.ArrayBuffer (byteLength)

68−putStringUtf8 :: forall m. (MonadEffect m) => String -> PutM m Unit

61+putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit

69putStringUtf8 s = do

62putStringUtf8 s = do

70 let stringbuf = buffer $ encodeUtf8 s

63 let stringbuf = buffer $ encodeUtf8 s

71 -- Put a 32-bit big-endian length prefix for the length of the utf8 string, in bytes.

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

@@ -90,7 +83,7 @@ import Data.ArrayBuffer.Builder (execPut, putInt32be)

90import Data.Foldable (traverse_)

83import Data.Foldable (traverse_)

91import Data.Array (length)

84import Data.Array (length)

93−putArrayInt32 :: forall m. (MonadEffect m) => Array Int -> PutM m Unit

86+putArrayInt32 :: forall m. MonadEffect m => Array Int -> PutM m Unit

94putArrayInt32 xs = do

87putArrayInt32 xs = do

95 -- Put a 64-bit big-endian length prefix for the length of the array.

88 -- Put a 64-bit big-endian length prefix for the length of the array.

96 putInt32be 0

89 putInt32be 0

@@ -101,6 +94,28 @@ do

101 arraybuffer <- execPut $ putArrayInt32 [1,2,3]

94 arraybuffer <- execPut $ putArrayInt32 [1,2,3]

102```

95```

103

97+### Serialize an `Array Int` stack-safe

98+

99+Stack-safe version of the `putArrayInt32` function above. For stack-safety

100+we use `foldRecM` instead of `traverse_` because `foldRecM` has a `MonadRec`

101+constraint which makes it stack-safe.

102+

103+```purescript

104+import Data.Array (foldRecM)

105+

106+putArrayInt32 :: forall m. MonadEffect m => MonadRec m => Array Int -> PutM m Unit

107+putArrayInt32 xs = do

108+ -- Put a 64-bit big-endian length prefix for the length of the array.

109+ putInt32be 0

110+ putInt32be $ length xs

111+ foldRecM (\_ x -> putInt32be x) unit xs

112+```

113+

114+## Stack-safety

115+

116+This package will always be stack-safe if all of the functions called inside

117+of the `PutM` builder expression are stack-safe.

118+

104## Deserialization

119## Deserialization

105

120

106This package is only for writing `ArrayBuffer`s, not reading them.

121This package is only for writing `ArrayBuffer`s, not reading them.

@@ -108,13 +123,17 @@ See

108[__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)

123[__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)

109for a way to deserialize from `ArrayBuffer` back to Purescript data.

124for a way to deserialize from `ArrayBuffer` back to Purescript data.

110

125

111−## References

112−

113−* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)

114−

115## Alternative packages for serializing to an `ArrayBuffer`

126## Alternative packages for serializing to an `ArrayBuffer`

116

127

117* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)

128* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)

118* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)

129* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)

119* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)

130* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)

120−* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)

131+* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)

132+

133+## Development

134+

135+To run the tests,

136+

137+```shell

138+spago -x test.dhall test

139+```

spago.dhall+4

@@ -4,12 +4,16 @@

4, dependencies =

5 [ "effect"

6 , "float32"

7+ , "identity"

8+ , "lists"

7 , "maybe"

9 , "maybe"

10+ , "newtype"

8 , "prelude"

11 , "prelude"

9 , "transformers"

12 , "transformers"

10 , "uint"

13 , "uint"

11 , "arraybuffer-types"

14 , "arraybuffer-types"

12 , "arraybuffer"

15 , "arraybuffer"

16+ , "tailrec"

13 ]

17 ]

14, packages = ./packages.dhall

18, packages = ./packages.dhall

15, sources = [ "src/**/*.purs" ]

19, sources = [ "src/**/*.purs" ]

src/Data/ArrayBuffer/Builder.purs+4−3

@@ -38,6 +38,7 @@ where

39import Prelude

41+import Control.Monad.Rec.Class (class MonadRec)

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

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

42import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))

43import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))

43import Data.ArrayBuffer.Builder.Internal as Internal

44import Data.ArrayBuffer.Builder.Internal as Internal

@@ -58,11 +59,11 @@ type PutM = WriterT Builder

58-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.

59-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.

59type Put = PutM Effect

60type Put = PutM Effect

61−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*

62+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.

62−execPutM :: forall m. MonadEffect m => PutM m Unit -> m ArrayBuffer

63+execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer

63execPutM = Internal.execBuilder <=< execWriterT

64execPutM = Internal.execBuilder <=< execWriterT

65−-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)*

66+-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.

66execPut :: Put Unit -> Effect ArrayBuffer

67execPut :: Put Unit -> Effect ArrayBuffer

67execPut = execPutM

68execPut = execPutM

src/Data/ArrayBuffer/Internal.purs+25−9

@@ -109,12 +109,16 @@ where

109

110import Prelude

111

112+import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)

112import Data.ArrayBuffer.ArrayBuffer as AB

113import Data.ArrayBuffer.ArrayBuffer as AB

113import Data.ArrayBuffer.DataView as DV

114import Data.ArrayBuffer.DataView as DV

114import Data.ArrayBuffer.Typed as AT

115import Data.ArrayBuffer.Typed as AT

115import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)

116import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)

116import Data.Float32 (Float32)

117import Data.Float32 (Float32)

118+import Data.Identity (Identity)

119+import Data.List (List(..), uncons, (:))

117import Data.Maybe (Maybe(..))

120import Data.Maybe (Maybe(..))

121+import Data.Newtype (unwrap)

118import Data.UInt (UInt)

122import Data.UInt (UInt)

119import Effect (Effect)

123import Effect (Effect)

120import Effect.Class (class MonadEffect, liftEffect)

124import Effect.Class (class MonadEffect, liftEffect)

@@ -198,15 +202,27 @@ infixl 5 append as <>>

198instance monoidBuilder :: Monoid Builder where

202instance monoidBuilder :: Monoid Builder where

199 mempty = Null

203 mempty = Null

200

204

201−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.

205+-- | Stack-safe `foldl` over a `Builder`. *O(n)*

202−foldl :: forall b. (b -> DataBuff -> b) -> b -> Builder -> b

206+foldl :: forall a. (a -> DataBuff -> a) -> a -> Builder -> a

203−foldl _ a Null = a

207+foldl f a0 b = (unwrap :: Identity a -> a) $ foldM (\a' b' -> pure (f a' b')) a0 b

204−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r

205

208

206−-- | Monomorphic foldM copied from

209+-- | Stack-safe `foldM` over a `Builder`. *O(n)*.

207−-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)

208−foldM :: forall b m. (Monad m) => (b -> DataBuff -> m b) -> b -> Builder -> m b

210+foldM :: forall m a. MonadRec m => (a -> DataBuff -> m a) -> a -> Builder -> m a

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

211+-- The Art of Computer Programming 2.3.1

212+-- Inorder traversal using a stack

213+-- https://yuyuan.org/MorrisAlgorithm/

214+foldM f a0 b = tailRecM outer {p: b, stack: Nil, accum: a0}

215+ where

216+ outer {p,stack,accum} = do

217+ stack' <- tailRecM inner {p_:p,stack_:stack}

218+ case uncons stack' of

219+ Nothing -> pure $ Done accum

220+ Just {head: Node _ x r, tail} -> do

221+ accum' <- f accum x

222+ pure $ Loop {p: r, stack: tail, accum: accum'}

223+ Just {head:Null} -> pure $ Done accum

224+ inner {p_:Null,stack_} = pure $ Done stack_

225+ inner {p_: n@(Node l _ _), stack_} = pure $ Loop {p_: l, stack_: n:stack_}

210

226

211-- | Construct a `Builder` with a single `DataBuff`. *O(1)*

227-- | Construct a `Builder` with a single `DataBuff`. *O(1)*

212singleton :: DataBuff -> Builder

228singleton :: DataBuff -> Builder

@@ -229,7 +245,7 @@ snoc :: Builder -> DataBuff -> Builder

229snoc bs x = Node bs x Null

245snoc bs x = Node bs x Null

230

246

231-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*

247-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*

232−execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer

248+execBuilder :: forall m. MonadEffect m => MonadRec m => Builder -> m ArrayBuffer

233execBuilder bldr = do

249execBuilder bldr = do

234 let buflen = length bldr

250 let buflen = length bldr

235 -- Allocate the final ArrayBuffer

251 -- Allocate the final ArrayBuffer

test.dhall+5−2

@@ -12,5 +12,8 @@ let conf = ./spago.dhall

13in conf //

14 { sources = conf.sources # [ "test/**/*.purs" ]

15− , dependencies = conf.dependencies # [ "assert" ]

15+ , dependencies = conf.dependencies #

16+ [ "assert"

17+ , "arrays"

18+ ]

16− }

19+ }

test/Main.purs+20−14

@@ -1,15 +1,18 @@

1module Test.Main where

3−import Data.ArrayBuffer.Builder

3+import Prelude

5+import Control.Monad.Rec.Class (Step(..), tailRecM)

5import Control.Monad.Writer.Trans (tell)

6import Control.Monad.Writer.Trans (tell)

7+import Data.Array (foldRecM)

8+import Data.Array as Array

9+import Data.ArrayBuffer.Builder (Builder, DataBuff(..), PutM, execPut, putInt16be, putInt32le, putInt8, subBuilder)

6import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))

10import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))

7import Data.ArrayBuffer.DataView as DV

11import Data.ArrayBuffer.DataView as DV

8import Data.ArrayBuffer.Typed as AT

12import Data.ArrayBuffer.Typed as AT

9import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)

13import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)

10import Data.UInt as UInt

14import Data.UInt as UInt

11import Effect (Effect)

15import Effect (Effect)

12−import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))

13import Test.Assert (assertEqual')

16import Test.Assert (assertEqual')

15asBytes :: ArrayBuffer -> Effect (Array Int)

18asBytes :: ArrayBuffer -> Effect (Array Int)

@@ -29,39 +32,39 @@ buildTest label expected bldr = do

30main :: Effect Unit

33main :: Effect Unit

31main = do

34main = do

32− putTest "Test 0" [6,7,8] $ do

35+ putTest "Test 0" [6,7,8] do

33 putInt8 6

36 putInt8 6

34 putInt8 7

37 putInt8 7

35 putInt8 8

38 putInt8 8

37− putTest "Test 1" [255,254] $ do

40+ putTest "Test 1" [255,254] do

38 putInt16be (-2)

41 putInt16be (-2)

40− putTest "Test 3" [3,0,0,0] $ do

43+ putTest "Test 3" [3,0,0,0] do

41 putInt32le 3

44 putInt32le 3

43− buildTest "Test 4" [1,2,3,4] $ do

46+ buildTest "Test 4" [1,2,3,4] do

44 b1 <- Buff <$> encodeInt8 1

47 b1 <- Buff <$> encodeInt8 1

45 b2 <- Buff <$> encodeInt8 2

48 b2 <- Buff <$> encodeInt8 2

46 b3 <- Buff <$> encodeInt8 3

49 b3 <- Buff <$> encodeInt8 3

47 b4 <- Buff <$> encodeInt8 4

50 b4 <- Buff <$> encodeInt8 4

48 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4

51 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4

50− buildTest "Test 5" [1,2,3,4] $ do

53+ buildTest "Test 5" [1,2,3,4] do

51 b1 <- Buff <$> encodeInt8 1

54 b1 <- Buff <$> encodeInt8 1

52 b2 <- Buff <$> encodeInt8 2

55 b2 <- Buff <$> encodeInt8 2

53 b3 <- Buff <$> encodeInt8 3

56 b3 <- Buff <$> encodeInt8 3

54 b4 <- Buff <$> encodeInt8 4

57 b4 <- Buff <$> encodeInt8 4

55 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4

58 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4

57− buildTest "Test 6" [1,2,3,4] $ do

60+ buildTest "Test 6" [1,2,3,4] do

58 b1 <- Buff <$> encodeInt8 1

61 b1 <- Buff <$> encodeInt8 1

59 b2 <- Buff <$> encodeInt8 2

62 b2 <- Buff <$> encodeInt8 2

60 b3 <- Buff <$> encodeInt8 3

63 b3 <- Buff <$> encodeInt8 3

61 b4 <- Buff <$> encodeInt8 4

64 b4 <- Buff <$> encodeInt8 4

62 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4

65 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4

64− buildTest "Test 6" [1,2,3,4,5,6,7,8] $ do

67+ buildTest "Test 6" [1,2,3,4,5,6,7,8] do

65 b1 <- Buff <$> encodeInt8 1

68 b1 <- Buff <$> encodeInt8 1

66 b2 <- Buff <$> encodeInt8 2

69 b2 <- Buff <$> encodeInt8 2

67 b3 <- Buff <$> encodeInt8 3

70 b3 <- Buff <$> encodeInt8 3

@@ -73,7 +76,7 @@ main = do

73 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4

76 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4

74 <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8

77 <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8

76− buildTest "Test 7" [1,2,3,4,5,6,7,8] $ do

79+ buildTest "Test 7" [1,2,3,4,5,6,7,8] do

77 b1 <- Buff <$> encodeInt8 1

80 b1 <- Buff <$> encodeInt8 1

78 b2 <- Buff <$> encodeInt8 2

81 b2 <- Buff <$> encodeInt8 2

79 b3 <- Buff <$> encodeInt8 3

82 b3 <- Buff <$> encodeInt8 3

@@ -85,15 +88,15 @@ main = do

85 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))

88 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))

86 <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))

89 <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))

88− buildTest "Test 8" [1,2,3,4] $ do

91+ buildTest "Test 8" [1,2,3,4] do

89 b1 <- Buff <$> encodeInt8 1

92 b1 <- Buff <$> encodeInt8 1

90 b2 <- Buff <$> encodeInt8 2

93 b2 <- Buff <$> encodeInt8 2

91 b3 <- Buff <$> encodeInt8 3

94 b3 <- Buff <$> encodeInt8 3

92 b4 <- Buff <$> encodeInt8 4

95 b4 <- Buff <$> encodeInt8 4

93 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))

96 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))

95− putTest "Test 9" [1,2,2,3,4] $ do

98+ putTest "Test 9" [1,2,2,3,4] do

96− x <- subBuilder $ do

99+ x <- subBuilder do

97 putInt8 3

100 putInt8 3

98 putInt8 4

101 putInt8 4

99 putInt8 1

102 putInt8 1

@@ -101,7 +104,7 @@ main = do

101 putInt8 $ length x

104 putInt8 $ length x

102 tell x

105 tell x

103

106

104− buildTest "Test 10" [1,2,3,4,5,6,7,8] $ do

107+ buildTest "Test 10" [1,2,3,4,5,6,7,8] do

105 b1 <- View <$> DV.whole <$> encodeInt8 1

108 b1 <- View <$> DV.whole <$> encodeInt8 1

106 b2 <- View <$> DV.whole <$> encodeInt8 2

109 b2 <- View <$> DV.whole <$> encodeInt8 2

107 b3 <- View <$> DV.whole <$> encodeInt8 3

110 b3 <- View <$> DV.whole <$> encodeInt8 3

@@ -113,3 +116,6 @@ main = do

113 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))

116 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))

114 <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))

117 <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))

115

118

119+ let stackblower = Array.replicate 20000 2

120+ putTest "Stack test" stackblower do

121+ foldRecM (\_ x -> putInt8 x) unit stackblower