{-
  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
    , shortByteString
    , text
    , shortText
    , packedVarints
    , packedFixed32
    , packedFixed64
    , packedFloats
    , packedDoubles
    , fixed32
    , fixed64
    , sfixed32
    , sfixed64
    , float
    , double
      -- * Decoding Messages
    , at
    , oneof
    , one
    , repeated
    , embedded
    , embedded'
      -- * ZigZag codec
    , 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 -- 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.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

-- $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 :: forall a. (Num a, Bits a) => 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 -> RawPrimitive -> ShowS
[RawPrimitive] -> ShowS
RawPrimitive -> [Char]
(Int -> RawPrimitive -> ShowS)
-> (RawPrimitive -> [Char])
-> ([RawPrimitive] -> ShowS)
-> Show RawPrimitive
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawPrimitive -> ShowS
showsPrec :: Int -> RawPrimitive -> ShowS
$cshow :: RawPrimitive -> [Char]
show :: RawPrimitive -> [Char]
$cshowList :: [RawPrimitive] -> ShowS
showList :: [RawPrimitive] -> ShowS
Show, RawPrimitive -> RawPrimitive -> Bool
(RawPrimitive -> RawPrimitive -> Bool)
-> (RawPrimitive -> RawPrimitive -> Bool) -> Eq RawPrimitive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawPrimitive -> RawPrimitive -> Bool
== :: RawPrimitive -> RawPrimitive -> Bool
$c/= :: RawPrimitive -> RawPrimitive -> Bool
/= :: RawPrimitive -> RawPrimitive -> Bool
Eq)

-- | Convert key-value pairs to a map of keys to a sequence of values with that
-- key, in their reverse occurrence order.
--
--
decodeWireMessage :: B.ByteString -> Either String RawMessage
decodeWireMessage :: ByteString -> Either [Char] RawMessage
decodeWireMessage = (Maybe (RawMessage, Int, [RawPrimitive])
 -> FieldNumber
 -> RawPrimitive
 -> Maybe (RawMessage, Int, [RawPrimitive]))
