{-# Language BangPatterns #-}
{- | 
Here are the serialization and deserialization functions.

This module cooperates with the generated code to implement the Wire
instances.  The encoding is mostly documented at
<http://code.google.com/apis/protocolbuffers/docs/encoding.html>.

The user API functions are grouped into sections and documented.  The
rest are for internal use.  The main functions are 'messageGet' and
'messagePut' (and 'messageSize').  There are then several 'message*'
variants which allow for finer control and for making delimited
messages.
-}
module Text.ProtocolBuffers.WireMessage
    ( -- * User API functions
      -- ** Main encoding and decoding operations (non-delimited message encoding)
      messageSize,messagePut,messageGet,messagePutM,messageGetM
      -- ** These should agree with the length delimited message format of protobuf-2.10, where the message size preceeds the data.
    , messageWithLengthSize,messageWithLengthPut,messageWithLengthGet,messageWithLengthPutM,messageWithLengthGetM
      -- ** Encoding to write or read a single message field (good for delimited messages or incremental use)
    , messageAsFieldSize,messageAsFieldPutM,messageAsFieldGetM
      -- ** The Put monad from the binary package, and a custom binary Get monad ("Text.ProtocolBuffers.Get")
    , Put,PutM,Get,runPut,runPutM,runGet,runGetOnLazy,getFromBS
      -- * The Wire monad itself.  Users should beware that passing an incompatible 'FieldType' is a runtime error or fail
    , Wire(..)
      -- * The internal exports, for use by generated code and the "Text.ProtcolBuffer.Extensions" module
    , size'WireTag,size'WireSize,toWireType,toWireTag,toPackedWireTag,mkWireTag
    , prependMessageSize,putSize,putVarUInt,getVarInt,putLazyByteString,splitWireTag,fieldIdOf
    , wireSizeReq,wireSizeOpt,wireSizeRep,wireSizePacked
    , wirePutReq,wirePutOpt,wirePutRep,wirePutPacked
    , wirePutReqWithSize,wirePutOptWithSize,wirePutRepWithSize,wirePutPackedWithSize
    , sequencePutWithSize
    , wireSizeErr,wirePutErr,wireGetErr
    , getMessageWith,getBareMessageWith,wireGetEnum,wireGetPackedEnum
    , unknownField,unknown,wireGetFromWire
    , castWord64ToDouble,castWord32ToFloat,castDoubleToWord64,castFloatToWord32
    , zzEncode64,zzEncode32,zzDecode64,zzDecode32
    ) where

import Control.Monad(when,foldM)
import Control.Monad.Error.Class(throwError)
import Control.Monad.ST
import Data.Array.ST(newArray,readArray)
import Data.Array.Unsafe(castSTUArray)
import Data.Bits (Bits(..))
--import qualified Data.ByteString as S(last)
--import qualified Data.ByteString.Unsafe as S(unsafeIndex)
import qualified Data.ByteString.Lazy as BS (length)
import qualified Data.Foldable as F(foldl', Foldable)
--import Data.List (genericLength)
import Data.Maybe(fromMaybe)
import Data.Sequence ((|>))
import qualified Data.Sequence as Seq(length,empty)
import qualified Data.Set as Set(delete,null)
import Data.Typeable (Typeable,typeOf)
-- GHC internals for getting at Double and Float representation as Word64 and Word32
-- This has been superceded by the ST array trick (ugly, but promised to work)
--import GHC.Exts (Double(D#),Float(F#),unsafeCoerce#)
--import GHC.Word (Word64(W64#)) -- ,Word32(W32#))
-- binary package
import Data.Binary.Put (Put,PutM,runPutM,runPut,putWord8,putWord32le,putWord64le,putLazyByteString)

import Text.ProtocolBuffers.Basic
import Text.ProtocolBuffers.Get as Get (Result(..),Get,runGet,runGetAll,bytesRead,isReallyEmpty,decode7unrolled
                                       ,spanOf,skip,lookAhead,highBitRun -- ,getByteString,getWord8,decode7
                                       ,getWord32le,getWord64le,getLazyByteString)
import Text.ProtocolBuffers.Reflections(ReflectDescriptor(reflectDescriptorInfo,getMessageInfo)
                                       ,DescriptorInfo(..),GetMessageInfo(..))

-- import Debug.Trace(trace)

trace :: a -> b -> b
trace :: a -> b -> b
trace a
_  = b -> b
forall a. a -> a
id

-- External user API for writing and reading messages

-- | This computes the size of the message's fields with tags on the
-- wire with no initial tag or length (in bytes).  This is also the
-- length of the message as placed between group start and stop tags.
messageSize :: (ReflectDescriptor msg,Wire msg) => msg -> WireSize
messageSize :: msg -> WireSize
messageSize msg
msg = FieldType -> msg -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
wireSize FieldType
10 msg
msg

-- | This computes the size of the message fields as in 'messageSize'
-- and add the length of the encoded size to the total.  Thus this is
-- the the length of the message including the encoded length header,
-- but without any leading tag.
messageWithLengthSize :: (ReflectDescriptor msg,Wire msg) => msg -> WireSize
messageWithLengthSize :: msg -> WireSize
messageWithLengthSize msg
msg = FieldType -> msg -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
wireSize FieldType
11 msg
msg

-- | This computes the size of the 'messageWithLengthSize' and then
-- adds the length an initial tag with the given 'FieldId'.
messageAsFieldSize :: (ReflectDescriptor msg,Wire msg) => FieldId -> msg -> WireSize
messageAsFieldSize :: FieldId -> msg -> WireSize
messageAsFieldSize FieldId
fi msg
msg = let headerSize :: WireSize
headerSize = WireTag -> WireSize
size'WireTag (FieldId -> FieldType -> WireTag
toWireTag FieldId
fi FieldType
11)
                            in WireSize
headerSize WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ msg -> WireSize
forall msg. (ReflectDescriptor msg, Wire msg) => msg -> WireSize
messageWithLengthSize msg
msg

-- | This is 'runPut' applied to 'messagePutM'. It result in a
-- 'ByteString' with a length of 'messageSize' bytes.
messagePut :: (ReflectDescriptor msg, Wire msg) => msg -> ByteString
messagePut :: msg -> ByteString
messagePut msg
msg = Put -> ByteString
runPut (msg -> Put
forall msg. (ReflectDescriptor msg, Wire msg) => msg -> Put
messagePutM msg
msg)

-- | This is 'runPut' applied to 'messageWithLengthPutM'.  It results
-- in a 'ByteString' with a length of 'messageWithLengthSize' bytes.
messageWithLengthPut :: (ReflectDescriptor msg, Wire msg) => msg -> ByteString
messageWithLengthPut :: msg -> ByteString
messageWithLengthPut msg
msg = Put -> ByteString
runPut (msg -> Put
forall msg. (ReflectDescriptor msg, Wire msg) => msg -> Put
messageWithLengthPutM msg
msg)

-- | This writes just the message's fields with tags to the wire.  This
-- 'Put' monad can be composed and eventually executed with 'runPut'.
--
-- This is actually @ wirePut 10 msg @
messagePutM :: (ReflectDescriptor msg, Wire msg) => msg -> Put
messagePutM :: msg -> Put
messagePutM msg
msg = FieldType -> msg -> Put
forall b. Wire b => FieldType -> b -> Put
wirePut FieldType
10 msg
msg

-- | This writes the encoded length of the message's fields and then
--  the message's fields with tags to the wire.  This 'Put' monad can
--  be composed and eventually executed with 'runPut'.
--
-- This is actually @ wirePut 11 msg @
messageWithLengthPutM :: (ReflectDescriptor msg, Wire msg) => msg -> Put
messageWithLengthPutM :: msg -> Put
messageWithLengthPutM msg
msg = FieldType -> msg -> Put
forall b. Wire b => FieldType -> b -> Put
wirePut FieldType
11 msg
msg

-- | This writes an encoded wire tag with the given 'FieldId' and then
--  the encoded length of the message's fields and then the message's
--  fields with tags to the wire.  This 'Put' monad can be composed
--  and eventually executed with 'runPut'.
messageAsFieldPutM :: (ReflectDescriptor msg, Wire msg) => FieldId -> msg -> Put
messageAsFieldPutM :: FieldId -> msg -> Put
messageAsFieldPutM FieldId
fi msg
msg = let wireTag :: WireTag
wireTag = FieldId -> FieldType -> WireTag
toWireTag FieldId
fi FieldType
11
                            in WireTag -> FieldType -> msg -> Put
forall v. Wire v => WireTag -> FieldType -> v -> Put
wirePutReq WireTag
wireTag FieldType
11 msg
msg

-- | This consumes the 'ByteString' to decode a message.  It assumes
-- the 'ByteString' is merely a sequence of the tagged fields of the
-- message, and consumes until a group stop tag is detected or the
-- entire input is consumed.  Any 'ByteString' past the end of the
-- stop tag is returned as well.
--
-- This is 'runGetOnLazy' applied to 'messageGetM'.
messageGet :: (ReflectDescriptor msg, Wire msg) => ByteString -> Either String (msg,ByteString)
messageGet :: ByteString -> Either String (msg, ByteString)
messageGet ByteString
bs = Get msg -> ByteString -> Either String (msg, ByteString)
forall r. Get r -> ByteString -> Either String (r, ByteString)
runGetOnLazy Get msg
forall msg. (ReflectDescriptor msg, Wire msg) => Get msg
messageGetM ByteString
bs

-- | This 'runGetOnLazy' applied to 'messageWithLengthGetM'.
--
-- This first reads the encoded length of the message and will then
-- succeed when it has consumed precisely this many additional bytes.
-- The 'ByteString' after this point will be returned.
messageWithLengthGet :: (ReflectDescriptor msg, Wire msg) => ByteString -> Either String (msg,ByteString)
messageWithLengthGet :: ByteString -> Either String (msg, ByteString)
messageWithLengthGet ByteString
bs = Get msg -> ByteString -> Either String (msg, ByteString)
forall r. Get r -> ByteString -> Either String (r, ByteString)
runGetOnLazy Get msg
forall msg. (ReflectDescriptor msg, Wire msg) => Get msg
messageWithLengthGetM ByteString
bs

-- | This reads the tagged message fields until the stop tag or the
-- end of input is reached.
--
-- This is actually @ wireGet 10 msg @
messageGetM :: (ReflectDescriptor msg, Wire msg) => Get msg
messageGetM :: Get msg
messageGetM = FieldType -> Get msg
forall b. Wire b => FieldType -> Get b
wireGet FieldType
10

-- | This reads the encoded message length and then the message.
--
-- This is actually @ wireGet 11 msg @
messageWithLengthGetM :: (ReflectDescriptor msg, Wire msg) => Get msg
messageWithLengthGetM :: Get msg
messageWithLengthGetM = FieldType -> Get msg
forall b. Wire b => FieldType -> Get b
wireGet FieldType
11

-- | This reads a wire tag (must be of type '2') to get the 'FieldId'.
-- Then the encoded message length is read, followed by the message
-- itself.  Both the 'FieldId' and the message are returned.
--
-- This allows for incremental reading and processing.
messageAsFieldGetM :: (ReflectDescriptor msg, Wire msg) => Get (FieldId,msg)
messageAsFieldGetM :: Get (FieldId, msg)
messageAsFieldGetM = do
  WireTag
wireTag <- (Word32 -> WireTag) -> Get Word32 -> Get WireTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> WireTag
WireTag Get Word32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  let (FieldId
fieldId,WireType
wireType) = WireTag -> (FieldId, WireType)
splitWireTag WireTag
wireTag
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WireType
wireType WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
/= WireType
2) (String -> Get ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"messageAsFieldGetM: wireType was not 2 "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldId, WireType) -> String
forall a. Show a => a -> String
show (FieldId
fieldId,WireType
wireType))
  msg
msg <- FieldType -> Get msg
forall b. Wire b => FieldType -> Get b
wireGet FieldType
11
  (FieldId, msg) -> Get (FieldId, msg)
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldId
fieldId,msg
msg)

-- more functions

-- | This is 'runGetOnLazy' with the 'Left' results converted to
-- 'error' calls and the trailing 'ByteString' discarded.  This use of
-- runtime errors is discouraged, but may be convenient.
getFromBS :: Get r -> ByteString -> r
getFromBS :: Get r -> ByteString -> r
getFromBS Get r
parser ByteString
bs = case Get r -> ByteString -> Either String (r, ByteString)
forall r. Get r -> ByteString -> Either String (r, ByteString)
runGetOnLazy Get r
parser ByteString
bs of
                        Left String
msg -> String -> r
forall a. HasCallStack => String -> a
error String
msg
                        Right (r
r,ByteString
_) -> r
r

-- | This is like 'runGet', without the ability to pass in more input
-- beyond the initial ByteString.  Thus the 'ByteString' argument is
-- taken to be the entire input.  To be able to incrementally feed in
-- more input you should use 'runGet' and respond to 'Partial'
-- differently.
runGetOnLazy :: Get r -> ByteString -> Either String (r,ByteString)
runGetOnLazy :: Get r -> ByteString -> Either String (r, ByteString)
runGetOnLazy Get r
parser ByteString
bs = Result r -> Either String (r, ByteString)
forall r. Result r -> Either String (r, ByteString)
resolve (Get r -> ByteString -> Result r
forall a. Get a -> ByteString -> Result a
runGetAll Get r
parser ByteString
bs)
  where resolve :: Result r -> Either String (r,ByteString)
        resolve :: Result r -> Either String (r, ByteString)
resolve (Failed WireSize
i String
s) = String -> Either String (r, ByteString)
forall a b. a -> Either a b
Left (String
"Failed at "String -> String -> String
forall a. [a] -> [a] -> [a]
++WireSize -> String
forall a. Show a => a -> String
show WireSize
iString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" : "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)
        resolve (Finished ByteString
bsOut WireSize
_i r
r) = (r, ByteString) -> Either String (r, ByteString)
forall a b. b -> Either a b
Right (r
r,ByteString
bsOut)
        resolve (Partial Maybe ByteString -> Result r
op) = Result r -> Either String (r, ByteString)
forall r. Result r -> Either String (r, ByteString)
resolve (Maybe ByteString -> Result r
op Maybe ByteString
forall a. Maybe a
Nothing) -- should be impossible

-- | Used in generated code.
prependMessageSize :: WireSize -> WireSize
prependMessageSize :: WireSize -> WireSize
prependMessageSize WireSize
n = WireSize
n WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> WireSize
size'WireSize WireSize
n

{-# INLINE sequencePutWithSize #-}
-- | Used in generated code.
sequencePutWithSize :: F.Foldable f => f (PutM WireSize) -> PutM WireSize
sequencePutWithSize :: f (PutM WireSize) -> PutM WireSize
sequencePutWithSize =
    let combine :: b -> m b -> m b
combine b
size m b
act =
            do b
size2 <- m b
act
               b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$! b
size b -> b -> b
forall a. Num a => a -> a -> a
+ b
size2
    in (WireSize -> PutM WireSize -> PutM WireSize)
-> WireSize -> f (PutM WireSize) -> PutM WireSize
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM WireSize -> PutM WireSize -> PutM WireSize
forall (m :: * -> *) b. (Monad m, Num b) => b -> m b -> m b
combine WireSize
0

{-# INLINE wirePutReqWithSize #-}
-- | Used in generated code.
wirePutReqWithSize :: Wire v => WireTag -> FieldType -> v -> PutM WireSize
wirePutReqWithSize :: WireTag -> FieldType -> v -> PutM WireSize
wirePutReqWithSize WireTag
wireTag FieldType
fieldType v
v =
  let startTag :: Word32
startTag = WireTag -> Word32
getWireTag WireTag
wireTag
      endTag :: Word32
endTag = Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
startTag
      putTag :: Word32 -> PutM WireSize
putTag Word32
tag = Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt Word32
tag Put -> PutM WireSize -> PutM WireSize
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WireSize -> PutM WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> WireSize
size'Word32 Word32
tag)
      putAct :: PutM WireSize
putAct = FieldType -> v -> PutM WireSize
forall b. Wire b => FieldType -> b -> PutM WireSize
wirePutWithSize FieldType
fieldType v
v
  in case FieldType
fieldType of
       FieldType
10 -> [PutM WireSize] -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
sequencePutWithSize [Word32 -> PutM WireSize
putTag Word32
startTag, PutM WireSize
putAct, Word32 -> PutM WireSize
putTag Word32
endTag]
       FieldType
_ -> [PutM WireSize] -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
sequencePutWithSize [Word32 -> PutM WireSize
putTag Word32
startTag, PutM WireSize
putAct]

{-# INLINE wirePutOptWithSize #-}
-- | Used in generated code.
wirePutOptWithSize :: Wire v => WireTag -> FieldType -> Maybe v -> PutM WireSize
wirePutOptWithSize :: WireTag -> FieldType -> Maybe v -> PutM WireSize
wirePutOptWithSize WireTag
_wireTag FieldType
_fieldType Maybe v
Nothing = WireSize -> PutM WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return WireSize
0
wirePutOptWithSize WireTag
wireTag FieldType
fieldType (Just v
v) = WireTag -> FieldType -> v -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> v -> PutM WireSize
wirePutReqWithSize WireTag
wireTag FieldType
fieldType v
v

{-# INLINE wirePutRepWithSize #-}
-- | Used in generated code.
wirePutRepWithSize :: Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
wirePutRepWithSize :: WireTag -> FieldType -> Seq v -> PutM WireSize
wirePutRepWithSize WireTag
wireTag FieldType
fieldType Seq v
vs =
  Seq (PutM WireSize) -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
sequencePutWithSize (Seq (PutM WireSize) -> PutM WireSize)
-> Seq (PutM WireSize) -> PutM WireSize
forall a b. (a -> b) -> a -> b
$ (v -> PutM WireSize) -> Seq v -> Seq (PutM WireSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WireTag -> FieldType -> v -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> v -> PutM WireSize
wirePutReqWithSize WireTag
wireTag FieldType
fieldType) Seq v
vs

{-# INLINE wirePutPackedWithSize #-}
-- | Used in generated code.
wirePutPackedWithSize :: Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
wirePutPackedWithSize :: WireTag -> FieldType -> Seq v -> PutM WireSize
wirePutPackedWithSize WireTag
wireTag FieldType
fieldType Seq v
vs =
  let actInner :: PutM WireSize
actInner = Seq (PutM WireSize) -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
sequencePutWithSize (Seq (PutM WireSize) -> PutM WireSize)
-> Seq (PutM WireSize) -> PutM WireSize
forall a b. (a -> b) -> a -> b
$ (v -> PutM WireSize) -> Seq v -> Seq (PutM WireSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldType -> v -> PutM WireSize
forall b. Wire b => FieldType -> b -> PutM WireSize
wirePutWithSize FieldType
fieldType) Seq v
vs
      (WireSize
size, ByteString
_) = PutM WireSize -> (WireSize, ByteString)
forall a. PutM a -> (a, ByteString)
runPutM PutM WireSize
actInner -- This should be lazy enough not to allocate the ByteString
      tagSize :: WireSize
tagSize = WireTag -> WireSize
size'WireTag WireTag
wireTag
      putTag :: WireTag -> PutM WireSize
putTag WireTag
tag = Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt (WireTag -> Word32
getWireTag WireTag
tag) Put -> PutM WireSize -> PutM WireSize
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WireSize -> PutM WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return WireSize
tagSize
  in [PutM WireSize] -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
sequencePutWithSize [WireTag -> PutM WireSize
putTag WireTag
wireTag, WireSize -> Put
putSize WireSize
sizePut -> PutM WireSize -> PutM WireSize
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>WireSize -> PutM WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return (WireSize -> WireSize
size'WireSize WireSize
size), PutM WireSize
actInner]

{-# INLINE wirePutReq #-}
-- | Used in generated code.
wirePutReq :: Wire v => WireTag -> FieldType -> v -> Put
wirePutReq :: WireTag -> FieldType -> v -> Put
wirePutReq WireTag
wireTag FieldType
fieldType v
v = WireTag -> FieldType -> v -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> v -> PutM WireSize
wirePutReqWithSize WireTag
wireTag FieldType
fieldType v
v PutM WireSize -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE wirePutOpt #-}
-- | Used in generated code.
wirePutOpt :: Wire v => WireTag -> FieldType -> Maybe v -> Put
wirePutOpt :: WireTag -> FieldType -> Maybe v -> Put
wirePutOpt WireTag
wireTag FieldType
fieldType Maybe v
v = WireTag -> FieldType -> Maybe v -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
wirePutOptWithSize WireTag
wireTag FieldType
fieldType Maybe v
v PutM WireSize -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE wirePutRep #-}
-- | Used in generated code.
wirePutRep :: Wire v => WireTag -> FieldType -> Seq v -> Put
wirePutRep :: WireTag -> FieldType -> Seq v -> Put
wirePutRep WireTag
wireTag FieldType
fieldType Seq v
vs = WireTag -> FieldType -> Seq v -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
wirePutRepWithSize WireTag
wireTag FieldType
fieldType Seq v
vs PutM WireSize -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE wirePutPacked #-}
-- | Used in generated code.
wirePutPacked :: Wire v => WireTag -> FieldType -> Seq v -> Put
wirePutPacked :: WireTag -> FieldType -> Seq v -> Put
wirePutPacked WireTag
wireTag FieldType
fieldType Seq v
vs = WireTag -> FieldType -> Seq v -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
wirePutPackedWithSize WireTag
wireTag FieldType
fieldType Seq v
vs PutM WireSize -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE wireSizeReq #-}
-- | Used in generated code.
wireSizeReq :: Wire v => Int64 -> FieldType -> v -> Int64
wireSizeReq :: WireSize -> FieldType -> v -> WireSize
wireSizeReq WireSize
tagSize FieldType
10 v
v = WireSize
tagSize WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ FieldType -> v -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
wireSize FieldType
10 v
v WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize
tagSize
wireSizeReq WireSize
tagSize FieldType
fieldType v
v = WireSize
tagSize WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ FieldType -> v -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
wireSize FieldType
fieldType v
v

{-# INLINE wireSizeOpt #-}
-- | Used in generated code.
wireSizeOpt :: Wire v => Int64 -> FieldType -> Maybe v -> Int64
wireSizeOpt :: WireSize -> FieldType -> Maybe v -> WireSize
wireSizeOpt WireSize
_tagSize FieldType
_i Maybe v
Nothing = WireSize
0
wireSizeOpt WireSize
tagSize FieldType
i (Just v
v) = WireSize -> FieldType -> v -> WireSize
forall v. Wire v => WireSize -> FieldType -> v -> WireSize
wireSizeReq WireSize
tagSize FieldType
i v
v

{-# INLINE wireSizeRep #-}
-- | Used in generated code.
wireSizeRep :: Wire v => Int64 -> FieldType -> Seq v -> Int64
wireSizeRep :: WireSize -> FieldType -> Seq v -> WireSize
wireSizeRep WireSize
tagSize FieldType
i Seq v
vs = (WireSize -> v -> WireSize) -> WireSize -> Seq v -> WireSize
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\WireSize
n v
v -> WireSize
n WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> v -> WireSize
forall v. Wire v => WireSize -> FieldType -> v -> WireSize
wireSizeReq WireSize
tagSize FieldType
i v
v) WireSize
0 Seq v
vs

{-# INLINE wireSizePacked #-}
-- | Used in generated code.
wireSizePacked :: Wire v => Int64 -> FieldType -> Seq v -> Int64
wireSizePacked :: WireSize -> FieldType -> Seq v -> WireSize
wireSizePacked WireSize
tagSize FieldType
i Seq v
vs = WireSize
tagSize WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> WireSize
prependMessageSize ((WireSize -> v -> WireSize) -> WireSize -> Seq v -> WireSize
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\WireSize
n v
v -> WireSize
n WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ FieldType -> v -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
wireSize FieldType
i v
v) WireSize
0 Seq v
vs)

{-# INLINE putSize #-}
-- | Used in generated code.
putSize :: WireSize -> Put
putSize :: WireSize -> Put
putSize = WireSize -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt

toPackedWireTag :: FieldId -> WireTag
toPackedWireTag :: FieldId -> WireTag
toPackedWireTag FieldId
fieldId = FieldId -> WireType -> WireTag
mkWireTag FieldId
fieldId WireType
2 {- packed always uses Length delimited and has wire type of 2 -}

toWireTag :: FieldId -> FieldType -> WireTag
toWireTag :: FieldId -> FieldType -> WireTag
toWireTag FieldId
fieldId FieldType
fieldType
    = FieldId -> WireType -> WireTag
mkWireTag FieldId
fieldId (FieldType -> WireType
toWireType FieldType
fieldType)

mkWireTag :: FieldId -> WireType -> WireTag
mkWireTag :: FieldId -> WireType -> WireTag
mkWireTag FieldId
fieldId WireType
wireType
    = ((Int32 -> WireTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> WireTag) -> (FieldId -> Int32) -> FieldId -> WireTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldId -> Int32
getFieldId (FieldId -> WireTag) -> FieldId -> WireTag
forall a b. (a -> b) -> a -> b
$ FieldId
fieldId) WireTag -> Int -> WireTag
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) WireTag -> WireTag -> WireTag
forall a. Bits a => a -> a -> a
.|. (Word32 -> WireTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> WireTag) -> (WireType -> Word32) -> WireType -> WireTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireType -> Word32
getWireType (WireType -> WireTag) -> WireType -> WireTag
forall a b. (a -> b) -> a -> b
$ WireType
wireType)

splitWireTag :: WireTag -> (FieldId,WireType)
splitWireTag :: WireTag -> (FieldId, WireType)
splitWireTag (WireTag Word32
wireTag) = ( Int32 -> FieldId
FieldId (Int32 -> FieldId) -> (Word32 -> Int32) -> Word32 -> FieldId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> FieldId) -> Word32 -> FieldId
forall a b. (a -> b) -> a -> b
$ Word32
wireTag Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
                                 , Word32 -> WireType
WireType (Word32 -> WireType) -> (Word32 -> Word32) -> Word32 -> WireType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> WireType) -> Word32 -> WireType
forall a b. (a -> b) -> a -> b
$ Word32
wireTag Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
7 )

fieldIdOf :: WireTag -> FieldId
fieldIdOf :: WireTag -> FieldId
fieldIdOf = (FieldId, WireType) -> FieldId
forall a b. (a, b) -> a
fst ((FieldId, WireType) -> FieldId)
-> (WireTag -> (FieldId, WireType)) -> WireTag -> FieldId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> (FieldId, WireType)
splitWireTag

{-# INLINE wireGetPackedEnum #-}
wireGetPackedEnum :: (Typeable e,Enum e) => (Int -> Maybe e) -> Get (Seq e)
wireGetPackedEnum :: (Int -> Maybe e) -> Get (Seq e)
wireGetPackedEnum Int -> Maybe e
toMaybe'Enum = do
  WireSize
packedLength <- Get WireSize
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  WireSize
start <- Get WireSize
bytesRead
  let stop :: WireSize
stop = WireSize
packedLengthWireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+WireSize
start
      next :: Seq e -> Get (Seq e)
next !Seq e
soFar = do
        WireSize
here <- Get WireSize
bytesRead
        case WireSize -> WireSize -> Ordering
forall a. Ord a => a -> a -> Ordering
compare WireSize
stop WireSize
here of
          Ordering
EQ -> Seq e -> Get (Seq e)
forall (m :: * -> *) a. Monad m => a -> m a
return Seq e
soFar
          Ordering
LT -> WireSize -> Seq e -> WireSize -> WireSize -> Get (Seq e)
tooMuchData WireSize
packedLength Seq e
soFar WireSize
start WireSize
here
          Ordering
GT -> do
            e
value <- (Int -> Maybe e) -> Get e
forall e. (Typeable e, Enum e) => (Int -> Maybe e) -> Get e
wireGetEnum Int -> Maybe e
toMaybe'Enum
            e -> Get (Seq e) -> Get (Seq e)
seq e
value (Get (Seq e) -> Get (Seq e)) -> Get (Seq e) -> Get (Seq e)
forall a b. (a -> b) -> a -> b
$ Seq e -> Get (Seq e)
next (Seq e
soFar Seq e -> e -> Seq e
forall a. Seq a -> a -> Seq a
|> e
value)
  Seq e -> Get (Seq e)
next Seq e
forall a. Seq a
Seq.empty
 where
  Just e
e = Maybe e
forall a. HasCallStack => a
undefined Maybe e -> Maybe e -> Maybe e
forall a. a -> a -> a
`asTypeOf` (Int -> Maybe e
toMaybe'Enum Int
forall a. HasCallStack => a
undefined)
  tooMuchData :: WireSize -> Seq e -> WireSize -> WireSize -> Get (Seq e)
tooMuchData WireSize
packedLength Seq e
soFar WireSize
start WireSize
here =
      String -> Get (Seq e)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Text.ProtocolBuffers.WireMessage.wireGetPackedEnum: overran expected length."
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  The type and count of values so far is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (TypeRep, Int) -> String
forall a. Show a => a -> String
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (e
forall a. HasCallStack => a
undefined e -> e -> e
forall a. a -> a -> a
`asTypeOf` e
e),Seq e -> Int
forall a. Seq a -> Int
Seq.length Seq e
soFar)
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  at (packedLength,start,here) == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (WireSize, WireSize, WireSize) -> String
forall a. Show a => a -> String
show (WireSize
packedLength,WireSize
start,WireSize
here))

{-# INLINE genericPacked #-}
genericPacked :: Wire a => FieldType -> Get (Seq a)
genericPacked :: FieldType -> Get (Seq a)
genericPacked FieldType
ft = do
  WireSize
packedLength <- Get WireSize
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  WireSize
start <- Get WireSize
bytesRead
  let stop :: WireSize
stop = WireSize
packedLengthWireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+WireSize
start
      next :: Seq a -> Get (Seq a)
next !Seq a
soFar = do
        WireSize
here <- Get WireSize
bytesRead
        case WireSize -> WireSize -> Ordering
forall a. Ord a => a -> a -> Ordering
compare WireSize
stop WireSize
here of
          Ordering
EQ -> Seq a -> Get (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return Seq a
soFar
          Ordering
LT -> WireSize -> Seq a -> WireSize -> WireSize -> Get (Seq a)
tooMuchData WireSize
packedLength Seq a
soFar WireSize
start WireSize
here
          Ordering
GT -> do
            a
value <- FieldType -> Get a
forall b. Wire b => FieldType -> Get b
wireGet FieldType
ft
            a -> Get (Seq a) -> Get (Seq a)
seq a
value (Get (Seq a) -> Get (Seq a)) -> Get (Seq a) -> Get (Seq a)
forall a b. (a -> b) -> a -> b
$! Seq a -> Get (Seq a)
next (Seq a -> Get (Seq a)) -> Seq a -> Get (Seq a)
forall a b. (a -> b) -> a -> b
$! Seq a
soFar Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
value
  Seq a -> Get (Seq a)
next Seq a
forall a. Seq a
Seq.empty
 where
  tooMuchData :: WireSize -> Seq a -> WireSize -> WireSize -> Get (Seq a)
tooMuchData WireSize
packedLength Seq a
soFar WireSize
start WireSize
here =
      String -> Get (Seq a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Text.ProtocolBuffers.WireMessage.genericPacked: overran expected length."
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  The FieldType and count of values so far are " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (FieldType, Int) -> String
forall a. Show a => a -> String
show (FieldType
ft,Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
soFar)
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  at (packedLength,start,here) == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (WireSize, WireSize, WireSize) -> String
forall a. Show a => a -> String
show (WireSize
packedLength,WireSize
start,WireSize
here))

-- getMessageWith assumes the wireTag for the message, if it existed, has already been read.
-- getMessageWith assumes that it still needs to read the Varint encoded length of the message.
getMessageWith :: (Default message, ReflectDescriptor message)
--               => (WireTag -> FieldId -> WireType -> message -> Get message)
               => (WireTag -> message -> Get message)
               -> Get message
{- manyTAT.bin testing INLINE getMessageWith but made slower -}
getMessageWith :: (WireTag -> message -> Get message) -> Get message
getMessageWith WireTag -> message -> Get message
updater = do
  WireSize
messageLength <- Get WireSize
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  WireSize
start <- Get WireSize
bytesRead
  let stop :: WireSize
stop = WireSize
messageLengthWireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+WireSize
start
      -- switch from go to go' once all the required fields have been found
      go :: Set WireTag -> message -> Get message
go Set WireTag
reqs !message
message | Set WireTag -> Bool
forall a. Set a -> Bool
Set.null Set WireTag
reqs = message -> Get message
go' message
message
                       | Bool
otherwise = do
        WireSize
here <- Get WireSize
bytesRead
        case WireSize -> WireSize -> Ordering
forall a. Ord a => a -> a -> Ordering
compare WireSize
stop WireSize
here of
          Ordering
EQ -> WireSize -> WireSize -> Get message
notEnoughData WireSize
messageLength WireSize
start
          Ordering
LT -> WireSize -> WireSize -> WireSize -> Get message
tooMuchData WireSize
messageLength WireSize
start WireSize
here
          Ordering
GT -> do
            WireTag
wireTag <- (Word32 -> WireTag) -> Get Word32 -> Get WireTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> WireTag
WireTag Get Word32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt -- get tag off wire
            let -- (fieldId,wireType) = splitWireTag wireTag
                reqs' :: Set WireTag
reqs' = WireTag -> Set WireTag -> Set WireTag
forall a. Ord a => a -> Set a -> Set a
Set.delete WireTag
wireTag Set WireTag
reqs
            WireTag -> message -> Get message
updater WireTag
wireTag {- fieldId wireType -} message
message Get message -> (message -> Get message) -> Get message
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Set WireTag -> message -> Get message
go Set WireTag
reqs'
      go' :: message -> Get message
go' !message
message = do
        WireSize
here <- Get WireSize
bytesRead
        case WireSize -> WireSize -> Ordering
forall a. Ord a => a -> a -> Ordering
compare WireSize
stop WireSize
here of
          Ordering
EQ -> message -> Get message
forall (m :: * -> *) a. Monad m => a -> m a
return message
message
          Ordering
LT -> WireSize -> WireSize -> WireSize -> Get message
tooMuchData WireSize
messageLength WireSize
start WireSize
here
          Ordering
GT -> do
            WireTag
wireTag <- (Word32 -> WireTag) -> Get Word32 -> Get WireTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> WireTag
WireTag Get Word32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt -- get tag off wire
--            let (fieldId,wireType) = splitWireTag wireTag
            WireTag -> message -> Get message
updater WireTag
wireTag {- fieldId wireType -} message
message Get message -> (message -> Get message) -> Get message
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= message -> Get message
go'
  Set WireTag -> message -> Get message
go Set WireTag
required message
initialMessage
 where
  initialMessage :: message
initialMessage = message
forall a. Default a => a
defaultValue
  (GetMessageInfo {requiredTags :: GetMessageInfo -> Set WireTag
requiredTags=Set WireTag
required}) = message -> GetMessageInfo
forall m. ReflectDescriptor m => m -> GetMessageInfo
getMessageInfo message
initialMessage
  notEnoughData :: WireSize -> WireSize -> Get message
notEnoughData WireSize
messageLength WireSize
start =
      String -> Get message
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Text.ProtocolBuffers.WireMessage.getMessageWith: Required fields missing when processing "
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ProtoName -> String
forall a. Show a => a -> String
show (ProtoName -> String)
-> (message -> ProtoName) -> message -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorInfo -> ProtoName
descName (DescriptorInfo -> ProtoName)
-> (message -> DescriptorInfo) -> message -> ProtoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. message -> DescriptorInfo
forall m. ReflectDescriptor m => m -> DescriptorInfo
reflectDescriptorInfo (message -> String) -> message -> String
forall a b. (a -> b) -> a -> b
$ message
initialMessage)
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  at (messageLength,start) == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (WireSize, WireSize) -> String
forall a. Show a => a -> String
show (WireSize
messageLength,WireSize
start))
  tooMuchData :: WireSize -> WireSize -> WireSize -> Get message
tooMuchData WireSize
messageLength WireSize
start WireSize
here =
      String -> Get message
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Text.ProtocolBuffers.WireMessage.getMessageWith: overran expected length when processing"
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ProtoName -> String
forall a. Show a => a -> String
show (ProtoName -> String)
-> (message -> ProtoName) -> message -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorInfo -> ProtoName
descName (DescriptorInfo -> ProtoName)
-> (message -> DescriptorInfo) -> message -> ProtoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. message -> DescriptorInfo
forall m. ReflectDescriptor m => m -> DescriptorInfo
reflectDescriptorInfo (message -> String) -> message -> String
forall a b. (a -> b) -> a -> b
$ message
initialMessage)
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  at  (messageLength,start,here) == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (WireSize, WireSize, WireSize) -> String
forall a. Show a => a -> String
show (WireSize
messageLength,WireSize
start,WireSize
here))

-- | Used by generated code
-- getBareMessageWith assumes the wireTag for the message, if it existed, has already been read.
-- getBareMessageWith assumes that it does needs to read the Varint encoded length of the message.
-- getBareMessageWith will consume the entire ByteString it is operating on, or until it
-- finds any STOP_GROUP tag (wireType == 4)
getBareMessageWith :: (Default message, ReflectDescriptor message)
--                   => (WireTag -> FieldId -> WireType -> message -> Get message) -- handle wireTags that are unknown or produce errors
                   => (WireTag -> message -> Get message) -- handle wireTags that are unknown or produce errors
                   -> Get message
{- manyTAT.bin testing INLINE getBareMessageWith but made slower -}
getBareMessageWith :: (WireTag -> message -> Get message) -> Get message
getBareMessageWith WireTag -> message -> Get message
updater = Set WireTag -> message -> Get message
go Set WireTag
required message
initialMessage
 where
  go :: Set WireTag -> message -> Get message
go Set WireTag
reqs !message
message | Set WireTag -> Bool
forall a. Set a -> Bool
Set.null Set WireTag
reqs = message -> Get message
go' message
message
                   | Bool
otherwise = do
    Bool
done <- Get Bool
isReallyEmpty
    if Bool
done then Get message
notEnoughData
      else do
        WireTag
wireTag <- (Word32 -> WireTag) -> Get Word32 -> Get WireTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> WireTag
WireTag Get Word32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt -- get tag off wire
        let (FieldId
_fieldId,WireType
wireType) = WireTag -> (FieldId, WireType)
splitWireTag WireTag
wireTag
        if WireType
wireType WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
== WireType
4 then Get message
notEnoughData -- END_GROUP too soon
          else let reqs' :: Set WireTag
reqs' = WireTag -> Set WireTag -> Set WireTag
forall a. Ord a => a -> Set a -> Set a
Set.delete WireTag
wireTag Set WireTag
reqs
               in WireTag -> message -> Get message
updater WireTag
wireTag {- fieldId wireType -} message
message Get message -> (message -> Get message) -> Get message
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Set WireTag -> message -> Get message
go Set WireTag
reqs'
  go' :: message -> Get message
go' !message
message = do
    Bool
done <- Get Bool
isReallyEmpty
    if Bool
done then message -> Get message
forall (m :: * -> *) a. Monad m => a -> m a
return message
message
      else do
        WireTag
wireTag <- (Word32 -> WireTag) -> Get Word32 -> Get WireTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> WireTag
WireTag Get Word32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt -- get tag off wire
        let (FieldId
_fieldId,WireType
wireType) = WireTag -> (FieldId, WireType)
splitWireTag WireTag
wireTag
        if WireType
wireType WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
== WireType
4 then message -> Get message
forall (m :: * -> *) a. Monad m => a -> m a
return message
message
          else WireTag -> message -> Get message
updater WireTag
wireTag {- fieldId wireType -} message
message Get message -> (message -> Get message) -> Get message
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= message -> Get message
go'
  initialMessage :: message
initialMessage = message
forall a. Default a => a
defaultValue
  (GetMessageInfo {requiredTags :: GetMessageInfo -> Set WireTag
requiredTags=Set WireTag
required}) = message -> GetMessageInfo
forall m. ReflectDescriptor m => m -> GetMessageInfo
getMessageInfo message
initialMessage
  notEnoughData :: Get message
notEnoughData = String -> Get message
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Text.ProtocolBuffers.WireMessage.getBareMessageWith: Required fields missing when processing "
                              String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ProtoName -> String
forall a. Show a => a -> String
show (ProtoName -> String)
-> (message -> ProtoName) -> message -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorInfo -> ProtoName
descName (DescriptorInfo -> ProtoName)
-> (message -> DescriptorInfo) -> message -> ProtoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. message -> DescriptorInfo
forall m. ReflectDescriptor m => m -> DescriptorInfo
reflectDescriptorInfo (message -> String) -> message -> String
forall a b. (a -> b) -> a -> b
$ message
initialMessage))

