protocol-buffers 1.0.1 → 1.2.1

raw patch · 5 files changed

+330/−109 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/ProtocolBuffers/Basic.hs +22/−1
• Text/ProtocolBuffers/Extensions.hs +7/−21
• Text/ProtocolBuffers/Header.hs +13/−12
• Text/ProtocolBuffers/WireMessage.hs +287/−74
• protocol-buffers.cabal +1/−1

@@ -9,6 +9,7 @@   , WireTag(..),FieldId(..),WireType(..),FieldType(..),EnumCode(..),WireSize     -- * Some of the type classes implemented messages and fields   , Mergeable(..),Default(..),Wire(..)+  , isValidUTF8   ) where  import Data.Binary.Put(Put)@@ -21,9 +22,10 @@ import Data.Monoid(Monoid(..)) import Data.Sequence(Seq) import Data.Typeable(Typeable(..))-import Data.Word(Word32,Word64)+import Data.Word(Word8,Word32,Word64) import Text.ProtocolBuffers.Get(Get) +import qualified Data.ByteString.Lazy as L(unpack) import Data.ByteString.Lazy.UTF8 as U (toString,fromString)  -- Num instances are derived below for the purpose of getting fromInteger for case matching@@ -197,3 +199,22 @@   wirePut :: FieldType -> b -> Put   {-# INLINE wireGet #-}   wireGet :: FieldType -> Get b++-- Returns Nothing if valid, and the position of the error if invalid+isValidUTF8 :: ByteString -> Maybe Int+isValidUTF8 ws = go 0 (L.unpack ws) 0 where+  go :: Int -> [Word8] -> Int -> Maybe Int+  go 0 [] _ = Nothing+  go 0 (x:xs) n | x <= 127 = go 0 xs $! succ n -- binary 01111111+                | x <= 193 = Just n            -- binary 11000001, decodes to <=127, should not be here+                | x <= 223 = go 1 xs $! succ n -- binary 11011111+                | x <= 239 = go 2 xs $! succ n -- binary 11101111+                | x <= 243 = go 3 xs $! succ n -- binary 11110011+                | x == 244 = high xs $! succ n -- binary 11110100+                | otherwise = Just n+  go i (x:xs) n | 128 <= x && x <= 191 = go (pred i) xs $! succ n+  go _ _ n = Just n+  -- leading 3 bits are 100, so next 6 are at most 001111, i.e. 10001111+  high (x:xs) n | 128 <= x && x <= 143 = go 2 xs $! succ n+                | otherwise = Just n+  high [] n = Just n

@@ -22,14 +22,14 @@   -- * External types and classes   , Key(..),ExtKey(..),MessageAPI(..)   -- * Internal types, functions, and classes-  , wireSizeExtField,wirePutExtField,getMessageExt,getBareMessageExt,loadExtension+  , wireSizeExtField,wirePutExtField,loadExtension,notExtension   , GPB,ExtField(..),ExtendMessage(..),ExtFieldValue(..)   ) where +import Control.Monad.Error.Class(throwError) import qualified Data.ByteString.Lazy as L import qualified Data.Foldable as F import Data.Generics-import Data.Ix(inRange) import Data.Map(Map) import qualified Data.Map as M import Data.Maybe(fromMaybe)@@ -538,28 +538,15 @@   aPut (fi,(ExtOptional ft (GPDyn GPWitness d))) = wirePutOpt (toWireTag fi ft) ft (Just d)   aPut (fi,(ExtRepeated ft (GPDynSeq GPWitness s))) = wirePutRep (toWireTag fi ft) ft s --- | This is used by the generated code to get messages that have extensions-getMessageExt :: (Mergeable message, ReflectDescriptor message,Typeable message,ExtendMessage message)-              => (FieldId -> message -> Get message)           -- handles "allowed" wireTags-              -> Get message-getMessageExt = getMessageWith loadExtension---- | This is used by the generated code to get messages that have extensions-getBareMessageExt :: (Mergeable message, ReflectDescriptor message,Typeable message,ExtendMessage message)-                  => (FieldId -> message -> Get message)           -- handles "allowed" wireTags-                  -> Get message-getBareMessageExt = getBareMessageWith loadExtension---- | 'isValidExt' is used by 'extension' to check whether the field--- number is in one of the ranges declared in the '.proto' file.-{-# INLINE isValidExt #-}-isValidExt ::  ExtendMessage a => FieldId -> a -> Bool-isValidExt fi msg = any (flip inRange fi) (validExtRanges msg)+notExtension :: (ReflectDescriptor a, ExtendMessage a,Typeable a) => FieldId -> WireType -> a -> Get a+notExtension fieldId _wireType msg = throwError ("Field id "++show fieldId++" is not a valid extension field id for "++show (typeOf (undefined `asTypeOf` msg)))  -- | get a value from the wire into the message's ExtField. This is -- used by 'getMessageExt' and 'getBareMessageExt' above. loadExtension :: (ReflectDescriptor a, ExtendMessage a) => FieldId -> WireType -> a -> Get a-loadExtension fieldId wireType msg | isValidExt fieldId msg = do+--loadExtension fieldId wireType msg | isValidExt fieldId msg = do -- XXX+--loadExtension fieldId wireType msg = unknown fieldId wireType msg -- XXX+loadExtension fieldId wireType msg = do   let (ExtField ef) = getExtField msg       badwt wt = do here <- bytesRead                     fail $ "Conflicting wire types at byte position "++show here ++ " for extension to message: "++show (typeOf msg,fieldId,wireType,wt)@@ -587,7 +574,6 @@       let v' = ExtRepeated ft (GPDynSeq x (s |> a))           ef' = M.insert fieldId v' ef       seq v' $ seq ef' $ return (putExtField (ExtField ef') msg)-loadExtension fieldId wireType msg = unknown fieldId wireType msg  class MessageAPI msg a b | msg a -> b where   -- | Access data in a message.  The first argument is always the

@@ -1,12 +1,10 @@--- | This provides much that is needed for the output of 'hprotoc' to--- compile.  It will be imported qualified as P', the prime ensuring--- no name conflicts are possible.+-- | This provides what is needed for the output of 'hprotoc' to+-- compile.  This and the Prelude will both be imported qualified as+-- P', the prime ensuring no name conflicts are possible. module Text.ProtocolBuffers.Header-    ( -- needed for Gen.hs output-      emptyBS-    , pack-    , append-    , module Control.Monad+    ( emptyBS, pack, append, fromMaybe, ap+    , fromDistinctAscList, member+    , throwError,catchError     , module Data.Generics     , module Data.Typeable     , module Text.ProtocolBuffers.Basic@@ -18,29 +16,32 @@     ) where  import Control.Monad(ap)+import Control.Monad.Error.Class(throwError,catchError) import Data.ByteString.Lazy(empty) import Data.ByteString.Lazy.Char8(pack) import Data.Generics(Data(..))+import Data.Maybe(fromMaybe) import Data.Sequence((|>)) -- for append, see below+import Data.Set(fromDistinctAscList,member) import Data.Typeable(Typeable(..))  import Text.ProtocolBuffers.Basic -- all import Text.ProtocolBuffers.Default() import Text.ProtocolBuffers.Extensions-  ( wireSizeExtField,wirePutExtField,loadExtension,getMessageExt,getBareMessageExt+  ( wireSizeExtField,wirePutExtField,loadExtension,notExtension   , GPB,Key(..),ExtField,ExtendMessage(..),MessageAPI(..),ExtKey(wireGetKey) ) import Text.ProtocolBuffers.Identifiers(FIName(..),MName(..),FName(..)) import Text.ProtocolBuffers.Mergeable() import Text.ProtocolBuffers.Reflections-  ( ReflectDescriptor(..),ReflectEnum(..),EnumInfo(..),ProtoName(..),DescriptorInfo(extRanges),makePNF )+  ( ReflectDescriptor(..),ReflectEnum(..),EnumInfo(..),ProtoName(..)+  , GetMessageInfo(GetMessageInfo),DescriptorInfo(extRanges),makePNF ) import Text.ProtocolBuffers.Unknown   ( UnknownField,UnknownMessage(..),wireSizeUnknownField,wirePutUnknownField,loadUnknown ) import Text.ProtocolBuffers.WireMessage   ( prependMessageSize,putSize   , wireSizeReq,wireSizeOpt,wireSizeRep   , wirePutReq,wirePutOpt,wirePutRep-  , getMessage,getBareMessage-  , getMessageWith,getBareMessageWith+  , getMessageWith,getBareMessageWith,wireGetEnum   , wireSizeErr,wirePutErr,wireGetErr   , unknown,unknownField) 

@@ -29,22 +29,24 @@     , wireSizeReq,wireSizeOpt,wireSizeRep     , wirePutReq,wirePutOpt,wirePutRep     , wireSizeErr,wirePutErr,wireGetErr-    , getMessage,getBareMessage,getMessageWith,getBareMessageWith+    , getMessageWith,getBareMessageWith,wireGetEnum     , unknownField,unknown,wireGetFromWire     , castWord64ToDouble,castWord32ToFloat,castDoubleToWord64,castFloatToWord32     , zzEncode64,zzEncode32,zzDecode64,zzDecode32     ) where --- GHC internals for getting at Double and Float representation as Word64 and Word32 import Control.Monad(when)+import Control.Monad.Error.Class(throwError,catchError) import Control.Monad.ST import Data.Array.ST import Data.Bits (Bits(..)) import qualified Data.ByteString.Lazy as BS (length) import qualified Data.Foldable as F(foldl',forM_) import Data.List (genericLength)-import qualified Data.Set as Set(notMember,delete,null)+import qualified Data.Set as Set(delete,null,notMember) import Data.Typeable (Typeable(..))+-- 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#)) @@ -59,8 +61,6 @@ import Text.ProtocolBuffers.Reflections(ReflectDescriptor(reflectDescriptorInfo,getMessageInfo)                                        ,DescriptorInfo(..),GetMessageInfo(..)) ---import Debug.Trace(trace)- -- External user API for writing and reading messages  -- | This computes the size of the message's fields with tags on the@@ -155,7 +155,7 @@ messageAsFieldGetM = do   wireTag <- fmap WireTag getVarInt   let (fieldId,wireType) = splitWireTag wireTag-  when (wireType /= 2) (fail $ "messageAsFieldGetM: wireType was not 2 "++show (fieldId,wireType))+  when (wireType /= 2) (throwError $ "messageAsFieldGetM: wireType was not 2 "++show (fieldId,wireType))   msg <- wireGet 11   return (fieldId,msg) @@ -237,19 +237,14 @@ splitWireTag (WireTag wireTag) = ( FieldId . fromIntegral $ wireTag `shiftR` 3                                  , WireType . fromIntegral $ wireTag .&. 7 ) --- | Used by generated code-getMessage :: (Mergeable message, ReflectDescriptor message,Typeable message)-           => (FieldId -> message -> Get message)           -- handles "allowed" wireTags-           -> Get message-getMessage = getMessageWith unknown --- getMessage assumes the wireTag for the message, if it existed, has already been read.--- getMessage assumes that it still needs to read the Varint encoded length of the message.++-- 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 :: (Mergeable message, ReflectDescriptor message)-               => (FieldId -> WireType -> message -> Get message) -- handle wireTags that updater cannot-               -> (FieldId -> message -> Get message)             -- handles "allowed" wireTags+               => (WireTag -> FieldId -> WireType -> message -> Get message)                -> Get message-getMessageWith punt updater = do+getMessageWith updater = do   messageLength <- getVarInt   start <- bytesRead   let stop = messageLength+start@@ -263,10 +258,8 @@           GT -> do             wireTag <- fmap WireTag getVarInt -- get tag off wire             let (fieldId,wireType) = splitWireTag wireTag-            if Set.notMember wireTag allowed-              then punt fieldId wireType message >>= go reqs-              else let reqs' = Set.delete wireTag reqs-                   in updater fieldId message >>= go reqs'+                reqs' = Set.delete wireTag reqs+            updater wireTag fieldId wireType message >>= go reqs'       go' message = do         here <- bytesRead         case compare stop here of@@ -275,44 +268,29 @@           GT -> do             wireTag <- fmap WireTag getVarInt -- get tag off wire             let (fieldId,wireType) = splitWireTag wireTag-            if Set.notMember wireTag allowed-              then punt fieldId wireType message >>= go'-              else updater fieldId message >>= go'+            updater wireTag fieldId wireType message >>= go'   go required initialMessage  where   initialMessage = mergeEmpty-  (GetMessageInfo {requiredTags=required,allowedTags=allowed}) = getMessageInfo initialMessage+  (GetMessageInfo {requiredTags=required}) = getMessageInfo initialMessage   notEnoughData messageLength start =-      fail ("Text.ProtocolBuffers.WireMessage.getMessage: Required fields missing when processing "-            ++ (show . descName . reflectDescriptorInfo $ initialMessage)-            ++ " at (messageLength,start) == " ++ show (messageLength,start))+      throwError ("Text.ProtocolBuffers.WireMessage.getMessageWith: Required fields missing when processing "+                  ++ (show . descName . reflectDescriptorInfo $ initialMessage)+                  ++ " at (messageLength,start) == " ++ show (messageLength,start))   tooMuchData messageLength start here =-      fail ("Text.ProtocolBuffers.WireMessage.getMessage : overran expected length when processing"-            ++ (show . descName . reflectDescriptorInfo $ initialMessage)-            ++ " at  (messageLength,start,here) == " ++ show (messageLength,start,here))--unknown :: (Typeable a,ReflectDescriptor a) => FieldId -> WireType -> a -> Get a-unknown fieldId wireType initialMessage = do-  here <- bytesRead-  fail ("Text.ProtocolBuffers.WireMessage.unkown: Unknown wire tag read (type,fieldId,wireType,here) == "-        ++ show (typeOf initialMessage,fieldId,wireType,here) ++ " when processing "-        ++ (show . descName . reflectDescriptorInfo $ initialMessage))+      throwError ("Text.ProtocolBuffers.WireMessage.getMessageWith: overran expected length when processing"+                  ++ (show . descName . reflectDescriptorInfo $ initialMessage)+                  ++ " at  (messageLength,start,here) == " ++ show (messageLength,start,here))  -- | Used by generated code--- getBareMessage assumes the wireTag for the message, if it existed, has already been read.--- getBareMessage assumes that it does needs to read the Varint encoded length of the message.--- getBareMessage will consume the entire ByteString it is operating on, or until it--- finds any STOP_GROUP tag-getBareMessage :: (Typeable message, Mergeable message, ReflectDescriptor message)-               => (FieldId -> message -> Get message)             -- handles "allowed" wireTags-               -> Get message-getBareMessage = getBareMessageWith unknown-+-- 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 :: (Mergeable message, ReflectDescriptor message)-                   => (FieldId -> WireType -> message -> Get message) -- handle wireTags that updater cannot-                   -> (FieldId -> message -> Get message)             -- handles "allowed" wireTags+                   => (WireTag -> FieldId -> WireType -> message -> Get message) -- handle wireTags that are unknown or produce errors                    -> Get message-getBareMessageWith punt updater = go required initialMessage+getBareMessageWith updater = go required initialMessage  where   go reqs message | Set.null reqs = go' message                   | otherwise = do@@ -322,32 +300,37 @@         wireTag <- fmap WireTag getVarInt -- get tag off wire         let (fieldId,wireType) = splitWireTag wireTag         if wireType == 4 then notEnoughData -- END_GROUP too soon-          else if Set.notMember wireTag allowed-                 then punt fieldId wireType message >>= go reqs-                 else let reqs' = Set.delete wireTag reqs-                      in updater fieldId message >>= go reqs'+          else let reqs' = Set.delete wireTag reqs+               in updater wireTag fieldId wireType message >>= go reqs'   go' message = do     done <- isReallyEmpty     if done then return message       else do         wireTag <- fmap WireTag getVarInt -- get tag off wire-        let (fieldId,wireType) = splitWireTag wireTag -- WIRETYPE_END_GROUP+        let (fieldId,wireType) = splitWireTag wireTag         if wireType == 4 then return message-          else if Set.notMember wireTag allowed-                 then punt fieldId wireType message >>= go'-                 else updater fieldId message >>= go'+          else updater wireTag fieldId wireType message >>= go'   initialMessage = mergeEmpty-  (GetMessageInfo {requiredTags=required,allowedTags=allowed}) = getMessageInfo initialMessage-  notEnoughData = fail ("Text.ProtocolBuffers.WireMessage.getBareMessage: Required fields missing when processing "-                        ++ (show . descName . reflectDescriptorInfo $ initialMessage))+  (GetMessageInfo {requiredTags=required}) = getMessageInfo initialMessage+  notEnoughData = throwError ("Text.ProtocolBuffers.WireMessage.getBareMessageWith: Required fields missing when processing "+                              ++ (show . descName . reflectDescriptorInfo $ initialMessage)) -unknownField :: FieldId -> Get a-unknownField fieldId = do +unknownField :: Typeable a => a -> FieldId -> Get a+unknownField msg fieldId = do    here <- bytesRead-  fail ("Impossible? Text.ProtocolBuffers.WireMessage.unknownField "-        ++" The Message's updater claims there is an unknown field id on wire: "++show fieldId-        ++" at a position just before here == "++show here)+  throwError ("Impossible? Text.ProtocolBuffers.WireMessage.unknownField"+              ++"\n  Updater for "++show (typeOf msg)++" claims there is an unknown field id on wire: "++show fieldId+              ++"\n  at a position just before byte location "++show here) ++unknown :: (Typeable a,ReflectDescriptor a) => FieldId -> WireType -> a -> Get a+unknown fieldId wireType initialMessage = do+  here <- bytesRead+  throwError ("Text.ProtocolBuffers.WireMessage.unknown: Unknown field found or failure parsing field (e.g. unexpected Enum value):"+              ++ "(message type name,field id number,wire type code,bytes read) == "+              ++ show (typeOf initialMessage,fieldId,wireType,here) ++ " when processing "+              ++ (show . descName . reflectDescriptorInfo $ initialMessage))+ {-# INLINE castWord32ToFloat #-} castWord32ToFloat :: Word32 -> Float --castWord32ToFloat (W32# w) = F# (unsafeCoerce# w)@@ -376,8 +359,8 @@                                 , " does not match internal type ", show (typeOf x) ] wireGetErr :: Typeable a => FieldType -> Get a wireGetErr ft = answer where-  answer = fail $ concat [ "Impossible? wireGet field type mismatch error: Field type number ", show ft-                         , " does not match internal type ", show (typeOf (undefined `asTypeOf` typeHack answer)) ]+  answer = throwError $ concat [ "Impossible? wireGet field type mismatch error: Field type number ", show ft+                               , " does not match internal type ", show (typeOf (undefined `asTypeOf` typeHack answer)) ]   typeHack :: Get a -> a   typeHack = undefined @@ -458,7 +441,7 @@     case x of       0 -> return False       x' | x' < 128 -> return True-      _ -> fail ("TYPE_BOOL read failure : " ++ show x)+      _ -> throwError ("TYPE_BOOL read failure : " ++ show x)   wireGet ft = wireGetErr ft  instance Wire Utf8 where@@ -467,7 +450,7 @@   wireSize ft x = wireSizeErr ft x   wirePut  {- TYPE_STRING   -} 9      x = putVarUInt (BS.length (utf8 x)) >> putLazyByteString (utf8 x)   wirePut ft x = wirePutErr ft x-  wireGet  {- TYPE_STRING   -} 9        = getVarInt >>= getLazyByteString >>= return . Utf8+  wireGet  {- TYPE_STRING   -} 9        = getVarInt >>= getLazyByteString >>= verifyUtf8   wireGet ft = wireGetErr ft  instance Wire ByteString where@@ -476,7 +459,7 @@   wireSize ft x = wireSizeErr ft x   wirePut  {- TYPE_BYTES    -} 12     x = putVarUInt (BS.length x) >> putLazyByteString x   wirePut ft x = wirePutErr ft x-  wireGet  {- TYPE_BYTES    -} 12       = getVarInt >>= getLazyByteString >>= return+  wireGet  {- TYPE_BYTES    -} 12       = getVarInt >>= getLazyByteString   wireGet ft = wireGetErr ft  -- Wrap a protocol-buffer Enum in fromEnum or toEnum and serialize the Int:@@ -488,6 +471,23 @@   wireGet  {- TYPE_ENUM    -} 14        = getVarInt   wireGet ft = wireGetErr ft +{-# INLINE verifyUtf8 #-}+verifyUtf8 :: ByteString -> Get Utf8+verifyUtf8 bs = case isValidUTF8 bs of+                  Nothing -> return (Utf8 bs)+                  Just i -> throwError $ "Text.ProtocolBuffers.WireMessage.verifyUtf8: ByteString is not valid utf8 at position "++show i++{-# INLINE wireGetEnum #-}+wireGetEnum :: (Typeable e, Enum e) => (Int -> Maybe e) -> Get e+wireGetEnum toMaybe'Enum = do+  int <- wireGet 14+  case toMaybe'Enum int of+    Just v -> return v+    Nothing -> throwError (msg ++ show int)+ where msg = "Bad wireGet of Enum "++show (typeOf (undefined `asTypeOf` typeHack toMaybe'Enum))++", unrecognized Int value is "+       typeHack :: (Int -> Maybe e) -> e+       typeHack f = maybe undefined id (f undefined)+ -- This will have to examine the value of positive numbers to get the size {-# INLINE size'Varint #-} size'Varint :: (Bits a,Integral a) => a -> Int64@@ -586,9 +586,9 @@                      there <- bytesRead                      return ((there-here)+len)               3 -> lenOf (skipGroup fi)-              4 -> fail $ "Cannot wireGetFromWire with wireType of STOP_GROUP: "++show (fi,wt)+              4 -> throwError $ "Cannot wireGetFromWire with wireType of STOP_GROUP: "++show (fi,wt)               5 -> return 4-              wtf -> fail $ "Invalid wire type (expected 0,1,2,3,or 5) found: "++show (fi,wtf)+              wtf -> throwError $ "Invalid wire type (expected 0,1,2,3,or 5) found: "++show (fi,wtf)   lenOf g = do here <- bytesRead                there <- lookAhead (g >> bytesRead)                return (there-here)@@ -606,10 +606,10 @@       1 -> skip 8 >> go       2 -> getVarInt >>= skip >> go       3 -> skipGroup fieldId >> go-      4 | start_fi /= fieldId -> fail $ "skipGroup failed, fieldId mismatch bewteen START_GROUP and STOP_GROUP: "++show (start_fi,(fieldId,wireType))+      4 | start_fi /= fieldId -> throwError $ "skipGroup failed, fieldId mismatch bewteen START_GROUP and STOP_GROUP: "++show (start_fi,(fieldId,wireType))         | otherwise -> return ()       5 -> skip 4 >> go-      wtf -> fail $ "Invalid wire type (expected 0,1,2,3,4,or 5) found: "++show (fieldId,wtf)+      wtf -> throwError $ "Invalid wire type (expected 0,1,2,3,4,or 5) found: "++show (fieldId,wtf)  {-   enum WireType {@@ -659,3 +659,216 @@ toWireType 17 =  0 toWireType 18 =  0 toWireType  x = error $ "Text.ProcolBuffers.Basic.toWireType: Bad FieldType: "++show x++{-++-- 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 :: (Mergeable message, ReflectDescriptor message)+               => (FieldId -> WireType -> message -> Get message) -- handle wireTags that updater cannot+               -> (FieldId -> message -> Get message)             -- handles "allowed" wireTags+               -> Get message+getMessageWith punt updater = do+  messageLength <- getVarInt+  start <- bytesRead+  let stop = messageLength+start+      -- switch from go to go' once all the required fields have been found+      go reqs message | Set.null reqs = go' message+                      | otherwise = do+        here <- bytesRead+        case compare stop here of+          EQ -> notEnoughData messageLength start+          LT -> tooMuchData messageLength start here+          GT -> do+            wireTag <- fmap WireTag getVarInt -- get tag off wire+            let (fieldId,wireType) = splitWireTag wireTag+            if Set.notMember wireTag allowed+              then punt fieldId wireType message >>= go reqs+              else let reqs' = Set.delete wireTag reqs+                   in catchError (updater fieldId message) +                                 (\_ -> punt fieldId wireType message)+                        >>= go reqs'+      go' message = do+        here <- bytesRead+        case compare stop here of+          EQ -> return message+          LT -> tooMuchData messageLength start here+          GT -> do+            wireTag <- fmap WireTag getVarInt -- get tag off wire+            let (fieldId,wireType) = splitWireTag wireTag+            if Set.notMember wireTag allowed+              then punt fieldId wireType message >>= go'+              else catchError (updater fieldId message)+                              (\_ -> punt fieldId wireType message)+                     >>= go'+  go required initialMessage+ where+  initialMessage = mergeEmpty+  (GetMessageInfo {requiredTags=required,allowedTags=allowed}) = getMessageInfo initialMessage+  notEnoughData messageLength start =+      fail ("Text.ProtocolBuffers.WireMessage.getMessageWith: Required fields missing when processing "+            ++ (show . descName . reflectDescriptorInfo $ initialMessage)+            ++ " at (messageLength,start) == " ++ show (messageLength,start))+  tooMuchData messageLength start here =+      fail ("Text.ProtocolBuffers.WireMessage.getMessageWith: overran expected length when processing"+            ++ (show . descName . reflectDescriptorInfo $ initialMessage)+            ++ " at  (messageLength,start,here) == " ++ show (messageLength,start,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+getBareMessageWith :: (Mergeable message, ReflectDescriptor message)+                   => (FieldId -> WireType -> message -> Get message) -- handle wireTags that updater cannot+                   -> (FieldId -> message -> Get message)             -- handles "allowed" wireTags+                   -> Get message+getBareMessageWith punt updater = go required initialMessage+ where+  go reqs message | Set.null reqs = go' message+                  | otherwise = do+    done <- isReallyEmpty+    if done then notEnoughData+      else do+        wireTag <- fmap WireTag getVarInt -- get tag off wire+        let (fieldId,wireType) = splitWireTag wireTag+        if wireType == 4 then notEnoughData -- END_GROUP too soon+          else if Set.notMember wireTag allowed+                 then punt fieldId wireType message >>= go reqs+                 else let reqs' = Set.delete wireTag reqs+                      in catchError (updater fieldId message)+                                    (\_ -> punt fieldId wireType message)+                           >>= go reqs'+  go' message = do+    done <- isReallyEmpty+    if done then return message+      else do+        wireTag <- fmap WireTag getVarInt -- get tag off wire+        let (fieldId,wireType) = splitWireTag wireTag -- WIRETYPE_END_GROUP+        if wireType == 4 then return message+          else if Set.notMember wireTag allowed+                 then punt fieldId wireType message >>= go'+                 else catchError (updater fieldId message)+                                 (\_ -> punt fieldId wireType message)+                        >>= go'+  initialMessage = mergeEmpty+  (GetMessageInfo {requiredTags=required,allowedTags=allowed}) = getMessageInfo initialMessage+  notEnoughData = fail ("Text.ProtocolBuffers.WireMessage.getBareMessageWith: Required fields missing when processing "+                        ++ (show . descName . reflectDescriptorInfo $ initialMessage))+++-}+{-+-- 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 :: (Mergeable message, ReflectDescriptor message)+               => (FieldId -> message -> Get message)             -- handles "allowed" wireTags including known extensions+               -> Maybe (FieldId -> WireType -> message -> Get message) -- handle extension wireTags that updater does not+               -> (FieldId -> WireType -> message -> Get message) -- handle wireTags that are unknown or produce errors+               -> Get message+getMessageWith updater mayExt punt = do+  messageLength <- getVarInt+  start <- bytesRead+  let stop = messageLength+start+      getExt = case mayExt of+                 Nothing -> punt+                 Just loadExt -> +                   (\fieldId wireType msg -> catchError (loadExt fieldId wireType msg)+                                                        (\_ -> punt fieldId wireType msg))+      -- switch from go to go' once all the required fields have been found+      go reqs message | Set.null reqs = go' message+                      | otherwise = do+        here <- bytesRead+        case compare stop here of+          EQ -> notEnoughData messageLength start+          LT -> tooMuchData messageLength start here+          GT -> do+            wireTag <- fmap WireTag getVarInt -- get tag off wire+            let (fieldId,wireType) = splitWireTag wireTag+            if Set.notMember wireTag allowed+              then getExt fieldId wireType message >>= go reqs+              else let reqs' = Set.delete wireTag reqs+                   in catchError (updater fieldId message)+                                 (\_ -> punt fieldId wireType message)+                        >>= go reqs'+      go' message = do+        here <- bytesRead+        case compare stop here of+          EQ -> return message+          LT -> tooMuchData messageLength start here+          GT -> do+            wireTag <- fmap WireTag getVarInt -- get tag off wire+            let (fieldId,wireType) = splitWireTag wireTag+            if Set.notMember wireTag allowed+              then getExt fieldId wireType message >>= go'+              else catchError (updater fieldId message)+                              (\_ -> punt fieldId wireType message)+                     >>= go'+  go required initialMessage+ where+  initialMessage = mergeEmpty+  (GetMessageInfo {requiredTags=required,allowedTags=allowed}) = getMessageInfo initialMessage+  notEnoughData messageLength start =+      throwError ("Text.ProtocolBuffers.WireMessage.getMessageWith: Required fields missing when processing "+                  ++ (show . descName . reflectDescriptorInfo $ initialMessage)+                  ++ " at (messageLength,start) == " ++ show (messageLength,start))+  tooMuchData messageLength start here =+      throwError ("Text.ProtocolBuffers.WireMessage.getMessageWith: overran expected length when processing"+                  ++ (show . descName . reflectDescriptorInfo $ initialMessage)+                  ++ " at  (messageLength,start,here) == " ++ show (messageLength,start,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+getBareMessageWith :: (Mergeable message, ReflectDescriptor message)+                   => (FieldId -> message -> Get message)             -- handles "allowed" wireTags including known extensions+                   -> Maybe (FieldId -> WireType -> message -> Get message) -- handle extension wireTags that updater does not+                   -> (FieldId -> WireType -> message -> Get message) -- handle wireTags that are unknown or produce errors+                   -> Get message+getBareMessageWith updater mayExt punt = go required initialMessage+ where+  getExt = case mayExt of+             Nothing -> punt+             Just loadExt -> +               (\fieldId wireType msg -> catchError (loadExt fieldId wireType msg)+                                                    (\_ -> punt fieldId wireType msg))+  go reqs message | Set.null reqs = go' message+                  | otherwise = do+    done <- isReallyEmpty+    if done then notEnoughData+      else do+        wireTag <- fmap WireTag getVarInt -- get tag off wire+        let (fieldId,wireType) = splitWireTag wireTag+        if wireType == 4 then notEnoughData -- END_GROUP too soon+          else if Set.notMember wireTag allowed+                 then getExt fieldId wireType message >>= go reqs+                 else let reqs' = Set.delete wireTag reqs+                      in catchError (updater fieldId message)+                                    (\_ -> punt fieldId wireType message)+                           >>= go reqs'+  go' message = do+    done <- isReallyEmpty+    if done then return message+      else do+        wireTag <- fmap WireTag getVarInt -- get tag off wire+        let (fieldId,wireType) = splitWireTag wireTag -- WIRETYPE_END_GROUP+        if wireType == 4 then return message+          else if Set.notMember wireTag allowed+                 then getExt fieldId wireType message >>= go'+                 else catchError (updater fieldId message)+                                 (\_ -> punt fieldId wireType message)+                        >>= go'+  initialMessage = mergeEmpty+  (GetMessageInfo {requiredTags=required,allowedTags=allowed}) = getMessageInfo initialMessage+  notEnoughData = throwError ("Text.ProtocolBuffers.WireMessage.getBareMessageWith: Required fields missing when processing "+                              ++ (show . descName . reflectDescriptorInfo $ initialMessage))++unknownField :: FieldId -> Get a+unknownField fieldId = do +  here <- bytesRead+  throwError ("Impossible? Text.ProtocolBuffers.WireMessage.unknownField"+              ++"\n  Updater claims there is an unknown field id on wire: "++show fieldId+              ++"\n  at a position just before byte location "++show here)+-}

@@ -1,5 +1,5 @@ name:           protocol-buffers-version:        1.0.1+version:        1.2.1 cabal-version:  >= 1.2 build-type:     Simple license:        BSD3