protocol-buffers 2.4.12 → 2.4.17
raw patch · 7 files changed
Files
- Changes +95/−0
- Setup.hs +1/−1
- Text/ProtocolBuffers/Basic.hs +4/−0
- Text/ProtocolBuffers/Get.hs +96/−90
- Text/ProtocolBuffers/ProtoJSON.hs +5/−0
- Text/ProtocolBuffers/WireMessage.hs +1/−1
- protocol-buffers.cabal +21/−19
+ Changes view
@@ -0,0 +1,95 @@+Newest at the top.++2.4.17++- PR #94. Change code generate for `mergeAppend` to avoid triggering GHC bug+- Fixes generated code for GHC-8.10+- Some more small improvements of the generated code++2.4.16++- PR #93. Fix up a534ea to support older base16-bytestring again, via CPP++2.4.15++- PR #92. Allow newer haskell-src-exts and test for GHC-8.10.2+- PR #90. Use base16-bytestring >= 1.0.0.0 after 'decode' API change++2.4.14++- Issue #89 defaultUserHooks in Setup.hs is deprecated++2.4.13++- Fix build for GHC-8.8++2.4.12++- New option to derive ToJSON/FromJSON+- Fix build for GHC-8.6+- Drop support for GHC-7.10+- New testsuite++2.4.11++- pr #66. Attach deriving Typeable to data declaration in hs-boot files+- pr #65. Fix time complexity of serialization++2.4.10++- pr #59. Add Semigroup instance++2.4.9++- pr #48. Make parser float support natural or float data format++2.4.8++- pr #58. Fix build for HSE-1.20++2.4.7++- pr #57. Add GHC 8.4 support (add Semigroup instances)++2.4.6++- issue #55. Constraint haskell-src-exts to be < 1.20++2.4.5++- pr #54. Support haskell-src-exts 1.18++2.4.4++- pr #53. Allow decimal places at the end of line++2.4.3++- pr #50. restrict haskell-src-exts version constraint++2.4.2++- fix version constraints++2.4.1++- issue #10, pr #47. Fixed not to lookup a entity defined in the parent package++2.3.1:++- add Generic deriving++2016-03-22 2.3.0:++- Dump to text as decimal instead of octal (PR #34)+- Oneof lenses++2008-09: 0.3.1:++- Change Parser.hs to allow negative enum values to match actual behavior of protoc.+- Use runST & castSTUArray for both Float and Double conversion to Word32 and Word64.+- Adding UnknownField support controlled by "-u" flag to hprotoc.+- Fix messageGet to use the new 'isReallyEmpty' and Parial Results get Nothing, to work better.+- Fix default instances of Descriptor messages to be Nothing instead of Just defaultValue.++2008-09 : version 0.2.9 released. This is the first working release.
Setup.hs view
@@ -1,2 +1,2 @@ import Distribution.Simple-main = defaultMainWithHooks defaultUserHooks+main = defaultMainWithHooks simpleUserHooks
Text/ProtocolBuffers/Basic.hs view
@@ -22,6 +22,7 @@ import Data.Ix(Ix) import Data.Semigroup (Semigroup(..)) import Data.Sequence(Seq,(><))+import Data.String (IsString(..)) import Data.Typeable(Typeable) import Data.Word(Word8,Word32,Word64) @@ -51,6 +52,9 @@ showsPrec d (Utf8 bs) = let s :: Int -> String -> ShowS s = showsPrec in s d (U.toString bs)++instance IsString Utf8 where+ fromString = uFromString instance Semigroup Utf8 where (<>) (Utf8 x) (Utf8 y) = Utf8 (x <> y)
Text/ProtocolBuffers/Get.hs view
@@ -75,6 +75,7 @@ --import qualified Data.ByteString as S(unpack) -- XXX testing --import qualified Data.ByteString.Lazy as L(pack) -- XXX testing import Control.Monad(ap) -- instead of Functor.fmap; ap for Applicative+import qualified Control.Monad.Fail as Fail import Data.Bits(Bits((.|.),(.&.)),shiftL) import qualified Data.ByteString as S(concat,length,null,splitAt,findIndex) import qualified Data.ByteString.Internal as S(ByteString(..),toForeignPtr,inlinePerformIO)@@ -130,77 +131,77 @@ let (TU'OK x i) = unsafePerformIO $ withForeignPtr fp $ \ptr0 -> do if ptr0 == nullPtr || len < 1 then error "Get.decode7unrolled: ByteString invariant failed" else do- let ok :: s -> Int -> IO (TU s)- ok x0 i0 = return (TU'OK x0 i0)- more,err :: IO (TU s)- more = return (TU'OK 0 0) -- decode7- err = return (TU'OK 0 (-1)) -- throwError- {-# INLINE ok #-}- {-# INLINE more #-}- {-# INLINE err #-}+ let ok :: s -> Int -> IO (TU s)+ ok x0 i0 = return (TU'OK x0 i0)+ more,err :: IO (TU s)+ more = return (TU'OK 0 0) -- decode7+ err = return (TU'OK 0 (-1)) -- throwError+ {-# INLINE ok #-}+ {-# INLINE more #-}+ {-# INLINE err #-} --- -- Next line is segfault fix for null bytestrings from Nathan Howell <nhowell@alphaheavy.com>--- if ptr0 == nullPtr then more else do+ -- -- Next line is segfault fix for null bytestrings from Nathan Howell <nhowell@alphaheavy.com>+ -- if ptr0 == nullPtr then more else do - let start = ptr0 `plusPtr` off :: Ptr Word8- b'1 <- peek start- if b'1 < 128 then ok (fromIntegral b'1) 1 else do- let !val'1 = fromIntegral (b'1 .&. 0x7F)- !end = start `plusPtr` len- !ptr2 = start `plusPtr` 1 :: Ptr Word8- if ptr2 >= end then more else do+ let start = ptr0 `plusPtr` off :: Ptr Word8+ b'1 <- peek start+ if b'1 < 128 then ok (fromIntegral b'1) 1 else do+ let !val'1 = fromIntegral (b'1 .&. 0x7F)+ !end = start `plusPtr` len+ !ptr2 = start `plusPtr` 1 :: Ptr Word8+ if ptr2 >= end then more else do - b'2 <- peek ptr2- if b'2 < 128 then ok (val'1 .|. (fromIntegral b'2 `shiftL` 7)) 2 else do- let !val'2 = (val'1 .|. (fromIntegral (b'2 .&. 0x7F) `shiftL` 7))- !ptr3 = ptr2 `plusPtr` 1- if ptr3 >= end then more else do+ b'2 <- peek ptr2+ if b'2 < 128 then ok (val'1 .|. (fromIntegral b'2 `shiftL` 7)) 2 else do+ let !val'2 = (val'1 .|. (fromIntegral (b'2 .&. 0x7F) `shiftL` 7))+ !ptr3 = ptr2 `plusPtr` 1+ if ptr3 >= end then more else do - b'3::Word8 <- peek ptr3- if b'3 < 128 then ok (val'2 .|. (fromIntegral b'3 `shiftL` 14)) 3 else do- let !val'3 = (val'2 .|. (fromIntegral (b'3 .&. 0x7F) `shiftL` 14))- !ptr4 = ptr3 `plusPtr` 1- if ptr4 >= end then more else do+ b'3::Word8 <- peek ptr3+ if b'3 < 128 then ok (val'2 .|. (fromIntegral b'3 `shiftL` 14)) 3 else do+ let !val'3 = (val'2 .|. (fromIntegral (b'3 .&. 0x7F) `shiftL` 14))+ !ptr4 = ptr3 `plusPtr` 1+ if ptr4 >= end then more else do - b'4::Word8 <- peek ptr4- if b'4 < 128 then ok (val'3 .|. (fromIntegral b'4 `shiftL` 21)) 4 else do- let !val'4 = (val'3 .|. (fromIntegral (b'4 .&. 0x7F) `shiftL` 21))- !ptr5 = ptr4 `plusPtr` 1- if ptr5 >= end then more else do+ b'4::Word8 <- peek ptr4+ if b'4 < 128 then ok (val'3 .|. (fromIntegral b'4 `shiftL` 21)) 4 else do+ let !val'4 = (val'3 .|. (fromIntegral (b'4 .&. 0x7F) `shiftL` 21))+ !ptr5 = ptr4 `plusPtr` 1+ if ptr5 >= end then more else do - b'5::Word8 <- peek ptr5- if b'5 < 128 then ok (val'4 .|. (fromIntegral b'5 `shiftL` 28)) 5 else do- let !val'5 = (val'4 .|. (fromIntegral (b'5 .&. 0x7F) `shiftL` 28))- !ptr6 = ptr5 `plusPtr` 1- if ptr6 >= end then more else do+ b'5::Word8 <- peek ptr5+ if b'5 < 128 then ok (val'4 .|. (fromIntegral b'5 `shiftL` 28)) 5 else do+ let !val'5 = (val'4 .|. (fromIntegral (b'5 .&. 0x7F) `shiftL` 28))+ !ptr6 = ptr5 `plusPtr` 1+ if ptr6 >= end then more else do - b'6::Word8 <- peek ptr6- if b'6 < 128 then ok (val'5 .|. (fromIntegral b'6 `shiftL` 35)) 6 else do- let !val'6 = (val'5 .|. (fromIntegral (b'6 .&. 0x7F) `shiftL` 35))- !ptr7 = ptr6 `plusPtr` 1- if ptr7 >= end then more else do+ b'6::Word8 <- peek ptr6+ if b'6 < 128 then ok (val'5 .|. (fromIntegral b'6 `shiftL` 35)) 6 else do+ let !val'6 = (val'5 .|. (fromIntegral (b'6 .&. 0x7F) `shiftL` 35))+ !ptr7 = ptr6 `plusPtr` 1+ if ptr7 >= end then more else do - b'7::Word8 <- peek ptr7- if b'7 < 128 then ok (val'6 .|. (fromIntegral b'7 `shiftL` 42)) 7 else do- let !val'7 = (val'6 .|. (fromIntegral (b'7 .&. 0x7F) `shiftL` 42))- !ptr8 = ptr7 `plusPtr` 1- if ptr8 >= end then more else do+ b'7::Word8 <- peek ptr7+ if b'7 < 128 then ok (val'6 .|. (fromIntegral b'7 `shiftL` 42)) 7 else do+ let !val'7 = (val'6 .|. (fromIntegral (b'7 .&. 0x7F) `shiftL` 42))+ !ptr8 = ptr7 `plusPtr` 1+ if ptr8 >= end then more else do - b'8::Word8 <- peek ptr8- if b'8 < 128 then ok (val'7 .|. (fromIntegral b'8 `shiftL` 49)) 8 else do- let !val'8 = (val'7 .|. (fromIntegral (b'8 .&. 0x7F) `shiftL` 49))- !ptr9 = ptr8 `plusPtr` 1- if ptr9 >= end then more else do+ b'8::Word8 <- peek ptr8+ if b'8 < 128 then ok (val'7 .|. (fromIntegral b'8 `shiftL` 49)) 8 else do+ let !val'8 = (val'7 .|. (fromIntegral (b'8 .&. 0x7F) `shiftL` 49))+ !ptr9 = ptr8 `plusPtr` 1+ if ptr9 >= end then more else do - b'9::Word8 <- peek ptr9- if b'9 < 128 then ok (val'8 .|. (fromIntegral b'9 `shiftL` 56)) 9 else do- let !val'9 = (val'8 .|. (fromIntegral (b'9 .&. 0x7F) `shiftL` 56))- !ptrA = ptr9 `plusPtr` 1- if ptrA >= end then more else do+ b'9::Word8 <- peek ptr9+ if b'9 < 128 then ok (val'8 .|. (fromIntegral b'9 `shiftL` 56)) 9 else do+ let !val'9 = (val'8 .|. (fromIntegral (b'9 .&. 0x7F) `shiftL` 56))+ !ptrA = ptr9 `plusPtr` 1+ if ptrA >= end then more else do - b'A::Word8 <- peek ptrA- if b'A < 128 then ok (val'9 .|. (fromIntegral b'A `shiftL` 63)) 10 else do- err+ b'A::Word8 <- peek ptrA+ if b'A < 128 then ok (val'9 .|. (fromIntegral b'A `shiftL` 63)) 10 else do+ err in if i > 0 then let ss' = (S.unsafeDrop i ss)@@ -232,44 +233,44 @@ | ptr < end = do w <- peek ptr trace ("w: " ++ show w) $ do- if (128>) w- then return $ T3 (succ (ptr `minusPtr` start) ) -- length of capture- (s .|. ((fromIntegral w) `shiftL` shift)) -- put the last bits into high position- (-1) -- negative shift indicates satisfied- else inner (ptr `plusPtr` 1) -- loop on next byte- (s .|. ((fromIntegral (w .&. 0x7F)) `shiftL` shift)) -- put the new bits into high position- (shift+7) -- increase high position for next loop+ if (128>) w+ then return $ T3 (succ (ptr `minusPtr` start) ) -- length of capture+ (s .|. ((fromIntegral w) `shiftL` shift)) -- put the last bits into high position+ (-1) -- negative shift indicates satisfied+ else inner (ptr `plusPtr` 1) -- loop on next byte+ (s .|. ((fromIntegral (w .&. 0x7F)) `shiftL` shift)) -- put the new bits into high position+ (shift+7) -- increase high position for next loop | otherwise = return $ T3 (ptr `minusPtr` start) -- length so far (ptr past end-of-string so no succ) s -- value so far shift -- next shift to use inner start s1 shift1 (S ss bs n) <- getFull trace ("getFull says: "++ show ((S.length ss,ss),(L.length bs),n)) $ do- if S.null ss- then do- continue <- suspend- if continue- then go s1 shift1- else fail "Get.decode7: Zero length input" -- XXX can be triggered!- else do- let (T3 i sOut shiftOut) = unsafePerformIO $ scanner ss- t = S.unsafeDrop i ss -- Warning: 't' may be mempty- n' = n + fromIntegral i- trace ("scanner says "++show ((i,toInteger sOut,shiftOut),(S.length t,n'))) $ do- if 0 <= shiftOut- then do- putFull_unsafe (make_state bs n')- if L.null bs+ if S.null ss+ then do+ continue <- suspend+ if continue+ then go s1 shift1+ else fail "Get.decode7: Zero length input" -- XXX can be triggered!+ else do+ let (T3 i sOut shiftOut) = unsafePerformIO $ scanner ss+ t = S.unsafeDrop i ss -- Warning: 't' may be mempty+ n' = n + fromIntegral i+ trace ("scanner says "++show ((i,toInteger sOut,shiftOut),(S.length t,n'))) $ do+ if 0 <= shiftOut then do- continue <- suspend- if continue- then go sOut shiftOut- else return sOut+ putFull_unsafe (make_state bs n')+ if L.null bs+ then do+ continue <- suspend+ if continue+ then go sOut shiftOut+ else return sOut+ else do+ go sOut shiftOut else do- go sOut shiftOut- else do- putFull_safe (S t bs n') -- bs from getFull is still valid- return sOut+ putFull_safe (S t bs n') -- bs from getFull is still valid+ return sOut data T2 = T2 !Int64 !Bool @@ -784,6 +785,11 @@ {-# INLINE return #-} m >>= k = Get (\sc -> unGet m (\ a -> seq a $ unGet (k a) sc)) {-# INLINE (>>=) #-}+#if !MIN_VERSION_base(4,11,0)+ fail = Fail.fail+#endif++instance Fail.MonadFail Get where fail = throwError . strMsg instance MonadError String Get where
Text/ProtocolBuffers/ProtoJSON.hs view
@@ -41,5 +41,10 @@ parseJSONByteString = withObject "bytes" $ \o -> do t <- o .: "payload" case B16.decode (T.encodeUtf8 t) of+# if MIN_VERSION_base16_bytestring(1,0,0)+ Right bs -> return (BL.fromStrict bs)+ Left err -> fail $ "Failed to parse base16: " <> err+# else (bs, "") -> return (BL.fromStrict bs) _ -> fail "Failed to parse base16."+# endif
Text/ProtocolBuffers/WireMessage.hs view
@@ -469,7 +469,7 @@ wireSizeErr ft x = error $ concat [ "Impossible? wireSize field type mismatch error: Field type number ", show ft , " does not match internal type ", show (typeOf x) ] wirePutErr :: Typeable a => FieldType -> a -> PutM b-wirePutErr ft x = fail $ concat [ "Impossible? wirePut field type mismatch error: Field type number ", show ft+wirePutErr ft x = error $ concat [ "Impossible? wirePut field type mismatch error: Field type number ", show ft , " does not match internal type ", show (typeOf x) ] wireGetErr :: Typeable a => FieldType -> Get a wireGetErr ft = answer where
protocol-buffers.cabal view
@@ -1,6 +1,6 @@ name: protocol-buffers-version: 2.4.12-cabal-version: >= 1.6+version: 2.4.17+cabal-version: >= 1.10 build-type: Simple license: BSD3 license-file: LICENSE@@ -14,12 +14,14 @@ category: Text extra-source-files: TODO README.md-Tested-With: GHC == 8.0.2, GHC == 8.2.1, GHC == 8.4.2, GHC == 8.6.2+ Changes+Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2, GHC == 8.6.2, GHC == 8.8.4, GHC == 8.10.2 source-repository head type: git location: git://github.com/k-bx/protocol-buffers.git Library+ default-language: Haskell2010 -- Added -fspec-constr-count=10 to quiet ghc-7.0.2. ghc-options: -Wall -O2 -fspec-constr-count=10 -- ghc-prof-options: -auto-all -prof@@ -53,19 +55,19 @@ -- Most of these are needed for protocol-buffers (Get and WireMessage.hs) -- Nothing especially hazardous in this list- extensions: BangPatterns,- CPP,- DeriveDataTypeable,- EmptyDataDecls,- FlexibleInstances,- FunctionalDependencies,- GADTs,- GeneralizedNewtypeDeriving,- MagicHash,- MultiParamTypeClasses,- PatternGuards,- RankNTypes,- RecordWildCards- ScopedTypeVariables,- StandaloneDeriving,- TypeSynonymInstances+ default-extensions: BangPatterns,+ CPP,+ DeriveDataTypeable,+ EmptyDataDecls,+ FlexibleInstances,+ FunctionalDependencies,+ GADTs,+ GeneralizedNewtypeDeriving,+ MagicHash,+ MultiParamTypeClasses,+ PatternGuards,+ RankNTypes,+ RecordWildCards+ ScopedTypeVariables,+ StandaloneDeriving,+ TypeSynonymInstances