unknownField :: Typeable a => a -> FieldId -> Get a
unknownField :: a -> FieldId -> Get a
unknownField a
msg FieldId
fieldId = do 
  WireSize
here <- Get WireSize
bytesRead
  String -> Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Impossible? Text.ProtocolBuffers.WireMessage.unknownField"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n  Updater for "String -> String -> String
forall a. [a] -> [a] -> [a]
++TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
msg)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" claims there is an unknown field id on wire: "String -> String -> String
forall a. [a] -> [a] -> [a]
++FieldId -> String
forall a. Show a => a -> String
show FieldId
fieldId
              String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n  at a position just before byte location "String -> String -> String
forall a. [a] -> [a] -> [a]
++WireSize -> String
forall a. Show a => a -> String
show WireSize
here)


unknown :: (Typeable a,ReflectDescriptor a) => FieldId -> WireType -> a -> Get a
unknown :: FieldId -> WireType -> a -> Get a
unknown FieldId
fieldId WireType
wireType a
initialMessage = do
  WireSize
here <- Get WireSize
bytesRead
  String -> Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Text.ProtocolBuffers.WireMessage.unknown: Unknown field found or failure parsing field (e.g. unexpected Enum value):"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  (message type name,field id number,wire type code,bytes read) == "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ (TypeRep, FieldId, WireType, WireSize) -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
