{-# LANGUAGE DeriveDataTypeable,GeneralizedNewtypeDeriving #-}-- | "Text.ProtocolBuffers.Basic" defines or re-exports most of the-- basic field types; 'Maybe','Bool', 'Double', and 'Float' come from-- the Prelude instead. This module also defined the 'Mergeable' and-- 'Default' classes. The 'Wire' class is not defined here to avoid orphans.moduleText.ProtocolBuffers.Basic(-- * Basic types for protocol buffer fields in HaskellDouble,Float,Bool,Maybe,Seq,Utf8(Utf8),ByteString,Int32,Int64,Word32,Word64-- * Haskell types that act in the place of DescritorProto values,WireTag(..),FieldId(..),WireType(..),FieldType(..),EnumCode(..),WireSize-- * Some of the type classes implemented messages and fields,Mergeable(..),Default(..)-- ,Wire(..),isValidUTF8,toUtf8,utf8,uToString,uFromString)whereimportData.Bits(Bits)importData.ByteString.Lazy(ByteString)importData.FoldableasF(Foldable(foldl))importData.Generics(Data(..))importData.Int(Int32,Int64)importData.Ix(Ix)importData.Monoid(Monoid(..))importData.Sequence(Seq,(><))importData.Typeable(Typeable(..))importData.Word(Word8,Word32,Word64)importqualifiedData.ByteString.LazyasL(unpack)importData.ByteString.Lazy.UTF8asU(toString,fromString)-- Num instances are derived below for the purpose of getting fromInteger for case matching-- | 'Utf8' is used to mark 'ByteString' values that (should) contain-- valud utf8 encoded strings. This type is used to represent-- 'TYPE_STRING' values.newtypeUtf8=Utf8ByteStringderiving(Data,Typeable,Eq,Ord)utf8::Utf8->ByteStringutf8(Utf8bs)=bsinstanceReadUtf8wherereadsPrecdxs=letr::Int->ReadSStringr=readsPrecf::(String,String)->(Utf8,String)f(a,b)=(Utf8(U.fromStringa),b)inmapf.rd$xsinstanceShowUtf8whereshowsPrecd(Utf8bs)=lets::Int->String->ShowSs=showsPrecinsd(U.toStringbs)instanceMonoidUtf8wheremempty=Utf8memptymappend(Utf8x)(Utf8y)=Utf8(mappendxy)-- | 'WireTag' is the 32 bit value with the upper 29 bits being the-- 'FieldId' and the lower 3 bits being the 'WireType'newtypeWireTag=WireTag{getWireTag::Word32}-- bit concatenation of FieldId and WireTypederiving(Eq,Ord,Enum,Read,Show,Num,Bits,Bounded,Data,Typeable)-- | 'FieldId' is the field number which can be in the range 1 to-- 2^29-1 but the value from 19000 to 19999 are forbidden (so sayeth-- Google).newtypeFieldId=FieldId{getFieldId::Int32}-- really 29 bitsderiving(Eq,Ord,Enum,Read,Show,Num,Data,Typeable,Ix)-- Note that values 19000-19999 are forbidden for FieldIdinstanceBoundedFieldIdwhereminBound=1maxBound=536870911-- 2^29-1-- | 'WireType' is the 3 bit wire encoding value, and is currently in-- the range 0 to 5, leaving 6 and 7 currently invalid.---- * 0 /Varint/ : int32, int64, uint32, uint64, sint32, sint64, bool, enum---- * 1 /64-bit/ : fixed64, sfixed64, double---- * 2 /Length-delimited/ : string, bytes, embedded messages---- * 3 /Start group/ : groups (deprecated)---- * 4 /End group/ : groups (deprecated)---- * 5 /32-bit/ : fixed32, sfixed32, float--newtypeWireType=WireType{getWireType::Word32}-- really 3 bitsderiving(Eq,Ord,Enum,Read,Show,Num,Data,Typeable)instanceBoundedWireTypewhereminBound=0maxBound=5{- | 'FieldType' is the integer associated with the
FieldDescriptorProto's Type. The allowed range is currently 1 to
18, as shown below (excerpt from descritor.proto)
> // 0 is reserved for errors.
> // Order is weird for historical reasons.
> TYPE_DOUBLE = 1;
> TYPE_FLOAT = 2;
> TYPE_INT64 = 3; // Not ZigZag encoded. Negative numbers
> // take 10 bytes. Use TYPE_SINT64 if negative
> // values are likely.
> TYPE_UINT64 = 4;
> TYPE_INT32 = 5; // Not ZigZag encoded. Negative numbers
> // take 10 bytes. Use TYPE_SINT32 if negative
> // values are likely.
> TYPE_FIXED64 = 6;
> TYPE_FIXED32 = 7;
> TYPE_BOOL = 8;
> TYPE_STRING = 9;
> TYPE_GROUP = 10; // Tag-delimited aggregate.
> TYPE_MESSAGE = 11; // Length-delimited aggregate.
>
> // New in version 2.
> TYPE_BYTES = 12;
> TYPE_UINT32 = 13;
> TYPE_ENUM = 14;
> TYPE_SFIXED32 = 15;
> TYPE_SFIXED64 = 16;
> TYPE_SINT32 = 17; // Uses ZigZag encoding.
> TYPE_SINT64 = 18; // Uses ZigZag encoding.
-}newtypeFieldType=FieldType{getFieldType::Int}-- really [1..18] as fromEnum of Type from Type.hsderiving(Eq,Ord,Enum,Read,Show,Num,Data,Typeable)instanceBoundedFieldTypewhereminBound=1maxBound=18-- | 'EnumCode' is the Int32 assoicated with a-- EnumValueDescriptorProto and is in the range 0 to 2^31-1.newtypeEnumCode=EnumCode{getEnumCode::Int32}-- really [0..maxBound::Int32] of some .proto defined enumerationderiving(Eq,Ord,Read,Show,Num,Data,Typeable)instanceBoundedEnumCodewhereminBound=0maxBound=2147483647-- 2^-31 -1 -- | 'WireSize' is the Int64 size type associate with the lazy-- bytestrings used in the 'Put' and 'Get' monads.typeWireSize=Int64-- | The 'Mergeable' class is not a 'Monoid', 'mergeEmpty' is not a-- left or right unit like 'mempty'. The default 'mergeAppend' is to-- take the second parameter and discard the first one. The-- 'mergeConcat' defaults to @foldl@ associativity.---- NOTE: 'mergeEmpty' has been removed in protocol buffers version 2.-- Use defaultValue instead. New strict fields would mean that required-- fields in messages will be automatic errors with 'mergeEmpty'.classDefaulta=>Mergeableawhere{-
-- | The 'mergeEmpty' value of a basic type or a message with
-- required fields will be undefined and a runtime error to
-- evaluate. These are only handy for reading the wire encoding and
-- users should employ 'defaultValue' instead.
mergeEmpty :: a
mergeEmpty = error "You did not define Mergeable.mergeEmpty!"
-}-- | 'mergeAppend' is the right-biased merge of two values. A-- message (or group) is merged recursively. Required field are-- always taken from the second message. Optional field values are-- taken from the most defined message or the second message if-- both are set. Repeated fields have the sequences concatenated.-- Note that strings and bytes are NOT concatenated.mergeAppend::a->a->amergeAppend_ab=b-- | 'mergeConcat' is @ F.foldl mergeAppend defaultValue @ and this-- default definition is not overridden in any of the code except-- for the (Seq a) instance.mergeConcat::F.Foldablet=>ta->amergeConcat=F.foldlmergeAppenddefaultValue-- | The Default class has the default-default values of types. See-- <http://code.google.com/apis/protocolbuffers/docs/proto.html#optional>-- and also note that 'Enum' types have a 'defaultValue' that is the-- first one in the @.proto@ file (there is always at least one-- value). Instances of this for messages hold any default value-- defined in the @.proto@ file. 'defaultValue' is where the-- 'MessageAPI' function 'getVal' looks when an optional field is not-- set.classDefaultawhere-- | The 'defaultValue' is never undefined or an error to evalute.-- This makes it much more useful compared to 'mergeEmpty'. In a-- default message all Optional field values are set to 'Nothing'-- and Repeated field values are empty.defaultValue::a-- Returns Nothing if valid, and the position of the error if invalidisValidUTF8::ByteString->MaybeIntisValidUTF8bs=go0(L.unpackbs)0wherego::Int->[Word8]->Int->MaybeIntgo0[]_=Nothinggo0(x:xs)n|x<=127=go0xs$!succn-- binary 01111111|x<=193=Justn-- binary 11000001, decodes to <=127, should not be here|x<=223=go1xs$!succn-- binary 11011111|x<=239=go2xs$!succn-- binary 11101111|x<=243=go3xs$!succn-- binary 11110011|x==244=highxs$!succn-- binary 11110100|otherwise=Justngoi(x:xs)n|128<=x&&x<=191=go(predi)xs$!succngo__n=Justn-- leading 3 bits are 100, so next 6 are at most 001111, i.e. 10001111high(x:xs)n|128<=x&&x<=143=go2xs$!succn|otherwise=Justnhigh[]n=JustntoUtf8::ByteString->EitherIntUtf8toUtf8bs=maybe(Right(Utf8bs))Left(isValidUTF8bs)uToString::Utf8->StringuToString(Utf8bs)=U.toStringbsuFromString::String->Utf8uFromStrings=Utf8(U.fromStrings)-- Base types are not very mergeable, but their Maybe and Seq versions are:instanceMergeablea=>Mergeable(Maybea)where-- mergeEmpty = NothingmergeAppend=mayMerge{-# INLINE mayMerge #-}mayMerge::(Mergeableb)=>Maybeb->Maybeb->MaybebmayMergeNothingy=ymayMergexNothing=xmayMerge(Justx)(Justy)=Just(mergeAppendxy)instanceMergeable(Seqa)where-- mergeEmpty = emptymergeAppend=(><)-- These all have errors as mergeEmpty and use the second paramater for mergeAppendinstanceMergeableBoolinstanceMergeableUtf8instanceMergeableByteStringinstanceMergeableDoubleinstanceMergeableFloatinstanceMergeableInt32instanceMergeableInt64instanceMergeableWord32instanceMergeableWord64instanceDefaultWord64wheredefaultValue=0instanceDefaultWord32wheredefaultValue=0instanceDefaultInt64wheredefaultValue=0instanceDefaultInt32wheredefaultValue=0instanceDefaultFloatwheredefaultValue=0instanceDefaultDoublewheredefaultValue=0instanceDefaultBoolwheredefaultValue=FalseinstanceDefault(Maybea)wheredefaultValue=NothinginstanceDefault(Seqa)wheredefaultValue=memptyinstanceDefaultByteStringwheredefaultValue=memptyinstanceDefaultUtf8wheredefaultValue=mempty