protocol-buffers 2.4.10 → 2.4.11
raw patch · 6 files changed
+92/−35 lines, 6 filesnew-uploader
Files
- README.md +7/−7
- Text/ProtocolBuffers/Extensions.hs +6/−1
- Text/ProtocolBuffers/Header.hs +8/−4
- Text/ProtocolBuffers/Unknown.hs +6/−1
- Text/ProtocolBuffers/WireMessage.hs +62/−19
- protocol-buffers.cabal +3/−3
README.md view
@@ -5,8 +5,8 @@ `protocol-buffers-descriptors`, and `hprotoc`. These are three interdependent Haskell packages originally written by Chris Kuklewicz. -Currently, maintainership was taken by Kostiantyn Rybnikov. It is-planned to only support GHC 7.8 and newer unless someone explicitly+Currently, maintainership was taken by Timo von Holtz. It is+planned to only support GHC 7.10 and newer unless someone explicitly asks for support of earlier versions. (Needs check) This README was updated most recently to reflect version@@ -299,7 +299,7 @@ ADT, so we implement the feature. In `hprotoc/oneoftest`, we have an example for this. `school.proto` defines-a collection of members in a school, which is organized into dormitories. +a collection of members in a school, which is organized into dormitories. Each member should have common attributes like `id` and `name`, but there are attributes only specific to students, faculties or administrators. @@ -308,7 +308,7 @@ Once `protocol-buffers` is installed, using `hprotoc`, we can generate Haskell source codes. Assuming we run `hprotoc` on the `oneoftest` directory and generate-source code in `hs` directory: +source code in `hs` directory: ``` oneoftest> hprotoc --proto_path=. --haskell_out=hs school.proto@@ -327,13 +327,13 @@ data Property = Prop_student {prop_student :: Student } | Prop_faculty {prop_faculty :: Faculty } | Prop_admin {prop_admin :: Admin }-``` +``` where `Student`, `Faculty` and `Admin` are defined as ordinary nested message data types in separate modules, respectively. Therefore, the `oneof` feature is smoothly matched with Haskell sum types. Note that `Maybe` will be always present for a `oneof` field in the owner data type definition (Here, `Maybe Property` in the definition of `Member`). This is because of compatibility with other language-implementations that treat `oneof` as a collection of `optional` fields. +implementations that treat `oneof` as a collection of `optional` fields. In the `oneoftest` directory, we provides a Haskell example in `hprotoc/oneoftest/hs`, modification of the previous example using lenses in `hprotoc/oneoftest/hs-lens`@@ -372,7 +372,7 @@ grade: 5 specialty: "defense of dark arts" }-} +} ``` ```
Text/ProtocolBuffers/Extensions.hs view
@@ -24,7 +24,7 @@ , Key(..),ExtKey(..),MessageAPI(..) , PackedSeq(..), EP(..) -- * Internal types, functions, and classes- , wireSizeExtField,wirePutExtField,loadExtension,notExtension+ , wireSizeExtField,wirePutExtField,wirePutExtFieldWithSize,loadExtension,notExtension , wireGetKeyToUnPacked, wireGetKeyToPacked , GPB,ExtField(..),ExtendMessage(..),ExtFieldValue(..) ) where@@ -693,6 +693,11 @@ aPut (fi,(ExtOptional ft (GPDyn d))) = wirePutOpt (toWireTag fi ft) ft (Just d) aPut (fi,(ExtRepeated ft (GPDynSeq s))) = wirePutRep (toWireTag fi ft) ft s aPut (fi,(ExtPacked ft (GPDynSeq s))) = wirePutPacked (toPackedWireTag fi) ft s++-- FIXME: implement this directly+-- | This is used by the generated code+wirePutExtFieldWithSize :: ExtField -> PutM WireSize+wirePutExtFieldWithSize m = wirePutExtField m >> return (wireSizeExtField m) 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)))
Text/ProtocolBuffers/Header.hs view
@@ -29,7 +29,8 @@ import Text.ProtocolBuffers.Basic -- all import Text.ProtocolBuffers.Extensions- ( wireSizeExtField,wirePutExtField,loadExtension,notExtension+ ( wireSizeExtField,wirePutExtField,wirePutExtFieldWithSize+ , loadExtension,notExtension , wireGetKeyToUnPacked, wireGetKeyToPacked , GPB,Key(..),ExtField,ExtendMessage(..),MessageAPI(..),ExtKey(wireGetKey),PackedSeq ) import Text.ProtocolBuffers.Identifiers(FIName(..),MName(..),FName(..))@@ -38,15 +39,18 @@ , GetMessageInfo(GetMessageInfo),DescriptorInfo(extRanges),makePNF ) import Text.ProtocolBuffers.TextMessage -- all import Text.ProtocolBuffers.Unknown- ( UnknownField,UnknownMessage(..),wireSizeUnknownField,wirePutUnknownField,catch'Unknown )+ ( UnknownField,UnknownMessage(..),wireSizeUnknownField,wirePutUnknownField,wirePutUnknownFieldWithSize,catch'Unknown ) import Text.ProtocolBuffers.WireMessage ( Wire(..) , prependMessageSize,putSize,splitWireTag+ , runPutM , wireSizeReq,wireSizeOpt,wireSizeRep , wirePutReq,wirePutOpt,wirePutRep- , wirePutPacked,wireSizePacked+ , wirePutReqWithSize,wirePutOptWithSize,wirePutRepWithSize+ , sequencePutWithSize+ , wirePutPacked,wirePutPackedWithSize,wireSizePacked , getMessageWith,getBareMessageWith,wireGetEnum,wireGetPackedEnum- , wireSizeErr,wirePutErr,wireGetErr+ , wireSizeErr,wirePutErr,wireGetErr,size'WireSize , unknown,unknownField , fieldIdOf)
Text/ProtocolBuffers/Unknown.hs view
@@ -4,7 +4,7 @@ -- notice. Importer beware. module Text.ProtocolBuffers.Unknown ( UnknownField(..),UnknownMessage(..),UnknownFieldValue(..)- , wireSizeUnknownField,wirePutUnknownField,catch'Unknown+ , wireSizeUnknownField,wirePutUnknownField, wirePutUnknownFieldWithSize,catch'Unknown ) where import qualified Data.ByteString.Lazy as L@@ -52,6 +52,11 @@ wirePutUnknownField :: UnknownField -> Put wirePutUnknownField (UnknownField m) = F.mapM_ aPut m where aPut (UFV tag bs) = putVarUInt (getWireTag tag) >> putLazyByteString bs++-- | This is used by the generated code+wirePutUnknownFieldWithSize :: UnknownField -> PutM WireSize+wirePutUnknownFieldWithSize m =+ wirePutUnknownField m >> return (wireSizeUnknownField m) {-# INLINE catch'Unknown #-} -- | This is used by the generated code
Text/ProtocolBuffers/WireMessage.hs view
@@ -21,14 +21,16 @@ -- ** 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,Get,runPut,runGet,runGetOnLazy,getFromBS+ , 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,toWireType,toWireTag,toPackedWireTag,mkWireTag+ , 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@@ -36,7 +38,7 @@ , zzEncode64,zzEncode32,zzDecode64,zzDecode32 ) where -import Control.Monad(when)+import Control.Monad(when,foldM) import Control.Monad.Error.Class(throwError) import Control.Monad.ST import Data.Array.ST(newArray,readArray)@@ -45,7 +47,7 @@ --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',forM_)+import qualified Data.Foldable as F(foldl', Foldable) --import Data.List (genericLength) import Data.Maybe(fromMaybe) import Data.Sequence ((|>))@@ -57,7 +59,7 @@ --import GHC.Exts (Double(D#),Float(F#),unsafeCoerce#) --import GHC.Word (Word64(W64#)) -- ,Word32(W32#)) -- binary package-import Data.Binary.Put (Put,runPut,putWord8,putWord32le,putWord64le,putLazyByteString)+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@@ -179,7 +181,7 @@ Left msg -> error msg Right (r,_) -> r --- This is like 'runGet', without the ability to pass in more input+-- | 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'@@ -195,33 +197,68 @@ prependMessageSize :: WireSize -> WireSize prependMessageSize n = n + size'WireSize n +{-# INLINE sequencePutWithSize #-}+-- | Used in generated code.+sequencePutWithSize :: F.Foldable f => f (PutM WireSize) -> PutM WireSize+sequencePutWithSize =+ let combine size act =+ do size2 <- act+ return $! size + size2+ in foldM combine 0++{-# INLINE wirePutReqWithSize #-}+-- | Used in generated code.+wirePutReqWithSize :: Wire v => WireTag -> FieldType -> v -> PutM WireSize+wirePutReqWithSize wireTag fieldType v =+ let startTag = getWireTag wireTag+ endTag = succ startTag+ putTag tag = putVarUInt tag >> return (size'Word32 tag)+ putAct = wirePutWithSize fieldType v+ in case fieldType of+ 10 -> sequencePutWithSize [putTag startTag, putAct, putTag endTag]+ _ -> sequencePutWithSize [putTag startTag, putAct]++{-# INLINE wirePutOptWithSize #-}+-- | Used in generated code.+wirePutOptWithSize :: Wire v => WireTag -> FieldType -> Maybe v -> PutM WireSize+wirePutOptWithSize _wireTag _fieldType Nothing = return 0+wirePutOptWithSize wireTag fieldType (Just v) = wirePutReqWithSize wireTag fieldType v++{-# INLINE wirePutRepWithSize #-}+-- | Used in generated code.+wirePutRepWithSize :: Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize+wirePutRepWithSize wireTag fieldType vs =+ sequencePutWithSize $ fmap (wirePutReqWithSize wireTag fieldType) vs++{-# INLINE wirePutPackedWithSize #-}+-- | Used in generated code.+wirePutPackedWithSize :: Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize+wirePutPackedWithSize wireTag fieldType vs =+ let actInner = sequencePutWithSize $ fmap (wirePutWithSize fieldType) vs+ (size, _) = runPutM actInner -- This should be lazy enough not to allocate the ByteString+ tagSize = size'WireTag wireTag+ putTag tag = putVarUInt (getWireTag tag) >> return tagSize+ in sequencePutWithSize [putTag wireTag, putSize size>>return (size'WireSize size), actInner]+ {-# INLINE wirePutReq #-} -- | Used in generated code. wirePutReq :: Wire v => WireTag -> FieldType -> v -> Put-wirePutReq wireTag 10 v = let startTag = getWireTag wireTag- endTag = succ startTag- in putVarUInt startTag >> wirePut 10 v >> putVarUInt endTag-wirePutReq wireTag fieldType v = putVarUInt (getWireTag wireTag) >> wirePut fieldType v+wirePutReq wireTag fieldType v = wirePutReqWithSize wireTag fieldType v >> return () {-# INLINE wirePutOpt #-} -- | Used in generated code. wirePutOpt :: Wire v => WireTag -> FieldType -> Maybe v -> Put-wirePutOpt _wireTag _fieldType Nothing = return ()-wirePutOpt wireTag fieldType (Just v) = wirePutReq wireTag fieldType v+wirePutOpt wireTag fieldType v = wirePutOptWithSize wireTag fieldType v >> return () {-# INLINE wirePutRep #-} -- | Used in generated code. wirePutRep :: Wire v => WireTag -> FieldType -> Seq v -> Put-wirePutRep wireTag fieldType vs = F.forM_ vs (\v -> wirePutReq wireTag fieldType v)+wirePutRep wireTag fieldType vs = wirePutRepWithSize wireTag fieldType vs >> return () {-# INLINE wirePutPacked #-} -- | Used in generated code. wirePutPacked :: Wire v => WireTag -> FieldType -> Seq v -> Put-wirePutPacked wireTag fieldType vs = do- putVarUInt (getWireTag wireTag)- let size = F.foldl' (\n v -> n + wireSize fieldType v) 0 vs- putSize size- F.forM_ vs (\v -> wirePut fieldType v)+wirePutPacked wireTag fieldType vs = wirePutPackedWithSize wireTag fieldType vs >> return () {-# INLINE wireSizeReq #-} -- | Used in generated code.@@ -431,7 +468,7 @@ wireSizeErr :: Typeable a => FieldType -> a -> WireSize 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 -> Put+wirePutErr :: Typeable a => FieldType -> a -> PutM b wirePutErr ft x = fail $ 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@@ -449,8 +486,14 @@ -- "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 ft x = wirePutWithSize ft x >> return ()+ {-# INLINE wirePutWithSize #-}+ wirePutWithSize :: FieldType -> b -> PutM WireSize+ wirePutWithSize ft x = wirePut ft x >> return (wireSize ft x) wireGet :: FieldType -> Get b {-# INLINE wireGetPacked #-} wireGetPacked :: FieldType -> Get (Seq b)
protocol-buffers.cabal view
@@ -1,12 +1,12 @@ name: protocol-buffers-version: 2.4.10+version: 2.4.11 cabal-version: >= 1.6 build-type: Simple license: BSD3 license-file: LICENSE copyright: (c) 2008-2015 Christopher Edward Kuklewicz author: Christopher Edward Kuklewicz-maintainer: Kostiantyn Rybnikov <k-bx@k-bx.com>+maintainer: Timo von Holtz <tvh@tvholtz.de>, Kostiantyn Rybnikov <k-bx@k-bx.com> homepage: https://github.com/k-bx/protocol-buffers package-url: http://hackage.haskell.org/package/protocol-buffers synopsis: Parse Google Protocol Buffer specifications@@ -20,7 +20,7 @@ Library -- Added -fspec-constr-count=10 to quiet ghc-7.0.2.- ghc-options: -Wall -O2 -fspec-constr-count=10 + ghc-options: -Wall -O2 -fspec-constr-count=10 -- ghc-prof-options: -auto-all -prof exposed-modules: Text.ProtocolBuffers Text.ProtocolBuffers.Basic