initialMessage,FieldId
fieldId,WireType
wireType,WireSize
here)
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  when processing "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ProtoName -> String
forall a. Show a => a -> String
show (ProtoName -> String) -> (a -> ProtoName) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorInfo -> ProtoName
descName (DescriptorInfo -> ProtoName)
-> (a -> DescriptorInfo) -> a -> ProtoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DescriptorInfo
forall m. ReflectDescriptor m => m -> DescriptorInfo
reflectDescriptorInfo (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a
initialMessage))

{-# INLINE castWord32ToFloat #-}
castWord32ToFloat :: Word32 -> Float
--castWord32ToFloat (W32# w) = F# (unsafeCoerce# w)
--castWord32ToFloat x = unsafePerformIO $ alloca $ \p -> poke p x >> peek (castPtr p)
castWord32ToFloat :: Word32 -> Float
castWord32ToFloat Word32
x = (forall s. ST s Float) -> Float
forall a. (forall s. ST s a) -> a
runST ((Int, Int) -> Word32 -> ST s (STUArray s Int Word32)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0::Int,Int
0) Word32
x ST s (STUArray s Int Word32)
-> (STUArray s Int Word32 -> ST s (STUArray s Int Float))
-> ST s (STUArray s Int Float)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUArray s Int Word32 -> ST s (STUArray s Int Float)
forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray ST s (STUArray s Int Float)
-> (STUArray s Int Float -> ST s Float) -> ST s Float
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (STUArray s Int Float -> Int -> ST s Float)
-> Int -> STUArray s Int Float -> ST s Float
forall a b c. (a -> b -> c) -> b -> a -> c
flip STUArray s Int Float -> Int -> ST s Float
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Int
0)
{-# INLINE castFloatToWord32 #-}
castFloatToWord32 :: Float -> Word32
--castFloatToWord32 (F# f) = W32# (unsafeCoerce# f)
castFloatToWord32 :: Float -> Word32
castFloatToWord32 Float
x = (forall s. ST s Word32) -> Word32
forall a. (forall s. ST s a) -> a
runST ((Int, Int) -> Float -> ST s (STUArray s Int Float)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0::Int,Int
0) Float
x ST s (STUArray s Int Float)
-> (STUArray s Int Float -> ST s (STUArray s Int Word32))
-> ST s (STUArray s Int Word32)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUArray s Int Float -> ST s (STUArray s Int Word32)
forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray ST s (STUArray s Int Word32)
-> (STUArray s Int Word32 -> ST s Word32) -> ST s Word32
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (STUArray s Int Word32 -> Int -> ST s Word32)
-> Int -> STUArray s Int Word32 -> ST s Word32
forall a b c. (a -> b -> c) -> b -> a -> c
flip STUArray s Int Word32 -> Int -> ST s Word32
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Int
0)

{-# INLINE castWord64ToDouble #-}
castWord64ToDouble :: Word64 -> Double
-- castWord64ToDouble (W64# w) = D# (unsafeCoerce# w)
castWord64ToDouble :: Word64 -> Double
castWord64ToDouble Word64
x = (forall s. ST s Double) -> Double
forall a. (forall s. ST s a) -> a
runST ((Int, Int) -> Word64 -> ST s (STUArray s Int Word64)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0::Int,Int
0) Word64
x ST s (STUArray s Int Word64)
-> (STUArray s Int Word64 -> ST s (STUArray s Int Double))
-> ST s (STUArray s Int Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUArray s Int Word64 -> ST s (STUArray s Int Double)
forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray ST s (STUArray s Int Double)
-> (STUArray s Int Double -> ST s Double) -> ST s Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (STUArray s Int Double -> Int -> ST s Double)
-> Int -> STUArray s Int Double -> ST s Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip STUArray s Int Double -> Int -> ST s Double
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Int
0)
{-# INLINE castDoubleToWord64 #-}
castDoubleToWord64 :: Double -> Word64
-- castDoubleToWord64 (D# d) = W64# (unsafeCoerce# d)
castDoubleToWord64 :: Double -> Word64
castDoubleToWord64 Double
x = (forall s. ST s Word64) -> Word64
forall a. (forall s. ST s a) -> a
runST ((Int, Int) -> Double -> ST s (STUArray s Int Double)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0::Int,Int
0) Double
x ST s (STUArray s Int Double)
-> (STUArray s Int Double -> ST s (STUArray s Int Word64))
-> ST s (STUArray s Int Word64)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUArray s Int Double -> ST s (STUArray s Int Word64)
forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray ST s (STUArray s Int Word64)
-> (STUArray s Int Word64 -> ST s Word64) -> ST s Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (STUArray s Int Word64 -> Int -> ST s Word64)
-> Int -> STUArray s Int Word64 -> ST s Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip STUArray s Int Word64 -> Int -> ST s Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Int
0)

-- These error handlers are exported to the generated code
wireSizeErr :: Typeable a => FieldType -> a -> WireSize
wireSizeErr :: FieldType -> a -> WireSize
wireSizeErr FieldType
ft a
x = String -> WireSize
forall a. HasCallStack => String -> a
error (String -> WireSize) -> String -> WireSize
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Impossible? wireSize field type mismatch error: Field type number ", FieldType -> String
forall a. Show a => a -> String
show FieldType
ft
                                  , String
" does not match internal type ", TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x) ]
wirePutErr :: Typeable a => FieldType -> a -> PutM b
wirePutErr :: FieldType -> a -> PutM b
wirePutErr FieldType
ft a
x = String -> PutM b
forall a. HasCallStack => String -> a
error (String -> PutM b) -> String -> PutM b
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Impossible? wirePut field type mismatch error: Field type number ", FieldType -> String
forall a. Show a => a -> String
show FieldType
ft
                                , String
" does not match internal type ", TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x) ]
wireGetErr :: Typeable a => FieldType -> Get a
wireGetErr :: FieldType -> Get a
wireGetErr FieldType
ft = Get a
answer where
  answer :: Get a
answer = String -> Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get a) -> String -> Get a
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Impossible? wireGet field type mismatch error: Field type number ", FieldType -> String
forall a. Show a => a -> String
show FieldType
ft
                               , String
