{-
  Copyright 2016 Awake Networks

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}

-- | Low level functions for reading data in the protobufs wire format.
--
-- This module exports a function 'decodeWire' which parses data in the raw wire
-- format into an untyped 'Map' representation.
--
-- This module also provides 'Parser' types and functions for reading messages
-- from the untyped 'Map' representation obtained from 'decodeWire'.

{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternGuards              #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}

module Proto3.Wire.Decode
    ( -- * Untyped Representation
      ParsedField(..)
    , decodeWire
      -- * Parser Types
    , Parser(..)
    , RawPrimitive
    , RawField
    , RawMessage
    , ParseError(..)
    , foldFields
    , parse
      -- * Primitives
    , bool
    , int32
    , int64
    , uint32
    , uint64
    , sint32
    , sint64
    , enum
    , byteString
    , lazyByteString
    , text
    , packedVarints
    , packedFixed32
    , packedFixed64
    , packedFloats
    , packedDoubles
    , fixed32
    , fixed64
    , sfixed32
    , sfixed64
    , float
    , double
      -- * Decoding Messages
    , at
    , oneof
    , one
    , repeated
    , embedded
    , embedded'
      -- * ZigZag codec
    , zigZagDecode
      -- * Exported For Doctest Only
    , 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 -- TODO intmap
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.Traversable        as T
import           Data.Int                ( Int32, Int64 )
import           Data.Word               ( Word8, Word32, Word64 )
import           Proto3.Wire.Class
import           Proto3.Wire.Types

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> :module Proto3.Wire.Decode Proto3.Wire.Types

-- | Decode a zigzag-encoded numeric type.
-- See: http://stackoverflow.com/questions/2210923/zig-zag-decoding
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))

-- | One field in a protobuf message.
--
-- We don't know what's inside some of these fields until we know what type
-- we're deserializing to, so we leave them as 'ByteString' until a later step
-- in the process.
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)

-- | Convert key-value pairs to a map of keys to a sequence of values with that
-- key, in their reverse occurrence order.
--
-- >>> toMap ([(FieldNumber 1, 3),(FieldNumber 2, 4),(FieldNumber 1, 6)] :: [(FieldNumber,Int)])
-- fromList [(1,[6,3]),(2,[4])]
--
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

-- | Parses data in the raw wire format into an untyped 'Map' representation.
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


-- * Parser Interface

-- | Type describing possible errors that can be encountered while parsing.
data ParseError =
                -- | A 'WireTypeError' occurs when the type of the data in the protobuf
                -- binary format does not match the type encountered by the parser. This can
                -- indicate that the type of a field has changed or is incorrect.
                WireTypeError Text
                |
                -- | A 'BinaryError' occurs when we can't successfully parse the contents of
                -- the field.
                BinaryError Text
                |
                -- | An 'EmbeddedError' occurs when we encounter an error while parsing an
                -- embedded message.
                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)

-- | This library does not use this instance, but it is provided for convenience,
-- so that 'ParseError' may be used with functions like `throwIO`
instance Exception ParseError

-- | A parsing function type synonym, to tidy up type signatures.
--
-- This synonym is used in three ways:
--
-- * Applied to 'RawPrimitive', to parse primitive fields.
-- * Applied to 'RawField', to parse fields which correspond to a single 'FieldNumber'.
-- * Applied to 'RawMessage', to parse entire messages.
--
-- Many of the combinators in this module are used to combine and convert between
-- these three parser types.
--
-- 'Parser's can be combined using the 'Applicative', 'Monad' and 'Alternative'
-- instances.
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
    -- return = pure
    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

-- | Raw data corresponding to a single encoded key/value pair.
type RawPrimitive = ParsedField

-- | Raw data corresponding to a single 'FieldNumber'.
type RawField = [RawPrimitive]

-- | Raw data corresponding to an entire message.
--
-- A 'Map' from 'FieldNumber's to the those values associated with
-- that 'FieldNumber'.
type RawMessage = M.IntMap RawField

-- | Fold over a list of parsed fields accumulating a result
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 a message (encoded in the raw wire format) using the specified
-- `Parser`.
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)

-- | To comply with the protobuf spec, if there are multiple fields with the same
-- field number, this will always return the last one.
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

-- | Parse a Boolean value.
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

-- | Parse a primitive with the @int32@ wire type.
int32 :: Parser RawPrimitive Int32
int32 :: Parser ParsedField Int32
int32 = Parser ParsedField Int32
forall a. Integral a => Parser ParsedField a
parseVarInt