-> Maybe (RawMessage, Int, [RawPrimitive])
-> (Maybe (RawMessage, Int, [RawPrimitive]) -> RawMessage)
-> ByteString
-> Either [Char] RawMessage
forall b r.
(b -> FieldNumber -> RawPrimitive -> b)
-> b -> (b -> r) -> ByteString -> Either [Char] r
decodeWire0 Maybe (RawMessage, Int, [RawPrimitive])
-> FieldNumber
-> RawPrimitive
-> Maybe (RawMessage, Int, [RawPrimitive])
forall v.
Maybe (IntMap [v], Int, [v])
-> FieldNumber -> v -> Maybe (IntMap [v], Int, [v])
combineSeen' Maybe (RawMessage, Int, [RawPrimitive])
forall a. Maybe a
Nothing Maybe (RawMessage, Int, [RawPrimitive]) -> RawMessage
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 = IntMap [a]
forall a. IntMap a
M.empty
    close (Just (IntMap [a]
m, Int
k, [a]
v)) = ([a] -> [a] -> [a]) -> Int -> [a] -> IntMap [a] -> IntMap [a]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
M.insertWith [a] -> [a] -> [a]
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 = Maybe (IntMap [v], Int, [v])
-> Int -> v -> Maybe (IntMap [v], Int, [v])
forall v.
Maybe (IntMap [v], Int, [v])
-> Int -> v -> Maybe (IntMap [v], Int, [v])
combineSeen Maybe (IntMap [v], Int, [v])
b (Word64 -> Int
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 = (IntMap [v], Int, [v]) -> Maybe (IntMap [v], Int, [v])
forall a. a -> Maybe a
Just (IntMap [v]
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k2
        then (IntMap [v], Int, [v]) -> Maybe (IntMap [v], Int, [v])
forall a. a -> Maybe a
Just (IntMap [v]
m, Int
k1, v
a1 v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
as)
        -- It might seem that we want to use DList but we don't because:
        -- - alter has worse performance than insertWith, and there's no upsert
        -- - We're building up a list of elements in a recursive way
        --    that will be opaque to GHC
        -- - DList would add another dependency
        else let !m' :: IntMap [v]
m' = ([v] -> [v] -> [v]) -> Int -> [v] -> IntMap [v] -> IntMap [v]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
M.insertWith [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
(++) Int
k2 [v]
as IntMap [v]
m
             in (IntMap [v], Int, [v]) -> Maybe (IntMap [v], Int, [v])
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, RawPrimitive)]
decodeWire = ([(FieldNumber, RawPrimitive)]
 -> FieldNumber -> RawPrimitive -> [(FieldNumber, RawPrimitive)])
-> [(FieldNumber, RawPrimitive)]
-> ([(FieldNumber, RawPrimitive)] -> [(FieldNumber, RawPrimitive)])
-> ByteString
-> Either [Char] [(FieldNumber, RawPrimitive)]
forall b r.
(b -> FieldNumber -> RawPrimitive -> b)
-> b -> (b -> r) -> ByteString -> Either [Char] r
decodeWire0 (\[(FieldNumber, RawPrimitive)]
xs FieldNumber
k RawPrimitive
v -> (FieldNumber
k,RawPrimitive
v)(FieldNumber, RawPrimitive)
-> [(FieldNumber, RawPrimitive)] -> [(FieldNumber, RawPrimitive)]
forall a. a -> [a] -> [a]
:[(FieldNumber, RawPrimitive)]
xs) [] [(FieldNumber, RawPrimitive)] -> [(FieldNumber, RawPrimitive)]
forall a. [a] -> [a]
reverse

-- | Parses data in the raw wire format into an untyped 'Map' representation.
decodeWire0 :: (b -> FieldNumber -> ParsedField -> b) -> b -> (b -> r) -> B.ByteString -> Either String r
decodeWire0 :: forall b r.
(b -> FieldNumber -> RawPrimitive -> b)
-> b -> (b -> r) -> ByteString -> Either [Char] r
decodeWire0 b -> FieldNumber -> RawPrimitive -> 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 = r -> Either [Char] r
forall a b. b -> Either a b
Right (r -> Either [Char] r) -> r -> Either [Char] r
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 (Word8 -> Either [Char] WireType)
-> Word8 -> Either [Char] 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
      (RawPrimitive
res, ByteString
rest2) <- WireType -> ByteString -> Either [Char] (RawPrimitive, ByteString)
takeWT WireType
wt ByteString
rest
      ByteString -> b -> Either [Char] r
drloop ByteString
rest2 (b -> FieldNumber -> RawPrimitive -> b
cl b
xs (Word64 -> FieldNumber
FieldNumber Word64
fn) RawPrimitive
res)
{-# INLINE decodeWire0 #-}

eitherUncons :: B.ByteString -> Either String (Word8, B.ByteString)
eitherUncons :: ByteString -> Either [Char] (Word8, ByteString)
eitherUncons = Either [Char] (Word8, ByteString)
-> ((Word8, ByteString) -> Either [Char] (Word8, ByteString))
-> Maybe (Word8, ByteString)
-> Either [Char] (Word8, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] (Word8, ByteString)
forall a b. a -> Either a b
Left [Char]
"failed to parse varint128") (Word8, ByteString) -> Either [Char] (Word8, ByteString)
forall a b. b -> Either a b
Right (Maybe (Word8, ByteString) -> Either [Char] (Word8, ByteString))
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Either [Char] (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 [Char] (Word64, ByteString)
takeVarInt !ByteString
bs =
  case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
     Maybe (Word8, ByteString)
Nothing -> (Word64, ByteString) -> Either [Char] (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 [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r1
        if Word8
w2 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r2
         if Word8
w3 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r3
          if Word8
w4 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r4
           if Word8
w5 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r5
            if Word8
w6 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r6
             if Word8
w7 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r7
              if Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r8
               if Word8
w9 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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 [Char] (Word8, ByteString)
eitherUncons ByteString
r9
                if Word8
w10 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then (Word64, ByteString) -> Either [Char] (Word64, ByteString)
forall a. a -> Either [Char] a
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

                 [Char] -> Either [Char] (Word64, ByteString)
forall a b. a -> Either a b
Left ([Char]
"failed to parse varint128: too big; " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
val6)
{-# INLINE takeVarInt #-}


gwireType :: Word8 -> Either String WireType
gwireType :: Word8 -> Either [Char] WireType
gwireType Word8
0 = WireType -> Either [Char] WireType
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return WireType
Varint
gwireType Word8
5 = WireType -> Either [Char] WireType
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return WireType
Fixed32
gwireType Word8
1 = WireType -> Either [Char] WireType
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return WireType
Fixed64
gwireType Word8
2 = WireType -> Either [Char] WireType
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return WireType
LengthDelimited
gwireType Word8
wt = [Char] -> Either [Char] WireType
forall a b. a -> Either a b
Left ([Char] -> Either [Char] WireType)
-> [Char] -> Either [Char] WireType
forall a b. (a -> b) -> a -> b
$ [Char]
"wireType got unknown wire type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = [Char] -> Either [Char] (ByteString, ByteString)
forall a b. a -> Either a b
Left [Char]
"failed to parse varint128: not enough bytes"
                | Bool
otherwise = (ByteString, ByteString) -> Either [Char] (ByteString, ByteString)
forall a b. b -> Either a b
Right ((ByteString, ByteString)
 -> Either [Char] (ByteString, ByteString))
-> (ByteString, ByteString)
-> Either [Char] (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 [Char] (RawPrimitive, ByteString)
takeWT WireType
Varint !ByteString
b  = ((Word64, ByteString) -> (RawPrimitive, ByteString))
-> Either [Char] (Word64, ByteString)
-> Either [Char] (RawPrimitive, ByteString)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64 -> RawPrimitive)
-> (Word64, ByteString) -> (RawPrimitive, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Word64 -> RawPrimitive
VarintField) (Either [Char] (Word64, ByteString)
 -> Either [Char] (RawPrimitive, ByteString))
-> Either [Char] (Word64, ByteString)
-> Either [Char] (RawPrimitive, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] (Word64, ByteString)
takeVarInt ByteString
b
takeWT WireType
Fixed32 !ByteString
b = ((ByteString, ByteString) -> (RawPrimitive, ByteString))
-> Either [Char] (ByteString, ByteString)
-> Either [Char] (RawPrimitive, ByteString)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> RawPrimitive)
-> (ByteString, ByteString) -> (RawPrimitive, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> RawPrimitive
Fixed32Field) (Either [Char] (ByteString, ByteString)
 -> Either [Char] (RawPrimitive, ByteString))
-> Either [Char] (ByteString, ByteString)
-> Either [Char] (RawPrimitive, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Either [Char] (ByteString, ByteString)
safeSplit Int
4 ByteString
b
takeWT WireType
Fixed64 !ByteString
b = ((ByteString, ByteString) -> (RawPrimitive, ByteString))
-> Either [Char] (ByteString, ByteString)
-> Either [Char] (RawPrimitive, ByteString)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> RawPrimitive)
-> (ByteString, ByteString) -> (RawPrimitive, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> RawPrimitive
Fixed64Field) (Either [Char] (ByteString, ByteString)
 -> Either [Char] (RawPrimitive, ByteString))
-> Either [Char] (ByteString, ByteString)
-> Either [Char] (RawPrimitive, ByteString)
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
   ((ByteString, ByteString) -> (RawPrimitive, ByteString))
-> Either [Char] (ByteString, ByteString)
-> Either [Char] (RawPrimitive, ByteString)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> RawPrimitive)
-> (ByteString, ByteString) -> (RawPrimitive, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> RawPrimitive
LengthDelimitedField) (Either [Char] (ByteString, ByteString)
 -> Either [Char] (RawPrimitive, ByteString))
-> Either [Char] (ByteString, ByteString)
-> Either [Char] (RawPrimitive, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Either [Char] (ByteString, ByteString)
safeSplit (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len) ByteString
rest
{-# INLINE takeWT #-}


-- * 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 -> [Char]
(Int -> ParseError -> ShowS)
-> (ParseError -> [Char])
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> [Char]
show :: ParseError -> [Char]
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show, ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: 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
$ccompare :: ParseError -> ParseError -> Ordering
compare :: ParseError -> ParseError -> Ordering
$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
>= :: ParseError -> ParseError -> Bool
$cmax :: ParseError -> ParseError -> ParseError
max :: ParseError -> ParseError -> ParseError
$cmin :: ParseError -> ParseError -> ParseError
min :: ParseError -> ParseError -> 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 { forall input a. Parser input a -> input -> Either ParseError a
runParser :: input -> Either ParseError a }
    deriving (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
$cfmap :: forall input a b. (a -> b) -> Parser input a -> Parser input b
fmap :: forall a b. (a -> b) -> Parser input a -> Parser input b
$c<$ :: forall input a b. a -> Parser input b -> Parser input a
<$ :: forall a b. a -> Parser input b -> Parser input a
Functor

instance Applicative (Parser input) where
    pure :: forall a. 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 a. a -> Either ParseError a
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 =
        (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 a b.
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 >>= :: forall a b.
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 a b.
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 :: forall a acc.
IntMap (Parser RawPrimitive a, a -> acc -> acc)
-> acc -> [(FieldNumber, RawPrimitive)] -> Either ParseError acc
foldFields IntMap (Parser RawPrimitive a, a -> acc -> acc)
parsers = (acc -> (FieldNumber, RawPrimitive) -> Either ParseError acc)
-> acc -> [(FieldNumber, RawPrimitive)] -> Either ParseError acc
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM acc -> (FieldNumber, RawPrimitive) -> Either ParseError acc
applyOne
  where applyOne :: acc -> (FieldNumber, RawPrimitive) -> Either ParseError acc
applyOne acc
acc (FieldNumber
fn, RawPrimitive
field) =
            case Int
-> IntMap (Parser RawPrimitive a, a -> acc -> acc)
-> Maybe (Parser RawPrimitive 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 RawPrimitive a, a -> acc -> acc)
parsers of
                Maybe (Parser RawPrimitive a, a -> acc -> acc)
Nothing              -> acc -> Either ParseError acc
forall a. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure acc
acc
                Just (Parser RawPrimitive a
parser, a -> acc -> acc
apply) ->
                    case Parser RawPrimitive a -> RawPrimitive -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser RawPrimitive a
parser RawPrimitive
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 a. a -> Either ParseError a
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 :: 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 -> ParseError -> Either ParseError a
forall a b. a -> Either a b
Left (Text -> ParseError
BinaryError ([Char] -> Text
pack [Char]
err))
    Right RawMessage
res -> Parser RawMessage a -> RawMessage -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser RawMessage a
parser RawMessage
res
{-# INLINE parse #-}

-- | 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 :: [RawPrimitive] -> Maybe RawPrimitive
parsedField [RawPrimitive]
xs = case [RawPrimitive]
xs of
    [] -> Maybe RawPrimitive
forall a. Maybe a
Nothing
    (RawPrimitive
x:[RawPrimitive]
_) -> RawPrimitive -> Maybe RawPrimitive
forall a. a -> Maybe a
Just RawPrimitive
x

wireTypeError :: String
              -> RawPrimitive
              -> ParseError
wireTypeError :: [Char] -> RawPrimitive -> ParseError
wireTypeError [Char]
expected RawPrimitive
wrong = Text -> ParseError
WireTypeError ([Char] -> Text
pack [Char]
msg)
  where
    msg :: [Char]
msg = [Char]
"Wrong wiretype. Expected " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
expected [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" but got " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ RawPrimitive -> [Char]
forall a. Show a => a -> [Char]
show RawPrimitive
wrong

throwWireTypeError :: String
                   -> RawPrimitive
                   -> Either ParseError expected
throwWireTypeError :: forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
expected RawPrimitive
wrong =
    ParseError -> Either ParseError expected
forall a b. a -> Either a b
Left ([Char] -> RawPrimitive -> ParseError
wireTypeError [Char]
expected RawPrimitive
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
        [Char]
expected [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" field. " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Error from cereal was: " [Char] -> ShowS
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 =
    ParseError -> Either ParseError a
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 RawPrimitive a
parseVarInt = (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a)
-> (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive 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)
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError a
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"varint" RawPrimitive
wrong

runGetPacked :: Get a -> Parser RawPrimitive a
runGetPacked :: forall a. Get a -> Parser RawPrimitive a
runGetPacked Get a
g = (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a)
-> (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a
forall a b. (a -> b) -> a -> b
$
    \case
        LengthDelimitedField ByteString
bs ->
            case Get a -> ByteString -> Either [Char] a
forall a. Get a -> ByteString -> Either [Char] a
runGet Get a
g ByteString
bs of
                Left [Char]
e -> [Char] -> [Char] -> Either ParseError a
forall a. [Char] -> [Char] -> Either ParseError a
throwCerealError [Char]
"packed repeated field" [Char]
e
                Right a
xs -> a -> Either ParseError a
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
xs
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError a
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"packed repeated field" RawPrimitive
wrong

runGetFixed32 :: Get a -> Parser RawPrimitive a
runGetFixed32 :: forall a. Get a -> Parser RawPrimitive a
runGetFixed32 Get a
g = (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a)
-> (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a
forall a b. (a -> b) -> a -> b
$
    \case
        Fixed32Field ByteString
bs -> case Get a -> ByteString -> Either [Char] a
forall a. Get a -> ByteString -> Either [Char] a
runGet Get a
g ByteString
bs of
            Left [Char]
e -> [Char] -> [Char] -> Either ParseError a
forall a. [Char] -> [Char] -> Either ParseError a
throwCerealError [Char]
"fixed32 field" [Char]
e
            Right a
x -> a -> Either ParseError a
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError a
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"fixed 32 field" RawPrimitive
wrong

runGetFixed64 :: Get a -> Parser RawPrimitive a
runGetFixed64 :: forall a. Get a -> Parser RawPrimitive a
runGetFixed64 Get a
g = (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a)
-> (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a
forall a b. (a -> b) -> a -> b
$
    \case
        Fixed64Field ByteString
bs -> case Get a -> ByteString -> Either [Char] a
forall a. Get a -> ByteString -> Either [Char] a
runGet Get a
g ByteString
bs of
            Left [Char]
e -> [Char] -> [Char] -> Either ParseError a
forall a. [Char] -> [Char] -> Either ParseError a
throwCerealError [Char]
"fixed 64 field" [Char]
e
            Right a
x -> a -> Either ParseError a
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError a
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"fixed 64 field" RawPrimitive
wrong

bytes :: Parser RawPrimitive B.ByteString
bytes :: Parser RawPrimitive ByteString
bytes = (RawPrimitive -> Either ParseError ByteString)
-> Parser RawPrimitive ByteString
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError ByteString)
 -> Parser RawPrimitive ByteString)
-> (RawPrimitive -> Either ParseError ByteString)
-> Parser RawPrimitive ByteString
forall a b. (a -> b) -> a -> b
$
    \case
        LengthDelimitedField ByteString
bs -> ByteString -> Either ParseError ByteString
forall a. a -> Either ParseError a
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
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError ByteString
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"bytes" RawPrimitive
wrong

-- | Parse a Boolean value.
bool :: Parser RawPrimitive Bool
bool :: Parser RawPrimitive Bool
bool = (RawPrimitive -> Either ParseError Bool)
-> Parser RawPrimitive Bool
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError Bool)
 -> Parser RawPrimitive Bool)
-> (RawPrimitive -> Either ParseError Bool)
-> Parser RawPrimitive Bool
forall a b. (a -> b) -> a -> b
$
    \case
        VarintField Word64
i -> Bool -> Either ParseError Bool
forall a. a -> Either ParseError a
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
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError Bool
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"bool" RawPrimitive
wrong

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

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

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

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

-- | Parse a primitive with the @sint32@ wire type.
sint32 :: Parser RawPrimitive Int32
sint32 :: Parser RawPrimitive Int32
sint32 = (Word32 -> Int32)
-> Parser RawPrimitive Word32 -> Parser RawPrimitive Int32
forall a b.
(a -> b) -> Parser RawPrimitive a -> Parser RawPrimitive b
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 RawPrimitive Word32
forall a. Integral a => Parser RawPrimitive a
parseVarInt

-- | Parse a primitive with the @sint64@ wire type.
sint64 :: Parser RawPrimitive Int64
sint64 :: Parser RawPrimitive Int64
sint64 = (Word64 -> Int64)
-> Parser RawPrimitive Word64 -> Parser RawPrimitive Int64
forall a b.
(a -> b) -> Parser RawPrimitive a -> Parser RawPrimitive b
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 RawPrimitive Word64
forall a. Integral a => Parser RawPrimitive a
parseVarInt

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

-- | Parse a primitive with the @bytes@ wire type as a lazy 'BL.ByteString'.
lazyByteString :: Parser RawPrimitive BL.ByteString
lazyByteString :: Parser RawPrimitive ByteString
lazyByteString = (ByteString -> ByteString)
-> Parser RawPrimitive ByteString -> Parser RawPrimitive ByteString
forall a b.
(a -> b) -> Parser RawPrimitive a -> Parser RawPrimitive b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BL.fromStrict Parser RawPrimitive ByteString
bytes

-- | Parse a primitive with the @bytes@ wire type as a 'BS.ShortByteString'.
shortByteString :: Parser RawPrimitive BS.ShortByteString
shortByteString :: Parser RawPrimitive ShortByteString
shortByteString = (RawPrimitive -> Either ParseError ShortByteString)
-> Parser RawPrimitive ShortByteString
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError ShortByteString)
 -> Parser RawPrimitive ShortByteString)
-> (RawPrimitive -> Either ParseError ShortByteString)
-> Parser RawPrimitive ShortByteString
forall a b. (a -> b) -> a -> b
$
    \case
        LengthDelimitedField ByteString
bs -> ShortByteString -> Either ParseError ShortByteString
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString -> Either ParseError ShortByteString)
-> ShortByteString -> Either ParseError ShortByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ShortByteString
BS.toShort ByteString
bs
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError ShortByteString
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"bytes" RawPrimitive
wrong

-- | Parse a primitive with the @bytes@ wire type as 'Text'.
text :: Parser RawPrimitive Text
text :: Parser RawPrimitive Text
text = (RawPrimitive -> Either ParseError Text)
-> Parser RawPrimitive Text
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError Text)
 -> Parser RawPrimitive Text)
-> (RawPrimitive -> Either ParseError Text)
-> Parser RawPrimitive 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 ([Char] -> Text
pack ([Char]
"Failed to decode UTF-8: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
                                                         UnicodeException -> [Char]
forall a. Show a => a -> [Char]
show UnicodeException
err)))
                Right Text
txt -> Text -> Either ParseError Text
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError Text
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"string" RawPrimitive
wrong

-- | Parse a primitive with the @bytes@ wire type as `Text.Short.ShortText`.
shortText :: Parser RawPrimitive Text.Short.ShortText
shortText :: Parser RawPrimitive ShortText
shortText = (RawPrimitive -> Either ParseError ShortText)
-> Parser RawPrimitive ShortText
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError ShortText)
 -> Parser RawPrimitive ShortText)
-> (RawPrimitive -> Either ParseError ShortText)
-> Parser RawPrimitive ShortText
forall a b. (a -> b) -> a -> b
$
    \case
        LengthDelimitedField ByteString
bs ->
            case ByteString -> Maybe ShortText
Text.Short.fromByteString ByteString
bs of
                Maybe ShortText
Nothing -> ParseError -> Either ParseError ShortText
forall a b. a -> Either a b
Left (Text -> ParseError
BinaryError ([Char] -> Text
pack ([Char]
"Failed to decode UTF-8")))
                Just ShortText
txt -> ShortText -> Either ParseError ShortText
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortText
txt
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError ShortText
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"string" RawPrimitive
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 :: forall e. ProtoEnum e => Parser RawPrimitive (Either Int32 e)
enum = (Int32 -> Either Int32 e)
-> Parser RawPrimitive Int32
-> Parser RawPrimitive (Either Int32 e)
forall a b.
(a -> b) -> Parser RawPrimitive a -> Parser RawPrimitive b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Either Int32 e
toEither Parser RawPrimitive Int32
forall a. Integral a => Parser RawPrimitive 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 :: forall a. Integral a => Parser RawPrimitive [a]
packedVarints = ([Word64] -> [a])
-> Parser RawPrimitive [Word64] -> Parser RawPrimitive [a]
forall a b.
(a -> b) -> Parser RawPrimitive a -> Parser RawPrimitive b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64 -> a) -> [Word64] -> [a]
forall a b. (a -> b) -> [a] -> [b]
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 RawPrimitive [Word64]
forall a. Get a -> Parser RawPrimitive a
runGetPacked (Get Word64 -> Get [Word64]
forall a. Get a -> Get [a]
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 {p}. Bits p => p -> Bool
base128Terminal Word8
w8
            then t -> Get t
forall a. a -> Get a
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 :: p -> Bool
base128Terminal p
w8 = (Bool -> Bool
not (Bool -> Bool) -> (p -> Bool) -> p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7)) (p -> Bool) -> p -> Bool
forall a b. (a -> b) -> a -> b
$ p
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 RawPrimitive [Float]
packedFloats = Get [Float] -> Parser RawPrimitive [Float]
forall a. Get a -> Parser RawPrimitive a
runGetPacked (Get Float -> Get [Float]
forall a. Get a -> Get [a]
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 RawPrimitive [Double]
packedDoubles = Get [Double] -> Parser RawPrimitive [Double]
forall a. Get a -> Parser RawPrimitive a
runGetPacked (Get Double -> Get [Double]
forall a. Get a -> Get [a]
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 :: forall a. Integral a => Parser RawPrimitive [a]
packedFixed32 = ([Word32] -> [a])
-> Parser RawPrimitive [Word32] -> Parser RawPrimitive [a]
forall a b.
(a -> b) -> Parser RawPrimitive a -> Parser RawPrimitive b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word32 -> a) -> [Word32] -> [a]
forall a b. (a -> b) -> [a] -> [b]
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 RawPrimitive [Word32]
forall a. Get a -> Parser RawPrimitive a
runGetPacked (Get Word32 -> Get [Word32]
forall a. Get a -> Get [a]
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 :: forall a. Integral a => Parser RawPrimitive [a]
packedFixed64 = ([Word64] -> [a])
-> Parser RawPrimitive [Word64] -> Parser RawPrimitive [a]
forall a b.
(a -> b) -> Parser RawPrimitive a -> Parser RawPrimitive b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64 -> a) -> [Word64] -> [a]
forall a b. (a -> b) -> [a] -> [b]
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 RawPrimitive [Word64]
forall a. Get a -> Parser RawPrimitive a
runGetPacked (Get Word64 -> Get [Word64]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get Word64
getWord64le))

-- | Parse a @float@.
float :: Parser RawPrimitive Float
float :: Parser RawPrimitive Float
float = Get Float -> Parser RawPrimitive Float
forall a. Get a -> Parser RawPrimitive a
runGetFixed32 Get Float
getFloat32le

-- | Parse a @double@.
double :: Parser RawPrimitive Double
double :: Parser RawPrimitive Double
double = Get Double -> Parser RawPrimitive Double
forall a. Get a -> Parser RawPrimitive a
runGetFixed64 Get Double
getFloat64le

-- | Parse an integer primitive with the @fixed32@ wire type.
fixed32 :: Parser RawPrimitive Word32
fixed32 :: Parser RawPrimitive Word32
fixed32 = Get Word32 -> Parser RawPrimitive Word32
forall a. Get a -> Parser RawPrimitive a
runGetFixed32 Get Word32
getWord32le

-- | Parse an integer primitive with the @fixed64@ wire type.
fixed64 :: Parser RawPrimitive Word64
fixed64 :: Parser RawPrimitive Word64
fixed64 = Get Word64 -> Parser RawPrimitive Word64
forall a. Get a -> Parser RawPrimitive a
runGetFixed64 Get Word64
getWord64le

-- | Parse a signed integer primitive with the @fixed32@ wire type.
sfixed32 :: Parser RawPrimitive Int32
sfixed32 :: Parser RawPrimitive Int32
sfixed32 = Get Int32 -> Parser RawPrimitive Int32
forall a. Get a -> Parser RawPrimitive a
runGetFixed32 Get Int32
getInt32le

-- | Parse a signed integer primitive with the @fixed64@ wire type.
sfixed64 :: Parser RawPrimitive Int64
sfixed64 :: Parser RawPrimitive Int64
sfixed64 = Get Int64 -> Parser RawPrimitive Int64
forall a. Get a -> Parser RawPrimitive 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 :: forall a.
Parser [RawPrimitive] a -> FieldNumber -> Parser RawMessage a
at Parser [RawPrimitive] 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 [RawPrimitive] a -> [RawPrimitive] -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser [RawPrimitive] a
parser ([RawPrimitive] -> Either ParseError a)
-> (RawMessage -> [RawPrimitive])
-> RawMessage
-> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RawPrimitive] -> Maybe [RawPrimitive] -> [RawPrimitive]
forall a. a -> Maybe a -> a
fromMaybe [RawPrimitive]
forall a. Monoid a => a
mempty (Maybe [RawPrimitive] -> [RawPrimitive])
-> (RawMessage -> Maybe [RawPrimitive])
-> RawMessage
-> [RawPrimitive]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RawMessage -> Maybe [RawPrimitive]
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)
{-# INLINE at #-}

-- | 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 :: forall a.
a
-> [(FieldNumber, Parser [RawPrimitive] a)] -> Parser RawMessage a
oneof a
def [(FieldNumber, Parser [RawPrimitive] 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 [RawPrimitive] a, [RawPrimitive])]
-> Maybe (Parser [RawPrimitive] a, [RawPrimitive])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((\(FieldNumber
num,Parser [RawPrimitive] a
p) -> (Parser [RawPrimitive] a
p,) ([RawPrimitive] -> (Parser [RawPrimitive] a, [RawPrimitive]))
-> Maybe [RawPrimitive]
-> Maybe (Parser [RawPrimitive] a, [RawPrimitive])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RawMessage -> Maybe [RawPrimitive]
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 [RawPrimitive] a)
 -> Maybe (Parser [RawPrimitive] a, [RawPrimitive]))
-> [(FieldNumber, Parser [RawPrimitive] a)]
-> [Maybe (Parser [RawPrimitive] a, [RawPrimitive])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FieldNumber, Parser [RawPrimitive] a)]
parsersByFieldNum) of
    Maybe (Parser [RawPrimitive] a, [RawPrimitive])