" does not match internal type ", TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined a -> a -> a
forall a. a -> a -> a
`asTypeOf` Get a -> a
forall a. Get a -> a
typeHack Get a
answer)) ]
  typeHack :: Get a -> a
  typeHack :: Get a -> a
typeHack = Get a -> a
forall a. HasCallStack => a
undefined

-- | The 'Wire' class is for internal use, and may change.  If there
-- is a mis-match between the 'FieldType' and the type of @b@ then you
-- will get a failure at runtime.
--
-- Users should stick to the message functions defined in
-- "Text.ProtocolBuffers.WireMessage" and exported to use user by
-- "Text.ProtocolBuffers".  These are less likely to change.
class Wire b where
  {-# MINIMAL wireGet, wireSize, (wirePut | wirePutWithSize) #-}
  wireSize :: FieldType -> b -> WireSize
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> b -> Put
  wirePut FieldType
ft b
x = FieldType -> b -> PutM WireSize
forall b. Wire b => FieldType -> b -> PutM WireSize
wirePutWithSize FieldType
ft b
x PutM WireSize -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  {-# INLINE wirePutWithSize #-}
  wirePutWithSize :: FieldType -> b -> PutM WireSize
  wirePutWithSize FieldType
ft b
x = FieldType -> b -> Put
forall b. Wire b => FieldType -> b -> Put
wirePut FieldType
ft b
x Put -> PutM WireSize -> PutM WireSize
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WireSize -> PutM WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldType -> b -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
wireSize FieldType
ft b
x)
  wireGet :: FieldType -> Get b
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq b)
  wireGetPacked FieldType