-- | Parse a primitive with the @int64@ wire type.
int64 :: Parser RawPrimitive Int64
int64 :: Parser ParsedField Int64
int64 = Parser ParsedField Int64
forall a. Integral a => Parser ParsedField a
parseVarInt

-- | Parse a primitive with the @uint32@ wire type.
uint32 :: Parser RawPrimitive Word32
uint32 :: Parser ParsedField Word32
uint32 = Parser ParsedField Word32
forall a. Integral a => Parser ParsedField a
parseVarInt

-- | Parse a primitive with the @uint64@ wire type.
uint64 :: Parser RawPrimitive Word64
uint64 :: Parser ParsedField Word64
uint64 = Parser ParsedField Word64
forall a. Integral a => Parser ParsedField a
parseVarInt

-- | Parse a primitive with the @sint32@ wire type.
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

-- | Parse a primitive with the @sint64@ wire type.
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

-- | Parse a primitive with the @bytes@ wire type as a 'B.ByteString'.
byteString :: Parser RawPrimitive B.ByteString
byteString :: Parser ParsedField ByteString
byteString = Parser ParsedField ByteString
bytes

-- | Parse a primitive with the @bytes@ wire type as a lazy 'BL.ByteString'.
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

-- | Parse a primitive with the @bytes@ wire type as 'Text'.
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

-- | Parse a primitive with an enumerated type.
--
-- This parser will return 'Left' if the encoded integer value
-- is not a code for a known enumerator.
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

-- | Parse a packed collection of variable-width integer values (any of @int32@,
-- @int64@, @sint32@, @sint64@, @uint32@, @uint64@ or enumerations).
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)))



-- | Parse a packed collection of @float@ values.
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)

-- | Parse a packed collection of @double@ values.
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)

-- | Parse a packed collection of @fixed32@ values.
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))

-- | Parse a packed collection of @fixed64@ values.
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))

-- | Parse a @float@.
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

-- | Parse a @double@.
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

-- | Parse an integer primitive with the @fixed32@ wire type.
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

-- | Parse an integer primitive with the @fixed64@ wire type.
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

-- | Parse a signed integer primitive with the @fixed32@ wire type.
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

-- | Parse a signed integer primitive with the @fixed64@ wire type.
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

-- | Turn a field parser into a message parser, by specifying the 'FieldNumber'.
--
-- This parser will fail if the specified 'FieldNumber' is not present.
--
-- For example:
--
-- > one float `at` fieldNumber 1 :: Parser RawMessage (Maybe Float)
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)

-- | Try to parse different field numbers with their respective parsers. This is
-- used to express alternative between possible fields of a oneof.
--
-- TODO: contrary to the protobuf spec, in the case of multiple fields number
-- matching the oneof content, the choice of field is biased to the order of the
-- list, instead of being biased to the last field of group of field number in
-- the oneof. This is related to the Map used for input that preserve order
-- across multiple invocation of the same field, but not across a group of
-- field.
oneof :: a
         -- ^ The value to produce when no field numbers belonging to the oneof
         -- are present in the input
      -> [(FieldNumber, Parser RawField a)]
         -- ^ Left-biased oneof field parsers, one per field number belonging to
         -- the oneof
      -> 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

-- | This turns a primitive parser into a field parser by keeping the
-- last received value, or return a default value if the field number is missing.
--
-- Used to ensure that we return the last value with the given field number
-- in the message, in compliance with the protobuf standard.
--
-- The protocol buffers specification specifies default values for
-- primitive types.
--
-- For example:
--
-- > one float 0 :: Parser RawField Float
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)

-- | Parse a repeated field, or an unpacked collection of primitives.
--
-- Each value with the identified 'FieldNumber' will be passed to the parser
-- in the first argument, to be converted into a value of the correct type.
--
-- For example, to parse a packed collection of @uint32@ values:
--
-- > repeated uint32 :: Parser RawField ([Word32])
--
-- or to parse a collection of embedded messages:
--
-- > repeated . embedded' :: Parser RawMessage a -> Parser RawField ([a])
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)

-- | For a field containing an embedded message, parse as far as getting the
-- wire-level fields out of the message.
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

-- | Create a field parser for an embedded message, from a message parser.
--
-- The protobuf spec requires that embedded messages be mergeable, so that
-- protobuf encoding has the flexibility to transmit embedded messages in
-- pieces. This function reassembles the pieces, and must be used to parse all
-- embedded non-repeated messages.
--
-- If the embedded message is not found in the outer message, this function
-- returns 'Nothing'.
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

-- | Create a primitive parser for an embedded message from a message parser.
--
-- This parser does no merging of fields if multiple message fragments are
-- sent separately.
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


-- TODO test repeated and embedded better for reverse logic...