Nothing     -> a -> Either ParseError a
forall a. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
    Just (Parser [RawPrimitive] a
p, [RawPrimitive]
v) -> Parser [RawPrimitive] a -> [RawPrimitive] -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser [RawPrimitive] a
p [RawPrimitive]
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 :: forall a. Parser RawPrimitive a -> a -> Parser [RawPrimitive] a
one Parser RawPrimitive a
parser a
def = ([RawPrimitive] -> Either ParseError a) -> Parser [RawPrimitive] a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((Maybe a -> a)
-> Either ParseError (Maybe a) -> Either ParseError a
forall a b. (a -> b) -> Either ParseError a -> Either ParseError b
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)
-> ([RawPrimitive] -> Either ParseError (Maybe a))
-> [RawPrimitive]
-> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawPrimitive -> Either ParseError a)
-> Maybe RawPrimitive -> Either ParseError (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Parser RawPrimitive a -> RawPrimitive -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser RawPrimitive a
parser) (Maybe RawPrimitive -> Either ParseError (Maybe a))
-> ([RawPrimitive] -> Maybe RawPrimitive)
-> [RawPrimitive]
-> Either ParseError (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RawPrimitive] -> Maybe RawPrimitive
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 :: forall a. Parser RawPrimitive a -> Parser [RawPrimitive] [a]
repeated Parser RawPrimitive a
parser = ([RawPrimitive] -> Either ParseError [a])
-> Parser [RawPrimitive] [a]
forall input a. (input -> Either ParseError a) -> Parser input a
Parser (([RawPrimitive] -> Either ParseError [a])
 -> Parser [RawPrimitive] [a])