ft = String -> Get (Seq b)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Text.ProtocolBuffers.ProtoCompile.Basic: wireGetPacked default:"
                                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  There is no way to get a packed FieldType of "String -> String -> String
forall a. [a] -> [a] -> [a]
++FieldType -> String
forall a. Show a => a -> String
show FieldType
ft
                                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".\n  Either there is a bug in this library or the wire format is has been updated.")

instance Wire Double where
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> Double -> WireSize
wireSize {- TYPE_DOUBLE   -} FieldType
1      Double
_ = WireSize
8
  wireSize FieldType
ft Double
x = FieldType -> Double -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft Double
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> Double -> Put
wirePut  {- TYPE_DOUBLE   -} FieldType
1      Double
x = Word64 -> Put
putWord64le (Double -> Word64
castDoubleToWord64 Double
x)
  wirePut FieldType
ft Double
x = FieldType -> Double -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft Double
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get Double
wireGet  {- TYPE_DOUBLE   -} FieldType
1        = (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Double
castWord64ToDouble Get Word64
getWord64le
  wireGet FieldType
ft = FieldType -> Get Double
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq Double)
wireGetPacked FieldType
1 = FieldType -> Get (Seq Double)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
1
  wireGetPacked FieldType
ft = FieldType -> Get (Seq Double)
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

instance Wire Float where
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> Float -> WireSize
wireSize {- TYPE_FLOAT    -} FieldType
2      Float
_ = WireSize
4
  wireSize FieldType
ft Float
x = FieldType -> Float -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft Float
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> Float -> Put
wirePut  {- TYPE_FLOAT    -} FieldType
2      Float
x = Word32 -> Put
putWord32le (Float -> Word32
castFloatToWord32 Float
x)
  wirePut FieldType
ft Float
x = FieldType -> Float -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft Float
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get Float
wireGet  {- TYPE_FLOAT    -} FieldType
2        = (Word32 -> Float) -> Get Word32 -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Float
castWord32ToFloat Get Word32
getWord32le
  wireGet FieldType
ft = FieldType -> Get Float
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq Float)
wireGetPacked FieldType
2 = FieldType -> Get (Seq Float)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
2
  wireGetPacked FieldType
ft = FieldType -> Get (Seq Float)
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

instance Wire Int64 where
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> WireSize -> WireSize
wireSize {- TYPE_INT64    -} FieldType
3      WireSize
x = WireSize -> WireSize
size'Int64 WireSize
x
  wireSize {- TYPE_SINT64   -} FieldType
