{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Proto3.Wire.Decode
(
ParsedField(..)
, decodeWire
, Parser(..)
, RawPrimitive
, RawField
, RawMessage
, ParseError(..)
, foldFields
, parse
, bool
, int32
, int64
, uint32
, uint64
, sint32
, sint64
, enum
, byteString
, lazyByteString
, text
, packedVarints
, packedFixed32
, packedFixed64
, packedFloats
, packedDoubles
, fixed32
, fixed64
, sfixed32
, sfixed64
, float
, double
, at
, oneof
, one
, repeated
, embedded
, embedded'
, toMap
) where
import Control.Applicative
import Control.Arrow (first)
import Control.Exception ( Exception )
import Control.Monad ( msum, foldM )
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Foldable ( foldl' )
import qualified Data.IntMap.Strict as M
import Data.Maybe ( fromMaybe )
import Data.Monoid ( (<>) )
import Data.Serialize.Get ( Get, getWord8, getInt32le
, getInt64le, getWord32le, getWord64le
, runGet )
import Data.Serialize.IEEE754 ( getFloat32le, getFloat64le )
import Data.Text.Lazy ( Text, pack )
import Data.Text.Lazy.Encoding ( decodeUtf8' )
import qualified Data.Traversable as T
import Data.Int ( Int32, Int64 )
import Data.Word ( Word8, Word32, Word64 )
import Proto3.Wire.Class
import Proto3.Wire.Types
zigZagDecode :: (Num a, Bits a) => a -> a
zigZagDecode :: a -> a
zigZagDecode a
i = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
i Int
1 a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (-(a
i a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1))
data ParsedField = VarintField Word64
| Fixed32Field B.ByteString
| Fixed64Field B.ByteString
| LengthDelimitedField B.ByteString
deriving (Int -> ParsedField -> ShowS
[ParsedField] -> ShowS
ParsedField -> String
(Int -> ParsedField -> ShowS)
-> (ParsedField -> String)
-> ([ParsedField] -> ShowS)
-> Show ParsedField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedField] -> ShowS
$cshowList :: [ParsedField] -> ShowS
show :: ParsedField -> String
$cshow :: ParsedField -> String
showsPrec :: Int -> ParsedField -> ShowS
$cshowsPrec :: Int -> ParsedField -> ShowS
Show, ParsedField -> ParsedField -> Bool
(ParsedField -> ParsedField -> Bool)
-> (ParsedField -> ParsedField -> Bool) -> Eq ParsedField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsedField -> ParsedField -> Bool
$c/= :: ParsedField -> ParsedField -> Bool
== :: ParsedField -> ParsedField -> Bool
$c== :: ParsedField -> ParsedField -> Bool
Eq)
toMap :: [(FieldNumber, v)] -> M.IntMap [v]
toMap :: [(FieldNumber, v)] -> IntMap [v]
toMap [(FieldNumber, v)]
kvs0 = ([v] -> [v] -> [v]) -> [(Int, [v])] -> IntMap [v]
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
M.fromListWith [v] -> [v] -> [v]
forall a. Semigroup a => a -> a -> a
(<>) ([(Int, [v])] -> IntMap [v])
-> ([(FieldNumber, v)] -> [(Int, [v])])
-> [(FieldNumber, v)]
-> IntMap [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, v) -> (Int, [v])) -> [(Int, v)] -> [(Int, [v])]
forall a b. (a -> b) -> [a] -> [b]
map ((v -> [v]) -> (Int, v) -> (Int, [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v -> [v] -> [v]
forall a. a -> [a] -> [a]
:[])) ([(Int, v)] -> [(Int, [v])])
-> ([(FieldNumber, v)] -> [(Int, v)])
-> [(FieldNumber, v)]
-> [(Int, [v])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FieldNumber, v) -> (Int, v)) -> [(FieldNumber, v)] -> [(Int, v)]
forall a b. (a -> b) -> [a] -> [b]
map ((FieldNumber -> Int) -> (FieldNumber, v) -> (Int, v)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> (FieldNumber -> Word64) -> FieldNumber -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> Word64
getFieldNumber)) ([(FieldNumber, v)] -> IntMap [v])
-> [(FieldNumber, v)] -> IntMap [v]
forall a b. (a -> b) -> a -> b
$ [(FieldNumber, v)]
kvs0
decodeWire :: B.ByteString -> Either String [(FieldNumber, ParsedField)]
decodeWire :: ByteString -> Either String [(FieldNumber, ParsedField)]
decodeWire ByteString
bstr = ByteString
-> [(FieldNumber, ParsedField)]
-> Either String [(FieldNumber, ParsedField)]
drloop ByteString
bstr []
where
drloop :: ByteString
-> [(FieldNumber, ParsedField)]
-> Either String [(FieldNumber, ParsedField)]
drloop !ByteString
bs [(FieldNumber, ParsedField)]
xs | ByteString -> Bool
B.null ByteString
bs = [(FieldNumber, ParsedField)]
-> Either String [(FieldNumber, ParsedField)]
forall a b. b -> Either a b
Right ([(FieldNumber, ParsedField)]
-> Either String [(FieldNumber, ParsedField)])
-> [(FieldNumber, ParsedField)]
-> Either String [(FieldNumber, ParsedField)]
forall a b. (a -> b) -> a -> b
$ [(FieldNumber, ParsedField)] -> [(FieldNumber, ParsedField)]
forall a. [a] -> [a]
reverse [(FieldNumber, ParsedField)]
xs
drloop !ByteString
bs [(FieldNumber, ParsedField)]
xs | Bool
otherwise = do
(Word64
w, ByteString
rest) <- ByteString -> Either String (Word64, ByteString)
takeVarInt ByteString
bs
WireType
wt <- Word8 -> Either String WireType
gwireType (Word8 -> Either String WireType)
-> Word8 -> Either String WireType
forall a b. (a -> b) -> a -> b
$ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
7)
let fn :: Word64
fn = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
(ParsedField
res, ByteString
rest2) <- WireType -> ByteString -> Either String (ParsedField, ByteString)
takeWT WireType
wt ByteString
rest
ByteString
-> [(FieldNumber, ParsedField)]
-> Either String [(FieldNumber, ParsedField)]
drloop ByteString
rest2 ((Word64 -> FieldNumber
FieldNumber Word64
fn,ParsedField
res)(FieldNumber, ParsedField)
-> [(FieldNumber, ParsedField)] -> [(FieldNumber, ParsedField)]
forall a. a -> [a] -> [a]
:[(FieldNumber, ParsedField)]
xs)
eitherUncons :: B.ByteString -> Either String (Word8, B.ByteString)
eitherUncons :: ByteString -> Either String (Word8, ByteString)
eitherUncons = Either String (Word8, ByteString)
-> ((Word8, ByteString) -> Either String (Word8, ByteString))
-> Maybe (Word8, ByteString)
-> Either String (Word8, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Word8, ByteString)
forall a b. a -> Either a b
Left String
"failed to parse varint128") (Word8, ByteString) -> Either String (Word8, ByteString)
forall a b. b -> Either a b
Right (Maybe (Word8, ByteString) -> Either String (Word8, ByteString))
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Either String (Word8, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Word8, ByteString)
B.uncons
takeVarInt :: B.ByteString -> Either String (Word64, B.ByteString)
takeVarInt :: ByteString -> Either String (Word64, ByteString)
takeVarInt !ByteString
bs =
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> (Word64, ByteString) -> Either String (Word64, ByteString)
forall a b. b -> Either a b
Right (Word64
0, ByteString
B.empty)
Just (Word8
w1, ByteString
r1) -> do
if Word8
w1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1, ByteString
r1) else do
let val1 :: Word64
val1 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w1 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80)
(Word8
w2,ByteString
r2) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r1
if Word8
w2 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
7), ByteString
r2) else do
let val2 :: Word64
val2 = (Word64
val1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
7))
(Word8
w3,ByteString
r3) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r2
if Word8
w3 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
14), ByteString
r3) else do
let val3 :: Word64
val3 = (Word64
val2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w3 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
14))
(Word8
w4,ByteString
r4) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r3
if Word8
w4 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w4 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
21), ByteString
r4) else do
let val4 :: Word64
val4 = (Word64
val3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w4 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
21))
(Word8
w5,ByteString
r5) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r4
if Word8
w5 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val4 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
28), ByteString
r5) else do
let val5 :: Word64
val5 = (Word64
val4 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w5 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
28))
(Word8
w6,ByteString
r6) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r5
if Word8
w6 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val5 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w6 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
35), ByteString
r6) else do
let val6 :: Word64
val6 = (Word64
val5 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w6 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
35))
(Word8
w7,ByteString
r7) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r6
if Word8
w7 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val6 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w7 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
42), ByteString
r7) else do
let val7 :: Word64
val7 = (Word64
val6 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w7 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
42))
(Word8
w8,ByteString
r8) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r7
if Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val7 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
49), ByteString
r8) else do
let val8 :: Word64
val8 = (Word64
val7 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w8 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
49))
(Word8
w9,ByteString
r9) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r8
if Word8
w9 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w9 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56), ByteString
r9) else do
let val9 :: Word64
val9 = (Word64
val8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w9 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56))
(Word8
w10,ByteString
r10) <- ByteString -> Either String (Word8, ByteString)
eitherUncons ByteString
r9
if Word8
w10 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either String (Word64, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val9 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w10 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
63), ByteString
r10) else do
String -> Either String (Word64, ByteString)
forall a b. a -> Either a b
Left (String
"failed to parse varint128: too big; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
val6)
gwireType :: Word8 -> Either String WireType
gwireType :: Word8 -> Either String WireType
gwireType Word8
0 = WireType -> Either String WireType
forall (m :: * -> *) a. Monad m => a -> m a
return WireType
Varint
gwireType Word8
5 = WireType -> Either String WireType
forall (m :: * -> *) a. Monad m => a -> m a
return WireType
Fixed32
gwireType Word8
1 = WireType -> Either String WireType
forall (m :: * -> *) a. Monad m => a -> m a
return WireType
Fixed64
gwireType Word8
2 = WireType -> Either String WireType
forall (m :: * -> *) a. Monad m => a -> m a
return WireType
LengthDelimited
gwireType Word8
wt = String -> Either String WireType
forall a b. a -> Either a b
Left (String -> Either String WireType)
-> String -> Either String WireType
forall a b. (a -> b) -> a -> b
$ String
"wireType got unknown wire type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
wt
safeSplit :: Int -> B.ByteString -> Either String (B.ByteString, B.ByteString)
safeSplit :: Int -> ByteString -> Either String (ByteString, ByteString)
safeSplit !Int
i !ByteString
b | ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = String -> Either String (ByteString, ByteString)
forall a b. a -> Either a b
Left String
"failed to parse varint128: not enough bytes"
| Bool
otherwise = (ByteString, ByteString) -> Either String (ByteString, ByteString)
forall a b. b -> Either a b
Right ((ByteString, ByteString)
-> Either String (ByteString, ByteString))
-> (ByteString, ByteString)
-> Either String (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
i ByteString
b
takeWT :: WireType -> B.ByteString -> Either String (ParsedField, B.ByteString)
takeWT :: WireType -> ByteString -> Either String (ParsedField, ByteString)
takeWT WireType
Varint !ByteString
b = ((Word64, ByteString) -> (ParsedField, ByteString))
-> Either String (Word64, ByteString)
-> Either String (ParsedField, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64 -> ParsedField)
-> (Word64, ByteString) -> (ParsedField, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Word64 -> ParsedField
VarintField) (Either String (Word64, ByteString)
-> Either String (ParsedField, ByteString))
-> Either String (Word64, ByteString)
-> Either String (ParsedField, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String (Word64, ByteString)
takeVarInt ByteString
b
takeWT WireType
Fixed32 !ByteString
b = ((ByteString, ByteString) -> (ParsedField, ByteString))
-> Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> ParsedField)
-> (ByteString, ByteString) -> (ParsedField, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> ParsedField
Fixed32Field) (Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString))
-> Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Either String (ByteString, ByteString)
safeSplit Int
4 ByteString
b
takeWT WireType
Fixed64 !ByteString
b = ((ByteString, ByteString) -> (ParsedField, ByteString))
-> Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> ParsedField)
-> (ByteString, ByteString) -> (ParsedField, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> ParsedField
Fixed64Field) (Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString))
-> Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Either String (ByteString, ByteString)
safeSplit Int
8 ByteString
b
takeWT WireType
LengthDelimited ByteString
b = do
(!Word64
len, ByteString
rest) <- ByteString -> Either String (Word64, ByteString)
takeVarInt ByteString
b
((ByteString, ByteString) -> (ParsedField, ByteString))
-> Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> ParsedField)
-> (ByteString, ByteString) -> (ParsedField, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> ParsedField
LengthDelimitedField) (Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString))
-> Either String (ByteString, ByteString)
-> Either String (ParsedField, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Either String (ByteString, ByteString)
safeSplit (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len) ByteString
rest
data ParseError =
WireTypeError Text
|
BinaryError Text
|
EmbeddedError Text
(Maybe ParseError)
deriving (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show, ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq, Eq ParseError
Eq ParseError
-> (ParseError -> ParseError -> Ordering)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> ParseError)
-> (ParseError -> ParseError -> ParseError)
-> Ord ParseError
ParseError -> ParseError -> Bool
ParseError -> ParseError -> Ordering
ParseError -> ParseError -> ParseError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParseError -> ParseError -> ParseError
$cmin :: ParseError -> ParseError -> ParseError
max :: ParseError -> ParseError -> ParseError
$cmax :: ParseError -> ParseError -> ParseError
>= :: ParseError -> ParseError -> Bool
$c>= :: ParseError -> ParseError -> Bool
> :: ParseError -> ParseError -> Bool
$c> :: ParseError -> ParseError -> Bool
<= :: ParseError -> ParseError -> Bool
$c<= :: ParseError -> ParseError -> Bool
< :: ParseError -> ParseError -> Bool
$c< :: ParseError -> ParseError -> Bool
compare :: ParseError -> ParseError -> Ordering
$ccompare :: ParseError -> ParseError -> Ordering
$cp1Ord :: Eq ParseError
Ord)
instance Exception ParseError
newtype Parser input a = Parser { Parser input a -> input -> Either ParseError a
runParser :: input -> Either ParseError a }
deriving a -> Parser input b -> Parser input a
(a -> b) -> Parser input a -> Parser input b
(forall a b. (a -> b) -> Parser input a -> Parser input b)
-> (forall a b. a -> Parser input b -> Parser input a)
-> Functor (Parser input)
forall a b. a -> Parser input b -> Parser input a
forall a b. (a -> b) -> Parser input a -> Parser input b
forall input a b. a -> Parser input b -> Parser input a
forall input a b. (a -> b) -> Parser input a -> Parser input b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser input b -> Parser input a
$c<$ :: forall input a b. a -> Parser input b -> Parser input a
fmap :: (a -> b) -> Parser input a -> Parser input b
$cfmap :: forall input a b. (a -> b) -> Parser input a -> Parser input b
Functor
instance Applicative (Parser input) where
pure :: a -> Parser input a
pure = (input -> Either ParseError a) -> Parser input a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((input -> Either ParseError a) -> Parser input a)
-> (a -> input -> Either ParseError a) -> a -> Parser input a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseError a -> input -> Either ParseError a
forall a b. a -> b -> a
const (Either ParseError a -> input -> Either ParseError a)
-> (a -> Either ParseError a) -> a -> input -> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Parser input -> Either ParseError (a -> b)
p1 <*> :: Parser input (a -> b) -> Parser input a -> Parser input b
<*> Parser input -> Either ParseError a
p2 =
(input -> Either ParseError b) -> Parser input b
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((input -> Either ParseError b) -> Parser input b)
-> (input -> Either ParseError b) -> Parser input b
forall a b. (a -> b) -> a -> b
$ \input
input -> input -> Either ParseError (a -> b)
p1 input
input Either ParseError (a -> b)
-> Either ParseError a -> Either ParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> input -> Either ParseError a
p2 input
input
instance Monad (Parser input) where
Parser input -> Either ParseError a
p >>= :: Parser input a -> (a -> Parser input b) -> Parser input b
>>= a -> Parser input b
f = (input -> Either ParseError b) -> Parser input b
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((input -> Either ParseError b) -> Parser input b)
-> (input -> Either ParseError b) -> Parser input b
forall a b. (a -> b) -> a -> b
$ \input
input -> input -> Either ParseError a
p input
input Either ParseError a
-> (a -> Either ParseError b) -> Either ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser input b -> input -> Either ParseError b
forall input a. Parser input a -> input -> Either ParseError a
`runParser` input
input) (Parser input b -> Either ParseError b)
-> (a -> Parser input b) -> a -> Either ParseError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser input b
f
type RawPrimitive = ParsedField
type RawField = [RawPrimitive]
type RawMessage = M.IntMap RawField
foldFields :: M.IntMap (Parser RawPrimitive a, a -> acc -> acc)
-> acc
-> [(FieldNumber, ParsedField)]
-> Either ParseError acc
foldFields :: IntMap (Parser ParsedField a, a -> acc -> acc)
-> acc -> [(FieldNumber, ParsedField)] -> Either ParseError acc
foldFields IntMap (Parser ParsedField a, a -> acc -> acc)
parsers = (acc -> (FieldNumber, ParsedField) -> Either ParseError acc)
-> acc -> [(FieldNumber, ParsedField)] -> Either ParseError acc
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM acc -> (FieldNumber, ParsedField) -> Either ParseError acc
applyOne
where applyOne :: acc -> (FieldNumber, ParsedField) -> Either ParseError acc
applyOne acc
acc (FieldNumber
fn, ParsedField
field) =
case Int
-> IntMap (Parser ParsedField a, a -> acc -> acc)
-> Maybe (Parser ParsedField a, a -> acc -> acc)
forall a. Int -> IntMap a -> Maybe a
M.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> (FieldNumber -> Word64) -> FieldNumber -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> Word64
getFieldNumber (FieldNumber -> Int) -> FieldNumber -> Int
forall a b. (a -> b) -> a -> b
$ FieldNumber
fn) IntMap (Parser ParsedField a, a -> acc -> acc)
parsers of
Maybe (Parser ParsedField a, a -> acc -> acc)
Nothing -> acc -> Either ParseError acc
forall (f :: * -> *) a. Applicative f => a -> f a
pure acc
acc
Just (Parser ParsedField a
parser, a -> acc -> acc
apply) ->
case Parser ParsedField a -> ParsedField -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser ParsedField a
parser ParsedField
field of
Left ParseError
err -> ParseError -> Either ParseError acc
forall a b. a -> Either a b
Left ParseError
err
Right a
a -> acc -> Either ParseError acc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (acc -> Either ParseError acc) -> acc -> Either ParseError acc
forall a b. (a -> b) -> a -> b
$ a -> acc -> acc
apply a
a acc
acc
parse :: Parser RawMessage a -> B.ByteString -> Either ParseError a
parse :: Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage a
parser ByteString
bs = case ByteString -> Either String [(FieldNumber, ParsedField)]
decodeWire ByteString
bs of
Left String
err -> ParseError -> Either ParseError a
forall a b. a -> Either a b
Left (Text -> ParseError
BinaryError (String -> Text
pack String
err))
Right [(FieldNumber, ParsedField)]
res -> Parser RawMessage a -> RawMessage -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser RawMessage a
parser ([(FieldNumber, ParsedField)] -> RawMessage
forall v. [(FieldNumber, v)] -> IntMap [v]
toMap [(FieldNumber, ParsedField)]
res)
parsedField :: RawField -> Maybe RawPrimitive
parsedField :: [ParsedField] -> Maybe ParsedField
parsedField [ParsedField]
xs = case [ParsedField]
xs of
[] -> Maybe ParsedField
forall a. Maybe a
Nothing
(ParsedField
x:[ParsedField]
_) -> ParsedField -> Maybe ParsedField
forall a. a -> Maybe a
Just ParsedField
x
throwWireTypeError :: Show input
=> String
-> input
-> Either ParseError expected
throwWireTypeError :: String -> input -> Either ParseError expected
throwWireTypeError String
expected input
wrong =
ParseError -> Either ParseError expected
forall a b. a -> Either a b
Left (Text -> ParseError
WireTypeError (String -> Text
pack String
msg))
where
msg :: String
msg = String
"Wrong wiretype. Expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
forall a. Show a => a -> String
show input
wrong
throwCerealError :: String -> String -> Either ParseError a
throwCerealError :: String -> String -> Either ParseError a
throwCerealError String
expected String
cerealErr =
ParseError -> Either ParseError a
forall a b. a -> Either a b
Left (Text -> ParseError
BinaryError (String -> Text
pack String
msg))
where
msg :: String
msg = String
"Failed to parse contents of " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" field. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Error from cereal was: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cerealErr
parseVarInt :: Integral a => Parser RawPrimitive a
parseVarInt :: Parser ParsedField a
parseVarInt = (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((ParsedField -> Either ParseError a) -> Parser ParsedField a)
-> (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall a b. (a -> b) -> a -> b
$
\case
VarintField Word64
i -> a -> Either ParseError a
forall a b. b -> Either a b
Right (Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
ParsedField
wrong -> String -> ParsedField -> Either ParseError a
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"varint" ParsedField
wrong
runGetPacked :: Get a -> Parser RawPrimitive a
runGetPacked :: Get a -> Parser ParsedField a
runGetPacked Get a
g = (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((ParsedField -> Either ParseError a) -> Parser ParsedField a)
-> (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall a b. (a -> b) -> a -> b
$
\case
LengthDelimitedField ByteString
bs ->
case Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGet Get a
g ByteString
bs of
Left String
e -> String -> String -> Either ParseError a
forall a. String -> String -> Either ParseError a
throwCerealError String
"packed repeated field" String
e
Right a
xs -> a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
xs
ParsedField
wrong -> String -> ParsedField -> Either ParseError a
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"packed repeated field" ParsedField
wrong
runGetFixed32 :: Get a -> Parser RawPrimitive a
runGetFixed32 :: Get a -> Parser ParsedField a
runGetFixed32 Get a
g = (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((ParsedField -> Either ParseError a) -> Parser ParsedField a)
-> (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall a b. (a -> b) -> a -> b
$
\case
Fixed32Field ByteString
bs -> case Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGet Get a
g ByteString
bs of
Left String
e -> String -> String -> Either ParseError a
forall a. String -> String -> Either ParseError a
throwCerealError String
"fixed32 field" String
e
Right a
x -> a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
ParsedField
wrong -> String -> ParsedField -> Either ParseError a
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"fixed 32 field" ParsedField
wrong
runGetFixed64 :: Get a -> Parser RawPrimitive a
runGetFixed64 :: Get a -> Parser ParsedField a
runGetFixed64 Get a
g = (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((ParsedField -> Either ParseError a) -> Parser ParsedField a)
-> (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall a b. (a -> b) -> a -> b
$
\case
Fixed64Field ByteString
bs -> case Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGet Get a
g ByteString
bs of
Left String
e -> String -> String -> Either ParseError a
forall a. String -> String -> Either ParseError a
throwCerealError String
"fixed 64 field" String
e
Right a
x -> a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
ParsedField
wrong -> String -> ParsedField -> Either ParseError a
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"fixed 64 field" ParsedField
wrong
bytes :: Parser RawPrimitive B.ByteString
bytes :: Parser ParsedField ByteString
bytes = (ParsedField -> Either ParseError ByteString)
-> Parser ParsedField ByteString
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((ParsedField -> Either ParseError ByteString)
-> Parser ParsedField ByteString)
-> (ParsedField -> Either ParseError ByteString)
-> Parser ParsedField ByteString
forall a b. (a -> b) -> a -> b
$
\case
LengthDelimitedField ByteString
bs ->
ByteString -> Either ParseError ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either ParseError ByteString)
-> ByteString -> Either ParseError ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
B.copy ByteString
bs
ParsedField
wrong -> String -> ParsedField -> Either ParseError ByteString
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"bytes" ParsedField
wrong
bool :: Parser RawPrimitive Bool
bool :: Parser ParsedField Bool
bool = (ParsedField -> Either ParseError Bool) -> Parser ParsedField Bool
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((ParsedField -> Either ParseError Bool)
-> Parser ParsedField Bool)
-> (ParsedField -> Either ParseError Bool)
-> Parser ParsedField Bool
forall a b. (a -> b) -> a -> b
$
\case
VarintField Word64
i -> Bool -> Either ParseError Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Either ParseError Bool) -> Bool -> Either ParseError Bool
forall a b. (a -> b) -> a -> b
$! Word64
i Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0
ParsedField
wrong -> String -> ParsedField -> Either ParseError Bool
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"bool" ParsedField
wrong
int32 :: Parser RawPrimitive Int32
int32 :: Parser ParsedField Int32
int32 = Parser ParsedField Int32
forall a. Integral a => Parser ParsedField a
parseVarInt
int64 :: Parser RawPrimitive Int64
int64 :: Parser ParsedField Int64
int64 = Parser ParsedField Int64
forall a. Integral a => Parser ParsedField a
parseVarInt
uint32 :: Parser RawPrimitive Word32
uint32 :: Parser ParsedField Word32
uint32 = Parser ParsedField Word32
forall a. Integral a => Parser ParsedField a
parseVarInt
uint64 :: Parser RawPrimitive Word64
uint64 :: Parser ParsedField Word64
uint64 = Parser ParsedField Word64
forall a. Integral a => Parser ParsedField a
parseVarInt
sint32 :: Parser RawPrimitive Int32
sint32 :: Parser ParsedField Int32
sint32 = (Word32 -> Int32)
-> Parser ParsedField Word32 -> Parser ParsedField Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> (Word32 -> Word32) -> Word32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32
forall a. (Num a, Bits a) => a -> a
zigZagDecode :: Word32 -> Word32)) Parser ParsedField Word32
forall a. Integral a => Parser ParsedField a
parseVarInt
sint64 :: Parser RawPrimitive Int64
sint64 :: Parser ParsedField Int64
sint64 = (Word64 -> Int64)
-> Parser ParsedField Word64 -> Parser ParsedField Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (Word64 -> Word64) -> Word64 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64
forall a. (Num a, Bits a) => a -> a
zigZagDecode :: Word64 -> Word64)) Parser ParsedField Word64
forall a. Integral a => Parser ParsedField a
parseVarInt
byteString :: Parser RawPrimitive B.ByteString
byteString :: Parser ParsedField ByteString
byteString = Parser ParsedField ByteString
bytes
lazyByteString :: Parser RawPrimitive BL.ByteString
lazyByteString :: Parser ParsedField ByteString
lazyByteString = (ByteString -> ByteString)
-> Parser ParsedField ByteString -> Parser ParsedField ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BL.fromStrict Parser ParsedField ByteString
bytes
text :: Parser RawPrimitive Text
text :: Parser ParsedField Text
text = (ParsedField -> Either ParseError Text) -> Parser ParsedField Text
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((ParsedField -> Either ParseError Text)
-> Parser ParsedField Text)
-> (ParsedField -> Either ParseError Text)
-> Parser ParsedField Text
forall a b. (a -> b) -> a -> b
$
\case
LengthDelimitedField ByteString
bs ->
case ByteString -> Either UnicodeException Text
decodeUtf8' (ByteString -> Either UnicodeException Text)
-> ByteString -> Either UnicodeException Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
bs of
Left UnicodeException
err -> ParseError -> Either ParseError Text
forall a b. a -> Either a b
Left (Text -> ParseError
BinaryError (String -> Text
pack (String
"Failed to decode UTF-8: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
err)))
Right Text
txt -> Text -> Either ParseError Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt
ParsedField
wrong -> String -> ParsedField -> Either ParseError Text
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"string" ParsedField
wrong
enum :: forall e. ProtoEnum e => Parser RawPrimitive (Either Int32 e)
enum :: Parser ParsedField (Either Int32 e)
enum = (Int32 -> Either Int32 e)
-> Parser ParsedField Int32 -> Parser ParsedField (Either Int32 e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Either Int32 e
toEither Parser ParsedField Int32
forall a. Integral a => Parser ParsedField a
parseVarInt
where
toEither :: Int32 -> Either Int32 e
toEither :: Int32 -> Either Int32 e
toEither Int32
i
| Just e
e <- Int32 -> Maybe e
forall a. ProtoEnum a => Int32 -> Maybe a
toProtoEnumMay Int32
i = e -> Either Int32 e
forall a b. b -> Either a b
Right e
e
| Bool
otherwise = Int32 -> Either Int32 e
forall a b. a -> Either a b
Left Int32
i
packedVarints :: Integral a => Parser RawPrimitive [a]
packedVarints :: Parser ParsedField [a]
packedVarints = ([Word64] -> [a])
-> Parser ParsedField [Word64] -> Parser ParsedField [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64 -> a) -> [Word64] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Get [Word64] -> Parser ParsedField [Word64]
forall a. Get a -> Parser ParsedField a
runGetPacked (Get Word64 -> Get [Word64]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get Word64
getBase128Varint))
getBase128Varint :: Get Word64
getBase128Varint :: Get Word64
getBase128Varint = Int -> Word64 -> Get Word64
forall t. (Bits t, Num t) => Int -> t -> Get t
loop Int
0 Word64
0
where
loop :: Int -> t -> Get t
loop !Int
i !t
w64 = do
Word8
w8 <- Get Word8
getWord8
if Word8 -> Bool
forall a. Bits a => a -> Bool
base128Terminal Word8
w8
then t -> Get t
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Get t) -> t -> Get t
forall a b. (a -> b) -> a -> b
$ Int -> t -> Word8 -> t
forall a a.
(Integral a, Bits a, Bits a, Num a) =>
Int -> a -> a -> a
combine Int
i t
w64 Word8
w8
else Int -> t -> Get t
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> t -> Word8 -> t
forall a a.
(Integral a, Bits a, Bits a, Num a) =>
Int -> a -> a -> a
combine Int
i t
w64 Word8
w8)
base128Terminal :: a -> Bool
base128Terminal a
w8 = (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7)) (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ a
w8
combine :: Int -> a -> a -> a
combine Int
i a
w64 a
w8 = (a
w64 a -> a -> a
forall a. Bits a => a -> a -> a
.|.
(a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w8 a -> Int -> a
forall a. Bits a => a -> Int -> a
`clearBit` Int
7)
a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL`
(Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7)))
packedFloats :: Parser RawPrimitive [Float]
packedFloats :: Parser ParsedField [Float]
packedFloats = Get [Float] -> Parser ParsedField [Float]
forall a. Get a -> Parser ParsedField a
runGetPacked (Get Float -> Get [Float]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get Float
getFloat32le)
packedDoubles :: Parser RawPrimitive [Double]
packedDoubles :: Parser ParsedField [Double]
packedDoubles = Get [Double] -> Parser ParsedField [Double]
forall a. Get a -> Parser ParsedField a
runGetPacked (Get Double -> Get [Double]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get Double
getFloat64le)
packedFixed32 :: Integral a => Parser RawPrimitive [a]
packedFixed32 :: Parser ParsedField [a]
packedFixed32 = ([Word32] -> [a])
-> Parser ParsedField [Word32] -> Parser ParsedField [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word32 -> a) -> [Word32] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Get [Word32] -> Parser ParsedField [Word32]
forall a. Get a -> Parser ParsedField a
runGetPacked (Get Word32 -> Get [Word32]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get Word32
getWord32le))
packedFixed64 :: Integral a => Parser RawPrimitive [a]
packedFixed64 :: Parser ParsedField [a]
packedFixed64 = ([Word64] -> [a])
-> Parser ParsedField [Word64] -> Parser ParsedField [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64 -> a) -> [Word64] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Get [Word64] -> Parser ParsedField [Word64]
forall a. Get a -> Parser ParsedField a
runGetPacked (Get Word64 -> Get [Word64]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get Word64
getWord64le))
float :: Parser RawPrimitive Float
float :: Parser ParsedField Float
float = Get Float -> Parser ParsedField Float
forall a. Get a -> Parser ParsedField a
runGetFixed32 Get Float
getFloat32le
double :: Parser RawPrimitive Double
double :: Parser ParsedField Double
double = Get Double -> Parser ParsedField Double
forall a. Get a -> Parser ParsedField a
runGetFixed64 Get Double
getFloat64le
fixed32 :: Parser RawPrimitive Word32
fixed32 :: Parser ParsedField Word32
fixed32 = Get Word32 -> Parser ParsedField Word32
forall a. Get a -> Parser ParsedField a
runGetFixed32 Get Word32
getWord32le
fixed64 :: Parser RawPrimitive Word64
fixed64 :: Parser ParsedField Word64
fixed64 = Get Word64 -> Parser ParsedField Word64
forall a. Get a -> Parser ParsedField a
runGetFixed64 Get Word64
getWord64le
sfixed32 :: Parser RawPrimitive Int32
sfixed32 :: Parser ParsedField Int32
sfixed32 = Get Int32 -> Parser ParsedField Int32
forall a. Get a -> Parser ParsedField a
runGetFixed32 Get Int32
getInt32le
sfixed64 :: Parser RawPrimitive Int64
sfixed64 :: Parser ParsedField Int64
sfixed64 = Get Int64 -> Parser ParsedField Int64
forall a. Get a -> Parser ParsedField a
runGetFixed64 Get Int64
getInt64le
at :: Parser RawField a -> FieldNumber -> Parser RawMessage a
at :: Parser [ParsedField] a -> FieldNumber -> Parser RawMessage a
at Parser [ParsedField] a
parser FieldNumber
fn = (RawMessage -> Either ParseError a) -> Parser RawMessage a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawMessage -> Either ParseError a) -> Parser RawMessage a)
-> (RawMessage -> Either ParseError a) -> Parser RawMessage a
forall a b. (a -> b) -> a -> b
$ Parser [ParsedField] a -> [ParsedField] -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser [ParsedField] a
parser ([ParsedField] -> Either ParseError a)
-> (RawMessage -> [ParsedField])
-> RawMessage
-> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsedField] -> Maybe [ParsedField] -> [ParsedField]
forall a. a -> Maybe a -> a
fromMaybe [ParsedField]
forall a. Monoid a => a
mempty (Maybe [ParsedField] -> [ParsedField])
-> (RawMessage -> Maybe [ParsedField])
-> RawMessage
-> [ParsedField]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RawMessage -> Maybe [ParsedField]
forall a. Int -> IntMap a -> Maybe a
M.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> (FieldNumber -> Word64) -> FieldNumber -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> Word64
getFieldNumber (FieldNumber -> Int) -> FieldNumber -> Int
forall a b. (a -> b) -> a -> b
$ FieldNumber
fn)
oneof :: a
-> [(FieldNumber, Parser RawField a)]
-> Parser RawMessage a
oneof :: a -> [(FieldNumber, Parser [ParsedField] a)] -> Parser RawMessage a
oneof a
def [(FieldNumber, Parser [ParsedField] a)]
parsersByFieldNum = (RawMessage -> Either ParseError a) -> Parser RawMessage a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawMessage -> Either ParseError a) -> Parser RawMessage a)
-> (RawMessage -> Either ParseError a) -> Parser RawMessage a
forall a b. (a -> b) -> a -> b
$ \RawMessage
input ->
case [Maybe (Parser [ParsedField] a, [ParsedField])]
-> Maybe (Parser [ParsedField] a, [ParsedField])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((\(FieldNumber
num,Parser [ParsedField] a
p) -> (Parser [ParsedField] a
p,) ([ParsedField] -> (Parser [ParsedField] a, [ParsedField]))
-> Maybe [ParsedField]
-> Maybe (Parser [ParsedField] a, [ParsedField])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RawMessage -> Maybe [ParsedField]
forall a. Int -> IntMap a -> Maybe a
M.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> (FieldNumber -> Word64) -> FieldNumber -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> Word64
getFieldNumber (FieldNumber -> Int) -> FieldNumber -> Int
forall a b. (a -> b) -> a -> b
$ FieldNumber
num) RawMessage
input) ((FieldNumber, Parser [ParsedField] a)
-> Maybe (Parser [ParsedField] a, [ParsedField]))
-> [(FieldNumber, Parser [ParsedField] a)]
-> [Maybe (Parser [ParsedField] a, [ParsedField])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FieldNumber, Parser [ParsedField] a)]
parsersByFieldNum) of
Maybe (Parser [ParsedField] a, [ParsedField])
Nothing -> a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
Just (Parser [ParsedField] a
p, [ParsedField]
v) -> Parser [ParsedField] a -> [ParsedField] -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser [ParsedField] a
p [ParsedField]
v
one :: Parser RawPrimitive a -> a -> Parser RawField a
one :: Parser ParsedField a -> a -> Parser [ParsedField] a
one Parser ParsedField a
parser a
def = ([ParsedField] -> Either ParseError a) -> Parser [ParsedField] a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((Maybe a -> a)
-> Either ParseError (Maybe a) -> Either ParseError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def) (Either ParseError (Maybe a) -> Either ParseError a)
-> ([ParsedField] -> Either ParseError (Maybe a))
-> [ParsedField]
-> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedField -> Either ParseError a)
-> Maybe ParsedField -> Either ParseError (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Parser ParsedField a -> ParsedField -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser ParsedField a
parser) (Maybe ParsedField -> Either ParseError (Maybe a))
-> ([ParsedField] -> Maybe ParsedField)
-> [ParsedField]
-> Either ParseError (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsedField] -> Maybe ParsedField
parsedField)
repeated :: Parser RawPrimitive a -> Parser RawField [a]
repeated :: Parser ParsedField a -> Parser [ParsedField] [a]
repeated Parser ParsedField a
parser = ([ParsedField] -> Either ParseError [a])
-> Parser [ParsedField] [a]
forall input a. (input -> Either ParseError a) -> Parser input a
Parser (([ParsedField] -> Either ParseError [a])
-> Parser [ParsedField] [a])
-> ([ParsedField] -> Either ParseError [a])
-> Parser [ParsedField] [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> Either ParseError [a] -> Either ParseError [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse (Either ParseError [a] -> Either ParseError [a])
-> ([ParsedField] -> Either ParseError [a])
-> [ParsedField]
-> Either ParseError [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedField -> Either ParseError a)
-> [ParsedField] -> Either ParseError [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Parser ParsedField a -> ParsedField -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser ParsedField a
parser)
embeddedToParsedFields :: RawPrimitive -> Either ParseError RawMessage
embeddedToParsedFields :: ParsedField -> Either ParseError RawMessage
embeddedToParsedFields (LengthDelimitedField ByteString
bs) =
case ByteString -> Either String [(FieldNumber, ParsedField)]
decodeWire ByteString
bs of
Left String
err -> ParseError -> Either ParseError RawMessage
forall a b. a -> Either a b
Left (Text -> Maybe ParseError -> ParseError
EmbeddedError (Text
"Failed to parse embedded message: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack String
err))
Maybe ParseError
forall a. Maybe a
Nothing)
Right [(FieldNumber, ParsedField)]
result -> RawMessage -> Either ParseError RawMessage
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FieldNumber, ParsedField)] -> RawMessage
forall v. [(FieldNumber, v)] -> IntMap [v]
toMap [(FieldNumber, ParsedField)]
result)
embeddedToParsedFields ParsedField
wrong =
String -> ParsedField -> Either ParseError RawMessage
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"embedded" ParsedField
wrong
embedded :: Parser RawMessage a -> Parser RawField (Maybe a)
embedded :: Parser RawMessage a -> Parser [ParsedField] (Maybe a)
embedded Parser RawMessage a
p = ([ParsedField] -> Either ParseError (Maybe a))
-> Parser [ParsedField] (Maybe a)
forall input a. (input -> Either ParseError a) -> Parser input a
Parser (([ParsedField] -> Either ParseError (Maybe a))
-> Parser [ParsedField] (Maybe a))
-> ([ParsedField] -> Either ParseError (Maybe a))
-> Parser [ParsedField] (Maybe a)
forall a b. (a -> b) -> a -> b
$
\[ParsedField]
xs -> if [ParsedField]
xs [ParsedField] -> [ParsedField] -> Bool
forall a. Eq a => a -> a -> Bool
== [ParsedField]
forall (f :: * -> *) a. Alternative f => f a
empty
then Maybe a -> Either ParseError (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
else do
[RawMessage]
innerMaps <- (ParsedField -> Either ParseError RawMessage)
-> [ParsedField] -> Either ParseError [RawMessage]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM ParsedField -> Either ParseError RawMessage
embeddedToParsedFields [ParsedField]
xs
let combinedMap :: RawMessage
combinedMap = (RawMessage -> RawMessage -> RawMessage)
-> RawMessage -> [RawMessage] -> RawMessage
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([ParsedField] -> [ParsedField] -> [ParsedField])
-> RawMessage -> RawMessage -> RawMessage
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
M.unionWith [ParsedField] -> [ParsedField] -> [ParsedField]
forall a. Semigroup a => a -> a -> a
(<>)) RawMessage
forall a. IntMap a
M.empty [RawMessage]
innerMaps
a
parsed <- Parser RawMessage a -> RawMessage -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser RawMessage a
p RawMessage
combinedMap
Maybe a -> Either ParseError (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Either ParseError (Maybe a))
-> Maybe a -> Either ParseError (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
parsed
embedded' :: Parser RawMessage a -> Parser RawPrimitive a
embedded' :: Parser RawMessage a -> Parser ParsedField a
embedded' Parser RawMessage a
parser = (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((ParsedField -> Either ParseError a) -> Parser ParsedField a)
-> (ParsedField -> Either ParseError a) -> Parser ParsedField a
forall a b. (a -> b) -> a -> b
$
\case
LengthDelimitedField ByteString
bs ->
case Parser RawMessage a -> ByteString -> Either ParseError a
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage a
parser ByteString
bs of
Left ParseError
err -> ParseError -> Either ParseError a
forall a b. a -> Either a b
Left (Text -> Maybe ParseError -> ParseError
EmbeddedError Text
"Failed to parse embedded message."
(ParseError -> Maybe ParseError
forall a. a -> Maybe a
Just ParseError
err))
Right a
result -> a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
ParsedField
wrong -> String -> ParsedField -> Either ParseError a
forall input expected.
Show input =>
String -> input -> Either ParseError expected
throwWireTypeError String
"embedded" ParsedField
wrong