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