@@ -3,39 +3,52 @@
33-- | You almost never need to import this module.
44-- | See package README for explanation.
55module Protobuf.Decode
6−( double
7−, float
8−, int32
9−, int64
10−, uint32
11−, uint64
12−, sint32
13−, sint64
14−, fixed32
15−, fixed64
16−, sfixed32
17−, sfixed64
18−, bool
19−, string
20−, bytes
21−, module Protobuf.Decode32
22−, module Protobuf.Decode64
23−) where
6+ ( double
7+ , doubleArray
8+ , float
9+ , floatArray
10+ , int32
11+ , int64
12+ , uint32
13+ , uint64
14+ , sint32
15+ , sint64
16+ , fixed32
17+ , fixed32Array
18+ , fixed64
19+ , fixed64Array
20+ , sfixed32
21+ , sfixed32Array
22+ , sfixed64
23+ , sfixed64Array
24+ , bool
25+ , string
26+ , bytes
27+ , module Protobuf.Decode32
28+ , module Protobuf.Decode64
29+ ) where
2430
2531import Prelude
26−
32+import Control.Apply (lift2)
33+import Control.Monad.Except (ExceptT(..))
34+import Control.Monad.State (StateT(..))
2735import Control.Monad.Trans.Class (lift)
2836import Data.ArrayBuffer.ArrayBuffer as AB
37+import Data.ArrayBuffer.DataView (AProxy(..), getFloat32le, getFloat64le, getInt32le, getUint32le)
2938import Data.ArrayBuffer.DataView as DV
3039import Data.ArrayBuffer.Typed as AT
31−import Data.ArrayBuffer.Types (DataView, Uint8Array)
40+import Data.ArrayBuffer.Types (ByteLength, ByteOffset, DataView, Uint8Array, kind ArrayViewType)
41+import Data.ArrayBuffer.Types as ArrayTypes
42+import Data.ArrayBuffer.ValueMapping (class BinaryValue, class BytesPerValue, class ShowArrayViewType)
3243import Data.Either (Either(..))
3344import Data.Float32 (Float32)
34−import Data.Int (Radix, radix, toStringAs)
3545import Data.Long.Internal (Long, Signed, Unsigned, fromLowHighBits, highBits, lowBits, unsignedToSigned)
36−import Data.Long.Internal as Long
37−import Data.Maybe (Maybe(..), fromJust)
46+import Data.Maybe (Maybe, fromJust)
47+import Data.String (joinWith)
48+import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
3849import Data.TextDecoding (decodeUtf8)
50+import Data.Tuple (Tuple(..))
51+import Data.Typelevel.Num (class Nat, D8, toInt')
3952import Data.UInt (UInt)
4053import Data.UInt as UInt
4154import Effect (Effect)
@@ -44,8 +57,10 @@ import Partial.Unsafe (unsafePartial)
4457import Protobuf.Common (Bytes(..))
4558import Protobuf.Decode32 (varint32, zigzag32, tag32)
4659import Protobuf.Decode64 (varint64, zigzag64)
47−import Text.Parsing.Parser (ParserT, fail)
60+import Text.Parsing.Parser (ParseError(..), ParseState(..), ParserT(..), fail)
4861import Text.Parsing.Parser.DataView as Parse
62+import Text.Parsing.Parser.Pos (Position(..))
63+import Type.Proxy (Proxy(..))
4964
5065-- | __double__
5166-- | [Scalar Value Type](https://developers.google.com/protocol-buffers/docs/proto3#scalar)
@@ -57,28 +72,135 @@ double = Parse.anyFloat64le
5772float :: forall m. MonadEffect m => ParserT DataView m Float32
5873float = Parse.anyFloat32le
5974
75+-- | __repeated packed float__
76+floatArray :: forall m. MonadEffect m => Int -> ParserT DataView m (Array Float32)
77+floatArray = typedArray (AProxy :: AProxy ArrayTypes.Float32) getFloat32le
78+
79+-- | __repeated packed double__
80+doubleArray :: forall m. MonadEffect m => Int -> ParserT DataView m (Array Number)
81+doubleArray = typedArray (AProxy :: AProxy ArrayTypes.Float64) getFloat64le
82+
83+-- | __repeated packed sfixed32__
84+sfixed32Array :: forall m. MonadEffect m => Int -> ParserT DataView m (Array Int)
85+sfixed32Array = typedArray (AProxy :: AProxy ArrayTypes.Int32) getInt32le
86+
87+foreign import data BigInt64 :: ArrayViewType
88+
89+instance bytesPerValueBigInt64 :: BytesPerValue BigInt64 D8
90+
91+instance binaryValueBigInt64 :: BinaryValue BigInt64 (Long Signed)
92+
93+instance showArrayViewBigInt64 :: ShowArrayViewType BigInt64 "long signed"
94+
95+getLongle :: DataView -> Int -> Effect (Maybe (Long Signed))
96+getLongle dv idx = do
97+ lo <- getInt32le dv idx
98+ hi <- getInt32le dv (idx + 4)
99+ pure $ lift2 fromLowHighBits lo hi
100+
101+-- | __repeated packed sfixed64__
102+sfixed64Array :: forall m. MonadEffect m => Int -> ParserT DataView m (Array (Long Signed))
103+sfixed64Array = typedArray (AProxy :: AProxy BigInt64) getLongle
104+
105+foreign import data BigUInt64 :: ArrayViewType
106+
107+instance bytesPerValueBigUInt64 :: BytesPerValue BigUInt64 D8
108+
109+instance binaryValueBigUInt64 :: BinaryValue BigUInt64 (Long Unsigned)
110+
111+instance showArrayViewBigUInt64 :: ShowArrayViewType BigUInt64 "long unsigned"
112+
113+getULongle :: DataView -> Int -> Effect (Maybe (Long Unsigned))
114+getULongle dv idx = do
115+ lo <- getInt32le dv idx
116+ hi <- getInt32le dv (idx + 4)
117+ pure $ lift2 fromLowHighBits lo hi
118+
119+-- | __repeated packed fixed32__
120+fixed32Array :: forall m. MonadEffect m => Int -> ParserT DataView m (Array UInt)
121+fixed32Array = typedArray (AProxy :: AProxy ArrayTypes.Uint32) getUint32le
122+
123+-- | __repeated packed fixed64__
124+fixed64Array :: forall m. MonadEffect m => Int -> ParserT DataView m (Array (Long Unsigned))
125+fixed64Array = typedArray (AProxy :: AProxy BigUInt64) getULongle
126+
127+foreign import _decodeArray ::
128+ forall t. (ByteOffset -> Effect t) -> Int -> Effect (Array t)
129+
130+-- | Parse a slice of the DataView to an Array given a parser for the
131+-- | individual elements
132+typedArray ::
133+ forall a m b t name.
134+ BinaryValue a t =>
135+ BytesPerValue a b =>
136+ ShowArrayViewType a name =>
137+ IsSymbol name =>
138+ Nat b =>
139+ MonadEffect m =>
140+ AProxy a ->
141+ (DataView -> ByteOffset -> Effect (Maybe t)) ->
142+ ByteLength ->
143+ ParserT DataView m (Array t)
144+typedArray _ decodeValue n =
145+ let
146+ byteSize = toInt' (Proxy :: Proxy b)
147+
148+ name = reflectSymbol (SProxy :: SProxy name)
149+ in
150+ do
151+ unless
152+ (n `mod` byteSize == 0)
153+ ( pure unit
154+ >>= \_ ->
155+ fail
156+ $ joinWith " "
157+ [ "byte length not a multiple of"
158+ , show byteSize
159+ , "when parsing"
160+ , name
161+ , "array"
162+ ]
163+ )
164+ ParserT $ ExceptT
165+ $ StateT \state@(ParseState s pos@(Position { line, column }) _) ->
166+ let
167+ pos' = Position { line, column: column + n }
168+
169+ -- we assume all indexing into the dataview will be valid given the
170+ -- check against the byteLength
171+ unsafeDecodeValue i =
172+ unsafePartial
173+ $ map fromJust
174+ $ decodeValue s ((i * byteSize) + column - 1)
175+ in
176+ if column + n - 1 > DV.byteLength s then
177+ pure (Tuple (Left (ParseError "index out of bounds" pos')) state)
178+ else do
179+ x <- liftEffect (_decodeArray unsafeDecodeValue (n `div` byteSize))
180+ pure (Tuple (pure x) (ParseState s pos' true))
181+
60182-- | __int32__
61183-- | [Scalar Value Type](https://developers.google.com/protocol-buffers/docs/proto3#scalar)
62184int32 :: forall m. MonadEffect m => ParserT DataView m Int
63185int32 = do
64186 n <- varint64
187+ -- But this is a problem with the Protobuf spec?
188+ -- “If you use int32 or int64 as the type for a negative number, the resulting
189+ -- varint is always ten bytes long”
190+ -- https://developers.google.com/protocol-buffers/docs/encoding#signed_integers
191+ -- So what are we supposed to do if the field type is int32 but the
192+ -- decoded varint is too big? There is no guarantee that either negative
193+ -- or positive numbers encoded as varints will be in range.
194+ -- I suppose we could check that the high bits are all 0
195+ -- for positive or all 1 for negative.
196+ -- The conformance tests seem to like it if we just throw away
197+ -- the hight bits. So that's what we'll do.
198+ --
199+ -- conformance checker hates this:
200+ -- case Long.toInt n of
201+ -- Nothing -> fail "int32 value out of range."
202+ -- Just x -> pure x
65203 pure $ lowBits n
66− -- But this is a problem with the Protobuf spec?
67− -- “If you use int32 or int64 as the type for a negative number, the resulting
68− -- varint is always ten bytes long”
69− -- https://developers.google.com/protocol-buffers/docs/encoding#signed_integers
70− -- So what are we supposed to do if the field type is int32 but the
71− -- decoded varint is too big? There is no guarantee that either negative
72− -- or positive numbers encoded as varints will be in range.
73− -- I suppose we could check that the high bits are all 0
74− -- for positive or all 1 for negative.
75− -- The conformance tests seem to like it if we just throw away
76− -- the hight bits. So that's what we'll do.
77− --
78− -- conformance checker hates this:
79− -- case Long.toInt n of
80− -- Nothing -> fail "int32 value out of range."
81− -- Just x -> pure x
82204
83205-- | __int64__
84206-- | [Scalar Value Type](https://developers.google.com/protocol-buffers/docs/proto3#scalar)
@@ -103,12 +225,6 @@ sint32 :: forall m. MonadEffect m => ParserT DataView m Int
103225sint32 = do
104226 n <- zigzag32 <$> varint32
105227 pure n
106− -- n <- zigzag64 <$> varint64
107− -- -- pure $ lowBits n
108− -- case Long.toInt n of
109− -- -- Nothing -> fail "sint32 value out of range."
110− -- Nothing -> fail $ "\nsint32 value out of range.\n lowBits " <> toStringAs (unsafePartial $ fromJust $ radix 16) (lowBits n) <> "\n highBits " <> toStringAs (unsafePartial $ fromJust $ radix 16) (highBits n)
111− -- Just x -> pure x
112228
113229-- | __sint64__
114230-- | [Scalar Value Type](https://developers.google.com/protocol-buffers/docs/proto3#scalar)
@@ -140,9 +256,10 @@ sfixed64 = fromLowHighBits <$> Parse.anyInt32le <*> Parse.anyInt32le
140256bool :: forall m. MonadEffect m => ParserT DataView m Boolean
141257bool = do
142258 x <- varint64
143− if lowBits x == 0 && highBits x == 0
144− then pure false
145− else pure true
259+ if lowBits x == 0 && highBits x == 0 then
260+ pure false
261+ else
262+ pure true
146263
147264-- | __string__
148265-- | [Scalar Value Type](https://developers.google.com/protocol-buffers/docs/proto3#scalar)
@@ -153,12 +270,15 @@ string = do
153270 case decodeUtf8 stringarray of
154271 Left err -> fail $ "string decodeUtf8 failed. " <> show err
155272 Right s -> pure s
156− where
273+ where
157274 mkTypedArray :: DataView -> Effect Uint8Array
158275 mkTypedArray dv = do
159− let buffer = DV.buffer dv
160− byteOffset = DV.byteOffset dv
161− byteLength = DV.byteLength dv
276+ let
277+ buffer = DV.buffer dv
278+
279+ byteOffset = DV.byteOffset dv
280+
281+ byteLength = DV.byteLength dv
162282 AT.part buffer byteOffset byteLength
163283
164284-- | __bytes__
@@ -167,8 +287,8 @@ bytes :: forall m. MonadEffect m => ParserT DataView m Bytes
167287bytes = do
168288 len <- UInt.toInt <$> varint32
169289 dv <- Parse.takeN len
170− let ab = DV.buffer dv
171− let begin = DV.byteOffset dv
290+ let
291+ ab = DV.buffer dv
292+ let
293+ begin = DV.byteOffset dv
172294 pure $ Bytes $ AB.slice begin (begin + len) ab
173−
174−