18     WireSize
x = Word64 -> WireSize
size'Word64 (WireSize -> Word64
zzEncode64 WireSize
x)
  wireSize {- TYPE_SFIXED64 -} FieldType
16     WireSize
_ = WireSize
8
  wireSize FieldType
ft WireSize
x = FieldType -> WireSize -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft WireSize
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> WireSize -> Put
wirePut  {- TYPE_INT64    -} FieldType
3      WireSize
x = WireSize -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarSInt WireSize
x
  wirePut  {- TYPE_SINT64   -} FieldType
18     WireSize
x = Word64 -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt (WireSize -> Word64
zzEncode64 WireSize
x)
  wirePut  {- TYPE_SFIXED64 -} FieldType
16     WireSize
x = Word64 -> Put
putWord64le (WireSize -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WireSize
x)
  wirePut FieldType
ft WireSize
x = FieldType -> WireSize -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft WireSize
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get WireSize
wireGet  {- TYPE_INT64    -} FieldType
3        = Get WireSize
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  wireGet  {- TYPE_SINT64   -} FieldType
18       = (Word64 -> WireSize) -> Get Word64 -> Get WireSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> WireSize
zzDecode64 Get Word64
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  wireGet  {- TYPE_SFIXED64 -} FieldType
16       = (Word64 -> WireSize) -> Get Word64 -> Get WireSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> WireSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word64
getWord64le
  wireGet FieldType
ft = FieldType -> Get WireSize
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq WireSize)
wireGetPacked FieldType
3 = FieldType -> Get (Seq WireSize)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
3
  wireGetPacked FieldType
18 = FieldType -> Get (Seq WireSize)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
18
  wireGetPacked FieldType
16 = FieldType -> Get (Seq WireSize)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
16
  wireGetPacked FieldType
ft = FieldType -> Get (Seq WireSize)
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

instance Wire Int32 where
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> Int32 -> WireSize
wireSize {- TYPE_INT32    -} FieldType
5      Int32
x = Int32 -> WireSize
size'Int32 Int32
x
  wireSize {- TYPE_SINT32   -} FieldType
17     Int32
x = Word32 -> WireSize
size'Word32 (Int32 -> Word32
zzEncode32 Int32
x)
  wireSize {- TYPE_SFIXED32 -} FieldType
15     Int32
_ = WireSize
4
  wireSize FieldType
ft Int32
x = FieldType -> Int32 -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft Int32
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> Int32 -> Put
wirePut  {- TYPE_INT32    -} FieldType
5      Int32
x = Int32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarSInt Int32
x
  wirePut  {- TYPE_SINT32   -} FieldType
17     Int32
x = Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt (Int32 -> Word32
zzEncode32 Int32
x)
  wirePut  {- TYPE_SFIXED32 -} FieldType
15     Int32
x = Word32 -> Put
putWord32le (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  wirePut FieldType
ft Int32
x = FieldType -> Int32 -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft Int32
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get Int32
wireGet  {- TYPE_INT32    -} FieldType
5        = Get Int32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  wireGet  {- TYPE_SINT32   -} FieldType
17       = (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int32
zzDecode32 Get Word32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  wireGet  {- TYPE_SFIXED32 -} FieldType
15       = (Word32 -> Int32) -> Get Word32 -> Get 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 Get Word32
getWord32le
  wireGet FieldType
ft = FieldType -> Get Int32
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq Int32)
wireGetPacked FieldType
5 = FieldType -> Get (Seq Int32)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
5
  wireGetPacked FieldType
17 = FieldType -> Get (Seq Int32)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
17
  wireGetPacked FieldType
15 = FieldType -> Get (Seq Int32)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
15
  wireGetPacked FieldType
ft = FieldType -> Get (Seq Int32)
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

instance Wire Word64 where
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> Word64 -> WireSize
wireSize {- TYPE_UINT64   -} FieldType
4      Word64
x = Word64 -> WireSize
size'Word64 Word64
x
  wireSize {- TYPE_FIXED64  -} FieldType
6      Word64
_ = WireSize
8
  wireSize FieldType
ft Word64
x = FieldType -> Word64 -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft Word64
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> Word64 -> Put
wirePut  {- TYPE_UINT64   -} FieldType
4      Word64
x = Word64 -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt Word64
x
  wirePut  {- TYPE_FIXED64  -} FieldType
6      Word64
x = Word64 -> Put
putWord64le Word64
x
  wirePut FieldType
ft Word64
x = FieldType -> Word64 -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft Word64
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get Word64
wireGet  {- TYPE_FIXED64  -} FieldType
6        = Get Word64
getWord64le
  wireGet  {- TYPE_UINT64   -} FieldType
4        = Get Word64
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  wireGet FieldType
ft = FieldType -> Get Word64
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq Word64)
wireGetPacked FieldType
6 = FieldType -> Get (Seq Word64)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
6
  wireGetPacked FieldType
4 = FieldType -> Get (Seq Word64)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
4
  wireGetPacked FieldType
ft = FieldType -> Get (Seq Word64)
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

instance Wire Word32 where
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> Word32 -> WireSize
wireSize {- TYPE_UINT32   -} FieldType
13     Word32
x = Word32 -> WireSize
size'Word32 Word32
x
  wireSize {- TYPE_FIXED32  -} FieldType
7      Word32
_ = WireSize
4
  wireSize FieldType
ft Word32
x = FieldType -> Word32 -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft Word32
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> Word32 -> Put
wirePut  {- TYPE_UINT32   -} FieldType
13     Word32
x = Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt Word32
x
  wirePut  {- TYPE_FIXED32  -} FieldType
7      Word32
x = Word32 -> Put
putWord32le Word32
x
  wirePut FieldType
ft Word32
x = FieldType -> Word32 -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft Word32
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get Word32
wireGet  {- TYPE_UINT32   -} FieldType
13       = Get Word32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  wireGet  {- TYPE_FIXED32  -} FieldType
7        = Get Word32
getWord32le
  wireGet FieldType
ft = FieldType -> Get Word32
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq Word32)
wireGetPacked FieldType
13 = FieldType -> Get (Seq Word32)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
13
  wireGetPacked FieldType
7 = FieldType -> Get (Seq Word32)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
7
  wireGetPacked FieldType
ft = FieldType -> Get (Seq Word32)
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

instance Wire Bool where
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> Bool -> WireSize
wireSize {- TYPE_BOOL     -} FieldType
8      Bool
_ = WireSize
1
  wireSize FieldType
ft Bool
x = FieldType -> Bool -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft Bool
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> Bool -> Put
wirePut  {- TYPE_BOOL     -} FieldType
8  Bool
False = Word8 -> Put
putWord8 Word8
0
  wirePut  {- TYPE_BOOL     -} FieldType
8  Bool
True  = Word8 -> Put
putWord8 Word8
1 -- google's wire_format_lite_inl.h
  wirePut FieldType
ft Bool
x = FieldType -> Bool -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft Bool
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get Bool
wireGet  {- TYPE_BOOL     -} FieldType
8        = do
    Int32
x <- Get Int32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt :: Get Int32 -- google's wire_format_lit_inl.h line 155
    case Int32
x of
      Int32
0 -> Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Int32
_ -> Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
--      x' | x' < 128 -> return True
--      _ -> throwError ("TYPE_BOOL read failure : " ++ show x)
  wireGet FieldType
ft = FieldType -> Get Bool
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq Bool)
wireGetPacked FieldType
8 = FieldType -> Get (Seq Bool)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
8
  wireGetPacked FieldType
ft = FieldType -> Get (Seq Bool)
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

instance Wire Utf8 where
-- items of TYPE_STRING is already in a UTF8 encoded Data.ByteString.Lazy
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> Utf8 -> WireSize
wireSize {- TYPE_STRING   -} FieldType
9      Utf8
x = WireSize -> WireSize
prependMessageSize (WireSize -> WireSize) -> WireSize -> WireSize
forall a b. (a -> b) -> a -> b
$ ByteString -> WireSize
BS.length (Utf8 -> ByteString
utf8 Utf8
x)
  wireSize FieldType
ft Utf8
x = FieldType -> Utf8 -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft Utf8
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> Utf8 -> Put
wirePut  {- TYPE_STRING   -} FieldType
9      Utf8
x = WireSize -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt (ByteString -> WireSize
BS.length (Utf8 -> ByteString
utf8 Utf8
x)) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLazyByteString (Utf8 -> ByteString
utf8 Utf8
x)
  wirePut FieldType