-> ([RawPrimitive] -> Either ParseError [a])
-> Parser [RawPrimitive] [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> Either ParseError [a] -> Either ParseError [a]
forall a b. (a -> b) -> Either ParseError a -> Either ParseError b
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])
-> ([RawPrimitive] -> Either ParseError [a])
-> [RawPrimitive]
-> Either ParseError [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawPrimitive -> Either ParseError a)
-> [RawPrimitive] -> Either ParseError [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Parser RawPrimitive a -> RawPrimitive -> Either ParseError a
forall input a. Parser input a -> input -> Either ParseError a
runParser Parser RawPrimitive a
parser)


embeddedParseError :: String -> ParseError
embeddedParseError :: [Char] -> ParseError
embeddedParseError [Char]
err = Text -> Maybe ParseError -> ParseError
EmbeddedError Text
msg Maybe ParseError
forall a. Maybe a
Nothing
  where
    msg :: Text
msg = Text
"Failed to parse embedded message: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack [Char]
err)
{-# NOINLINE embeddedParseError #-}

-- | 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 :: RawPrimitive -> Either ParseError RawMessage
embeddedToParsedFields (LengthDelimitedField ByteString
bs) =
    case ByteString -> Either [Char] RawMessage
decodeWireMessage ByteString
bs of
        Left [Char]
err -> ParseError -> Either ParseError RawMessage
forall a b. a -> Either a b
Left ([Char] -> ParseError
embeddedParseError [Char]
err)
        Right RawMessage
result -> RawMessage -> Either ParseError RawMessage
forall a b. b -> Either a b
Right RawMessage
result
embeddedToParsedFields RawPrimitive
wrong =
    [Char] -> RawPrimitive -> Either ParseError RawMessage
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"embedded" RawPrimitive
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 :: forall a. Parser RawMessage a -> Parser [RawPrimitive] (Maybe a)
embedded Parser RawMessage a
p = ([RawPrimitive] -> Either ParseError (Maybe a))
-> Parser [RawPrimitive] (Maybe a)
forall input a. (input -> Either ParseError a) -> Parser input a
Parser (([RawPrimitive] -> Either ParseError (Maybe a))
 -> Parser [RawPrimitive] (Maybe a))
-> ([RawPrimitive] -> Either ParseError (Maybe a))
-> Parser [RawPrimitive] (Maybe a)
forall a b. (a -> b) -> a -> b
$
    \[RawPrimitive]
xs -> if [RawPrimitive]
xs [RawPrimitive] -> [RawPrimitive] -> Bool
forall a. Eq a => a -> a -> Bool
== [RawPrimitive]
forall a. [a]
forall (f :: * -> *) a. Alternative f => f a
empty
           then Maybe a -> Either ParseError (Maybe a)
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
           else do
               [RawMessage]
innerMaps <- (RawPrimitive -> Either ParseError RawMessage)
-> [RawPrimitive] -> Either ParseError [RawMessage]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
T.mapM RawPrimitive -> Either ParseError RawMessage
embeddedToParsedFields [RawPrimitive]
xs
               let combinedMap :: RawMessage
combinedMap = (RawMessage -> RawMessage -> RawMessage)
-> RawMessage -> [RawMessage] -> RawMessage
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([RawPrimitive] -> [RawPrimitive] -> [RawPrimitive])
-> RawMessage -> RawMessage -> RawMessage
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
M.unionWith [RawPrimitive] -> [RawPrimitive] -> [RawPrimitive]
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 a. a -> Either ParseError 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
{-# INLINE embedded #-}

-- | 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' :: forall a. Parser RawMessage a -> Parser RawPrimitive a
embedded' Parser RawMessage a
parser = (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a
forall input a. (input -> Either ParseError a) -> Parser input a
Parser ((RawPrimitive -> Either ParseError a) -> Parser RawPrimitive a)
-> (RawPrimitive -> Either ParseError a) -> Parser RawPrimitive 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 a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
        RawPrimitive
wrong -> [Char] -> RawPrimitive -> Either ParseError a
forall expected.
[Char] -> RawPrimitive -> Either ParseError expected
throwWireTypeError [Char]
"embedded" RawPrimitive
wrong
{-# INLINE embedded' #-}



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