ft Utf8
x = FieldType -> Utf8 -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft Utf8
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get Utf8
wireGet  {- TYPE_STRING   -} FieldType
9        = Get WireSize
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt Get WireSize -> (WireSize -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WireSize -> Get ByteString
getLazyByteString Get ByteString -> (ByteString -> Get Utf8) -> Get Utf8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Get Utf8
verifyUtf8
  wireGet FieldType
ft = FieldType -> Get Utf8
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

instance Wire ByteString where
-- items of TYPE_BYTES is an untyped binary Data.ByteString.Lazy
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> ByteString -> WireSize
wireSize {- TYPE_BYTES    -} FieldType
12     ByteString
x = WireSize -> WireSize
prependMessageSize (WireSize -> WireSize) -> WireSize -> WireSize
forall a b. (a -> b) -> a -> b
$ ByteString -> WireSize
BS.length ByteString
x
  wireSize FieldType
ft ByteString
x = FieldType -> ByteString -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft ByteString
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> ByteString -> Put
wirePut  {- TYPE_BYTES    -} FieldType
12     ByteString
x = WireSize -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt (ByteString -> WireSize
BS.length ByteString
x) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLazyByteString ByteString
x
  wirePut FieldType
ft ByteString
x = FieldType -> ByteString -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft ByteString
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get ByteString
wireGet  {- TYPE_BYTES    -} FieldType
12       = Get WireSize
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt Get WireSize -> (WireSize -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WireSize -> Get ByteString
getLazyByteString
  wireGet FieldType
ft = FieldType -> Get ByteString
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

-- Wrap a protocol-buffer Enum in fromEnum or toEnum and serialize the Int:
instance Wire Int where
  {-# INLINE wireSize #-}
  wireSize :: FieldType -> Int -> WireSize
wireSize {- TYPE_ENUM    -} FieldType
14      Int
x = Int -> WireSize
size'Int Int
x
  wireSize FieldType
ft Int
x = FieldType -> Int -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
wireSizeErr FieldType
ft Int
x
  {-# INLINE wirePut #-}
  wirePut :: FieldType -> Int -> Put
wirePut  {- TYPE_ENUM    -} FieldType
14      Int
x = Int -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarSInt Int
x
  wirePut FieldType
ft Int
x = FieldType -> Int -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
wirePutErr FieldType
ft Int
x
  {-# INLINE wireGet #-}
  wireGet :: FieldType -> Get Int
wireGet  {- TYPE_ENUM    -} FieldType
14        = Get Int
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
  wireGet FieldType
ft = FieldType -> Get Int
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft
  {-# INLINE wireGetPacked #-}
  wireGetPacked :: FieldType -> Get (Seq Int)
wireGetPacked FieldType
14 = FieldType -> Get (Seq Int)
forall a. Wire a => FieldType -> Get (Seq a)
genericPacked FieldType
14 -- Should not actually be used, see wireGetPackedEnum, though this ought to work if it were used (e.g. genericPacked)
  wireGetPacked FieldType
ft = FieldType -> Get (Seq Int)
forall a. Typeable a => FieldType -> Get a
wireGetErr FieldType
ft

{-# INLINE verifyUtf8 #-}
verifyUtf8 :: ByteString -> Get Utf8
verifyUtf8 :: ByteString -> Get Utf8
verifyUtf8 ByteString
bs = case ByteString -> Maybe Int
isValidUTF8 ByteString
bs of
                  Maybe Int
Nothing -> Utf8 -> Get Utf8
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Utf8
Utf8 ByteString
bs)
                  Just Int
i -> String -> Get Utf8
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get Utf8) -> String -> Get Utf8
forall a b. (a -> b) -> a -> b
$ String
"Text.ProtocolBuffers.WireMessage.verifyUtf8: ByteString is not valid utf8 at position "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
i

{-# INLINE wireGetEnum #-}
wireGetEnum :: (Typeable e, Enum e) => (Int -> Maybe e) -> Get e
wireGetEnum :: (Int -> Maybe e) -> Get e
wireGetEnum Int -> Maybe e
toMaybe'Enum = do
  Int
int <- FieldType -> Get Int
forall b. Wire b => FieldType -> Get b
wireGet FieldType
14 -- uses the "instance Wire Int" defined above
  case Int -> Maybe e
toMaybe'Enum Int
int of
    Just !e
v -> e -> Get e
forall (m :: * -> *) a. Monad m => a -> m a
return e
v
    Maybe e
Nothing -> String -> Get e
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
int)
 where msg :: String
msg = String
"Bad wireGet of Enum "String -> String -> String
forall a. [a] -> [a] -> [a]
++TypeRep -> String
forall a. Show a => a -> String
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (e
forall a. HasCallStack => a
undefined e -> e -> e
forall a. a -> a -> a
`asTypeOf` (Int -> Maybe e) -> e
forall e. (Int -> Maybe e) -> e
typeHack Int -> Maybe e
toMaybe'Enum))String -> String -> String
forall a. [a] -> [a] -> [a]
++String
", unrecognized Int value is "
       typeHack :: (Int -> Maybe e) -> e
       typeHack :: (Int -> Maybe e) -> e
typeHack Int -> Maybe e
f = e -> Maybe e -> e
forall a. a -> Maybe a -> a
fromMaybe e
forall a. HasCallStack => a
undefined (Int -> Maybe e
f Int
forall a. HasCallStack => a
undefined)

-- This will have to examine the value of positive numbers to get the size
size'WireTag :: WireTag -> Int64
size'WireTag :: WireTag -> WireSize
size'WireTag = Word32 -> WireSize
size'Word32 (Word32 -> WireSize) -> (WireTag -> Word32) -> WireTag -> WireSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> Word32
getWireTag

size'Word32 :: Word32 -> Int64
size'Word32 :: Word32 -> WireSize
size'Word32 Word32
b | Word32
b Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0x7F = WireSize
1
              | Word32
b Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0x3FFF = WireSize
2
              | Word32
b Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0x1FFFFF = WireSize
3
              | Word32
b Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0xFFFFFFF = WireSize
4
              | Bool
otherwise = WireSize
5

size'Int32 :: Int32 -> Int64
size'Int32 :: Int32 -> WireSize
size'Int32 Int32
b | Int32
b Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0 = WireSize
10
             | Int32
b Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0x7F = WireSize
1
             | Int32
b Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0x3FFF = WireSize
2
             | Int32
b Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0x1FFFFF = WireSize
3
             | Int32
b Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0xFFFFFFF = WireSize
4
             | Bool
otherwise = WireSize
5


size'Word64 :: Word64 -> Int64
size'Word64 :: Word64 -> WireSize
size'Word64 Word64
b | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x7F = WireSize
1
              | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x3FFF = WireSize
2
              | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x1FFFFF = WireSize
3
              | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFFFFF = WireSize
4
              | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0X7FFFFFFFF = WireSize
5
              | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x3FFFFFFFFFF = WireSize
6
              | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x1FFFFFFFFFFFF = WireSize
7
              | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFFFFFFFFFFFF = WireSize
8
              | Word64
b Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x7FFFFFFFFFFFFFFF = WireSize
9
              | Bool
otherwise = WireSize
10

-- Should work for Int of 32 and 64 bits
size'Int :: Int -> Int64
size'Int :: Int -> WireSize
size'Int Int
b | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = WireSize
10
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7F = WireSize
1
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x3FFF = WireSize
2
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x1FFFFF = WireSize
3
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFFFFF = WireSize
4
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7FFFFFFF = WireSize
5  -- maxBound :: Int32
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7FFFFFFFF = WireSize
5
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x3FFFFFFFFFF = WireSize
6
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x1FFFFFFFFFFFF = WireSize
7
           | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFFFFFFFFFFFF = WireSize
8
           | Bool
otherwise = WireSize
9

size'Int64,size'WireSize :: Int64 -> Int64
size'WireSize :: WireSize -> WireSize
size'WireSize = WireSize -> WireSize
size'Int64
size'Int64 :: WireSize -> WireSize
size'Int64 WireSize
b | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
< WireSize
0 = WireSize
10
             | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WireSize
0x7F = WireSize
1
             | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WireSize
0x3FFF = WireSize
2
             | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WireSize
0x1FFFFF = WireSize
3
             | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WireSize
0xFFFFFFF = WireSize
4
             | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WireSize
0x7FFFFFFFF = WireSize
5
             | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WireSize
0x3FFFFFFFFFF = WireSize
6
             | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WireSize
0x1FFFFFFFFFFFF = WireSize
7
             | WireSize
b WireSize -> WireSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WireSize
0xFFFFFFFFFFFFFF = WireSize
8
             | Bool
otherwise = WireSize
9

{-
size'Varint :: (Integral b, Bits b) => b -> Int64
{-# INLINE size'Varint #-}
size'Varint b = case compare b 0 of
                  LT -> 10 -- fromIntegral (divBy (bitSize b) 7)
                  EQ -> 1
                  GT -> genericLength . takeWhile (0<) . iterate (`shiftR` 7) $ b
-}

-- Taken from google's code, but I had to explcitly add fromIntegral in the right places:
zzEncode32 :: Int32 -> Word32
zzEncode32 :: Int32 -> Word32
zzEncode32 Int32
x = Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int32
x Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
`xor` (Int32
x Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftR` Int
31))
zzEncode64 :: Int64 -> Word64
zzEncode64 :: WireSize -> Word64
zzEncode64 WireSize
x = WireSize -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((WireSize
x WireSize -> Int -> WireSize
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) WireSize -> WireSize -> WireSize
forall a. Bits a => a -> a -> a
`xor` (WireSize
x WireSize -> Int -> WireSize
forall a. Bits a => a -> Int -> a
`shiftR` Int
63))
zzDecode32 :: Word32 -> Int32
zzDecode32 :: Word32 -> Int32
zzDecode32 Word32
w = (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
`xor` (Int32 -> Int32
forall a. Num a => a -> a
negate (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
1)))
zzDecode64 :: Word64 -> Int64
zzDecode64 :: Word64 -> WireSize
zzDecode64 Word64
w = (Word64 -> WireSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)) WireSize -> WireSize -> WireSize
forall a. Bits a => a -> a -> a
`xor` (WireSize -> WireSize
forall a. Num a => a -> a
negate (Word64 -> WireSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1)))

{-
-- The above is tricky, so the testing roundtrips and versus examples is needed:
testZZ :: Bool
testZZ = and (concat testsZZ)
  where testsZZ = [ map (\v -> v ==zzEncode64 (zzDecode64 v)) values
                  , map (\v -> v ==zzEncode32 (zzDecode32 v)) values
                  , map (\v -> v ==zzDecode64 (zzEncode64 v)) values
                  , map (\v -> v ==zzDecode32 (zzEncode32 v)) values
                  , [ zzEncode32 minBound == maxBound
                    , zzEncode32 maxBound == pred maxBound
                    , zzEncode64 minBound == maxBound
                    , zzEncode64 maxBound == pred maxBound
                    , zzEncode64 0 == 0,    zzEncode32 0 == 0
                    , zzEncode64 (-1) == 1, zzEncode32 (-1) == 1
                    , zzEncode64 1 == 2,    zzEncode32 1 == 2
                    ] ]
let values :: (Bounded a,Integral a) => [a]; values = [minBound,div minBound 2 - 1,div minBound 2, div minBound 2 + 1,-257,-256,-255,-129,-128,-127,-3,-2,-1,0,1,2,3,127,128,129,255,256,257,div maxBound 2 - 1, div maxBound 2, div maxBound 2 + 1, maxBound]
-}

getVarInt :: (Show a, Integral a, Bits a) => Get a
{-# INLINE getVarInt #-}
--getVarInt = decode7unrolled -- decode7 -- getVarInt below
getVarInt :: Get a
getVarInt = do
  a
a <- Get a
forall s. (Num s, Integral s, Bits s) => Get s
decode7unrolled
  String -> Get a -> Get a
forall a b. a -> b -> b
trace (String
"getVarInt: "String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
show a
a) (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

{-
getVarInt = do -- optimize first read instead of calling (go 0 0)
  b <- getWord8
  if testBit b 7 then go 7 (fromIntegral (b .&. 0x7F))
    else return (fromIntegral b)
 where
  go n val = do
    b <- getWord8
    if testBit b 7 then go (n+7) (val .|. ((fromIntegral (b .&. 0x7F)) `shiftL` n))
      else return (val .|. ((fromIntegral b) `shiftL` n))
-}

-- This can be used on any Integral type and is needed for signed types; unsigned can use putVarUInt below.
-- This has been changed to handle only up to 64 bit integral values (to match documentation).
{-# INLINE putVarSInt #-}
putVarSInt :: (Integral a, Bits a) => a -> Put
putVarSInt :: a -> Put
putVarSInt a
bIn =
  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
bIn a
0 of
    Ordering
LT -> let b :: Int64 -- upcast to 64 bit to match documentation of 10 bytes for all negative values
              b :: WireSize
b = a -> WireSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
bIn
              len :: Int
              len :: Int
len = Int
10                                -- (pred 10)*7 < 64 <= 10*7
              last'Mask :: WireSize
last'Mask = WireSize
1                           -- pred (1 `shiftL` 1)
              go :: WireSize -> Int -> Put
go !WireSize
i Int
1 = Word8 -> Put
putWord8 (WireSize -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WireSize
i WireSize -> WireSize -> WireSize
forall a. Bits a => a -> a -> a
.&. WireSize
last'Mask))
              go !WireSize
i Int
n = Word8 -> Put
putWord8 (WireSize -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WireSize
i WireSize -> WireSize -> WireSize
forall a. Bits a => a -> a -> a
.&. WireSize
0x7F) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WireSize -> Int -> Put
go (WireSize
i WireSize -> Int -> WireSize
forall a. Bits a => a -> Int -> a
`shiftR` Int
7) (Int -> Int
forall a. Enum a => a -> a
pred Int
n)
          in WireSize -> Int -> Put
go WireSize
b Int
len
    Ordering
EQ -> Word8 -> Put
putWord8 Word8
0
    Ordering
GT -> a -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt a
bIn

-- This should be used on unsigned Integral types only (not checked)
{-# INLINE putVarUInt #-}
putVarUInt :: (Integral a, Bits a) => a -> Put
putVarUInt :: a -> Put
putVarUInt a
i | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x80 = Word8 -> Put
putWord8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
             | Bool
otherwise = Word8 -> Put
putWord8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
i a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7F) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt (a
i a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
7)

-- | This reads in the raw bytestring corresponding to an field known
-- only through the wiretag's 'FieldId' and 'WireType'.
wireGetFromWire :: FieldId -> WireType -> Get ByteString
wireGetFromWire :: FieldId -> WireType -> Get ByteString
wireGetFromWire FieldId
fi WireType
wt = WireSize -> Get ByteString
getLazyByteString (WireSize -> Get ByteString) -> Get WireSize -> Get ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get WireSize
calcLen where
  calcLen :: Get WireSize
calcLen = case WireType
wt of
              WireType
0 -> Get WireSize
highBitRun -- lenOf (spanOf (>=128) >> skip 1)
              WireType
1 -> WireSize -> Get WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return WireSize
8
              WireType
2 -> Get WireSize -> Get WireSize
forall a. Get a -> Get a
lookAhead (Get WireSize -> Get WireSize) -> Get WireSize -> Get WireSize
forall a b. (a -> b) -> a -> b
$ do
                     WireSize
here <- Get WireSize
bytesRead
                     WireSize
len <- Get WireSize
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
                     WireSize
there <- Get WireSize
bytesRead
                     WireSize -> Get WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return ((WireSize
thereWireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
-WireSize
here)WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+WireSize
len)
              WireType
3 -> Get () -> Get WireSize
lenOf (FieldId -> Get ()
skipGroup FieldId
fi)
              WireType
4 -> String -> Get WireSize
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get WireSize) -> String -> Get WireSize
forall a b. (a -> b) -> a -> b
$ String
"Cannot wireGetFromWire with wireType of STOP_GROUP: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldId, WireType) -> String
forall a. Show a => a -> String
show (FieldId
fi,WireType
wt)
              WireType
5 -> WireSize -> Get WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return WireSize
4
              WireType
wtf -> String -> Get WireSize
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get WireSize) -> String -> Get WireSize
forall a b. (a -> b) -> a -> b
$ String
"Invalid wire type (expected 0,1,2,3,or 5) found: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldId, WireType) -> String
forall a. Show a => a -> String
show (FieldId
fi,WireType
wtf)
  lenOf :: Get () -> Get WireSize
lenOf Get ()
g = do WireSize
here <- Get WireSize
bytesRead
               WireSize
there <- Get WireSize -> Get WireSize
forall a. Get a -> Get a
lookAhead (Get ()
g Get () -> Get WireSize -> Get WireSize
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get WireSize
bytesRead)
               String -> Get WireSize -> Get WireSize
forall a b. a -> b -> b
trace (String
":wireGetFromWire.lenOf: "String -> String -> String
forall a. [a] -> [a] -> [a]
++((FieldId, WireType), (WireSize, WireSize, WireSize)) -> String
forall a. Show a => a -> String
show ((FieldId
fi,WireType
wt),(WireSize
here,WireSize
there,WireSize
thereWireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
-WireSize
here))) (Get WireSize -> Get WireSize) -> Get WireSize -> Get WireSize
forall a b. (a -> b) -> a -> b
$ WireSize -> Get WireSize
forall (m :: * -> *) a. Monad m => a -> m a
return (WireSize
thereWireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
-WireSize
here)

-- | After a group start tag with the given 'FieldId' this will skip
-- ahead in the stream past the end tag of that group.  Used by
-- 'wireGetFromWire' to help compule the length of an unknown field
-- when loading an extension.
skipGroup :: FieldId -> Get ()
skipGroup :: FieldId -> Get ()
skipGroup FieldId
start_fi = Get ()
go where
  go :: Get ()
go = do
    (FieldId
fieldId,WireType
wireType) <- (Word32 -> (FieldId, WireType))
-> Get Word32 -> Get (FieldId, WireType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WireTag -> (FieldId, WireType)
splitWireTag (WireTag -> (FieldId, WireType))
-> (Word32 -> WireTag) -> Word32 -> (FieldId, WireType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> WireTag
WireTag) Get Word32
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt
    case WireType
wireType of
      WireType
0 -> (Word8 -> Bool) -> Get ByteString
spanOf (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>=Word8
128) Get ByteString -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WireSize -> Get ()
skip WireSize
1 Get () -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get ()
go
      WireType
1 -> WireSize -> Get ()
skip WireSize
8 Get () -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get ()
go
      WireType
2 -> Get WireSize
forall a. (Show a, Integral a, Bits a) => Get a
getVarInt Get WireSize -> (WireSize -> Get ()) -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WireSize -> Get ()
skip Get () -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get ()
go
      WireType
3 -> FieldId -> Get ()
skipGroup FieldId
fieldId Get () -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get ()
go
      WireType
4 | FieldId
start_fi FieldId -> FieldId -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldId
fieldId -> String -> Get ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"skipGroup failed, fieldId mismatch bewteen START_GROUP and STOP_GROUP: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldId, (FieldId, WireType)) -> String
forall a. Show a => a -> String
show (FieldId
start_fi,(FieldId
fieldId,WireType
wireType))
        | Bool
otherwise -> () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      WireType
5 -> WireSize -> Get ()
skip WireSize
4 Get () -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get ()
go
      WireType
wtf -> String -> Get ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid wire type (expected 0,1,2,3,4,or 5) found: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldId, WireType) -> String
forall a. Show a => a -> String
show (FieldId
fieldId,WireType
wtf)

{-
  enum WireType {
    WIRETYPE_VARINT           = 0,
    WIRETYPE_FIXED64          = 1,
    WIRETYPE_LENGTH_DELIMITED = 2,
    WIRETYPE_START_GROUP      = 3,
    WIRETYPE_END_GROUP        = 4,
    WIRETYPE_FIXED32          = 5, };

  FieldType is
    TYPE_DOUBLE         = 1;
    TYPE_FLOAT          = 2;
    TYPE_INT64          = 3;
    TYPE_UINT64         = 4;
    TYPE_INT32          = 5;
    TYPE_FIXED64        = 6;
    TYPE_FIXED32        = 7;
    TYPE_BOOL           = 8;
    TYPE_STRING         = 9;
    TYPE_GROUP          = 10;  // Tag-delimited aggregate.
    TYPE_MESSAGE        = 11;
    TYPE_BYTES          = 12;
    TYPE_UINT32         = 13;
    TYPE_ENUM           = 14;
    TYPE_SFIXED32       = 15;
    TYPE_SFIXED64       = 16;
    TYPE_SINT32         = 17;
    TYPE_SINT64         = 18; -}
-- http://code.google.com/apis/protocolbuffers/docs/encoding.html

toWireType :: FieldType -> WireType
toWireType :: FieldType -> WireType
toWireType  FieldType
1 =  WireType
1
toWireType  FieldType
2 =  WireType
5
toWireType  FieldType
3 =  WireType
0
toWireType  FieldType
4 =  WireType
0
toWireType  FieldType
5 =  WireType
0
toWireType  FieldType
6 =  WireType
1
toWireType  FieldType
7 =  WireType
5
toWireType  FieldType
8 =  WireType
0
toWireType  FieldType
9 =  WireType
2
toWireType FieldType
10 =  WireType
3 -- START_GROUP
toWireType FieldType
11 =  WireType
2
toWireType FieldType
12 =  WireType
2
toWireType FieldType
13 =  WireType
0
toWireType FieldType
14 =  WireType
0
toWireType FieldType
15 =  WireType
5
toWireType FieldType
16 =  WireType
1
toWireType FieldType
17 =  WireType
0
toWireType FieldType
18 =  WireType
0
toWireType  FieldType
x = String -> WireType
forall a. HasCallStack => String -> a
error (String -> WireType) -> String -> WireType
forall a b. (a -> b) -> a -> b
$ String
"Text.ProcolBuffers.Basic.toWireType: Bad FieldType: "String -> String -> String
forall a. [a] -> [a] -> [a]
++FieldType -> String
forall a. Show a => a -> String
show FieldType
x

{-
-- OPTIMIZE attempt:
-- Used in bench-003-highBitrun-and-new-getVarInt and much slower
-- This is a much slower variant than supplied by default in version 1.8.4
getVarInt :: (Integral a, Bits a) => Get a
getVarInt = do
  n <- highBitRun -- n is at least 0, or an error is thrown by highBitRun
  s <- getByteString (succ n) -- length of s is at least 1
  let go 0 val = return val
      go m val = let m' = pred m -- m' will be [(n-2) .. 0]
                     val' = (val `shiftL` 7) .|. (fromIntegral (0x7F .&. S.unsafeIndex s m'))
                 in go m' $! val'
  go n (fromIntegral (S.last s))
-}

-- OPTIMIZE try inlinining getMessageWith and getBareMessageWith: bench-005, slower


-- OPTIMIZE try NO-inlining getMessageWith and getBareMessageWith