packages feed

protocol-buffers 0.1.0 → 0.2.8

raw patch · 159 files changed

+11856/−8412 lines, 159 filesdep +QuickCheckdep +directorydep +filepathdep −binary-strictdep −derivedep −haskell-src-extsdep ~basebinary-added

Dependencies added: QuickCheck, directory, filepath, haskell-src, mtl

Dependencies removed: binary-strict, derive, haskell-src-exts

Dependency ranges changed: base

Files

LICENSE view
@@ -9,7 +9,7 @@  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -The descriptor.proto and unittest.proto files from google's code are under the Apache license (2.0):+The descriptor.proto, unittest.proto, unittest_import.proto, and addressbook.proto files from google's code are under the Apache license (2.0):                                   Apache License                            Version 2.0, January 2004
+ README view
@@ -0,0 +1,156 @@+This the README file for protocol-buffers, protocol-buffers-descriptors, and hprotoc.+These are three interdependent Haskell packages by Chris Kuklewicz.+This README was updated most recently to reflect version 0.2.8++Questions and answers:++What is this for?  What does it do?  Why?++  It is a pure Haskell re-implementation of the Google code at+http://code.Google.com/apis/protocolbuffers/docs/overview.html+  which is "...a language-neutral, platform-neutral, extensible way of serializing structured data for use in communications protocols, data storage, and more."+  Google's project produces C++, Java, and Python code.  This one produces Haskell code.++How well does this Haskell package duplicate Google's project?++  This provides non-mutable messages that ought to be wire-compatible with Google.+  These message support extensions.+  These messages do not support reading or storing unknown fields; these are errors.+  This does not generate anything for Services/Methods.++  Adding support for unknown fields as an option to hprotoc could be done.+  Adding support for services has not been considered.++  I reject negative field numbers in proto files.  Google's code silently changes them to positive numbers.+  I think that Google's code checks for some policy violations that are not well documented enough for me to reverse engineer.+  Some (all?) of Google's APIs include the possibility of mutable messages.+  I suspect that my message reflection is not as useful at runtime as in some of Google's APIs.++What is protocol-buffers?++  The protocol-buffers part is the main library which has two faces:++  1) It provides an external API exported by module Text.ProtocolBuffers for users to read and write the binary format and manipulate the message data structures created by hprotoc.+  2) It provides an internal API for the messages under module Text.ProtocolBuffers.Header to implement their tasks.++What is protocol-buffers-descriptor?++  1) It uses the protocol-buffers package.+  2) It provides the code generated by hprotoc from "descriptor.proto" under module Text.DescriptorProtos.+  3) This supports hprotoc which is used to describe proto files and the code they will generate.++What is hprotoc?++  1) It uses protocol-buffers and protocol-buffers-descriptor above.+  2) It is a command line tool that reads in ".proto" files and produces Haskell source trees like Google's protoc.+  3) ...and it contains a very nice lexer and parser for the ".proto" file...++  The hprotoc part is a executable program which reads ".proto" files and uses the protocol-buffers package to produce a tree of Haskell source files.  The program is called "hprotoc".  Usage is given by the program itself, the options themselves are processed in order.  It can take several input search paths, and allow an additional module prefix, a selectable output directory, and ends with a list of of proto file to generate from.++  The output has to be a tree of modules since each message is given its own namespace, and a module is the only partitioning of namespace in Haskell.  The keys for extension fields are defined alongside the message whose namespace they share.  Since message names are both a data type and a namespace the filename and the message name match (aside from the .hs file extension).++And what are the examples and tests sub-directories?++  The examples sub-directory is for duplicating the addressbook.proto example that Google has with its code.  The ABF and ABF2 file are included as binary addressbooks.  These can be read by the C++ examples from Google, and vice-versa.++  The tests sub-directory is where I have written some test code to drive the UnittestProto code generated from Google's unittest.proto (and unittest_import.proto) files.  The 'patchBoot' file has the needed file patches to fix up the recursive imports.++What do I need to compile the code?++  I use ghc (version 6.8.3) and cabal (version 1.2.4.0).++  The dependencies are listed in the .cabal files, and these currently require you to go to hackage.haskell.org and get packages "binary" (I use version 0.4.2) and "utf8-string" (I use 0.3.1.1).++  The hprotoc Lexer.hs is produced from Lexer.x by the alex program (I use version 2.2) which can be downloaded from http://www.haskell.org/alex/ if you edit Lexer.x and need to regenerate Lexer.hs.++  The usual cabal configure/buid/install works for the protocol-buffers library (and haddock for API docs):+    runhaskell Setup.hs configure +    runhaskell Setup.hs build+    runhaskell Setup.hs haddock+    runhaskell Setup.hs install+  After installing protocol-buffers go into the describe sub-directory and configure/build/install the protocol-buffers-descriptor library.+  After installing protocol-buffers  and protocol-buffers-descriptor go into the hprotoc sub-directory and configure/build/install the hprotoc executable.++  Note: Patches to support other compilers are welcome.++How mature is this code?++  It can write the wire encoding and read it back.  It will has been tested for interoperability against Google's read/write code with addressbook.proto.++  hprotoc generates and uses the Text.DescriptorProtos tree from Google "descriptor.proto" file.++  hprotoc has generated code from Google/protobuf/unittest.proto and Google/protobuf.unittest_import.  These compile after adding hs-boot files TestAllExtensions.hs-boot, TestFieldOrderings.hs-boot, and TestMutualRecursionA.hs-boot to resolve mutual recursion.  The SPARSE_D and SPARSE_E enum values in the original unittest.proto are negative, which is disallowed so I comment those out.  The TestEnumWithDupValue has duplicated values which cause a compilation warning.++  There has been QuickCheck tests done for UnittestProto/TestAllType.hs and UnittestProto/TestAllExtensions.hs in the tests subdirectory.  These pass as of 2008-09-19 for version 0.2.7 (which has been tagged right after writing this).  These test that random messages can be roundtripped to the wire format without changing — with the caveat that the new extension keys are read back as raw bytes but compare equal because of the parsing done by (==).++Mutual recursion is a problem?++  It is not fully automatic with GHC.  One can start with the Skeleton.hs-boot file (an extra in the source tree) or just write the needed hs-boot files by hand to break the recursion.  This is very similar to the making header files in C with forward declarations.  See the GHC user manual for more.++  Perhaps a future version will generate the needed hs-boot files automatically.  But the effort of add that feature is more than effort of making the hs-boot files manually.++How stable is the API?++  This is the first working release of the code.  I do not promise to keep any of the API but I am lazy so most things will not change.  The reflection capabilities may get improved/altered.  Stricter warnings and error detection may be added.  Code will move between protocol-buffers and hprotoc projects.  The internals of reading from the wire may be improved.++Where is the API documentation?++  These file should be able to have cabal run the haddock generation.  I am using Haddock version 2.2.2 at the moment.  The imports of Text.ProtocolBuffers are the public API.  The generated code's API is Text.ProtocolBuffers.Header.  The only usage examples are in the examples sub-directory and the tests sub-directory.  Since the messages are simply Haskell data types most of the manipulation should be easy.++  The main thing that is weird is that messages with extension ranges get an ExtField record field that holds ... an internal data structure.  This is currently a Map from field number to a rather complicated existential + GADT combination that should really only be touched by the ExtKey and MessageAPI type class methods.  The ExtField data constructor is not hidden, though it could be and probably ought to be.++  Note that extension fields are inherently slower, especially in ghci (though ghc's -O2 helps quite a bit).++  The entire proto file is stored in the top level module in wire-encoded form and can be accessed as a FileDescriptorProto.  The Haskell code also defines its own reflection data types, with one stored in each generated module and also in a master data type in the top level module (via Show and Read).++Who reads this far?++  I suspect no one ever will.++Why define your own Haskell reflection types in addition to FileDescriptorProto's types?++  This allows for the protocol-buffers library package to not depend on a single thing defined in the protocol-buffers-descriptor package.  This lack of recursion made for much simpler bootstrapping and allows the descriptor.proto generated files to be build separately.++  While descriptor.proto files are a great fit as output from parsing a proto file they are not as good a fit for code generation.  They mix fields and extension keys, they have all optional fields even though some things (especially names) are compulsory.  They obscure which descriptors are groups.  They have a nested structure which is useful when resolving the names but not for iterating over for code generation.++What are the pieces of protocol-buffers doing?++  Basic.hs defines the core data types (that are not already in Prelude) and many classes.+  Mergeable.hs defines the standard instances of Mergeable for combining types.+  Default.hs defines the standard default of the basic data types.+  Reflections.hs defines the Haskell reflection data types (stored with each generated module).+  Get.hs is here because I needed a slightly different style of binary Get monad (see binary and binary-strict packages).+    This is standalone and could be put into any project.  It has long comments inside.+  WireMessage.hs defines 3 things:+    (1) The Wire instances for the basic data types+    (2) The API for the generated module to use to define their own Wire instances+    (3) The API for the user to load and save messages+    This file would not compile with ghc-6.8.3 on a G4 (Mac OS X 10.5.4, XCode 3.1) without -fvia-C as the cabal file states.+  Extensions.hs is rather large because it add everything needed for extension fields (see haddock API docs).+    It should not export ExtField's constructor, but it currently does.+  Header.hs re-exports what is needed for the instance messages.+  ProtocolBuffer.hs re-exports what is needed for the user API.++What are the pieces of hprotoc doing?++  alex uses Lexer.x to generated Lexer.hs which slices up the ".proto" file into tokens.+    The ".proto" layout is well designed, quite unambiguous, and easy to tokenize.+    The lexer also does the jobs of decoding the backslash escape codes in quotes strings, and interpreting floating point numbers.+    Errors and unexpected input are inserted into the token list, with at least line number level precision.+  The Parser.hs file has a Parsec parser which are really used as nested parsers (allowing for the type of the user state to change).+    The ".proto" grammar is well designed and the system never needs to backtrack over tokens.+    The default values and options' values parsed according to the expected type, and string default are check for valid utf8 encoding.+    (This also import the Instances.hs file)+  The Resolve.hs has code to resolve all the names to a fully qualified form, including name mangling where necessary.+    This includes code to load and parse all the imported ".proto" files, reusing parses for efficiency, and detecting import loops.+    The context built from each imported file is combined to change the FileDescriptorProto into a modified FileDescriptorProto.+    This stage also determines that extension keys are in a valid extensions range declaration, and enum default values exists.+  The MakeReflections.hs file converts the nested FileDescriptorProto into a flatter Haskell reflection data structure.+    This includes parsing the default value stored in the FileDescriptorProto.+  The Gen.hs file takes a Haskell data structure from MakeReflections and builds a module syntax data structure.+    The syntax data is quite verbose and several helper functions are used to help with the composition.+    The result is easy to print as a string to a file.+  The ProtoCompile.hs file is the Main module which defines the command line program 'hprotoc'.+    This manages most of the interaction with the file system (aside from import loading in Resolve).+    Everything that is needed is collected into the Options data type which is passed to "run".+    The output style can be tweaked by changing "style" and "myMode".
+ Skeleton.hs-boot view
@@ -0,0 +1,19 @@+module $PARENT.$NAME ($NAME) where++import qualified Prelude as P'(Show,Eq,Ord,Maybe,Double,Float)+import qualified Text.ProtocolBuffers.Header as P'(Typeable,Mergeable,Default,Wire,MessageAPI,GPB,ReflectDescriptor+                                                  ,Seq,Utf8,ByteString,Int32,Int64,Word32,Word64,ExtendMessage)++data $NAME++instance P'.Show $NAME+instance P'.Eq $NAME+instance P'.Ord $NAME+instance P'.Typeable $NAME+instance P'.Mergeable $NAME+instance P'.Default $NAME+instance P'.Wire $NAME+instance P'.MessageAPI msg' (msg' -> $NAME) $NAME+instance P'.GPB $NAME+instance P'.ExtendMessage $NAME+instance P'.ReflectDescriptor $NAME
+ TODO view
@@ -0,0 +1,14 @@+Add the rest of the documentation for the public API.++Next task: re-organize code+  Goals:+    1) A command-line code generation tool+       a) CLI input+       b) lexer - parsers - resolver - reflector - generator+       c) importer+    2) Refine Header API used by generated classes+    3) A master API module to expose:+       a) Get/Set/Has/Ext/Default/Merge API+       b) Wire API+       c) Reflection API+       d) API for extensions?
− Text/DescriptorProtos.hs 
@@ -1,39 +0,0 @@-module Text.DescriptorProtos-    (Text.DescriptorProtos.DescriptorProto-    ,Text.DescriptorProtos.DescriptorProto.ExtensionRange-    ,Text.DescriptorProtos.EnumDescriptorProto-    ,Text.DescriptorProtos.EnumOptions-    ,Text.DescriptorProtos.EnumValueDescriptorProto-    ,Text.DescriptorProtos.EnumValueOptions-    ,Text.DescriptorProtos.FieldDescriptorProto-    ,Text.DescriptorProtos.FieldDescriptorProto.Label-    ,Text.DescriptorProtos.FieldDescriptorProto.Type-    ,Text.DescriptorProtos.FieldOptions-    ,Text.DescriptorProtos.FieldOptions.CType-    ,Text.DescriptorProtos.FileOptions-    ,Text.DescriptorProtos.FileOptions.OptimizeMode-    ,Text.DescriptorProtos.MessageOptions-    ,Text.DescriptorProtos.MethodDescriptorProto-    ,Text.DescriptorProtos.MethodOptions-    ,Text.DescriptorProtos.ServiceDescriptorProto-    ,Text.DescriptorProtos.ServiceOptions -    ) where--import qualified Text.DescriptorProtos.DescriptorProto as Text.DescriptorProtos(DescriptorProto)-import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as Text.DescriptorProtos.DescriptorProto(ExtensionRange)-import qualified Text.DescriptorProtos.EnumDescriptorProto as Text.DescriptorProtos(EnumDescriptorProto) -import qualified Text.DescriptorProtos.EnumOptions as Text.DescriptorProtos(EnumOptions)-import qualified Text.DescriptorProtos.EnumValueDescriptorProto as Text.DescriptorProtos(EnumValueDescriptorProto)-import qualified Text.DescriptorProtos.EnumValueOptions as Text.DescriptorProtos(EnumValueOptions) -import qualified Text.DescriptorProtos.FieldDescriptorProto as Text.DescriptorProtos(FieldDescriptorProto) -import qualified Text.DescriptorProtos.FieldDescriptorProto.Label as Text.DescriptorProtos.FieldDescriptorProto(Label)-import qualified Text.DescriptorProtos.FieldDescriptorProto.Type as Text.DescriptorProtos.FieldDescriptorProto(Type)-import qualified Text.DescriptorProtos.FieldOptions as Text.DescriptorProtos(FieldOptions)-import qualified Text.DescriptorProtos.FieldOptions.CType as Text.DescriptorProtos.FieldOptions(CType)-import qualified Text.DescriptorProtos.FileOptions as Text.DescriptorProtos(FileOptions)-import qualified Text.DescriptorProtos.FileOptions.OptimizeMode as Text.DescriptorProtos.FileOptions(OptimizeMode)-import qualified Text.DescriptorProtos.MessageOptions as Text.DescriptorProtos(MessageOptions)-import qualified Text.DescriptorProtos.MethodDescriptorProto as Text.DescriptorProtos(MethodDescriptorProto)-import qualified Text.DescriptorProtos.MethodOptions as Text.DescriptorProtos(MethodOptions)-import qualified Text.DescriptorProtos.ServiceDescriptorProto as Text.DescriptorProtos(ServiceDescriptorProto) -import qualified Text.DescriptorProtos.ServiceOptions as Text.DescriptorProtos(ServiceOptions)
− Text/DescriptorProtos/DescriptorProto.hs 
@@ -1,104 +0,0 @@-module Text.DescriptorProtos.DescriptorProto (DescriptorProto(..))-       where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.EnumDescriptorProto-       as DescriptorProtos (EnumDescriptorProto)-import qualified Text.DescriptorProtos.FieldDescriptorProto-       as DescriptorProtos (FieldDescriptorProto)-import qualified Text.DescriptorProtos.MessageOptions-       as DescriptorProtos (MessageOptions)-import qualified-       Text.DescriptorProtos.DescriptorProto.ExtensionRange-       as DescriptorProtos.DescriptorProto (ExtensionRange)- -data DescriptorProto = DescriptorProto{name ::-                                       P'.Maybe P'.ByteString,-                                       field :: P'.Seq DescriptorProtos.FieldDescriptorProto,-                                       extension :: P'.Seq DescriptorProtos.FieldDescriptorProto,-                                       nested_type :: P'.Seq DescriptorProto,-                                       enum_type :: P'.Seq DescriptorProtos.EnumDescriptorProto,-                                       extension_range ::-                                       P'.Seq DescriptorProtos.DescriptorProto.ExtensionRange,-                                       options :: P'.Maybe DescriptorProtos.MessageOptions}-                     deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable DescriptorProto where-        mergeEmpty-          = DescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-        mergeAppend (DescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7)-          (DescriptorProto y'1 y'2 y'3 y'4 y'5 y'6 y'7)-          = DescriptorProto (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)-              (P'.mergeAppend x'3 y'3)-              (P'.mergeAppend x'4 y'4)-              (P'.mergeAppend x'5 y'5)-              (P'.mergeAppend x'6 y'6)-              (P'.mergeAppend x'7 y'7)- -instance P'.Default DescriptorProto where-        defaultValue-          = DescriptorProto (P'.Just P'.defaultValue) (P'.defaultValue)-              (P'.defaultValue)-              (P'.defaultValue)-              (P'.defaultValue)-              (P'.defaultValue)-              (P'.Just P'.defaultValue)- -instance P'.Wire DescriptorProto where-        wireSize 11 (DescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7)-          = P'.lenSize-              (0 + P'.wireSizeOpt 1 9 x'1 + P'.wireSizeRep 1 11 x'2 +-                 P'.wireSizeRep 1 11 x'3-                 + P'.wireSizeRep 1 11 x'4-                 + P'.wireSizeRep 1 11 x'5-                 + P'.wireSizeRep 1 11 x'6-                 + P'.wireSizeOpt 1 11 x'7)-        wirePut 11 self'@(DescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 10 9 x'1-               P'.wirePutRep 18 11 x'2-               P'.wirePutRep 50 11 x'3-               P'.wirePutRep 26 11 x'4-               P'.wirePutRep 34 11 x'5-               P'.wirePutRep 42 11 x'6-               P'.wirePutOpt 58 11 x'7-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field})-                               (P'.wireGet 9)-                        2 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{field = P'.append (field old'Self) new'Field})-                               (P'.wireGet 11)-                        6 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{extension = P'.append (extension old'Self) new'Field})-                               (P'.wireGet 11)-                        3 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{nested_type =-                                             P'.append (nested_type old'Self) new'Field})-                               (P'.wireGet 11)-                        4 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{enum_type = P'.append (enum_type old'Self) new'Field})-                               (P'.wireGet 11)-                        5 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{extension_range =-                                             P'.append (extension_range old'Self) new'Field})-                               (P'.wireGet 11)-                        7 -> P'.fmap (\ new'Field -> old'Self{options = P'.Just new'Field})-                               (P'.wireGet 11)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor DescriptorProto where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"DescriptorProto\"}, fields = fromList [FieldInfo {fieldName = \"name\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"field\", fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.FieldDescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"extension\", fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.FieldDescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"nested_type\", fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"enum_type\", fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.EnumDescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"extension_range\", fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.DescriptorProto.ExtensionRange\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"options\", fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.MessageOptions\", hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/DescriptorProto/ExtensionRange.hs 
@@ -1,40 +0,0 @@-module Text.DescriptorProtos.DescriptorProto.ExtensionRange-       (ExtensionRange(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data ExtensionRange = ExtensionRange{start :: P'.Maybe P'.Int32,-                                     end :: P'.Maybe P'.Int32}-                    deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable ExtensionRange where-        mergeEmpty = ExtensionRange P'.mergeEmpty P'.mergeEmpty-        mergeAppend (ExtensionRange x'1 x'2) (ExtensionRange y'1 y'2)-          = ExtensionRange (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)- -instance P'.Default ExtensionRange where-        defaultValue-          = ExtensionRange (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)- -instance P'.Wire ExtensionRange where-        wireSize 11 (ExtensionRange x'1 x'2)-          = P'.lenSize (0 + P'.wireSizeOpt 1 5 x'1 + P'.wireSizeOpt 1 5 x'2)-        wirePut 11 self'@(ExtensionRange x'1 x'2)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 8 5 x'1-               P'.wirePutOpt 16 5 x'2-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{start = P'.Just new'Field})-                               (P'.wireGet 5)-                        2 -> P'.fmap (\ new'Field -> old'Self{end = P'.Just new'Field})-                               (P'.wireGet 5)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor ExtensionRange where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"ExtensionRange\"}, fields = fromList [FieldInfo {fieldName = \"start\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"end\", fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/EnumDescriptorProto.hs 
@@ -1,58 +0,0 @@-module Text.DescriptorProtos.EnumDescriptorProto-       (EnumDescriptorProto(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.EnumOptions-       as DescriptorProtos (EnumOptions)-import qualified Text.DescriptorProtos.EnumValueDescriptorProto-       as DescriptorProtos (EnumValueDescriptorProto)- -data EnumDescriptorProto = EnumDescriptorProto{name ::-                                               P'.Maybe P'.ByteString,-                                               value ::-                                               P'.Seq DescriptorProtos.EnumValueDescriptorProto,-                                               options :: P'.Maybe DescriptorProtos.EnumOptions}-                         deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable EnumDescriptorProto where-        mergeEmpty-          = EnumDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty-        mergeAppend (EnumDescriptorProto x'1 x'2 x'3)-          (EnumDescriptorProto y'1 y'2 y'3)-          = EnumDescriptorProto (P'.mergeAppend x'1 y'1)-              (P'.mergeAppend x'2 y'2)-              (P'.mergeAppend x'3 y'3)- -instance P'.Default EnumDescriptorProto where-        defaultValue-          = EnumDescriptorProto (P'.Just P'.defaultValue) (P'.defaultValue)-              (P'.Just P'.defaultValue)- -instance P'.Wire EnumDescriptorProto where-        wireSize 11 (EnumDescriptorProto x'1 x'2 x'3)-          = P'.lenSize-              (0 + P'.wireSizeOpt 1 9 x'1 + P'.wireSizeRep 1 11 x'2 +-                 P'.wireSizeOpt 1 11 x'3)-        wirePut 11 self'@(EnumDescriptorProto x'1 x'2 x'3)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 10 9 x'1-               P'.wirePutRep 18 11 x'2-               P'.wirePutOpt 26 11 x'3-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field})-                               (P'.wireGet 9)-                        2 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{value = P'.append (value old'Self) new'Field})-                               (P'.wireGet 11)-                        3 -> P'.fmap (\ new'Field -> old'Self{options = P'.Just new'Field})-                               (P'.wireGet 11)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor EnumDescriptorProto where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumDescriptorProto\"}, fields = fromList [FieldInfo {fieldName = \"name\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"value\", fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.EnumValueDescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"options\", fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.EnumOptions\", hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/EnumOptions.hs 
@@ -1,28 +0,0 @@-module Text.DescriptorProtos.EnumOptions (EnumOptions(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data EnumOptions = EnumOptions{}-                 deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable EnumOptions where-        mergeEmpty = EnumOptions-        mergeAppend (EnumOptions) (EnumOptions) = EnumOptions- -instance P'.Default EnumOptions where-        defaultValue = EnumOptions- -instance P'.Wire EnumOptions where-        wireSize 11 (EnumOptions) = P'.lenSize (0)-        wirePut 11 self'@(EnumOptions)-          = do P'.putSize (P'.wireSize 11 self')-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor EnumOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumOptions\"}, fields = fromList []}"
− Text/DescriptorProtos/EnumValueDescriptorProto.hs 
@@ -1,56 +0,0 @@-module Text.DescriptorProtos.EnumValueDescriptorProto-       (EnumValueDescriptorProto(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.EnumValueOptions-       as DescriptorProtos (EnumValueOptions)- -data EnumValueDescriptorProto = EnumValueDescriptorProto{name ::-                                                         P'.Maybe P'.ByteString,-                                                         number :: P'.Maybe P'.Int32,-                                                         options ::-                                                         P'.Maybe DescriptorProtos.EnumValueOptions}-                              deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable EnumValueDescriptorProto where-        mergeEmpty-          = EnumValueDescriptorProto P'.mergeEmpty P'.mergeEmpty-              P'.mergeEmpty-        mergeAppend (EnumValueDescriptorProto x'1 x'2 x'3)-          (EnumValueDescriptorProto y'1 y'2 y'3)-          = EnumValueDescriptorProto (P'.mergeAppend x'1 y'1)-              (P'.mergeAppend x'2 y'2)-              (P'.mergeAppend x'3 y'3)- -instance P'.Default EnumValueDescriptorProto where-        defaultValue-          = EnumValueDescriptorProto (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)- -instance P'.Wire EnumValueDescriptorProto where-        wireSize 11 (EnumValueDescriptorProto x'1 x'2 x'3)-          = P'.lenSize-              (0 + P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 5 x'2 +-                 P'.wireSizeOpt 1 11 x'3)-        wirePut 11 self'@(EnumValueDescriptorProto x'1 x'2 x'3)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 10 9 x'1-               P'.wirePutOpt 16 5 x'2-               P'.wirePutOpt 26 11 x'3-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field})-                               (P'.wireGet 9)-                        2 -> P'.fmap (\ new'Field -> old'Self{number = P'.Just new'Field})-                               (P'.wireGet 5)-                        3 -> P'.fmap (\ new'Field -> old'Self{options = P'.Just new'Field})-                               (P'.wireGet 11)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor EnumValueDescriptorProto where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueDescriptorProto\"}, fields = fromList [FieldInfo {fieldName = \"name\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"number\", fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"options\", fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.EnumValueOptions\", hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/EnumValueOptions.hs 
@@ -1,30 +0,0 @@-module Text.DescriptorProtos.EnumValueOptions-       (EnumValueOptions(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data EnumValueOptions = EnumValueOptions{}-                      deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable EnumValueOptions where-        mergeEmpty = EnumValueOptions-        mergeAppend (EnumValueOptions) (EnumValueOptions)-          = EnumValueOptions- -instance P'.Default EnumValueOptions where-        defaultValue = EnumValueOptions- -instance P'.Wire EnumValueOptions where-        wireSize 11 (EnumValueOptions) = P'.lenSize (0)-        wirePut 11 self'@(EnumValueOptions)-          = do P'.putSize (P'.wireSize 11 self')-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor EnumValueOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueOptions\"}, fields = fromList []}"
− Text/DescriptorProtos/FieldDescriptorProto.hs 
@@ -1,106 +0,0 @@-module Text.DescriptorProtos.FieldDescriptorProto-       (FieldDescriptorProto(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.FieldOptions-       as DescriptorProtos (FieldOptions)-import qualified Text.DescriptorProtos.FieldDescriptorProto.Label-       as DescriptorProtos.FieldDescriptorProto (Label)-import qualified Text.DescriptorProtos.FieldDescriptorProto.Type-       as DescriptorProtos.FieldDescriptorProto (Type)- -data FieldDescriptorProto = FieldDescriptorProto{name ::-                                                 P'.Maybe P'.ByteString,-                                                 number :: P'.Maybe P'.Int32,-                                                 label ::-                                                 P'.Maybe-                                                   DescriptorProtos.FieldDescriptorProto.Label,-                                                 type' ::-                                                 P'.Maybe-                                                   DescriptorProtos.FieldDescriptorProto.Type,-                                                 type_name :: P'.Maybe P'.ByteString,-                                                 extendee :: P'.Maybe P'.ByteString,-                                                 default_value :: P'.Maybe P'.ByteString,-                                                 options :: P'.Maybe DescriptorProtos.FieldOptions}-                          deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable FieldDescriptorProto where-        mergeEmpty-          = FieldDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-        mergeAppend (FieldDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)-          (FieldDescriptorProto y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8)-          = FieldDescriptorProto (P'.mergeAppend x'1 y'1)-              (P'.mergeAppend x'2 y'2)-              (P'.mergeAppend x'3 y'3)-              (P'.mergeAppend x'4 y'4)-              (P'.mergeAppend x'5 y'5)-              (P'.mergeAppend x'6 y'6)-              (P'.mergeAppend x'7 y'7)-              (P'.mergeAppend x'8 y'8)- -instance P'.Default FieldDescriptorProto where-        defaultValue-          = FieldDescriptorProto (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)- -instance P'.Wire FieldDescriptorProto where-        wireSize 11 (FieldDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)-          = P'.lenSize-              (0 + P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 5 x'2 +-                 P'.wireSizeOpt 1 14 x'3-                 + P'.wireSizeOpt 1 14 x'4-                 + P'.wireSizeOpt 1 9 x'5-                 + P'.wireSizeOpt 1 9 x'6-                 + P'.wireSizeOpt 1 9 x'7-                 + P'.wireSizeOpt 1 11 x'8)-        wirePut 11-          self'@(FieldDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 10 9 x'1-               P'.wirePutOpt 24 5 x'2-               P'.wirePutOpt 32 14 x'3-               P'.wirePutOpt 40 14 x'4-               P'.wirePutOpt 50 9 x'5-               P'.wirePutOpt 18 9 x'6-               P'.wirePutOpt 58 9 x'7-               P'.wirePutOpt 66 11 x'8-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field})-                               (P'.wireGet 9)-                        3 -> P'.fmap (\ new'Field -> old'Self{number = P'.Just new'Field})-                               (P'.wireGet 5)-                        4 -> P'.fmap (\ new'Field -> old'Self{label = P'.Just new'Field})-                               (P'.wireGet 14)-                        5 -> P'.fmap (\ new'Field -> old'Self{type' = P'.Just new'Field})-                               (P'.wireGet 14)-                        6 -> P'.fmap-                               (\ new'Field -> old'Self{type_name = P'.Just new'Field})-                               (P'.wireGet 9)-                        2 -> P'.fmap-                               (\ new'Field -> old'Self{extendee = P'.Just new'Field})-                               (P'.wireGet 9)-                        7 -> P'.fmap-                               (\ new'Field -> old'Self{default_value = P'.Just new'Field})-                               (P'.wireGet 9)-                        8 -> P'.fmap (\ new'Field -> old'Self{options = P'.Just new'Field})-                               (P'.wireGet 11)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor FieldDescriptorProto where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}, fields = fromList [FieldInfo {fieldName = \"name\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"number\", fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"label\", fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just \"DescriptorProtos.FieldDescriptorProto.Label\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"type'\", fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just \"DescriptorProtos.FieldDescriptorProto.Type\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"type_name\", fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"extendee\", fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"default_value\", fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"options\", fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.FieldOptions\", hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/FieldDescriptorProto/Label.hs 
@@ -1,48 +0,0 @@-module Text.DescriptorProtos.FieldDescriptorProto.Label (Label(..))-       where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data Label = LABEL_OPTIONAL-           | LABEL_REQUIRED-           | LABEL_REPEATED-           deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable Label- -instance P'.Bounded Label where-        minBound = LABEL_OPTIONAL-        maxBound = LABEL_REPEATED- -instance P'.Default Label where-        defaultValue = LABEL_OPTIONAL- -instance P'.Enum Label where-        fromEnum (LABEL_OPTIONAL) = 1-        fromEnum (LABEL_REQUIRED) = 2-        fromEnum (LABEL_REPEATED) = 3-        toEnum 1 = LABEL_OPTIONAL-        toEnum 2 = LABEL_REQUIRED-        toEnum 3 = LABEL_REPEATED-        succ (LABEL_OPTIONAL) = LABEL_REQUIRED-        succ (LABEL_REQUIRED) = LABEL_REPEATED-        pred (LABEL_REQUIRED) = LABEL_OPTIONAL-        pred (LABEL_REPEATED) = LABEL_REQUIRED- -instance P'.Wire Label where-        wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)-        wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)-        wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)- -instance P'.ReflectEnum Label where-        reflectEnum-          = [(1, "LABEL_OPTIONAL", LABEL_OPTIONAL),-             (2, "LABEL_REQUIRED", LABEL_REQUIRED),-             (3, "LABEL_REPEATED", LABEL_REPEATED)]-        reflectEnumInfo _-          = P'.EnumInfo-              (P'.ProtoName "Text" "DescriptorProtos.FieldDescriptorProto"-                 "Label")-              [(1, "LABEL_OPTIONAL"), (2, "LABEL_REQUIRED"),-               (3, "LABEL_REPEATED")]
− Text/DescriptorProtos/FieldDescriptorProto/Type.hs 
@@ -1,134 +0,0 @@-module Text.DescriptorProtos.FieldDescriptorProto.Type (Type(..))-       where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data Type = TYPE_DOUBLE-          | TYPE_FLOAT-          | TYPE_INT64-          | TYPE_UINT64-          | TYPE_INT32-          | TYPE_FIXED64-          | TYPE_FIXED32-          | TYPE_BOOL-          | TYPE_STRING-          | TYPE_GROUP-          | TYPE_MESSAGE-          | TYPE_BYTES-          | TYPE_UINT32-          | TYPE_ENUM-          | TYPE_SFIXED32-          | TYPE_SFIXED64-          | TYPE_SINT32-          | TYPE_SINT64-          deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable Type- -instance P'.Bounded Type where-        minBound = TYPE_DOUBLE-        maxBound = TYPE_SINT64- -instance P'.Default Type where-        defaultValue = TYPE_DOUBLE- -instance P'.Enum Type where-        fromEnum (TYPE_DOUBLE) = 1-        fromEnum (TYPE_FLOAT) = 2-        fromEnum (TYPE_INT64) = 3-        fromEnum (TYPE_UINT64) = 4-        fromEnum (TYPE_INT32) = 5-        fromEnum (TYPE_FIXED64) = 6-        fromEnum (TYPE_FIXED32) = 7-        fromEnum (TYPE_BOOL) = 8-        fromEnum (TYPE_STRING) = 9-        fromEnum (TYPE_GROUP) = 10-        fromEnum (TYPE_MESSAGE) = 11-        fromEnum (TYPE_BYTES) = 12-        fromEnum (TYPE_UINT32) = 13-        fromEnum (TYPE_ENUM) = 14-        fromEnum (TYPE_SFIXED32) = 15-        fromEnum (TYPE_SFIXED64) = 16-        fromEnum (TYPE_SINT32) = 17-        fromEnum (TYPE_SINT64) = 18-        toEnum 1 = TYPE_DOUBLE-        toEnum 2 = TYPE_FLOAT-        toEnum 3 = TYPE_INT64-        toEnum 4 = TYPE_UINT64-        toEnum 5 = TYPE_INT32-        toEnum 6 = TYPE_FIXED64-        toEnum 7 = TYPE_FIXED32-        toEnum 8 = TYPE_BOOL-        toEnum 9 = TYPE_STRING-        toEnum 10 = TYPE_GROUP-        toEnum 11 = TYPE_MESSAGE-        toEnum 12 = TYPE_BYTES-        toEnum 13 = TYPE_UINT32-        toEnum 14 = TYPE_ENUM-        toEnum 15 = TYPE_SFIXED32-        toEnum 16 = TYPE_SFIXED64-        toEnum 17 = TYPE_SINT32-        toEnum 18 = TYPE_SINT64-        succ (TYPE_DOUBLE) = TYPE_FLOAT-        succ (TYPE_FLOAT) = TYPE_INT64-        succ (TYPE_INT64) = TYPE_UINT64-        succ (TYPE_UINT64) = TYPE_INT32-        succ (TYPE_INT32) = TYPE_FIXED64-        succ (TYPE_FIXED64) = TYPE_FIXED32-        succ (TYPE_FIXED32) = TYPE_BOOL-        succ (TYPE_BOOL) = TYPE_STRING-        succ (TYPE_STRING) = TYPE_GROUP-        succ (TYPE_GROUP) = TYPE_MESSAGE-        succ (TYPE_MESSAGE) = TYPE_BYTES-        succ (TYPE_BYTES) = TYPE_UINT32-        succ (TYPE_UINT32) = TYPE_ENUM-        succ (TYPE_ENUM) = TYPE_SFIXED32-        succ (TYPE_SFIXED32) = TYPE_SFIXED64-        succ (TYPE_SFIXED64) = TYPE_SINT32-        succ (TYPE_SINT32) = TYPE_SINT64-        pred (TYPE_FLOAT) = TYPE_DOUBLE-        pred (TYPE_INT64) = TYPE_FLOAT-        pred (TYPE_UINT64) = TYPE_INT64-        pred (TYPE_INT32) = TYPE_UINT64-        pred (TYPE_FIXED64) = TYPE_INT32-        pred (TYPE_FIXED32) = TYPE_FIXED64-        pred (TYPE_BOOL) = TYPE_FIXED32-        pred (TYPE_STRING) = TYPE_BOOL-        pred (TYPE_GROUP) = TYPE_STRING-        pred (TYPE_MESSAGE) = TYPE_GROUP-        pred (TYPE_BYTES) = TYPE_MESSAGE-        pred (TYPE_UINT32) = TYPE_BYTES-        pred (TYPE_ENUM) = TYPE_UINT32-        pred (TYPE_SFIXED32) = TYPE_ENUM-        pred (TYPE_SFIXED64) = TYPE_SFIXED32-        pred (TYPE_SINT32) = TYPE_SFIXED64-        pred (TYPE_SINT64) = TYPE_SINT32- -instance P'.Wire Type where-        wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)-        wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)-        wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)- -instance P'.ReflectEnum Type where-        reflectEnum-          = [(1, "TYPE_DOUBLE", TYPE_DOUBLE), (2, "TYPE_FLOAT", TYPE_FLOAT),-             (3, "TYPE_INT64", TYPE_INT64), (4, "TYPE_UINT64", TYPE_UINT64),-             (5, "TYPE_INT32", TYPE_INT32), (6, "TYPE_FIXED64", TYPE_FIXED64),-             (7, "TYPE_FIXED32", TYPE_FIXED32), (8, "TYPE_BOOL", TYPE_BOOL),-             (9, "TYPE_STRING", TYPE_STRING), (10, "TYPE_GROUP", TYPE_GROUP),-             (11, "TYPE_MESSAGE", TYPE_MESSAGE), (12, "TYPE_BYTES", TYPE_BYTES),-             (13, "TYPE_UINT32", TYPE_UINT32), (14, "TYPE_ENUM", TYPE_ENUM),-             (15, "TYPE_SFIXED32", TYPE_SFIXED32),-             (16, "TYPE_SFIXED64", TYPE_SFIXED64),-             (17, "TYPE_SINT32", TYPE_SINT32), (18, "TYPE_SINT64", TYPE_SINT64)]-        reflectEnumInfo _-          = P'.EnumInfo-              (P'.ProtoName "Text" "DescriptorProtos.FieldDescriptorProto"-                 "Type")-              [(1, "TYPE_DOUBLE"), (2, "TYPE_FLOAT"), (3, "TYPE_INT64"),-               (4, "TYPE_UINT64"), (5, "TYPE_INT32"), (6, "TYPE_FIXED64"),-               (7, "TYPE_FIXED32"), (8, "TYPE_BOOL"), (9, "TYPE_STRING"),-               (10, "TYPE_GROUP"), (11, "TYPE_MESSAGE"), (12, "TYPE_BYTES"),-               (13, "TYPE_UINT32"), (14, "TYPE_ENUM"), (15, "TYPE_SFIXED32"),-               (16, "TYPE_SFIXED64"), (17, "TYPE_SINT32"), (18, "TYPE_SINT64")]
− Text/DescriptorProtos/FieldOptions.hs 
@@ -1,42 +0,0 @@-module Text.DescriptorProtos.FieldOptions (FieldOptions(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.FieldOptions.CType-       as DescriptorProtos.FieldOptions (CType)- -data FieldOptions = FieldOptions{ctype ::-                                 P'.Maybe DescriptorProtos.FieldOptions.CType,-                                 experimental_map_key :: P'.Maybe P'.ByteString}-                  deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable FieldOptions where-        mergeEmpty = FieldOptions P'.mergeEmpty P'.mergeEmpty-        mergeAppend (FieldOptions x'1 x'2) (FieldOptions y'1 y'2)-          = FieldOptions (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)- -instance P'.Default FieldOptions where-        defaultValue-          = FieldOptions (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)- -instance P'.Wire FieldOptions where-        wireSize 11 (FieldOptions x'1 x'2)-          = P'.lenSize (0 + P'.wireSizeOpt 1 14 x'1 + P'.wireSizeOpt 1 9 x'2)-        wirePut 11 self'@(FieldOptions x'1 x'2)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 8 14 x'1-               P'.wirePutOpt 74 9 x'2-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{ctype = P'.Just new'Field})-                               (P'.wireGet 14)-                        9 -> P'.fmap-                               (\ new'Field -> old'Self{experimental_map_key = P'.Just new'Field})-                               (P'.wireGet 9)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor FieldOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldOptions\"}, fields = fromList [FieldInfo {fieldName = \"ctype\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just \"DescriptorProtos.FieldOptions.CType\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"experimental_map_key\", fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 74}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/FieldOptions/CType.hs 
@@ -1,38 +0,0 @@-module Text.DescriptorProtos.FieldOptions.CType (CType(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data CType = CORD-           | STRING_PIECE-           deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable CType- -instance P'.Bounded CType where-        minBound = CORD-        maxBound = STRING_PIECE- -instance P'.Default CType where-        defaultValue = CORD- -instance P'.Enum CType where-        fromEnum (CORD) = 1-        fromEnum (STRING_PIECE) = 2-        toEnum 1 = CORD-        toEnum 2 = STRING_PIECE-        succ (CORD) = STRING_PIECE-        pred (STRING_PIECE) = CORD- -instance P'.Wire CType where-        wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)-        wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)-        wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)- -instance P'.ReflectEnum CType where-        reflectEnum-          = [(1, "CORD", CORD), (2, "STRING_PIECE", STRING_PIECE)]-        reflectEnumInfo _-          = P'.EnumInfo-              (P'.ProtoName "Text" "DescriptorProtos.FieldOptions" "CType")-              [(1, "CORD"), (2, "STRING_PIECE")]
− Text/DescriptorProtos/FileDescriptorProto.hs 
@@ -1,118 +0,0 @@-module Text.DescriptorProtos.FileDescriptorProto-       (FileDescriptorProto(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.DescriptorProto-       as DescriptorProtos (DescriptorProto)-import qualified Text.DescriptorProtos.EnumDescriptorProto-       as DescriptorProtos (EnumDescriptorProto)-import qualified Text.DescriptorProtos.FieldDescriptorProto-       as DescriptorProtos (FieldDescriptorProto)-import qualified Text.DescriptorProtos.FileOptions-       as DescriptorProtos (FileOptions)-import qualified Text.DescriptorProtos.ServiceDescriptorProto-       as DescriptorProtos (ServiceDescriptorProto)- -data FileDescriptorProto = FileDescriptorProto{name ::-                                               P'.Maybe P'.ByteString,-                                               package :: P'.Maybe P'.ByteString,-                                               dependency :: P'.Seq P'.ByteString,-                                               message_type ::-                                               P'.Seq DescriptorProtos.DescriptorProto,-                                               enum_type ::-                                               P'.Seq DescriptorProtos.EnumDescriptorProto,-                                               service ::-                                               P'.Seq DescriptorProtos.ServiceDescriptorProto,-                                               extension ::-                                               P'.Seq DescriptorProtos.FieldDescriptorProto,-                                               options :: P'.Maybe DescriptorProtos.FileOptions}-                         deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable FileDescriptorProto where-        mergeEmpty-          = FileDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-              P'.mergeEmpty-        mergeAppend (FileDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)-          (FileDescriptorProto y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8)-          = FileDescriptorProto (P'.mergeAppend x'1 y'1)-              (P'.mergeAppend x'2 y'2)-              (P'.mergeAppend x'3 y'3)-              (P'.mergeAppend x'4 y'4)-              (P'.mergeAppend x'5 y'5)-              (P'.mergeAppend x'6 y'6)-              (P'.mergeAppend x'7 y'7)-              (P'.mergeAppend x'8 y'8)- -instance P'.Default FileDescriptorProto where-        defaultValue-          = FileDescriptorProto (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.defaultValue)-              (P'.defaultValue)-              (P'.defaultValue)-              (P'.defaultValue)-              (P'.defaultValue)-              (P'.Just P'.defaultValue)- -instance P'.Wire FileDescriptorProto where-        wireSize 11 (FileDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)-          = P'.lenSize-              (0 + P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 9 x'2 +-                 P'.wireSizeRep 1 9 x'3-                 + P'.wireSizeRep 1 11 x'4-                 + P'.wireSizeRep 1 11 x'5-                 + P'.wireSizeRep 1 11 x'6-                 + P'.wireSizeRep 1 11 x'7-                 + P'.wireSizeOpt 1 11 x'8)-        wirePut 11-          self'@(FileDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 10 9 x'1-               P'.wirePutOpt 18 9 x'2-               P'.wirePutRep 26 9 x'3-               P'.wirePutRep 34 11 x'4-               P'.wirePutRep 42 11 x'5-               P'.wirePutRep 50 11 x'6-               P'.wirePutRep 58 11 x'7-               P'.wirePutOpt 66 11 x'8-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field})-                               (P'.wireGet 9)-                        2 -> P'.fmap (\ new'Field -> old'Self{package = P'.Just new'Field})-                               (P'.wireGet 9)-                        3 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{dependency = P'.append (dependency old'Self) new'Field})-                               (P'.wireGet 9)-                        4 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{message_type =-                                             P'.append (message_type old'Self) new'Field})-                               (P'.wireGet 11)-                        5 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{enum_type = P'.append (enum_type old'Self) new'Field})-                               (P'.wireGet 11)-                        6 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{service = P'.append (service old'Self) new'Field})-                               (P'.wireGet 11)-                        7 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{extension = P'.append (extension old'Self) new'Field})-                               (P'.wireGet 11)-                        8 -> P'.fmap (\ new'Field -> old'Self{options = P'.Just new'Field})-                               (P'.wireGet 11)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor FileDescriptorProto where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FileDescriptorProto\"}, fields = fromList [FieldInfo {fieldName = \"name\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"package\", fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"dependency\", fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"message_type\", fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.DescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"enum_type\", fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.EnumDescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"service\", fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.ServiceDescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"extension\", fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.FieldDescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"options\", fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.FileOptions\", hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/FileOptions.hs 
@@ -1,63 +0,0 @@-module Text.DescriptorProtos.FileOptions (FileOptions(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.FileOptions.OptimizeMode-       as DescriptorProtos.FileOptions (OptimizeMode)- -data FileOptions = FileOptions{java_package ::-                               P'.Maybe P'.ByteString,-                               java_outer_classname :: P'.Maybe P'.ByteString,-                               java_multiple_files :: P'.Maybe P'.Bool,-                               optimize_for :: P'.Maybe DescriptorProtos.FileOptions.OptimizeMode}-                 deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable FileOptions where-        mergeEmpty-          = FileOptions P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty-              P'.mergeEmpty-        mergeAppend (FileOptions x'1 x'2 x'3 x'4)-          (FileOptions y'1 y'2 y'3 y'4)-          = FileOptions (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)-              (P'.mergeAppend x'3 y'3)-              (P'.mergeAppend x'4 y'4)- -instance P'.Default FileOptions where-        defaultValue-          = FileOptions (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)-              (P'.Just (P'.False))-              (P'.Just P'.defaultValue)- -instance P'.Wire FileOptions where-        wireSize 11 (FileOptions x'1 x'2 x'3 x'4)-          = P'.lenSize-              (0 + P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 9 x'2 +-                 P'.wireSizeOpt 1 8 x'3-                 + P'.wireSizeOpt 1 14 x'4)-        wirePut 11 self'@(FileOptions x'1 x'2 x'3 x'4)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 10 9 x'1-               P'.wirePutOpt 66 9 x'2-               P'.wirePutOpt 80 8 x'3-               P'.wirePutOpt 72 14 x'4-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap-                               (\ new'Field -> old'Self{java_package = P'.Just new'Field})-                               (P'.wireGet 9)-                        8 -> P'.fmap-                               (\ new'Field -> old'Self{java_outer_classname = P'.Just new'Field})-                               (P'.wireGet 9)-                        10 -> P'.fmap-                                (\ new'Field -> old'Self{java_multiple_files = P'.Just new'Field})-                                (P'.wireGet 8)-                        9 -> P'.fmap-                               (\ new'Field -> old'Self{optimize_for = P'.Just new'Field})-                               (P'.wireGet 14)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor FileOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FileOptions\"}, fields = fromList [FieldInfo {fieldName = \"java_package\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"java_outer_classname\", fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"java_multiple_files\", fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 80}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just (Chunk \"false\" Empty), hsDefault = Just (HsDef'Bool False)},FieldInfo {fieldName = \"optimize_for\", fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 72}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just \"DescriptorProtos.FileOptions.OptimizeMode\", hsRawDefault = Just (Chunk \"CODE_SIZE\" Empty), hsDefault = Nothing}]}"
− Text/DescriptorProtos/FileOptions/OptimizeMode.hs 
@@ -1,38 +0,0 @@-module Text.DescriptorProtos.FileOptions.OptimizeMode-       (OptimizeMode(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data OptimizeMode = SPEED-                  | CODE_SIZE-                  deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable OptimizeMode- -instance P'.Bounded OptimizeMode where-        minBound = SPEED-        maxBound = CODE_SIZE- -instance P'.Default OptimizeMode where-        defaultValue = SPEED- -instance P'.Enum OptimizeMode where-        fromEnum (SPEED) = 1-        fromEnum (CODE_SIZE) = 2-        toEnum 1 = SPEED-        toEnum 2 = CODE_SIZE-        succ (SPEED) = CODE_SIZE-        pred (CODE_SIZE) = SPEED- -instance P'.Wire OptimizeMode where-        wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)-        wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)-        wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)- -instance P'.ReflectEnum OptimizeMode where-        reflectEnum = [(1, "SPEED", SPEED), (2, "CODE_SIZE", CODE_SIZE)]-        reflectEnumInfo _-          = P'.EnumInfo-              (P'.ProtoName "Text" "DescriptorProtos.FileOptions" "OptimizeMode")-              [(1, "SPEED"), (2, "CODE_SIZE")]
− Text/DescriptorProtos/MessageOptions.hs 
@@ -1,37 +0,0 @@-module Text.DescriptorProtos.MessageOptions (MessageOptions(..))-       where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data MessageOptions = MessageOptions{message_set_wire_format ::-                                     P'.Maybe P'.Bool}-                    deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable MessageOptions where-        mergeEmpty = MessageOptions P'.mergeEmpty-        mergeAppend (MessageOptions x'1) (MessageOptions y'1)-          = MessageOptions (P'.mergeAppend x'1 y'1)- -instance P'.Default MessageOptions where-        defaultValue = MessageOptions (P'.Just (P'.False))- -instance P'.Wire MessageOptions where-        wireSize 11 (MessageOptions x'1)-          = P'.lenSize (0 + P'.wireSizeOpt 1 8 x'1)-        wirePut 11 self'@(MessageOptions x'1)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 8 8 x'1-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{message_set_wire_format = P'.Just new'Field})-                               (P'.wireGet 8)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor MessageOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MessageOptions\"}, fields = fromList [FieldInfo {fieldName = \"message_set_wire_format\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just (Chunk \"false\" Empty), hsDefault = Just (HsDef'Bool False)}]}"
− Text/DescriptorProtos/MethodDescriptorProto.hs 
@@ -1,65 +0,0 @@-module Text.DescriptorProtos.MethodDescriptorProto-       (MethodDescriptorProto(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.MethodOptions-       as DescriptorProtos (MethodOptions)- -data MethodDescriptorProto = MethodDescriptorProto{name ::-                                                   P'.Maybe P'.ByteString,-                                                   input_type :: P'.Maybe P'.ByteString,-                                                   output_type :: P'.Maybe P'.ByteString,-                                                   options ::-                                                   P'.Maybe DescriptorProtos.MethodOptions}-                           deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable MethodDescriptorProto where-        mergeEmpty-          = MethodDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty-              P'.mergeEmpty-        mergeAppend (MethodDescriptorProto x'1 x'2 x'3 x'4)-          (MethodDescriptorProto y'1 y'2 y'3 y'4)-          = MethodDescriptorProto (P'.mergeAppend x'1 y'1)-              (P'.mergeAppend x'2 y'2)-              (P'.mergeAppend x'3 y'3)-              (P'.mergeAppend x'4 y'4)- -instance P'.Default MethodDescriptorProto where-        defaultValue-          = MethodDescriptorProto (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)-              (P'.Just P'.defaultValue)- -instance P'.Wire MethodDescriptorProto where-        wireSize 11 (MethodDescriptorProto x'1 x'2 x'3 x'4)-          = P'.lenSize-              (0 + P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 9 x'2 +-                 P'.wireSizeOpt 1 9 x'3-                 + P'.wireSizeOpt 1 11 x'4)-        wirePut 11 self'@(MethodDescriptorProto x'1 x'2 x'3 x'4)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 10 9 x'1-               P'.wirePutOpt 18 9 x'2-               P'.wirePutOpt 26 9 x'3-               P'.wirePutOpt 34 11 x'4-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field})-                               (P'.wireGet 9)-                        2 -> P'.fmap-                               (\ new'Field -> old'Self{input_type = P'.Just new'Field})-                               (P'.wireGet 9)-                        3 -> P'.fmap-                               (\ new'Field -> old'Self{output_type = P'.Just new'Field})-                               (P'.wireGet 9)-                        4 -> P'.fmap (\ new'Field -> old'Self{options = P'.Just new'Field})-                               (P'.wireGet 11)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor MethodDescriptorProto where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodDescriptorProto\"}, fields = fromList [FieldInfo {fieldName = \"name\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"input_type\", fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"output_type\", fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"options\", fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.MethodOptions\", hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/MethodOptions.hs 
@@ -1,29 +0,0 @@-module Text.DescriptorProtos.MethodOptions (MethodOptions(..))-       where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data MethodOptions = MethodOptions{}-                   deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable MethodOptions where-        mergeEmpty = MethodOptions-        mergeAppend (MethodOptions) (MethodOptions) = MethodOptions- -instance P'.Default MethodOptions where-        defaultValue = MethodOptions- -instance P'.Wire MethodOptions where-        wireSize 11 (MethodOptions) = P'.lenSize (0)-        wirePut 11 self'@(MethodOptions)-          = do P'.putSize (P'.wireSize 11 self')-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor MethodOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodOptions\"}, fields = fromList []}"
− Text/DescriptorProtos/ServiceDescriptorProto.hs 
@@ -1,60 +0,0 @@-module Text.DescriptorProtos.ServiceDescriptorProto-       (ServiceDescriptorProto(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.MethodDescriptorProto-       as DescriptorProtos (MethodDescriptorProto)-import qualified Text.DescriptorProtos.ServiceOptions-       as DescriptorProtos (ServiceOptions)- -data ServiceDescriptorProto = ServiceDescriptorProto{name ::-                                                     P'.Maybe P'.ByteString,-                                                     method ::-                                                     P'.Seq DescriptorProtos.MethodDescriptorProto,-                                                     options ::-                                                     P'.Maybe DescriptorProtos.ServiceOptions}-                            deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable ServiceDescriptorProto where-        mergeEmpty-          = ServiceDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty-        mergeAppend (ServiceDescriptorProto x'1 x'2 x'3)-          (ServiceDescriptorProto y'1 y'2 y'3)-          = ServiceDescriptorProto (P'.mergeAppend x'1 y'1)-              (P'.mergeAppend x'2 y'2)-              (P'.mergeAppend x'3 y'3)- -instance P'.Default ServiceDescriptorProto where-        defaultValue-          = ServiceDescriptorProto (P'.Just P'.defaultValue)-              (P'.defaultValue)-              (P'.Just P'.defaultValue)- -instance P'.Wire ServiceDescriptorProto where-        wireSize 11 (ServiceDescriptorProto x'1 x'2 x'3)-          = P'.lenSize-              (0 + P'.wireSizeOpt 1 9 x'1 + P'.wireSizeRep 1 11 x'2 +-                 P'.wireSizeOpt 1 11 x'3)-        wirePut 11 self'@(ServiceDescriptorProto x'1 x'2 x'3)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 10 9 x'1-               P'.wirePutRep 18 11 x'2-               P'.wirePutOpt 26 11 x'3-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field})-                               (P'.wireGet 9)-                        2 -> P'.fmap-                               (\ new'Field ->-                                  old'Self{method = P'.append (method old'Self) new'Field})-                               (P'.wireGet 11)-                        3 -> P'.fmap (\ new'Field -> old'Self{options = P'.Just new'Field})-                               (P'.wireGet 11)-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor ServiceDescriptorProto where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceDescriptorProto\"}, fields = fromList [FieldInfo {fieldName = \"name\", fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"method\", fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.MethodDescriptorProto\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"options\", fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just \"DescriptorProtos.ServiceOptions\", hsRawDefault = Nothing, hsDefault = Nothing}]}"
− Text/DescriptorProtos/ServiceOptions.hs 
@@ -1,29 +0,0 @@-module Text.DescriptorProtos.ServiceOptions (ServiceOptions(..))-       where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data ServiceOptions = ServiceOptions{}-                    deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable ServiceOptions where-        mergeEmpty = ServiceOptions-        mergeAppend (ServiceOptions) (ServiceOptions) = ServiceOptions- -instance P'.Default ServiceOptions where-        defaultValue = ServiceOptions- -instance P'.Wire ServiceOptions where-        wireSize 11 (ServiceOptions) = P'.lenSize (0)-        wirePut 11 self'@(ServiceOptions)-          = do P'.putSize (P'.wireSize 11 self')-        wireGet 11 = P'.getMessage update'Self-          where update'Self field'Number old'Self-                  = case field'Number of-                        _ -> P'.unknownField field'Number- -instance P'.ReflectDescriptor ServiceOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceOptions\"}, fields = fromList []}"
− Text/Hand-DescriptorProtos/DescriptorProto.hs 
@@ -1,25 +0,0 @@-module Text.DescriptorProtos.DescriptorProto-  (DescriptorProto(..))- where--import Text.ProtocolBuffers.Header-import qualified Text.DescriptorProtos.FileOptions as DescriptorProtos(FileOptions)-import qualified Text.DescriptorProtos.EnumDescriptorProto as DescriptorProtos(EnumDescriptorProto) -import qualified Text.DescriptorProtos.FieldDescriptorProto as DescriptorProtos(FieldDescriptorProto) -import qualified Text.DescriptorProtos.MessageOptions as DescriptorProtos(MessageOptions)-import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as DescriptorProtos.DescriptorProto(ExtensionRange)--data DescriptorProto = DescriptorProto-    { name :: Maybe ByteString-    , field :: Seq DescriptorProtos.FieldDescriptorProto-    , extension :: Seq DescriptorProtos.FieldDescriptorProto-    , nested_type :: Seq DescriptorProto-    , enum_type :: Seq DescriptorProtos.EnumDescriptorProto-    , extension_range :: Seq DescriptorProtos.DescriptorProto.ExtensionRange-    , options :: Maybe DescriptorProtos.MessageOptions-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''DescriptorProto )--instance Default DescriptorProto where
− Text/Hand-DescriptorProtos/DescriptorProto/ExtensionRange.hs 
@@ -1,15 +0,0 @@-module Text.DescriptorProtos.DescriptorProto.ExtensionRange-  (ExtensionRange(..))- where--import Text.ProtocolBuffers.Header--data ExtensionRange = ExtensionRange-    { start :: Maybe Int32-    , end :: Maybe Int32-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''ExtensionRange )--instance Default ExtensionRange where
− Text/Hand-DescriptorProtos/EnumDescriptorProto.hs 
@@ -1,19 +0,0 @@-module Text.DescriptorProtos.EnumDescriptorProto-  (EnumDescriptorProto(..))- where--import Text.ProtocolBuffers.Header--import qualified Text.DescriptorProtos.EnumValueDescriptorProto as DescriptorProtos(EnumValueDescriptorProto)-import qualified Text.DescriptorProtos.EnumOptions as DescriptorProtos(EnumOptions)--data EnumDescriptorProto = EnumDescriptorProto-    { name :: Maybe ByteString-    , value :: Seq DescriptorProtos.EnumValueDescriptorProto-    , options :: Maybe DescriptorProtos.EnumOptions-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''EnumDescriptorProto )--instance Default EnumDescriptorProto where
− Text/Hand-DescriptorProtos/EnumOptions.hs 
@@ -1,12 +0,0 @@-module Text.DescriptorProtos.EnumOptions-  (EnumOptions(..))- where--import Text.ProtocolBuffers.Header--data EnumOptions = EnumOptions-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''EnumOptions )--instance Default EnumOptions where
− Text/Hand-DescriptorProtos/EnumValueDescriptorProto.hs 
@@ -1,17 +0,0 @@-module Text.DescriptorProtos.EnumValueDescriptorProto-  (EnumValueDescriptorProto(..))- where--import Text.ProtocolBuffers.Header-import qualified Text.DescriptorProtos.EnumValueOptions as DescriptorProtos(EnumValueOptions) --data EnumValueDescriptorProto = EnumValueDescriptorProto-    { name :: Maybe ByteString-    , number :: Maybe Int32-    , options :: Maybe DescriptorProtos.EnumValueOptions-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''EnumValueDescriptorProto )--instance Default EnumValueDescriptorProto where
− Text/Hand-DescriptorProtos/EnumValueOptions.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Text.DescriptorProtos.EnumValueOptions-  (EnumValueOptions(..))- where--import Text.ProtocolBuffers.Header--data EnumValueOptions = EnumValueOptions-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''EnumValueOptions )--instance Default EnumValueOptions where
− Text/Hand-DescriptorProtos/FieldDescriptorProto.hs 
@@ -1,24 +0,0 @@-module Text.DescriptorProtos.FieldDescriptorProto-  (FieldDescriptorProto(..))- where--import Text.ProtocolBuffers.Header-import qualified Text.DescriptorProtos.FieldDescriptorProto.Label as DescriptorProtos.FieldDescriptorProto(Label)-import qualified Text.DescriptorProtos.FieldDescriptorProto.Type as DescriptorProtos.FieldDescriptorProto(Type)-import qualified Text.DescriptorProtos.FieldOptions as DescriptorProtos(FieldOptions)--data FieldDescriptorProto = FieldDescriptorProto-    { name :: Maybe ByteString-    , number :: Maybe Int32-    , label :: Maybe DescriptorProtos.FieldDescriptorProto.Label-    , type' :: Maybe DescriptorProtos.FieldDescriptorProto.Type-    , type_name :: Maybe ByteString-    , extendee :: Maybe ByteString-    , default_value :: Maybe ByteString-    , options :: Maybe DescriptorProtos.FieldOptions-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''FieldDescriptorProto )--instance Default FieldDescriptorProto where
− Text/Hand-DescriptorProtos/FieldDescriptorProto/Label.hs 
@@ -1,188 +0,0 @@-module Text.DescriptorProtos.FieldDescriptorProto.Label (Label(..))-       where-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data Label = LABEL_OPTIONAL-           | LABEL_REQUIRED-           | LABEL_REPEATED-           deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable Label- -instance P'.Bounded Label where-        minBound = LABEL_OPTIONAL-        maxBound = LABEL_REPEATED- -instance P'.Default Label where-        defaultValue = LABEL_OPTIONAL- -instance P'.Enum Label where-        fromEnum (LABEL_OPTIONAL) = 1-        fromEnum (LABEL_REQUIRED) = 2-        fromEnum (LABEL_REPEATED) = 3-        toEnum 1 = LABEL_OPTIONAL-        toEnum 2 = LABEL_REQUIRED-        toEnum 3 = LABEL_REPEATED-        succ (LABEL_OPTIONAL) = LABEL_REQUIRED-        succ (LABEL_REQUIRED) = LABEL_REPEATED-        pred (LABEL_REQUIRED) = LABEL_OPTIONAL-        pred (LABEL_REPEATED) = LABEL_REQUIRED- -instance P'.Wire Label where-        wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)-        wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)-        wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)- -instance P'.ReflectEnum Label where-        reflectEnum-          = [(1, "LABEL_OPTIONAL", LABEL_OPTIONAL),-             (2, "LABEL_REQUIRED", LABEL_REQUIRED),-             (3, "LABEL_REPEATED", LABEL_REPEATED)]-        reflectEnumInfo _-          = P'.EnumInfo-              (P'.ProtoName "Text" "DescriptorProtos.FieldDescriptorProto"-                 "Label")-              [(1, "LABEL_OPTIONAL"), (2, "LABEL_REQUIRED"),-               (3, "LABEL_REPEATED")]-{--module Text.DescriptorProtos.FieldDescriptorProto.Label (Label(..))-       where-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data Label = LABEL_OPTIONAL-           | LABEL_REQUIRED-           | LABEL_REPEATED-           deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable Label- -instance P'.Bounded Label where-        minBound = LABEL_OPTIONAL-        maxBound = LABEL_REPEATED- -instance P'.Default Label where-        defaultValue = LABEL_OPTIONAL- -instance P'.Enum Label where-        fromEnum (LABEL_OPTIONAL) = 1-        fromEnum (LABEL_REQUIRED) = 2-        fromEnum (LABEL_REPEATED) = 3-        toEnum 1 = LABEL_OPTIONAL-        toEnum 2 = LABEL_REQUIRED-        toEnum 3 = LABEL_REPEATED-        succ (LABEL_OPTIONAL) = LABEL_REQUIRED-        succ (LABEL_REQUIRED) = LABEL_REPEATED-        pred (LABEL_REQUIRED) = LABEL_OPTIONAL-        pred (LABEL_REPEATED) = LABEL_REQUIRED- -instance P'.ReflectEnum Label where-        reflectEnum-          = [(1, "LABEL_OPTIONAL", LABEL_OPTIONAL),-             (2, "LABEL_REQUIRED", LABEL_REQUIRED),-             (3, "LABEL_REPEATED", LABEL_REPEATED)]-        reflectEnumInfo _-          = P'.EnumInfo-              (P'.ProtoName "Text" "DescriptorProtos.FieldDescriptorProto"-                 "Label")-              [(1, "LABEL_OPTIONAL"), (2, "LABEL_REQUIRED"),-               (3, "LABEL_REPEATED")]--{-module Text.DescriptorProtos.FieldDescriptorProto.Label (Label(..))-       where-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data Label = LABEL_OPTIONAL-           | LABEL_REQUIRED-           | LABEL_REPEATED-           deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable Label- -instance P'.Bounded Label where-        minBound = LABEL_OPTIONAL-        maxBound = LABEL_REPEATED- -instance P'.Default Label where-        defaultValue = P'.minBound- -instance P'.Enum Label where-        fromEnum (LABEL_OPTIONAL) = 1-        fromEnum (LABEL_REQUIRED) = 2-        fromEnum (LABEL_REPEATED) = 3-        toEnum 1 = LABEL_OPTIONAL-        toEnum 2 = LABEL_REQUIRED-        toEnum 3 = LABEL_REPEATED-        succ (LABEL_OPTIONAL) = LABEL_REQUIRED-        succ (LABEL_REQUIRED) = LABEL_REPEATED-        pred (LABEL_REQUIRED) = LABEL_OPTIONAL-        pred (LABEL_REPEATED) = LABEL_REQUIRED- -instance P'.ReflectEnum Label where-        reflectEnum-          = [(1, "LABEL_OPTIONAL", LABEL_OPTIONAL),-             (2, "LABEL_REQUIRED", LABEL_REQUIRED),-             (3, "LABEL_REPEATED", LABEL_REPEATED)]-        reflectEnumInfo _-          = P'.EnumInfo-              (P'.ProtoName "Text" "DescriptorProtos.FieldDescriptorProto"-                 "Label")-              [(1, "LABEL_OPTIONAL"), (2, "LABEL_REQUIRED"),-               (3, "LABEL_REPEATED")]--{-module Text.DescriptorProtos.FieldDescriptorProto.Label (Label(..))-       where-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data Label = LABEL_OPTIONAL-           | LABEL_REQUIRED-           | LABEL_REPEATED-           deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable Label- -instance P'.Mergeable (P'.Maybe Label) where-        mergeEmpty = P'.Nothing-        mergeAppend = P'.mayMerge- -instance P'.Enum Label where-        fromEnum (LABEL_OPTIONAL) = 1-        fromEnum (LABEL_REQUIRED) = 2-        fromEnum (LABEL_REPEATED) = 3-        toEnum 1 = LABEL_OPTIONAL-        toEnum 2 = LABEL_REQUIRED-        toEnum 3 = LABEL_REPEATED-        succ (LABEL_OPTIONAL) = LABEL_REQUIRED-        succ (LABEL_REQUIRED) = LABEL_REPEATED-        pred (LABEL_REQUIRED) = LABEL_OPTIONAL-        pred (LABEL_REPEATED) = LABEL_REQUIRED- -instance P'.Bounded Label where-        minBound = LABEL_OPTIONAL-        maxBound = LABEL_REPEATED- -ascList' :: [] (P'.Integer, P'.String, Label)-ascList'-  = [(1, "LABEL_OPTIONAL", LABEL_OPTIONAL),-     (2, "LABEL_REQUIRED", LABEL_REQUIRED),-     (3, "LABEL_REPEATED", LABEL_REPEATED)]--{--module Text.DescriptorProtos.FieldDescriptorProto.Label-  (Label(..))- where--import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'--{--data Label = LABEL_OPTIONAL-           | LABEL_REQUIRED-           | LABEL_REPEATED-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeableEnum ''Label )--}-}-}-}-}
− Text/Hand-DescriptorProtos/FieldDescriptorProto/Type.hs 
@@ -1,162 +0,0 @@-module Text.DescriptorProtos.FieldDescriptorProto.Type (Type(..))-       where-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'- -data Type = TYPE_DOUBLE-          | TYPE_FLOAT-          | TYPE_INT64-          | TYPE_UINT64-          | TYPE_INT32-          | TYPE_FIXED64-          | TYPE_FIXED32-          | TYPE_BOOL-          | TYPE_STRING-          | TYPE_GROUP-          | TYPE_MESSAGE-          | TYPE_BYTES-          | TYPE_UINT32-          | TYPE_ENUM-          | TYPE_SFIXED32-          | TYPE_SFIXED64-          | TYPE_SINT32-          | TYPE_SINT64-          deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable Type where- -instance P'.Bounded Type where-        minBound = TYPE_DOUBLE-        maxBound = TYPE_SINT64- -instance P'.Default Type where-        defaultValue = TYPE_DOUBLE- -instance P'.Enum Type where-        fromEnum (TYPE_DOUBLE) = 1-        fromEnum (TYPE_FLOAT) = 2-        fromEnum (TYPE_INT64) = 3-        fromEnum (TYPE_UINT64) = 4-        fromEnum (TYPE_INT32) = 5-        fromEnum (TYPE_FIXED64) = 6-        fromEnum (TYPE_FIXED32) = 7-        fromEnum (TYPE_BOOL) = 8-        fromEnum (TYPE_STRING) = 9-        fromEnum (TYPE_GROUP) = 10-        fromEnum (TYPE_MESSAGE) = 11-        fromEnum (TYPE_BYTES) = 12-        fromEnum (TYPE_UINT32) = 13-        fromEnum (TYPE_ENUM) = 14-        fromEnum (TYPE_SFIXED32) = 15-        fromEnum (TYPE_SFIXED64) = 16-        fromEnum (TYPE_SINT32) = 17-        fromEnum (TYPE_SINT64) = 18-        toEnum 1 = TYPE_DOUBLE-        toEnum 2 = TYPE_FLOAT-        toEnum 3 = TYPE_INT64-        toEnum 4 = TYPE_UINT64-        toEnum 5 = TYPE_INT32-        toEnum 6 = TYPE_FIXED64-        toEnum 7 = TYPE_FIXED32-        toEnum 8 = TYPE_BOOL-        toEnum 9 = TYPE_STRING-        toEnum 10 = TYPE_GROUP-        toEnum 11 = TYPE_MESSAGE-        toEnum 12 = TYPE_BYTES-        toEnum 13 = TYPE_UINT32-        toEnum 14 = TYPE_ENUM-        toEnum 15 = TYPE_SFIXED32-        toEnum 16 = TYPE_SFIXED64-        toEnum 17 = TYPE_SINT32-        toEnum 18 = TYPE_SINT64-        succ (TYPE_DOUBLE) = TYPE_FLOAT-        succ (TYPE_FLOAT) = TYPE_INT64-        succ (TYPE_INT64) = TYPE_UINT64-        succ (TYPE_UINT64) = TYPE_INT32-        succ (TYPE_INT32) = TYPE_FIXED64-        succ (TYPE_FIXED64) = TYPE_FIXED32-        succ (TYPE_FIXED32) = TYPE_BOOL-        succ (TYPE_BOOL) = TYPE_STRING-        succ (TYPE_STRING) = TYPE_GROUP-        succ (TYPE_GROUP) = TYPE_MESSAGE-        succ (TYPE_MESSAGE) = TYPE_BYTES-        succ (TYPE_BYTES) = TYPE_UINT32-        succ (TYPE_UINT32) = TYPE_ENUM-        succ (TYPE_ENUM) = TYPE_SFIXED32-        succ (TYPE_SFIXED32) = TYPE_SFIXED64-        succ (TYPE_SFIXED64) = TYPE_SINT32-        succ (TYPE_SINT32) = TYPE_SINT64-        pred (TYPE_FLOAT) = TYPE_DOUBLE-        pred (TYPE_INT64) = TYPE_FLOAT-        pred (TYPE_UINT64) = TYPE_INT64-        pred (TYPE_INT32) = TYPE_UINT64-        pred (TYPE_FIXED64) = TYPE_INT32-        pred (TYPE_FIXED32) = TYPE_FIXED64-        pred (TYPE_BOOL) = TYPE_FIXED32-        pred (TYPE_STRING) = TYPE_BOOL-        pred (TYPE_GROUP) = TYPE_STRING-        pred (TYPE_MESSAGE) = TYPE_GROUP-        pred (TYPE_BYTES) = TYPE_MESSAGE-        pred (TYPE_UINT32) = TYPE_BYTES-        pred (TYPE_ENUM) = TYPE_UINT32-        pred (TYPE_SFIXED32) = TYPE_ENUM-        pred (TYPE_SFIXED64) = TYPE_SFIXED32-        pred (TYPE_SINT32) = TYPE_SFIXED64-        pred (TYPE_SINT64) = TYPE_SINT32- -instance P'.Wire Type where-        wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)-        wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)-        wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)- -instance P'.ReflectEnum Type where-        reflectEnum-          = [(1, "TYPE_DOUBLE", TYPE_DOUBLE), (2, "TYPE_FLOAT", TYPE_FLOAT),-             (3, "TYPE_INT64", TYPE_INT64), (4, "TYPE_UINT64", TYPE_UINT64),-             (5, "TYPE_INT32", TYPE_INT32), (6, "TYPE_FIXED64", TYPE_FIXED64),-             (7, "TYPE_FIXED32", TYPE_FIXED32), (8, "TYPE_BOOL", TYPE_BOOL),-             (9, "TYPE_STRING", TYPE_STRING), (10, "TYPE_GROUP", TYPE_GROUP),-             (11, "TYPE_MESSAGE", TYPE_MESSAGE), (12, "TYPE_BYTES", TYPE_BYTES),-             (13, "TYPE_UINT32", TYPE_UINT32), (14, "TYPE_ENUM", TYPE_ENUM),-             (15, "TYPE_SFIXED32", TYPE_SFIXED32),-             (16, "TYPE_SFIXED64", TYPE_SFIXED64),-             (17, "TYPE_SINT32", TYPE_SINT32), (18, "TYPE_SINT64", TYPE_SINT64)]-        reflectEnumInfo _-          = P'.EnumInfo-              (P'.ProtoName "Text" "DescriptorProtos.FieldDescriptorProto"-                 "Type")-              [(1, "TYPE_DOUBLE"), (2, "TYPE_FLOAT"), (3, "TYPE_INT64"),-               (4, "TYPE_UINT64"), (5, "TYPE_INT32"), (6, "TYPE_FIXED64"),-               (7, "TYPE_FIXED32"), (8, "TYPE_BOOL"), (9, "TYPE_STRING"),-               (10, "TYPE_GROUP"), (11, "TYPE_MESSAGE"), (12, "TYPE_BYTES"),-               (13, "TYPE_UINT32"), (14, "TYPE_ENUM"), (15, "TYPE_SFIXED32"),-               (16, "TYPE_SFIXED64"), (17, "TYPE_SINT32"), (18, "TYPE_SINT64")]-{-module Text.DescriptorProtos.FieldDescriptorProto.Type-  (Type(..))- where--import Text.ProtocolBuffers.Header--data Type = TYPE_DOUBLE-          | TYPE_FLOAT-          | TYPE_INT64    -- inefficient for negative values-          | TYPE_UINT64-          | TYPE_INT32    -- inefficient for negative values-          | TYPE_FIXED64-          | TYPE_FIXED32-          | TYPE_BOOL-          | TYPE_STRING-          | TYPE_GROUP      -- Tag-delimited aggregate.-          | TYPE_MESSAGE    -- Length-delimeted aggegate-            -- descriptor.proto "New in version 2"-          | TYPE_BYTES-          | TYPE_UINT32-          | TYPE_ENUM-          | TYPE_SFIXED32-          | TYPE_SFIXED64-          | TYPE_SINT32 -- Uses ZipZag encoding-          | TYPE_SINT64 -- Uses ZipZag encoding-  deriving (Show,Read,Eq,Ord,Typeable,Data,Enum)--$( makeMergeableEnum ''Type )--}
− Text/Hand-DescriptorProtos/FieldOptions.hs 
@@ -1,116 +0,0 @@--- *Text.ProtocolBuffers.Gen Numeric> putStrLn . prettyPrint . descriptorModule "Text" $ genFieldOptions-module Text.DescriptorProtos.FieldOptions (FieldOptions(..)) where-import Prelude ((+), (++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.FieldOptions.CType-       as DescriptorProtos.FieldOptions (CType)- -data FieldOptions = FieldOptions{ctype ::-                                 P'.Maybe DescriptorProtos.FieldOptions.CType,-                                 experimental_map_key :: P'.Maybe P'.ByteString}-                  deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable FieldOptions where-        mergeEmpty = FieldOptions P'.mergeEmpty P'.mergeEmpty-        mergeAppend (FieldOptions x'1 x'2) (FieldOptions y'1 y'2)-          = FieldOptions (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)- -instance P'.Default FieldOptions where-        defaultValue-          = FieldOptions (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)- -instance P'.Wire FieldOptions where-        wireSize 11 (FieldOptions x'1 x'2)-          = P'.lenSize (P'.wireSizeOpt 1 14 x'1 + P'.wireSizeOpt 1 9 x'2)-        wirePut 11 self'@(FieldOptions x'1 x'2)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 8 14 x'1-               P'.wirePutOpt 74 9 x'2-        wireGet 11 = P'.getMessage update'Self-         where-          update'Self field'Number old'Self =-            case field'Number of-              1 -> P'.fmap (\new'Field -> old'Self { ctype = P'.Just new'Field }) (P'.wireGet 14)-              9 -> P'.fmap (\new'Field -> old'Self { experimental_map_key = P'.Just new'Field }) (P'.wireGet 9)-              _ -> P'.unknownField field'Number---P'.fail ("Impossible? Message asked to parse an unknown field number on wire: "++P'.show field'Number)- -instance P'.ReflectDescriptor FieldOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldOptions\"}, fields = fromList [FieldInfo {fieldName = \"ctype\", fieldNumber = FieldId {getFieldID = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just \"DescriptorProtos.FieldOptions.CType\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"experimental_map_key\", fieldNumber = FieldId {getFieldID = 9}, wireTag = WireTag {getWireTag = 74}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}]}"---{--module Text.DescriptorProtos.FieldOptions (FieldOptions(..)) where-import Prelude((+),(>>),(>>=),(++))-import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Text.DescriptorProtos.FieldOptions.CType-       as DescriptorProtos.FieldOptions (CType)- -data FieldOptions = FieldOptions{ctype ::-                                 P'.Maybe DescriptorProtos.FieldOptions.CType,-                                 experimental_map_key :: P'.Maybe P'.ByteString}-                  deriving (P'.Show, P'.Read, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable FieldOptions where-        mergeEmpty = FieldOptions P'.mergeEmpty P'.mergeEmpty-        mergeAppend (FieldOptions x'1 x'2) (FieldOptions y'1 y'2)-          = FieldOptions (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)- -instance P'.Default FieldOptions where-        defaultValue-          = FieldOptions (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)---- Hand written, then I'll create the Gen.hs code-instance P'.Wire FieldOptions where-        wireSize 11 (FieldOptions x'1 x'2)-          = P'.lenSize (P'.wireSizeOpt 14 x'1 + P'.wireSizeOpt 9 x'2)-        wirePut 11 self'@(FieldOptions x'1 x'2)-          = do P'.putSize (P'.wireSize 11 self')-               P'.wirePutOpt 8 14 x'1-               P'.wirePutOpt 74 9 x'2-{--  wireSize 11 (FieldOptions x'1 x'2) = P'.lenSize (P'.wireSizeOpt 11 x'1 + P'.wireSizeOpt 9 x'2)-  wirePut 11 self'@(FieldOptions x'1 x'2) = do P'.putSize (P'.wireSize 11 self')-                                               P'.wirePutOpt 10 11 x'1-                                               P'.wirePutOpt 74  9 x'2--}-        wireGet 11 = P'.getMessage update'Self-         where -- updater :: P'.Updater FieldOptions-          update'Self field'Number old'Self =-            case field'Number of-              1 -> P'.fmap (\new'Field -> old'Self { ctype = P'.Just new'Field }) (P'.wireGet 11)-              9 -> P'.fmap (\new'Field -> old'Self { experimental_map_key = P'.Just new'Field }) (P'.wireGet 9)---           10 -> P'.fmap (\new'Field -> old'Self { requiredField = new'Field }) (P'.wireGet 4)---           11 -> P'.fmap (\new'Field -> old'Self { repeatedField = P'.append (repeatedField old'Self) new'Field }) (P'.wireGet 5)-              _ -> P'.fail ("Impossible? Message asked to parse an unknown field number on wire: "++P'.show field'Number)- -instance P'.ReflectDescriptor FieldOptions where-        reflectDescriptorInfo _-          = P'.read-              "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldOptions\"}, fields = fromList [FieldInfo {fieldName = \"ctype\", fieldNumber = FieldId {getFieldID = 1}, wireTag = WireTag {getWireTag = 8}, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just \"DescriptorProtos.FieldOptions.CType\", hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = \"experimental_map_key\", fieldNumber = FieldId {getFieldID = 9}, wireTag = WireTag {getWireTag = 74}, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}]}"----{-module Text.DescriptorProtos.FieldOptions-  (FieldOptions(..))- where--import Text.ProtocolBuffers.Header--import qualified Text.DescriptorProtos.FieldOptions.CType as DescriptorProtos.FieldOptions(CType)--data FieldOptions = FieldOptions-    { ctype :: Maybe DescriptorProtos.FieldOptions.CType-    , experimental_map_key :: Maybe ByteString-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''FieldOptions )--instance Default FieldOptions where---}-}
− Text/Hand-DescriptorProtos/FieldOptions/CType.hs 
@@ -1,19 +0,0 @@-module Text.DescriptorProtos.FieldOptions.CType-  (CType(..))- where--import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'--data CType = CORD | STRING_PIECE-  deriving (P'.Show,P'.Read,P'.Eq,P'.Ord,P'.Data,P'.Typeable)---- $( P'.makeMergeableEnum ''CType )--instance P'.Mergeable CType--instance P'.Default CType--instance P'.Wire CType--instance P'.ReflectEnum CType
− Text/Hand-DescriptorProtos/FileDescriptorProto.hs 
@@ -1,26 +0,0 @@-module Text.DescriptorProtos.FileDescriptorProto-  (FileDescriptorProto(..))- where--import Text.ProtocolBuffers.Header-import qualified Text.DescriptorProtos.DescriptorProto as DescriptorProtos(DescriptorProto) -import qualified Text.DescriptorProtos.EnumDescriptorProto as DescriptorProtos(EnumDescriptorProto) -import qualified Text.DescriptorProtos.FieldDescriptorProto as DescriptorProtos(FieldDescriptorProto) -import qualified Text.DescriptorProtos.FileOptions as DescriptorProtos(FileOptions)-import qualified Text.DescriptorProtos.ServiceDescriptorProto as DescriptorProtos(ServiceDescriptorProto) --data FileDescriptorProto = FileDescriptorProto-    { name :: Maybe ByteString-    , package :: Maybe ByteString-    , dependency :: Seq ByteString-    , message_type :: Seq DescriptorProtos.DescriptorProto-    , enum_type :: Seq DescriptorProtos.EnumDescriptorProto-    , service :: Seq DescriptorProtos.ServiceDescriptorProto-    , extension :: Seq DescriptorProtos.FieldDescriptorProto-    , options :: Maybe DescriptorProtos.FileOptions-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''FileDescriptorProto )--instance Default FileDescriptorProto where
− Text/Hand-DescriptorProtos/FileOptions.hs 
@@ -1,23 +0,0 @@-module Text.DescriptorProtos.FileOptions-  (FileOptions(..))- where--import Text.ProtocolBuffers.Header-import qualified Text.DescriptorProtos.FileOptions.OptimizeMode as DescriptorProtos.FileOptions(OptimizeMode)-import qualified Text.DescriptorProtos.FileOptions.OptimizeMode as DescriptorProtos.FileOptions.OptimizeMode(OptimizeMode(..))--data FileOptions = FileOptions-    { java_package :: Maybe ByteString-    , java_outer_classname :: Maybe ByteString-    , java_multiple_files :: Maybe Bool-    , optimize_for :: Maybe DescriptorProtos.FileOptions.OptimizeMode-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''FileOptions )--instance Default FileOptions where-  defaultValue = mergeEmpty-    { java_multiple_files = Just False-    , optimize_for = Just DescriptorProtos.FileOptions.OptimizeMode.CODE_SIZE-    }
− Text/Hand-DescriptorProtos/FileOptions/OptimizeMode.hs 
@@ -1,33 +0,0 @@-module Text.DescriptorProtos.FileOptions.OptimizeMode-  (OptimizeMode(..))- where--import Data.Monoid-import Text.ProtocolBuffers.Header--data OptimizeMode = SPEED | CODE_SIZE-  deriving (Read,Show,Eq,Ord,Typeable)--$( makeMergeableEnum ''OptimizeMode )--err'Name :: String-err'Name = "DescriptorProtos.FileOptions.OptimizeMode"--err' :: String -> b-err' a = error (err'Name ++ " : " ++ show a)--instance Enum OptimizeMode where-  fromEnum SPEED = 1-  fromEnum CODE_SIZE = 2--  toEnum 1 = SPEED-  toEnum 2 = CODE_SIZE-  toEnum x = err' ("toEnum failed on value "++show x)--  succ SPEED = CODE_SIZE-  succ CODE_SIZE = err' ("succ failed on value "++show CODE_SIZE)--  pred SPEED = err' ("pred failed on value "++show SPEED)-  pred CODE_SIZE = SPEED--instance ReflectEnum OptimizeMode where
− Text/Hand-DescriptorProtos/MessageOptions.hs 
@@ -1,17 +0,0 @@-module Text.DescriptorProtos.MessageOptions-  (MessageOptions(..))- where--import Text.ProtocolBuffers.Header--data MessageOptions = MessageOptions-    { message_set_wire_format :: Maybe Bool-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''MessageOptions )--instance Default MessageOptions where-  defaultValue = mergeEmpty-    { message_set_wire_format = Just False-    }
− Text/Hand-DescriptorProtos/MethodDescriptorProto.hs 
@@ -1,18 +0,0 @@-module Text.DescriptorProtos.MethodDescriptorProto-  (MethodDescriptorProto(..))- where--import Text.ProtocolBuffers.Header-import qualified Text.DescriptorProtos.MethodOptions as DescriptorProtos(MethodOptions)--data MethodDescriptorProto = MethodDescriptorProto-    { name :: Maybe ByteString-    , input_type :: Maybe ByteString-    , output_type :: Maybe ByteString-    , options :: Maybe DescriptorProtos.MethodOptions-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''MethodDescriptorProto )--instance Default MethodDescriptorProto where
− Text/Hand-DescriptorProtos/MethodOptions.hs 
@@ -1,12 +0,0 @@-module Text.DescriptorProtos.MethodOptions-  (MethodOptions(..))- where--import Text.ProtocolBuffers.Header--data MethodOptions = MethodOptions-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''MethodOptions )--instance Default MethodOptions where
− Text/Hand-DescriptorProtos/ServiceDescriptorProto.hs 
@@ -1,19 +0,0 @@-module Text.DescriptorProtos.ServiceDescriptorProto-  (ServiceDescriptorProto(..))- where--import Text.ProtocolBuffers.Header--import qualified Text.DescriptorProtos.MethodDescriptorProto as DescriptorProtos(MethodDescriptorProto)-import qualified Text.DescriptorProtos.ServiceOptions as DescriptorProtos(ServiceOptions)--data ServiceDescriptorProto = ServiceDescriptorProto-    { name :: Maybe ByteString-    , method :: Seq DescriptorProtos.MethodDescriptorProto-    , options :: Maybe DescriptorProtos.ServiceOptions-    }-  deriving (Show,Eq,Ord,Typeable)--$( makeMergeable ''ServiceDescriptorProto )--instance Default ServiceDescriptorProto where
− Text/Hand-DescriptorProtos/ServiceOptions.hs 
@@ -1,47 +0,0 @@-module Text.DescriptorProtos.ServiceOptions-  (ServiceOptions(..))- where--import qualified Prelude as P'-import qualified Text.ProtocolBuffers.Header as P'--data ServiceOptions = ServiceOptions-                    deriving (P'.Show, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable ServiceOptions where-        mergeEmpty = ServiceOptions-        mergeAppend (ServiceOptions) (ServiceOptions) = ServiceOptions- -instance P'.Default ServiceOptions--{--data ServiceOptions = ServiceOptions{field1 ::-                                     P'.Maybe P'.ByteString,-                                     field2 :: P'.Maybe ServiceOptions}-                    deriving (P'.Show, P'.Eq, P'.Ord, P'.Data, P'.Typeable)- -instance P'.Mergeable ServiceOptions where-        mergeEmpty = ServiceOptions P'.mergeEmpty P'.mergeEmpty-        mergeAppend (ServiceOptions x'1 x'2) (ServiceOptions y'1 y'2)-          = ServiceOptions (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)- -instance P'.Mergeable (P'.Maybe ServiceOptions) where-        mergeEmpty = P'.Nothing-        mergeAppend = P'.mayMerge- -instance P'.Default ServiceOptions--}-{--data ServiceOptions = ServiceOptions-  deriving (P'.Show,P'.Eq,P'.Ord,P'.Typeable)--instance P'.Mergeable ServiceOptions where-        mergeEmpty = ServiceOptions-        mergeAppend = P'.mergeAppend- -instance P'.Mergeable (P'.Maybe ServiceOptions) where-        mergeEmpty = P'.Nothing-        mergeAppend = P'.mayMerge--instance P'.Default ServiceOptions--}
+ Text/ProtocolBuffers.hs view
@@ -0,0 +1,50 @@+{- | ++"Text.ProtocolBuffers" exposes the client API.  This merely re-exports parts of the+other modules in protocol-buffers.  The exposed parts are:++@+import Text.ProtocolBuffers.Basic+  ( Seq,Utf8(..),ByteString,Int32,Int64,Word32,Word64+  , WireTag,FieldId,WireType,FieldType,EnumCode,WireSize+  , Mergeable(..),Default(..),Wire)+import Text.ProtocolBuffers.Default()+import Text.ProtocolBuffers.Extensions+  ( Key,ExtKey(getExt,putExt,clearExt),MessageAPI(..)+  , getKeyFieldId,getKeyFieldType,getKeyDefaultValue)+import Text.ProtocolBuffers.Mergeable()+import Text.ProtocolBuffers.Reflections+  ( ReflectDescriptor(..),ReflectEnum(..),ProtoName(..),HsDefault(..),EnumInfoApp+  , KeyInfo,FieldInfo(..),DescriptorInfo(..),EnumInfo(..),ProtoInfo(..))+import Text.ProtocolBuffers.WireMessage+  ( Put,Get,runPut,runGet,runGetOnLazy+  , messageSize,messagePut,messageGet,messagePutM,messageGetM+  , messageWithLengthSize,messageWithLengthPut,messageWithLengthGet,messageWithLengthPutM,messageWithLengthGetM+  , messageAsFieldSize,messageAsFieldPutM,messageAsFieldGetM)+@++-}+module Text.ProtocolBuffers(+    module Text.ProtocolBuffers.Basic+  , module Text.ProtocolBuffers.Extensions+  , module Text.ProtocolBuffers.Reflections+  , module Text.ProtocolBuffers.WireMessage+  ) where++import Text.ProtocolBuffers.Basic+  ( Seq,Utf8(..),ByteString,Int32,Int64,Word32,Word64+  , WireTag,FieldId,WireType,FieldType,EnumCode,WireSize+  , Mergeable(..),Default(..),Wire)+import Text.ProtocolBuffers.Default()+import Text.ProtocolBuffers.Extensions+  ( Key,ExtKey(getExt,putExt,clearExt),MessageAPI(..)+  , getKeyFieldId,getKeyFieldType,getKeyDefaultValue)+import Text.ProtocolBuffers.Mergeable()+import Text.ProtocolBuffers.Reflections+  ( ReflectDescriptor(..),ReflectEnum(..),ProtoName(..),HsDefault(..),EnumInfoApp+  , KeyInfo,FieldInfo(..),DescriptorInfo(..),EnumInfo(..),ProtoInfo(..))+import Text.ProtocolBuffers.WireMessage+  ( Put,Get,runPut,runGet,runGetOnLazy+  , messageSize,messagePut,messageGet,messagePutM,messageGetM+  , messageWithLengthSize,messageWithLengthPut,messageWithLengthGet,messageWithLengthPutM,messageWithLengthGetM+  , messageAsFieldSize,messageAsFieldPutM,messageAsFieldGetM)
+ Text/ProtocolBuffers/Basic.hs view
@@ -0,0 +1,179 @@+-- | "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',+-- 'Default', and 'Wire' classes.+module Text.ProtocolBuffers.Basic+  ( -- * Basic types for protocol buffer fields in Haskell+    Seq,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(..)+  ) where++import Data.Binary.Put(Put)+import Data.Bits(Bits)+import Data.ByteString.Lazy(ByteString)+import Data.Foldable as F(Foldable(foldl))+import Data.Generics(Data(..))+import Data.Int(Int32,Int64)+import Data.Ix(Ix)+import Data.Sequence(Seq)+import Data.Typeable(Typeable(..))+import Data.Word(Word32,Word64)+import Text.ProtocolBuffers.Get(Get)++-- 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.+newtype Utf8 = Utf8 {utf8 :: ByteString}+  deriving (Read,Show,Data,Typeable,Eq,Ord)++-- | 'WireTag' is the 32 bit value with the upper 29 bits being the+-- 'FieldId' and the lower 3 bits being the 'WireType'+newtype WireTag = WireTag { getWireTag :: Word32 } -- bit concatenation of FieldId and WireType+  deriving (Eq,Ord,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).+newtype FieldId = FieldId { getFieldId :: Int32 } -- really 29 bits+  deriving (Eq,Ord,Read,Show,Num,Data,Typeable,Ix)++-- Note that values 19000-19999 are forbidden for FieldId+instance Bounded FieldId where+  minBound = 0+  maxBound = 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+--+newtype WireType = WireType { getWireType :: Word32 }    -- really 3 bits+  deriving (Eq,Ord,Read,Show,Num,Data,Typeable)++instance Bounded WireType where+  minBound = 0+  maxBound = 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.++-}++newtype FieldType = FieldType { getFieldType :: Int } -- really [1..18] as fromEnum of Type from Type.hs+  deriving (Eq,Ord,Read,Show,Num,Data,Typeable)++instance Bounded FieldType where+  minBound = 1+  maxBound = 18++-- | 'EnumCode' is the Int32 assoicated with a+-- EnumValueDescriptorProto and is in the range 0 to 2^31-1.+newtype EnumCode = EnumCode { getEnumCode :: Int32 }  -- really [0..maxBound::Int32] of some .proto defined enumeration+  deriving (Eq,Ord,Read,Show,Num,Data,Typeable) ++instance Bounded EnumCode where+  minBound = 0+  maxBound = 2147483647 -- 2^-31 -1 ++-- | 'WireSize' is the Int64 size type associate with the lazy+-- bytestrings used in the 'Put' and 'Get' monads.+type WireSize = 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.+class Mergeable a where+  -- | 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 message message if+  -- both are set.  Repeated fields have the sequences concatenated.+  -- Note that strings and bytes are NOT concatenated.+  mergeAppend :: a -> a -> a+  mergeAppend _a b = b++  -- | 'mergeConcat' is @ F.foldl mergeAppend mergeEmpty @ and this+  -- default definition is not overrring in any of the code.+  mergeConcat :: F.Foldable t => t a -> a+  mergeConcat = F.foldl mergeAppend mergeEmpty++-- | 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.+class Default a where+  -- | 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++-- | 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+  {-# INLINE wireSize #-}+  wireSize :: FieldType -> b -> WireSize+  {-# INLINE wirePut #-}+  wirePut :: FieldType -> b -> Put+  {-# INLINE wireGet #-}+  wireGet :: FieldType -> Get b
− Text/ProtocolBuffers/Builder.hs 
@@ -1,6 +0,0 @@-module Text.ProtocolBuffers.Builder where--class Builder a where-  getBuildInfo :: a -> Int -> Maybe BuildInfo--
Text/ProtocolBuffers/Default.hs view
@@ -1,24 +1,18 @@-module Text.ProtocolBuffers.Default(Default(..)) where+-- | This only defined instances now.  The class definition was moved to Basic.hs+module Text.ProtocolBuffers.Default() where  import Text.ProtocolBuffers.Basic-import Text.ProtocolBuffers.Mergeable (Mergeable(mergeEmpty))---- Anything with an "mempty / mergeEmpty" can be a trivial "Mondad / Mergeable"------ So it makes some sense to make the default defaultValue be this empty value-class Mergeable a => Default a where-  defaultValue :: a-  defaultValue = mergeEmpty--instance Default a => Default (Maybe a) where defaultValue = Just defaultValue+import Data.Monoid(mempty) --- Take the mergeEmpty as the defaultValue-instance Default (Seq a) where-instance Default Bool where-instance Default ByteString where-instance Default Double where-instance Default Float where-instance Default Int32 where-instance Default Int64 where-instance Default Word32 where-instance Default Word64 where+--instance Default a => Default (Maybe a) where defaultValue = Just defaultValue+instance Default a => Default (Maybe a) where defaultValue = Nothing+instance Default (Seq a) where defaultValue = mempty+instance Default Bool where defaultValue = False+instance Default ByteString where defaultValue = mempty+instance Default Utf8 where defaultValue = Utf8 mempty+instance Default Double where defaultValue = 0+instance Default Float where defaultValue = 0+instance Default Int32 where defaultValue = 0+instance Default Int64 where defaultValue = 0+instance Default Word32 where defaultValue = 0+instance Default Word64 where defaultValue = 0
− Text/ProtocolBuffers/DeriveMergeable.hs 
@@ -1,91 +0,0 @@--- | Derives an instance of @Monoid@. This derivation is limited to--- data types with only one constructor; it uses the product--- construction of monoids.-module Text.ProtocolBuffers.DeriveMergeable(makeMergeable,makeMergeableEnum) where--import Text.ProtocolBuffers.Mergeable-import Language.Haskell.TH.All--import Control.Monad(liftM2)-import Data.Generics-import Data.DeriveTH--data Foo-instance Mergeable Foo where--example = (,) "Mergeable" [d|-  instance Mergeable (Maybe Foo) where-    mergeEmpty = Nothing-    mergeAppend = mayMerge- |]----makeMergeable t = liftM2 (++) (derive makeMergeable1 t) (derive makeMergeable2 t)-makeMergeable t = derive makeMergeable1 t--makeMergeableEnum t = derive makeMergeable1Enum t--- makeMergeableEnum t = liftM2 (++) (derive makeMergeable1Enum t) (derive makeMergeable2Enum t)--makeMergeable1 :: Derivation-makeMergeable1 = derivation mergeable1' "Mergeable"--mergeable1' dat | length (dataCtors dat) == 1-         = [instance_default "Mergeable" dat [funN "mergeEmpty" [empty],funN "mergeAppend" [append]]]-    where-        ctor = head $ dataCtors dat--        empty  = sclause [] $ lK (ctorName ctor) (replicate (ctorArity ctor) (l0 "mergeEmpty"))-        append = sclause [ctp ctor 'x',ctp ctor 'y'] $-                         lK (ctorName ctor) (zipWith (l2 "mergeAppend") (ctv ctor 'x') (ctv ctor 'y'))--mergeable1' dat = []-{--makeMergeable2 :: Derivation-makeMergeable2 = derivation mergeable2' "Mergeable2"---  instance Mergeable (Maybe a) where-mergeable2' dat = [InstanceD []-                             (AppT (ConT (mkName "Mergeable"))-                                         (AppT (ConT (mkName "Maybe"))-                                               (ConT (mkName foo))))-                             [(ValD (VarP (mkName "mergeEmpty"))-                                    (NormalB (ConE (mkName "Nothing"))) [])-                             ,(ValD (VarP (mkName "mergeAppend"))-                                    (NormalB (VarE (mkName "mayMerge"))) [])]]-  where foo = dataName dat--}--makeMergeable1Enum :: Derivation-makeMergeable1Enum = derivation mergeable1Enum' "Mergeable1Enum"---  instance Mergeable (Maybe a) where-mergeable1Enum' dat = [InstanceD []-                             (AppT (ConT (mkName "Mergeable"))-                                         (ConT (mkName foo)))-                             []]-  where foo = dataName dat-{--makeMergeable2Enum :: Derivation-makeMergeable2Enum = derivation mergeable2Enum' "Mergeable2Enum"---  instance Mergeable (Maybe a) where-mergeable2Enum' dat = [InstanceD []-                             (AppT (ConT (mkName "Mergeable"))-                                         (AppT (ConT (mkName "Maybe"))-                                               (ConT (mkName foo))))-                             [(ValD (VarP (mkName "mergeEmpty"))-                                    (NormalB (ConE (mkName "Nothing"))) [])-                             ,(ValD (VarP (mkName "mergeAppend"))-                                    (NormalB (VarE (mkName "mayMerge"))) [])]]-  where foo = dataName dat--}-{----  instance Mergeable a => Mergeable (Maybe a) where-mergeable2' dat = [InstanceD (concat ([[(AppT (ConT (mkName "Mergeable"))-                                              (ConT (mkName foo)))]]))-                             (head [(AppT (ConT (mkName "Mergeable"))-                                          (AppT (ConT (mkName "Maybe"))-                                                (ConT (mkName foo))))])-                             [(ValD (VarP (mkName "mergeEmpty"))-                                    (NormalB (ConE (mkName "Nothing"))) [])-                             ,(ValD (VarP (mkName "mergeAppend"))-                                    (NormalB (VarE (mkName "mayMerge"))) [])]]-  where foo = dataName dat---}
+ Text/ProtocolBuffers/Extensions.hs view
@@ -0,0 +1,693 @@+-- | The "Extensions" module contributes two main things.  The first+-- is the definition and implementation of extensible message+-- features.  This means that the 'ExtField' data type is exported but+-- its constructor is (in an ideal world) hidden.+--+-- This first part also includes the keys for the extension fields:+-- the 'Key' data type.  These are typically defined in code generated+-- by 'hprotoc' from '.proto' file definitions.+--+-- The second main part is the 'MessageAPI' class which defines+-- 'getVal' and 'isSet'.  These allow uniform access to normal and+-- extension fields for users.+--+-- Access to extension fields is strictly though keys.  There is not+-- currently any way to query or change or clear any other extension+-- field data.+--+-- This module is likely to get broken up into pieces.+module Text.ProtocolBuffers.Extensions+  ( -- * Query functions for 'Key'+    getKeyFieldId,getKeyFieldType,getKeyDefaultValue+  -- * External types and classes+  , Key(..),ExtKey(..),MessageAPI(..)+  -- * Internal types, functions, and classes+  , wireSizeExtField,wirePutExtField,getMessageExt,getBareMessageExt+  , GPB,ExtField(..),ExtendMessage(..)+  ) where++import Data.Map(Map)+import Data.Generics+import Data.Ix(inRange)+import Data.Maybe(fromMaybe)+import Data.Typeable+import Data.Monoid(mappend)+import Data.Sequence(Seq,(|>))+import qualified Data.Sequence as Seq+import qualified Data.ByteString.Lazy as L+import qualified Data.Foldable as F+import qualified Data.Map as M++import Text.ProtocolBuffers.Basic+import Text.ProtocolBuffers.Default()+import Text.ProtocolBuffers.WireMessage+import Text.ProtocolBuffers.Reflections+import Text.ProtocolBuffers.Get as Get (Get,runGet,Result(..),lookAhead,getLazyByteString,spanOf,skip,bytesRead)++err :: String -> b+err msg = error $ "Text.ProtocolBuffers.Extensions error\n"++msg++-- | The 'Key' data type is used with the 'ExtKey' class to put, get,+-- and clear external fields of messages.  The 'Key' can also be used+-- with the 'MessagesAPI' to get a possibly default value and to check+-- whether a key has been set in a message.+--+-- The 'Key' type (opaque to the user) has a phantom type of Maybe+-- or Seq that corresponds to Optional or Repeated fields. And a+-- second phantom type that matches the message type it must be used+-- with.  The third type parameter corresonds to the Haskell value+-- type.+--+-- The 'Key' is a GADT that puts all the needed class instances into+-- scope.  The actual content is the 'FieldId' ( numeric key), the+-- 'FieldType' (for sanity checks), and @Maybe v@ (a non-standard+-- default value).+--+-- When code is generated all of the known keys are taken into account+-- in the deserialization from the wire.  Unknown extension fields are+-- read as a collection of raw byte sequences.  If a key is then+-- presented it will be used to parse the bytes.+-- +-- There is no guarantee for what happens if two Keys disagree about+-- the type of a field; in particular there may be undefined values+-- and runtime errors.  The data constructor for 'Key' has to be+-- exported to the generated code, but is not exposed to the user by+-- "Text.ProtocolBuffers".+--+data Key c msg v where+  Key :: (ExtKey c,ExtendMessage msg,GPB v) => FieldId -> FieldType -> (Maybe v) -> Key c msg v++-- | This allows reflection, in this case it gives the numerical+-- 'FieldId' of the key, from 1 to 2^29-1 (excluding 19,000 through+-- 19,999).+getKeyFieldId :: Key c msg v -> FieldId+getKeyFieldId (Key fi _ _) = fi++-- | This allows reflection, in this case it gives the 'FieldType'+-- enumeration value (1 to 18) of the+-- "Text.DescriptorProtos.FieldDescriptorProto.Type" of the field.+getKeyFieldType :: Key c msg v -> FieldType+getKeyFieldType (Key _ ft _) = ft++-- | This will return the default value for a given 'Key', which is+-- set in the '.proto' file, or if unset it is the 'defaultValue' of+-- that type.+getKeyDefaultValue :: Key c msg v -> v+getKeyDefaultValue (Key _ _ md) = fromMaybe defaultValue md++instance Typeable1 c => Typeable2 (Key c) where+  typeOf2 _ = mkTyConApp (mkTyCon "Text.ProtocolBuffers.Extensions.Key") [typeOf1 (undefined :: c ())]++instance (Typeable1 c, Typeable msg, Typeable v) => Show (Key c msg v) where+  show key@(Key fieldId fieldType maybeDefaultValue) =+    concat ["(Key (",show fieldId+           ,") (",show fieldType+           ,") (",show maybeDefaultValue+           ,") :: ",show (typeOf key)+           ,")"]++-- | 'GPWitness' is an instance witness for the 'GPB' classes.  This+-- exists mainly to be a part of 'GPDyn' or 'GPDynSeq'.+data GPWitness a where GPWitness :: (GPB a) => GPWitness a+  deriving (Typeable)++-- | The 'GPDyn' is my specialization of 'Dynamic'.  It hides the type+-- with an existential but the 'GPWitness' brings the class instances+-- into scope.  This is used in 'ExtOptional' for optional fields.+data GPDyn = forall a . GPDyn (GPWitness a) a+  deriving (Typeable)++-- | The 'GPDynSeq' is another specialization of 'Dynamic' and is used+-- in 'ExtRepeated' for repeated fields.+data GPDynSeq = forall a . GPDynSeq (GPWitness a) (Seq a)+  deriving (Typeable)++-- | The WireType is used to ensure the Seq is homogenous.+-- The ByteString is the unparsed input after the tag.+-- The WireSize includes all tags.+data ExtFieldValue = ExtFromWire WireType (Seq ByteString)+                   | ExtOptional FieldType GPDyn+                   | ExtRepeated FieldType GPDynSeq+  deriving (Typeable,Ord,Show)++data DummyMessageType deriving (Typeable)+instance ExtendMessage DummyMessageType where+  getExtField = undefined+  putExtField = undefined+  validExtRanges = undefined++-- I want a complicated comparison here to at least allow testing of+-- setting a field, writing to wire, reading back from wire, and+-- comparing.+--+-- The comparison of ExtFromWire with ExtFromWire is conservative+-- about returning True.  It is entirely possible that if both value+-- were interpreted by the same Key that their resulting values would+-- compare True.+instance Eq ExtFieldValue where+  (==) (ExtFromWire a b) (ExtFromWire a' b') = a==a' && b==b'+  (==) (ExtOptional a b) (ExtOptional a' b') = a==a' && b==b'+  (==) (ExtRepeated a b) (ExtRepeated a' b') = a==a' && b==b'+  (==) x@(ExtOptional ft (GPDyn w@GPWitness _)) (ExtFromWire wt' s') =+    let wt = toWireType ft+    in wt==wt' && (let makeKeyType :: GPWitness a -> Key Maybe DummyMessageType a+                       makeKeyType = undefined+                       key = Key 0 ft Nothing `asTypeOf` makeKeyType w+                   in case parseWireExtMaybe key wt s' of+                        Right (_,y) -> x==y+                        _ -> False)+  (==) y@(ExtFromWire {}) x@(ExtOptional {})  = x == y+  (==) x@(ExtRepeated ft (GPDynSeq w@GPWitness _)) (ExtFromWire wt' s') =+    let wt = toWireType ft+    in wt==wt' && (let makeKeyType :: GPWitness a -> Key Seq DummyMessageType a+                       makeKeyType = undefined+                       key = Key 0 ft Nothing `asTypeOf` makeKeyType w+                   in case parseWireExtSeq key wt s' of+                        Right (_,y) -> x==y+                        _ -> False)+  (==) y@(ExtFromWire {}) x@(ExtRepeated {})  = x == y+  (==) _ _ = False++-- | ExtField is a newtype'd map from the numeric FieldId key to the+-- ExtFieldValue.  This allows for the needed class instances.+newtype ExtField = ExtField (Map FieldId ExtFieldValue)+  deriving (Typeable,Eq,Ord,Show)++-- | 'ExtendMessage' abstracts the operations of storing and+-- retrieving the 'ExtField' from the message, and provides the+-- reflection needed to know the valid field numbers.+--+-- This only used internally.+class Typeable msg => ExtendMessage msg where+  getExtField :: msg -> ExtField+  putExtField :: ExtField -> msg -> msg+  validExtRanges :: msg -> [(FieldId,FieldId)]++-- | The 'ExtKey' class has three functions for user of the API:+-- 'putExt', 'getExt', and 'clearExt'.  The 'wireGetKey' is used in+-- generated code.+--+-- There are two instances of this class, 'Maybe' for optional message+-- fields and 'Seq' for repeated message fields.  This class allows+-- for uniform treatment of these two kinds of extension fields.+class ExtKey c where+  -- | Change or clear the value of a key in a message. Passing+  -- 'Nothing' with an optional key or an empty 'Seq' with a repeated+  -- key clears the value.  This function thus maintains the invariant+  -- that having a field number in the 'ExtField' map means that the+  -- field is set and not empty.+  --+  -- This should be only way to set the contents of a extension field.+  putExt :: Key c msg v -> c v -> msg -> msg+  -- | Access the key in the message.  Optional have type @(Key Maybe+  -- msg v)@ and return type @(Maybe v)@ while repeated fields have+  -- type @(Key Seq msg v)@ and return type @(Seq v)@.+  --+  -- There are a few sources of errors with the lookup of the key:+  --+  --  * It may find unparsed bytes from loading the message. 'getExt'+  --  will attempt to parse the bytes as the key\'s value type, and+  --  may fail.  The parsing is done with the 'parseWireExt' method+  --  (which is not exported to user API).+  --+  --  * The wrong optional-key versus repeated-key type is a failure+  -- +  --  * The wrong type of the value might be found in the map and+  --  * cause a failure+  --+  -- The failures above should only happen if two different keys are+  -- used with the same field number.+  getExt :: Key c msg v -> msg -> Either String (c v)+  -- 'clearExt' unsets the field of the 'Key' if it is present.+  clearExt :: Key c msg v -> msg -> msg+  -- 'wireGetKey' is used in generated code to load extension fields+  -- which are defined in the same '.proto' file as the message.  This+  -- results in the storing the parsed type instead of the raw bytes+  -- inside the message.+  wireGetKey :: Key c msg v -> msg -> Get msg++-- | The 'Key' and 'GPWitness' GADTs use 'GPB' as a shorthand for many+-- classes.+class (Mergeable a,Default a,Wire a,Show a,Typeable a,Eq a,Ord a) => GPB a ++instance GPB Bool+instance GPB ByteString+instance GPB Utf8+instance GPB Double+instance GPB Float+instance GPB Int32+instance GPB Int64+instance GPB Word32+instance GPB Word64++instance Mergeable ExtField where+  mergeEmpty = ExtField M.empty+  mergeAppend (ExtField m1) (ExtField m2) = ExtField (M.unionWith mergeExtFieldValue m1 m2)++mergeExtFieldValue :: ExtFieldValue -> ExtFieldValue -> ExtFieldValue+mergeExtFieldValue (ExtFromWire wt1 s1) (ExtFromWire wt2 s2) =+  if wt1 /= wt2 then err $ "mergeExtFieldValue : ExtFromWire WireType mismatch " ++ show (wt1,wt2)+    else ExtFromWire wt2 (mappend s1 s2)++mergeExtFieldValue (ExtOptional ft1 (GPDyn GPWitness d1))+                   (ExtOptional ft2 (GPDyn GPWitness d2)) =+  if ft1 /= ft2 then err $ "mergeExtFieldValue : ExtOptional FieldType mismatch "++show (ft1,ft2)+    else case cast d2 of+           Nothing -> err $ "mergeExtFieldValue : ExtOptional cast failed, FieldType "++show (ft2,typeOf d1,typeOf d2)+           Just d2' -> ExtOptional ft2 (GPDyn GPWitness (mergeAppend d1 d2'))++mergeExtFieldValue (ExtRepeated ft1 (GPDynSeq GPWitness s1))+                   (ExtRepeated ft2 (GPDynSeq GPWitness s2)) =+  if ft1 /= ft2 then err $ "mergeExtFieldValue : ExtRepeated FieldType mismatch "++show (ft1,ft2)+    else case cast s2 of+           Nothing -> err $ "mergeExtFieldValue : ExtRepeated cast failed, FieldType "++show (ft2,typeOf s1,typeOf s2)+           Just s2' -> ExtRepeated ft2 (GPDynSeq GPWitness (mappend s1 s2'))++mergeExtFieldValue a b = err $ "mergeExtFieldValue : mismatch of constructors "++show (a,b)++instance Default ExtField where+  defaultValue = ExtField M.empty++instance Show (GPWitness a) where+  showsPrec _n GPWitness = ("(GPWitness :: GPWitness ("++) . shows (typeOf (undefined :: a)) . (')':) . (')':)++instance Eq (GPWitness a) where+  (==) GPWitness GPWitness = True+  (/=) GPWitness GPWitness = False++instance Ord (GPWitness a) where+  compare GPWitness GPWitness = EQ++instance (GPB a) => Data (GPWitness a) where+  gunfold _k z c = case constrIndex c of+                     1 -> z GPWitness+                     _ -> err "gunfold of GPWitness error"+  toConstr GPWitness = gpWitnessC+  dataTypeOf _ = gpWitnessDT++gpWitnessC :: Constr+gpWitnessC = mkConstr gpWitnessDT "GPWitness" [] Prefix +gpWitnessDT :: DataType+gpWitnessDT = mkDataType "GPWitness" [gpWitnessC]++{-+gpDynC :: Constr+gpDynC = mkConstr gpDynDT "GPDyn" ["a"] Prefix+gpDynDT :: DataType+gpDynDT = mkDataType "GPDyn" [gpDynC]++fromGPDyn :: (GPB a) => GPDyn -> Maybe a+fromGPDyn (GPDyn GPWitness a) = cast a++typeOfGPDyn :: GPDyn -> TypeRep+typeOfGPDyn (GPDyn GPWitness a) = typeOf a++defaultValueGPDyn :: GPWitness a -> GPDyn+defaultValueGPDyn x@GPWitness = GPDyn x defaultValue++mergeEmptyGPDyn :: GPWitness a -> GPDyn+mergeEmptyGPDyn x@GPWitness = GPDyn x mergeEmpty++mergeAppendGPDyn :: GPDyn -> GPDyn -> Maybe GPDyn+mergeAppendGPDyn (GPDyn GPWitness a1) (GPDyn GPWitness a2) = fmap (GPDyn GPWitness . mergeAppend a1) (cast a2)+-}++instance Eq GPDyn where+  (==) a b = fromMaybe False (eqGPDyn a b)++instance Ord GPDyn where+  compare a b = fromMaybe (compare (show a) (show b)) (ordGPDyn a b)++instance Show GPDyn where+  showsPrec _n (GPDyn x@GPWitness a) = ("(GPDyn "++) . shows x . (" ("++) . shows a . ("))"++)++instance Eq GPDynSeq where+  (==) a b = fromMaybe False (eqGPDynSeq a b)++instance Ord GPDynSeq where+  compare a b = fromMaybe (compare (show a) (show b)) (ordGPDynSeq a b)++instance Show GPDynSeq where+  showsPrec _n (GPDynSeq x@GPWitness s) = ("(GPDynSeq "++) . shows x . (" ("++) . shows s . ("))"++)++ordGPDyn :: GPDyn -> GPDyn -> Maybe Ordering+ordGPDyn (GPDyn GPWitness a1) (GPDyn GPWitness a2) = fmap (compare a1) (cast a2)++eqGPDyn :: GPDyn -> GPDyn -> Maybe Bool+eqGPDyn (GPDyn GPWitness a1) (GPDyn GPWitness a2) = fmap (a1==) (cast a2)++-- showGPDyn :: GPDyn -> String+-- showGPDyn (GPDyn GPWitness s) = show s++ordGPDynSeq :: GPDynSeq -> GPDynSeq -> Maybe Ordering+ordGPDynSeq (GPDynSeq GPWitness a1) (GPDynSeq GPWitness a2) = fmap (compare a1) (cast a2)++eqGPDynSeq :: GPDynSeq -> GPDynSeq -> Maybe Bool+eqGPDynSeq (GPDynSeq GPWitness a1) (GPDynSeq GPWitness a2) = fmap (a1==) (cast a2)++-- showGPDynSeq :: GPDynSeq -> String+-- showGPDynSeq (GPDynSeq GPWitness s) = show s++-- wireSizeGPDyn :: FieldType -> GPDyn -> WireSize+-- wireSizeGPDyn ft (GPDyn GPWitness a) = wireSize ft a ++-- wirePutGPDyn :: FieldType -> GPDyn -> Put+-- wirePutGPDyn ft (GPDyn GPWitness a) = wirePut ft a ++-- wireGetGPDyn :: forall a. GPWitness a -> FieldType -> Get GPDyn+-- wireGetGPDyn GPWitness ft = fmap (GPDyn GPWitness) (wireGet ft :: Get a)++-- getWitness :: (GPB a) => GPDyn -> Maybe (GPWitness a)+-- getWitness (GPDyn x@GPWitness _) = cast x++-- readGPDyn :: forall a . Read a => GPWitness a -> String -> GPDyn+-- readGPDyn x@(GPWitness) s =+--   let t :: a; t = read s+--   in GPDyn x t++instance ExtKey Maybe where+  putExt key Nothing msg = clearExt key msg+  putExt (Key i t _) (Just v) msg =+    let (ExtField ef) = getExtField msg+        v' = ExtOptional t (GPDyn GPWitness v)+        ef' = M.insert i v' ef+    in seq v' $ seq ef' (putExtField (ExtField ef') msg)++  clearExt (Key i _ _ ) msg =+    let (ExtField ef) = getExtField msg+        ef' = M.delete i ef+    in seq ef' (putExtField (ExtField ef') msg)++  getExt k@(Key i t _) msg =+    let (ExtField ef) = getExtField msg+    in case M.lookup i ef of+         Nothing -> Right Nothing+         Just (ExtFromWire wt raw) -> either Left (getExt' . snd) (parseWireExtMaybe k wt raw)+         Just x -> getExt' x+   where getExt' (ExtRepeated t' _) = Left $ "getKey Maybe: ExtField has repeated type: "++show (k,t')+         getExt' (ExtOptional t' (GPDyn GPWitness d)) | t/=t' =+           Left $ "getExt Maybe: Key's FieldType does not match ExtField's: "++show (k,t')+                                                      | otherwise =+           case cast d of+             Nothing -> Left $ "getExt Maybe: Key's value cast failed: "++show (k,typeOf d)+             Just d' -> Right (Just d')+         getExt' _ = err $ "Impossible? getExt.getExt' Maybe should not have this case (after parseWireExt)!"+  wireGetKey k@(Key i t mv) msg = do+    let myCast :: Maybe a -> Get a+        myCast = undefined+    v <- wireGet t `asTypeOf` (myCast mv)+    let (ExtField ef) = getExtField msg+    v' <- case M.lookup i ef of+            Nothing -> return $ ExtOptional t (GPDyn GPWitness v)+            Just (ExtOptional t' (GPDyn GPWitness vOld)) | t /= t' ->+              fail $ "wireGetKey Maybe: Key mismatch! found wrong field type: "++show (k,t,t')+                                                         | otherwise ->+              case cast vOld of+                Nothing -> fail $ "wireGetKey Maybe: previous Maybe value case failed: "++show (k,typeOf vOld)+                Just vOld' -> return $ ExtOptional t (GPDyn GPWitness (mergeAppend vOld' v))+            Just (ExtFromWire wt raw) ->+              case parseWireExtMaybe k wt raw of+                Left errMsg -> fail $ "wireGetKey Maybe: Could not parseWireExtMaybe: "++show k++"\n"++errMsg+                Right (_,ExtOptional t' (GPDyn GPWitness vOld)) | t/=t' ->+                  fail $ "wireGetKey Maybe: Key mismatch! found wrong field type: "++show (k,t,t')+                                                         | otherwise ->+                  case cast vOld of+                    Nothing -> fail $ "wireGetKey Maybe: previous Maybe value case failed: "++show (k,typeOf vOld)+                    Just vOld' -> return $ ExtOptional t (GPDyn GPWitness (mergeAppend vOld' v))+                wtf -> fail $ "wireGetKey Maybe: Weird parseGetWireMaybe return value: "++show (k,wtf)+            wtf -> fail $ "wireGetKey Maybe: ExtRepeated found with ExtOptional expected: "++show (k,wtf)+    let ef' = M.insert i v' ef+    seq v' $ seq ef' $ return (putExtField (ExtField ef') msg)++-- | used by 'getVal' and 'wireGetKey' for the 'Maybe' instance+parseWireExtMaybe :: Key Maybe msg v -> WireType -> Seq ByteString -> Either String (FieldId,ExtFieldValue)+parseWireExtMaybe k@(Key fi ft mv)  wt raw | wt /= toWireType ft =+  Left $ "parseWireExt Maybe: Key's FieldType does not match ExtField's wire type: "++show (k,toWireType ft,wt)+                                      | otherwise = do+  let mkWitType :: Maybe a -> GPWitness a+      mkWitType = undefined+      witness = GPWitness `asTypeOf` (mkWitType mv)+      parsed = map (applyGet (wireGet ft)) . F.toList $ raw+      errs = [ m | Left m <- parsed ]+  if null errs then Right (fi,(ExtOptional ft (GPDyn witness (mergeConcat [ a | Right a <- parsed ]))))+    else Left (unlines errs)++-- | Converts the the 'Result' into an 'Either' type and enforces+-- consumption of entire 'ByteString'.  Used by 'parseWireExtMaybe'+-- and 'parseWireExtSeq' to process raw wire input that has been+-- stored in an 'ExtField'.+applyGet :: Get r -> ByteString -> Either String r+applyGet g bsIn = resolveEOF (runGet g bsIn) where+  resolveEOF :: Result r -> Either String r+  resolveEOF (Failed i s) = Left ("Failed at "++show i++" : "++s)+  resolveEOF (Finished bs _i r) | L.null bs = Right r+                                | otherwise = Left "Not all input consumed"+  resolveEOF (Partial {}) = Left "Not enough input"++instance ExtKey Seq where+  putExt key@(Key i t _) s msg | Seq.null s = clearExt key msg+                               | otherwise =+      let (ExtField ef) = getExtField msg+          v' = ExtRepeated t (GPDynSeq GPWitness s)+          ef' = M.insert i v' ef+      in seq v' $ seq ef' (putExtField (ExtField ef') msg)++  clearExt (Key i _ _ ) msg =+    let (ExtField ef) = getExtField msg+        ef' = M.delete i ef+    in seq ef' (putExtField (ExtField ef') msg)++  getExt k@(Key i t _) msg =+    let (ExtField ef) = getExtField msg+    in case M.lookup i ef of+         Nothing -> Right Seq.empty+         Just (ExtFromWire wt raw) -> either Left (getExt' . snd) (parseWireExtSeq k wt raw)+         Just x -> getExt' x+   where getExt' (ExtOptional t' _) = Left $ "getKey Seq: ExtField has optional type: "++show (k,t')+         getExt' (ExtRepeated t' (GPDynSeq GPWitness s)) | t'/=t =+           Left $ "getExt Seq: Key's FieldType does not match ExtField's: "++show (k,t')+                                                         | otherwise =+           case cast s of+             Nothing -> Left $ "getExt Seq: Key's Seq value cast failed: "++show (k,typeOf s)+             Just s' -> Right s'+         getExt' _ = err $ "Impossible? getExt.getExt' Maybe should not have this case (after parseWireExtSeq)!"+             +  -- This is more complicated than the Maybe instance because the old+  -- Seq needs to be retrieved and perhaps parsed and then appended+  -- to.  All sanity checks are included below.  TODO: do enough+  -- testing to be confident in removing some checks.+  wireGetKey k@(Key i t mv) msg = do+    let myCast :: Maybe a -> Get a+        myCast = undefined+    v <- wireGet t `asTypeOf` (myCast mv)+    let (ExtField ef) = getExtField msg+    v' <- case M.lookup i ef of+            Nothing -> return $ ExtRepeated t (GPDynSeq GPWitness (Seq.singleton v))+            Just (ExtRepeated t' (GPDynSeq GPWitness s)) | t/=t' ->+              fail $ "wireGetKey Seq: Key mismatch! found wrong field type: "++show (k,t,t')+                                                         | otherwise ->+              case cast s of+                Nothing -> fail $ "wireGetKey Seq: previous Seq value cast failed: "++show (k,typeOf s)+                Just s' -> return $ ExtRepeated t (GPDynSeq GPWitness (s' |> v))+            Just (ExtFromWire wt raw) ->+              case parseWireExtSeq k wt raw of+                Left errMsg -> fail $ "wireGetKey Seq: Could not parseWireExtSeq: "++show k++"\n"++errMsg+                Right (_,ExtRepeated t' (GPDynSeq GPWitness s)) | t/=t' ->+                  fail $ "wireGetKey Seq: Key mismatch! parseWireExtSeq returned wrong field type: "++show (k,t,t')+                                                                | otherwise ->+                  case cast s of+                    Nothing -> fail $ "wireGetKey Seq: previous Seq value cast failed: "++show (k,typeOf s)+                    Just s' -> return $ ExtRepeated t (GPDynSeq GPWitness (s' |> v))+                wtf -> fail $ "wireGetKey Seq: Weird parseWireExtSeq return value: "++show (k,wtf)+            wtf -> fail $ "wireGetKey Seq: ExtOptional found when ExtRepeated expected: "++show (k,wtf)+    let ef' = M.insert i v' ef+    seq v' $ seq ef' $ return (putExtField (ExtField ef') msg)++-- | used by 'getVal' and 'wireGetKey' for the 'Seq' instance+parseWireExtSeq :: Key Seq msg v -> WireType -> Seq ByteString -> Either String (FieldId,ExtFieldValue)+parseWireExtSeq k@(Key i t mv)  wt raw | wt /= toWireType t =+  Left $ "parseWireExt Maybe: Key mismatch! Key's FieldType does not match ExtField's wire type: "++show (k,toWireType t,wt)+                                      | otherwise = do+  let mkWitType :: Maybe a -> GPWitness a+      mkWitType = undefined+      witness = GPWitness `asTypeOf` (mkWitType mv)+      parsed = map (applyGet (wireGet t)) . F.toList $ raw+      errs = [ m | Left m <- parsed ]+  if null errs then Right (i,(ExtRepeated t (GPDynSeq witness (Seq.fromList [ a | Right a <- parsed ]))))+    else Left (unlines errs)++-- | This is used by the generated code+wireSizeExtField :: ExtField -> WireSize+wireSizeExtField (ExtField m) = F.foldl' aSize 0 (M.assocs m)  where+    aSize old (fi,(ExtFromWire wt bs)) = old ++      let tagSize = size'Varint (getWireTag (mkWireTag fi wt))+      in F.foldl' (\oldVal new -> oldVal + L.length new) (fromIntegral (Seq.length bs) * tagSize) bs+    aSize old (fi,(ExtOptional ft (GPDyn GPWitness d))) = old ++      let tagSize = size'Varint (getWireTag (toWireTag fi ft))+      in wireSizeReq tagSize ft d+    aSize old (fi,(ExtRepeated ft (GPDynSeq GPWitness s))) = old ++      let tagSize = size'Varint (getWireTag (toWireTag fi ft))+      in wireSizeRep tagSize ft s++-- | This is used by the generated code. The data is serialized in+-- order of increasing field number.+wirePutExtField :: ExtField -> Put+wirePutExtField (ExtField m) = mapM_ aPut (M.assocs m) where+    aPut (fi,(ExtFromWire wt raw)) = F.mapM_ (\bs -> putVarUInt (getWireTag $ mkWireTag fi wt) >> putLazyByteString bs) raw+    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 extension++-- | 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 extension++-- | '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)++-- | get a value from the wire into the message's ExtField. This is+-- used by 'getMessageExt' and 'getBareMessageExt' above.+extension :: (ReflectDescriptor a, ExtendMessage a) => FieldId -> WireType -> a -> Get a+extension fieldId wireType msg | isValidExt fieldId 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)+  case M.lookup fieldId ef of+    Nothing -> do+       bs <- wireGetFromWire fieldId wireType+       let v' = ExtFromWire wireType (Seq.singleton bs)+           ef' = M.insert fieldId v' ef+       seq v' $ seq ef' $ return $ putExtField (ExtField ef') msg+    Just (ExtFromWire wt raw) | wt /= wireType -> badwt wt+                              | otherwise -> do+      bs <- wireGetFromWire fieldId wireType+      let v' = ExtFromWire wt (raw |> bs)+          ef' = M.insert fieldId v' ef+      seq v' $ seq ef' $ return (putExtField (ExtField ef') msg)+    Just (ExtOptional ft (GPDyn x@GPWitness a)) | toWireType ft /= wireType -> badwt (toWireType ft)+                                                | otherwise -> do+      b <- wireGet ft+      let v' = ExtOptional ft (GPDyn x (mergeAppend a b))+          ef' = M.insert fieldId v' ef+      seq v' $ seq ef' $ return (putExtField (ExtField ef') msg)+    Just (ExtRepeated ft (GPDynSeq x@GPWitness s)) | toWireType ft /= wireType -> badwt (toWireType ft)+                                                   | otherwise -> do+      a <- wireGet ft+      let v' = ExtRepeated ft (GPDynSeq x (s |> a))+          ef' = M.insert fieldId v' ef+      seq v' $ seq ef' $ return (putExtField (ExtField ef') msg)+extension fieldId wireType msg = unknown fieldId wireType msg++-- | 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 fi wt = getLazyByteString =<< calcLen where+  calcLen = case wt of+              0 -> lenOf (spanOf (>=128) >> skip 1)+              1 -> return 8+              2 -> lookAhead $ do+                     here <- bytesRead+                     len <- getVarInt+                     there <- bytesRead+                     return ((there-here)+len)+              3 -> lenOf (skipGroup fi)+              4 -> fail $ "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)+  lenOf g = do here <- bytesRead+               there <- lookAhead (g >> bytesRead)+               return (there-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 start_fi = go where+  go = do+    (fieldId,wireType) <- fmap (splitWireTag . WireTag) getVarInt+    case wireType of+      0 -> spanOf (>=128) >> skip 1 >> go+      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))+        | otherwise -> return ()+      5 -> skip 4 >> go+      wtf -> fail $ "Invalid wire type (expected 0,1,2,3,4,or 5) found: "++show (fieldId,wtf)+                     +class MessageAPI msg a b | msg a -> b where+  -- | Access data in a message.  The first argument is always the+  -- message.  The second argument can be one of 4 categories.+  --+  -- * The field name of a required field acts a simple retrieval of+  -- the data from the message.+  --+  -- * The field name of an optional field will retreive the data if+  -- it is set or lookup the default value if it is not set.+  --+  -- * The field name of a repeated field always retrieves the+  -- (possibly empty) 'Seq' of values.+  --+  -- * A Key for an optional or repeated value will act as the field+  -- name does above, but if there is a type mismatch or parse error+  -- it will use the defaultValue for optional types and an empty+  -- sequence for repeated types.+  getVal :: msg -> a -> b++  -- | Check whether data is present in the message.+  --+  -- * Required fields always return 'True'.+  --+  -- * Optional fields return whether a value is present.+  --+  -- * Repeated field return 'False' if there are no values, otherwise+  -- they return 'True'.+  --+  -- * Keys return as optional or repeated, but checks only if the+  -- field # is present.  This assumes that there are no collisions+  -- where more that one key refers to the same field number of this+  -- message type.+  isSet :: msg -> a -> Bool+  isSet _ _ = True++instance (Default msg,Default a) => MessageAPI msg (msg -> Maybe a) a where+  getVal m f = fromMaybe (fromMaybe defaultValue (f defaultValue)) (f m)+  isSet m f = maybe False (const True) (f m)++instance MessageAPI msg (msg -> (Seq a)) (Seq a) where+  getVal m f = f m+  isSet m f = not (Seq.null (f m))++instance (Default v) => MessageAPI msg (Key Maybe msg v) v where+  getVal m k@(Key _ _ md) = case getExt k m of+                              Right (Just v) -> v+                              _ -> fromMaybe defaultValue md+  isSet m (Key fid _ _) = let (ExtField x) = getExtField m+                          in M.member fid x++instance (Default v) => MessageAPI msg (Key Seq msg v) (Seq v) where+  getVal m k@(Key _ _ _) = case getExt k m of+                             Right s -> s+                             _ -> Seq.empty+  isSet m (Key fid _ _) = let (ExtField x) = getExtField m+                          in M.member fid x++instance MessageAPI msg (msg -> ByteString) ByteString where getVal m f = f m+instance MessageAPI msg (msg -> Utf8) Utf8 where getVal m f = f m+instance MessageAPI msg (msg -> Double) Double where getVal m f = f m+instance MessageAPI msg (msg -> Float) Float where getVal m f = f m+instance MessageAPI msg (msg -> Int32) Int32 where getVal m f = f m+instance MessageAPI msg (msg -> Int64) Int64 where getVal m f = f m+instance MessageAPI msg (msg -> Word32) Word32 where getVal m f = f m+instance MessageAPI msg (msg -> Word64) Word64 where getVal m f = f m
− Text/ProtocolBuffers/Gen.hs 
@@ -1,752 +0,0 @@--- try "test", "testDesc", and "testLabel" to see sample output------ Turn *Proto into Language.Haskell.Exts.Syntax from haskell-src-exts package--- Need to get this just far enough to allow bootstrapping of 'descriptor.proto'--- Done: Enum modules--- Done: Descriptor modules (except for default values and reflection)------ Note that this must eventually also generate hs-boot files to allow--- for breaking mutual recursion.  This is ignored for getting--- descriptor.proto running.------ Mangling: For the current moment, assume the mangling is done in a prior pass:---   (*) Uppercase all module names and type names---   (*) lowercase all field names---   (*) add a prime after all field names than conflict with reserved words------ The names are also assumed to have become fully-qualified, and all--- the optional type codes have been set.------ default values are an awful mess.  They are documented in descriptor.proto as-{--  // For numeric types, contains the original text representation of the value.-  // For booleans, "true" or "false".-  // For strings, contains the default text contents (not escaped in any way).-  // For bytes, contains the C escaped value.  All bytes >= 128 are escaped.-  // TODO(kenton):  Base-64 encode?-  optional string default_value = 7;--}--- The above fails to mentions enums' default is their first value (always exists)--- see something like http://msdn.microsoft.com/en-us/library/6aw8xdf2.aspx for c escape parsing--- So rendering a message to text is ugly, the strings are valid UTF-8 and so are rendered in--- some other unicode form, while bytes must be unparsed to use. The only sane thing to do is--- put a parsed and converted Haskell data type into the defaults interface.--- This has been done in Reflections.hs-module Text.ProtocolBuffers.Gen(descriptorModule,enumModule,prettyPrint) where--import qualified Text.DescriptorProtos.DescriptorProto                as D(DescriptorProto)-import qualified Text.DescriptorProtos.DescriptorProto                as D.DescriptorProto(DescriptorProto(..))-{- not yet used-import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.DescriptorProto(ExtensionRange)-import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.DescriptorProto.ExtensionRange(ExtensionRange(..))--}-import qualified Text.DescriptorProtos.EnumDescriptorProto            as D(EnumDescriptorProto) -import qualified Text.DescriptorProtos.EnumDescriptorProto            as D.EnumDescriptorProto(EnumDescriptorProto(..)) -import qualified Text.DescriptorProtos.EnumOptions                    as D(EnumOptions)-import qualified Text.DescriptorProtos.EnumOptions                    as D.EnumOptions(EnumOptions(..))-import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D(EnumValueDescriptorProto)-import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D.EnumValueDescriptorProto(EnumValueDescriptorProto(..))-import qualified Text.DescriptorProtos.EnumValueOptions               as D(EnumValueOptions) -import qualified Text.DescriptorProtos.EnumValueOptions               as D.EnumValueOptions(EnumValueOptions(..)) -import qualified Text.DescriptorProtos.FieldDescriptorProto           as D(FieldDescriptorProto) -import qualified Text.DescriptorProtos.FieldDescriptorProto           as D.FieldDescriptorProto(FieldDescriptorProto(..)) -import qualified Text.DescriptorProtos.FieldDescriptorProto.Label     as D.FieldDescriptorProto(Label)-import           Text.DescriptorProtos.FieldDescriptorProto.Label     as D.FieldDescriptorProto.Label(Label(..))-import qualified Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto(Type)-import           Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto.Type(Type(..))-import qualified Text.DescriptorProtos.FieldOptions                   as D(FieldOptions)-import qualified Text.DescriptorProtos.FieldOptions                   as D.FieldOptions(FieldOptions(..))-import qualified Text.DescriptorProtos.FileDescriptorProto            as D(FileDescriptorProto) -import qualified Text.DescriptorProtos.FileDescriptorProto            as D.FileDescriptorProto(FileDescriptorProto(..)) -import qualified Text.DescriptorProtos.FileOptions                    as D(FileOptions)-import qualified Text.DescriptorProtos.FileOptions                    as D.FileOptions(FileOptions(..))-{- -- unused or unusable-import qualified Text.DescriptorProtos.FieldOptions.CType             as D.FieldOptions(CType)-import qualified Text.DescriptorProtos.FieldOptions.CType             as D.FieldOptions.CType(CType(..))-import qualified Text.DescriptorProtos.FileOptions.OptimizeMode       as D.FileOptions(OptimizeMode)-import qualified Text.DescriptorProtos.FileOptions.OptimizeMode       as D.FileOptions.OptimizeMode(OptimizeMode(..))-import qualified Text.DescriptorProtos.MessageOptions                 as D(MessageOptions)-import qualified Text.DescriptorProtos.MessageOptions                 as D.MessageOptions(MessageOptions(..))--}-{-  -- related to the rpc system-import qualified Text.DescriptorProtos.MethodDescriptorProto          as D(MethodDescriptorProto)-import qualified Text.DescriptorProtos.MethodDescriptorProto          as D.MethodDescriptorProto(MethodDescriptorProto(..))-import qualified Text.DescriptorProtos.MethodOptions                  as D(MethodOptions)-import qualified Text.DescriptorProtos.MethodOptions                  as D.MethodOptions(MethodOptions(..))-import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D(ServiceDescriptorProto) -import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D.ServiceDescriptorProto(ServiceDescriptorProto(..)) -import qualified Text.DescriptorProtos.ServiceOptions                 as D(ServiceOptions)-import qualified Text.DescriptorProtos.ServiceOptions                 as D.ServiceOptions(ServiceOptions(..))--}----import Text.ProtocolBuffers.Header-import Text.ProtocolBuffers.Basic-import Text.ProtocolBuffers.Default-import Text.ProtocolBuffers.Reflections-import Text.ProtocolBuffers.WireMessage(size'Varint)--import qualified Data.ByteString(concat)-import qualified Data.ByteString.Char8(spanEnd)-import qualified Data.ByteString.Lazy as BS-import qualified Data.ByteString.Lazy.Char8 as BSC-import qualified Data.ByteString.Lazy.UTF8 as U-import Data.Bits(Bits((.|.),shiftL))-import Data.Maybe(fromMaybe,catMaybes)-import Data.List(sort,group,foldl',foldl1')-import Data.Sequence(viewl,ViewL(..))-import qualified Data.Sequence as Seq(length,fromList)-import Data.Foldable as F(foldr,toList)-import Language.Haskell.Exts.Syntax-import Language.Haskell.Exts.Pretty---- -- -- -- Helper functions--($$) :: HsExp -> HsExp -> HsExp-($$) = HsApp--infixl 1 $$--toWireTag :: FieldId -> FieldType -> WireTag-toWireTag fieldId fieldType-    = ((fromIntegral . getFieldId $ fieldId) `shiftL` 3) .|. (fromIntegral . getWireType . toWireType $ fieldType)--{-  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  1 =  1-toWireType  2 =  5-toWireType  3 =  0-toWireType  4 =  0-toWireType  5 =  0-toWireType  6 =  1-toWireType  7 =  5-toWireType  8 =  0-toWireType  9 =  2-toWireType 10 =  error "TYPE_GROUP unsupported ..."-toWireType 11 =  2-toWireType 12 =  2-toWireType 13 =  0-toWireType 14 =  0-toWireType 15 =  5-toWireType 16 =  1-toWireType 17 =  5-toWireType 18 =  1-toWireType _ = error "WireMessage.toWireType: Bad FieldType"--dotPre :: String -> String -> String-dotPre "" = id-dotPre s | '.' == last s = (s ++)-         | otherwise = (s ++) . ('.':)--spanEndL f bs = let (a,b) = Data.ByteString.Char8.spanEnd f (Data.ByteString.concat . BSC.toChunks $ bs)-                in (BSC.fromChunks [a],BSC.fromChunks [b])---- Take a bytestring of "A" into "Right A" and "A.B.C" into "Left (A.B,C)"-splitMod :: ByteString -> Either (ByteString,ByteString) ByteString-splitMod bs = case spanEndL ('.'/=) bs of-                (pre,post) | BSC.length pre <= 1 -> Right bs-                           | otherwise -> Left (BSC.init pre,post)--unqual :: ByteString -> HsQName-unqual bs = UnQual (base bs)--base :: ByteString -> HsName-base bs = case splitMod bs of-            Right typeName -> (ident typeName)-            Left (_,typeName) -> (ident typeName)--src :: SrcLoc-src = SrcLoc "No SrcLoc" 0 0--ident :: ByteString -> HsName-ident bs = HsIdent (U.toString bs)--typeApp :: String -> HsType -> HsType-typeApp s =  HsTyApp (HsTyCon (private s))---- 'qual' and 'qmodname' are only correct for simple or fully looked-up names.-qual :: ByteString -> HsQName-qual bs = case splitMod bs of-            Right typeName -> UnQual (ident typeName)-            Left (modName,typeName) -> Qual (Module (U.toString modName)) (ident typeName)--pvar :: String -> HsExp-pvar t = HsVar (private t)--lvar :: String -> HsExp-lvar t = HsVar (UnQual (HsIdent t))--private :: String -> HsQName-private t = Qual (Module "P'") (HsIdent t)------------------------------------------------- EnumDescriptorProto module creation------------------------------------------------fqName :: ProtoName -> String-fqName (ProtoName a b c) = dotPre a (dotPre b c)--enumModule :: String -> D.EnumDescriptorProto -> HsModule-enumModule prefix-           e@(D.EnumDescriptorProto.EnumDescriptorProto-              { D.EnumDescriptorProto.name = Just rawName})-    = let protoName = case splitMod rawName of-                        Left (m,b) -> ProtoName prefix (U.toString m) (U.toString b)-                        Right b    -> ProtoName prefix ""             (U.toString b)-      in HsModule src (Module (fqName protoName))-                  (Just [HsEThingAll (UnQual (HsIdent (baseName protoName)))])-                  standardImports (enumDecls protoName e)--enumValues :: D.EnumDescriptorProto -> [(Integer,HsName)]-enumValues (D.EnumDescriptorProto.EnumDescriptorProto-            { D.EnumDescriptorProto.value = value}) -    = sort $ F.foldr ((:) . oneValue) [] value-  where oneValue  :: D.EnumValueDescriptorProto -> (Integer,HsName)-        oneValue (D.EnumValueDescriptorProto.EnumValueDescriptorProto-                  { D.EnumValueDescriptorProto.name = Just name-                  , D.EnumValueDescriptorProto.number = Just number })-            = (toInteger number,ident name)-      -enumX :: D.EnumDescriptorProto -> HsDecl-enumX e@(D.EnumDescriptorProto.EnumDescriptorProto-         { D.EnumDescriptorProto.name = Just rawName})-    = HsDataDecl src DataType [] (base rawName) [] (map enumValueX values) derives-        where values = enumValues e-              enumValueX :: (Integer,HsName) -> HsQualConDecl-              enumValueX (_,hsName) = HsQualConDecl src [] [] (HsConDecl hsName [])--enumDecls :: ProtoName -> D.EnumDescriptorProto -> [HsDecl]-enumDecls p e = enumX e :  [ instanceMergeableEnum e-                           , instanceBounded e-                           , instanceDefaultEnum e-                           , instanceEnum e-                           , instanceWireEnum e-                           , instanceReflectEnum p e ]--instanceBounded :: D.EnumDescriptorProto -> HsDecl-instanceBounded e@(D.EnumDescriptorProto.EnumDescriptorProto-                   { D.EnumDescriptorProto.name = Just name})-    = HsInstDecl src [] (private "Bounded") [HsTyCon (unqual name)] -                 (map (HsInsDecl . HsFunBind) [set "minBound" (head values)-                                              ,set "maxBound" (last values)]) where-        values = enumValues e-        set f (_,n) = [HsMatch src (HsIdent f) [] (HsUnGuardedRhs (HsCon (UnQual n))) noWhere]--instanceEnum :: D.EnumDescriptorProto -> HsDecl-instanceEnum e@(D.EnumDescriptorProto.EnumDescriptorProto-                { D.EnumDescriptorProto.name = Just name})-    = HsInstDecl src [] (private "Enum") [HsTyCon (unqual name)] -                 (map (HsInsDecl . HsFunBind) [fromEnum',toEnum',succ',pred']) where-        values = enumValues e-        fromEnum' = map fromEnum'one values-        fromEnum'one (v,n) = HsMatch src (HsIdent "fromEnum") [HsPApp (UnQual n) []]-                               (HsUnGuardedRhs (HsLit (HsInt v))) noWhere-        toEnum' = map toEnum'one values-        toEnum'one (v,n) = HsMatch src (HsIdent "toEnum") [HsPLit (HsInt v)]-                               (HsUnGuardedRhs (HsCon (UnQual n))) noWhere-        succ' = zipWith (equate "succ") values (tail values)-        pred' = zipWith (equate "pred") (tail values) values-        equate f (_,n1) (_,n2) = HsMatch src (HsIdent f) [HsPApp (UnQual n1) []]-                                   (HsUnGuardedRhs (HsCon (UnQual n2))) noWhere---- fromEnum TYPE_ENUM == 14 :: Int-instanceWireEnum :: D.EnumDescriptorProto -> HsDecl-instanceWireEnum (D.EnumDescriptorProto.EnumDescriptorProto-                  { D.EnumDescriptorProto.name = Just name })-    = HsInstDecl src [] (private "Wire") [HsTyCon (unqual name)]-      [ withName "wireSize", withName "wirePut", withGet ]-  where withName foo = HsInsDecl (HsFunBind [HsMatch src (HsIdent foo) [HsPLit (HsInt 14),HsPVar (HsIdent "enum")]-                                          (HsUnGuardedRhs rhs) noWhere])-          where rhs = (pvar foo $$ HsLit (HsInt 14)) $$-                      (HsParen $ pvar "fromEnum" $$ lvar "enum")-        withGet = HsInsDecl (HsFunBind [HsMatch src (HsIdent "wireGet") [HsPLit (HsInt 14)]-                                          (HsUnGuardedRhs rhs) noWhere])-          where rhs = (pvar "fmap" $$ pvar "toEnum") $$-                      (HsParen $ pvar "wireGet" $$ HsLit (HsInt 14))--instanceMergeableEnum :: D.EnumDescriptorProto -> HsDecl-instanceMergeableEnum (D.EnumDescriptorProto.EnumDescriptorProto-                       { D.EnumDescriptorProto.name = Just name }) =-    HsInstDecl src [] (private "Mergeable") [HsTyCon (unqual name)] []--{- from google's descriptor.h, about line 346:--  // Get the field default value if cpp_type() == CPPTYPE_ENUM.  If no-  // explicit default was defined, the default is the first value defined-  // in the enum type (all enum types are required to have at least one value).-  // This never returns NULL.---}--instanceDefaultEnum :: D.EnumDescriptorProto -> HsDecl-instanceDefaultEnum (D.EnumDescriptorProto.EnumDescriptorProto-                     { D.EnumDescriptorProto.name = Just name-                     , D.EnumDescriptorProto.value = value})-    = HsInstDecl src [] (private "Default") [HsTyCon (unqual name)]-      [ HsInsDecl (HsFunBind [HsMatch src (HsIdent "defaultValue") [] -                                          (HsUnGuardedRhs firstValue) noWhere])-      ]-  where firstValue :: HsExp-        firstValue = case viewl value of-                       (:<) (D.EnumValueDescriptorProto.EnumValueDescriptorProto-                             { D.EnumValueDescriptorProto.name = Just name }) _ ->-                                 HsCon (UnQual (ident name))-                       EmptyL -> error "EnumDescriptorProto had empty sequence of EnumValueDescriptorProto"--instanceReflectEnum :: ProtoName -> D.EnumDescriptorProto -> HsDecl-instanceReflectEnum protoName@(ProtoName a b c)-                    e@(D.EnumDescriptorProto.EnumDescriptorProto-                       { D.EnumDescriptorProto.name = Just rawName })-    = HsInstDecl src [] (private "ReflectEnum") [HsTyCon (unqual rawName)]-      [ HsInsDecl (HsFunBind [HsMatch src (HsIdent "reflectEnum") [] -                                          (HsUnGuardedRhs ascList) noWhere])-      , HsInsDecl (HsFunBind [HsMatch src (HsIdent "reflectEnumInfo") [ HsPWildCard ] -                                          (HsUnGuardedRhs ei) noWhere])-      ]-  where values = enumValues e-        ascList,ei,protoNameExp :: HsExp-        ascList = HsList (map one values)-          where one (v,n@(HsIdent ns)) = HsTuple [HsLit (HsInt v),HsLit (HsString ns),HsCon (UnQual n)]-        ei = foldl' HsApp (HsCon (private "EnumInfo")) [protoNameExp,HsList (map two values)]-          where two (v,n@(HsIdent ns)) = HsTuple [HsLit (HsInt v),HsLit (HsString ns)]-        protoNameExp = HsParen $ foldl' HsApp (HsCon (private "ProtoName")) [HsLit (HsString a)-                                                                            ,HsLit (HsString b)-                                                                            ,HsLit (HsString c)]------------------------------------------------- DescriptorProto module creation is unfinished---   There are difficult namespace issues-----------------------------------------------descriptorModule :: String -> D.DescriptorProto -> HsModule-descriptorModule prefix-                 d@(D.DescriptorProto.DescriptorProto-                    { D.DescriptorProto.name = Just rawName-                    , D.DescriptorProto.field = field })-    = let self = UnQual . HsIdent . U.toString . either snd id . splitMod $ rawName-          fqModuleName = Module (dotPre prefix (U.toString rawName))-          imports = standardImports ++ map formatImport (toImport d)-          protoName = case splitMod rawName of-                        Left (m,b) -> ProtoName prefix (U.toString m) (U.toString b)-                        Right b    -> ProtoName prefix ""             (U.toString b)-          (insts,di) = instancesDescriptor protoName d-      in HsModule src fqModuleName (Just [HsEThingAll self]) imports (descriptorX d : insts)-  where formatImport (Left (m,t)) = HsImportDecl src (Module (dotPre prefix (dotPre m t))) True-                                      (Just (Module m)) (Just (False,[HsIAbs (HsIdent t)]))-        formatImport (Right t)    = HsImportDecl src (Module (dotPre prefix t)) False-                                      Nothing (Just (False,[HsIAbs (HsIdent t)]))--standardImports = [ HsImportDecl src (Module "Prelude") False Nothing-                      (Just (False,[HsIVar (HsSymbol "+"),HsIVar (HsSymbol "++")]))-                  , HsImportDecl src (Module "Prelude") True (Just (Module "P'")) Nothing-                  , HsImportDecl src (Module "Text.ProtocolBuffers.Header") True (Just (Module "P'")) Nothing ]---- Create a list of (Module,Name) to import--- Assumes that all self references are _not_ qualified!-toImport :: D.DescriptorProto -> [Either (String,String) String]-toImport (D.DescriptorProto.DescriptorProto-          { D.DescriptorProto.name = Just name-          , D.DescriptorProto.field = field })-    = map head . group . sort-      . map (either (\(m,t) -> Left (U.toString m,U.toString t)) (Right . U.toString))-      . map splitMod-      . filter (selfName /=)-      . catMaybes -      . F.foldr ((:) . mayImport) [] $-        field-  where selfName = either snd id (splitMod name)-        mayImport (D.FieldDescriptorProto.FieldDescriptorProto-                   { D.FieldDescriptorProto.type' = type'-                   , D.FieldDescriptorProto.type_name = type_name })-            = answer-          where answer     = maybe answerName checkType type'-                checkType  = maybe answerName (const Nothing) . useType-                answerName = maybe (error "No Name for Type!") Just type_name---- data HsConDecl = HsConDecl HsName [HsBangType] -- ^ ordinary data constructor---                | HsRecDecl HsName [([HsName],HsBangType)] -- ^ record constructor-fieldX :: D.FieldDescriptorProto -> ([HsName],HsBangType)-fieldX (D.FieldDescriptorProto.FieldDescriptorProto-         { D.FieldDescriptorProto.name = Just name-         , D.FieldDescriptorProto.label = Just labelEnum-         , D.FieldDescriptorProto.type' = type'-         , D.FieldDescriptorProto.type_name = type_name })-    = ([ident name],HsUnBangedTy (labeled (HsTyCon typed)))-  where labeled = case labelEnum of-                    LABEL_OPTIONAL -> typeApp "Maybe"-                    LABEL_REPEATED -> typeApp "Seq"-                    LABEL_REQUIRED -> id-        typed,typedByName :: HsQName-        typed         = maybe typedByName typePrimitive type'-        typedByName   = maybe (error "No Name for Type!") qual type_name-        typePrimitive :: Type -> HsQName-        typePrimitive = maybe typedByName private . useType---- HsDataDecl     SrcLoc DataOrNew HsContext HsName [HsName] [HsQualConDecl] [HsQName]--- data HsQualConDecl = HsQualConDecl SrcLoc {-forall-} [HsTyVarBind] {- . -} HsContext {- => -} HsConDecl--- data HsConDecl = HsConDecl HsName [HsBangType] -- ^ ordinary data constructor---                | HsRecDecl HsName [([HsName],HsBangType)] -- ^ record constructor-descriptorX :: D.DescriptorProto -> HsDecl-descriptorX (D.DescriptorProto.DescriptorProto-              { D.DescriptorProto.name = Just name-              , D.DescriptorProto.field = field })-    = HsDataDecl src DataType [] (base name) [] [con] derives-        where con = HsQualConDecl src [] [] (HsRecDecl (base name) fields)-                  where fields = F.foldr ((:) . fieldX) [] field---- There is some confusing code below.  The FieldInfo and--- DescriptorInfo are getting built as a "side effect" of--- instanceDefault generating the instances for the Default class.--- This DescriptorInfo information is then passed to--- instanceReflectDescriptor to generate the instance of the--- ReflectDescriptor class.---- | HsInstDecl     SrcLoc HsContext HsQName [HsType] [HsInstDecl]-instancesDescriptor :: ProtoName -> D.DescriptorProto -> ([HsDecl],DescriptorInfo)-instancesDescriptor protoName d = ([ instanceMergeable d, def, instanceWireDescriptor di, instanceReflectDescriptor di ],di)-  where (def,di) = instanceDefault protoName d--instanceReflectDescriptor :: DescriptorInfo -> HsDecl-instanceReflectDescriptor di-    = HsInstDecl src [] (private "ReflectDescriptor") [HsTyCon (UnQual (HsIdent (baseName (descName di))))]-        [ HsInsDecl (HsFunBind [HsMatch src (HsIdent "reflectDescriptorInfo") [ HsPWildCard ] -                                            (HsUnGuardedRhs rdi) noWhere]) ]-  where -- massive shortcut through show and read-        rdi :: HsExp-        rdi = pvar "read" $$ HsLit (HsString (show di))--instanceDefault :: ProtoName -> D.DescriptorProto -> (HsDecl,DescriptorInfo)-instanceDefault protoName (D.DescriptorProto.DescriptorProto-                           { D.DescriptorProto.name = Just name-                           , D.DescriptorProto.field = field })-    = ( HsInstDecl src [] (private "Default") [HsTyCon (unqual name)]-          [ HsInsDecl (HsFunBind [HsMatch src (HsIdent "defaultValue") [] -                                          (HsUnGuardedRhs (foldl' HsApp (HsCon (unqual name)) deflist))-                                  noWhere])]-      , descriptorInfo )-  where len = Seq.length field-        old =  (replicate len (HsCon (private "defaultValue")))-        fieldInfos :: [FieldInfo]-        (deflist,fieldInfos) = unzip (F.foldr ((:) . defX) [] field)-        descriptorInfo = DescriptorInfo protoName (Seq.fromList fieldInfos)--defaultValueExp :: D.FieldDescriptorProto -> (HsExp,FieldInfo)-defaultValueExp  d@(D.FieldDescriptorProto.FieldDescriptorProto-                     { D.FieldDescriptorProto.name = Just rawName-                     , D.FieldDescriptorProto.number = Just number-                     , D.FieldDescriptorProto.label = Just label-                     , D.FieldDescriptorProto.type' = Just type'-                     , D.FieldDescriptorProto.type_name = mayTypeName-                     , D.FieldDescriptorProto.default_value = mayRawDef })-    = ( maybe (HsCon (private "defaultValue")) (HsParen . toSyntax) mayDef-      , fieldInfo )-  where toSyntax :: HsDefault -> HsExp-        toSyntax x = case x of-                       HsDef'Bool b -> HsCon (private (show b))-                       HsDef'ByteString bs -> pvar "pack" $$ HsLit (HsString (BSC.unpack bs))-                       HsDef'Rational r -> HsLit (HsFrac r)-                       HsDef'Integer i -> HsLit (HsInt i)-        mayDef = parseDefaultValue d-        fieldInfo = let fieldId = (FieldId (fromIntegral number))-                        fieldType = (FieldType (fromEnum type'))-                        wireTag = toWireTag fieldId fieldType-                        wireTagLength = size'Varint (getWireTag wireTag)-                    in FieldInfo (U.toString rawName) fieldId wireTag wireTagLength-                                 (label == LABEL_REQUIRED) (label == LABEL_REPEATED)-                                 fieldType-                                 (fmap U.toString mayTypeName) mayRawDef mayDef---- "Nothing" means no value specified--- A failure to parse a provided value will result in an error at the moment-parseDefaultValue :: D.FieldDescriptorProto -> Maybe HsDefault-parseDefaultValue d@(D.FieldDescriptorProto.FieldDescriptorProto-                     { D.FieldDescriptorProto.type' = type'-                     , D.FieldDescriptorProto.default_value = mayDef })-    = do bs <- mayDef-         t <- type'-         todo <- case t of-                   TYPE_MESSAGE -> Nothing-                   TYPE_ENUM    -> Nothing-                   TYPE_GROUP   -> error "<TYPE_GROUP IS UNIMPLEMENTED>"-                   TYPE_BOOL    -> return parseDefBool-                   TYPE_BYTES   -> return parseDefBytes-                   TYPE_DOUBLE  -> return parseDefDouble-                   TYPE_FLOAT   -> return parseDefFloat-                   TYPE_STRING  -> return parseDefString-                   _            -> return parseDefInteger-         case todo bs of-           Nothing -> error ("Could not parse the default value for "++show d)-           Just value -> return value--defX :: D.FieldDescriptorProto -> (HsExp,FieldInfo)-defX d@(D.FieldDescriptorProto.FieldDescriptorProto-         { D.FieldDescriptorProto.name = Just name-         , D.FieldDescriptorProto.label = Just labelEnum-         , D.FieldDescriptorProto.type' = type'-         , D.FieldDescriptorProto.type_name = type_name })-    =  ( HsParen $ case labelEnum of LABEL_OPTIONAL -> HsCon (private "Just") $$ dv-                                     _ -> dv-       , fi )-  where (dv,fi) = defaultValueExp d--instanceMergeable :: D.DescriptorProto -> HsDecl-instanceMergeable (D.DescriptorProto.DescriptorProto-              { D.DescriptorProto.name = Just name-              , D.DescriptorProto.field = field })-    = HsInstDecl src [] (private "Mergeable") [HsTyCon (unqual name)]-        [ HsInsDecl (HsFunBind [HsMatch src (HsIdent "mergeEmpty") [] -                                (HsUnGuardedRhs (foldl' HsApp (HsCon (unqual name)) -                                                              (replicate len (HsCon (private "mergeEmpty")))))-                                noWhere])-        , HsInsDecl (HsFunBind [HsMatch src (HsIdent "mergeAppend") [ HsPApp (unqual name) patternVars1-                                                                    , HsPApp (unqual name) patternVars2]-                                (HsUnGuardedRhs (foldl' HsApp (HsCon (unqual name)) -                                                              (zipWith append vars1 vars2)))-                                 noWhere])-        ]-  where len = Seq.length field-        con = HsCon (qual name)-        patternVars1 :: [HsPat]-        patternVars1 = take len inf-            where inf = map (\n -> HsPVar (HsIdent ("x'" ++ show n))) [1..]-        patternVars2 :: [HsPat]-        patternVars2 = take len inf-            where inf = map (\n -> HsPVar (HsIdent ("y'" ++ show n))) [1..]-        vars1 :: [HsExp]-        vars1 = take len inf-            where inf = map (\n -> lvar ("x'" ++ show n)) [1..]-        vars2 :: [HsExp]-        vars2 = take len inf-            where inf = map (\n -> lvar ("y'" ++ show n)) [1..]-        append x y = HsParen $ pvar "mergeAppend" $$ x $$ y--instanceWireDescriptor :: DescriptorInfo -> HsDecl-instanceWireDescriptor (DescriptorInfo { descName = protoName-                                       , fields = fieldInfos })-  = let myP11 = HsPLit (HsInt 11)-        my11 = HsLit (HsInt 11)-        me = UnQual (HsIdent (baseName protoName))-        mine = HsPApp me . take (Seq.length fieldInfos) . map (\n -> HsPVar (HsIdent ("x'" ++ show n))) $ [1..]-        vars = take (Seq.length fieldInfos) . map (\n -> lvar ("x'" ++ show n)) $ [1..]-        add a b = HsInfixApp a (HsQVarOp (UnQual (HsSymbol "+"))) b-        sizes =  zipWith toSize vars . F.toList $ fieldInfos-        toSize var fi = let f = if isRequired fi then "wireSizeReq"-                                  else if canRepeat fi then "wireSizeRep"-                                      else "wireSizeOpt"-                        in foldl' HsApp (pvar f) [ HsLit (HsInt (toInteger (wireTagLength fi)))-                                                 , HsLit (HsInt (toInteger (getFieldType (typeCode fi))))-                                                 , var]-        putStmts = zipWith toPut vars . F.toList $ fieldInfos-        toPut var fi = let f = if isRequired fi then "wirePutReq"-                                 else if canRepeat fi then "wirePutRep"-                                     else "wirePutOpt"-                       in HsQualifier $-                          foldl' HsApp (pvar f) [ HsLit (HsInt (toInteger (getWireTag (wireTag fi))))-                                                , HsLit (HsInt (toInteger (getFieldType (typeCode fi))))-                                                , var]-        whereUpdateSelf = HsBDecls [HsFunBind [HsMatch src (HsIdent "update'Self")-                            [HsPVar (HsIdent "field'Number") ,HsPVar (HsIdent "old'Self")]-                            (HsUnGuardedRhs (HsCase (lvar "field'Number") updateAlts)) noWhere]]-        updateAlts = map toUpdate (F.toList fieldInfos) ++ [HsAlt src HsPWildCard (HsUnGuardedAlt $-                       pvar "unknownField" $$ (lvar "field'Number")) noWhere]-        toUpdate fi = HsAlt src (HsPLit . HsInt . toInteger . getFieldId . fieldNumber $ fi) (HsUnGuardedAlt $ -                        pvar "fmap" $$ (HsParen $ HsLambda src [HsPVar (HsIdent "new'Field")] $-                                          HsRecUpdate (lvar "old'Self") [HsFieldUpdate (UnQual . HsIdent . fieldName $ fi)-                                                                                       (labelUpdate fi)])-                                    $$ (HsParen (pvar "wireGet" $$ (HsLit . HsInt . toInteger . getFieldType . typeCode $ fi)))) noWhere-        labelUpdate fi | isRequired fi = lvar "new'Field"-                       | canRepeat fi = pvar "append" $$ HsParen ((lvar . fieldName $ fi) $$ lvar "old'Self")-                                                      $$ lvar "new'Field"-                       | otherwise = HsCon (private "Just") $$ lvar "new'Field"--    in HsInstDecl src [] (private "Wire") [HsTyCon me]-        [ HsInsDecl (HsFunBind [HsMatch src (HsIdent "wireSize") [myP11,mine] (HsUnGuardedRhs $-                                  (pvar "lenSize" $$ HsParen (foldl' add (HsLit (HsInt 0)) sizes))) noWhere])-        , HsInsDecl (HsFunBind [HsMatch src (HsIdent "wirePut") [myP11,HsPAsPat (HsIdent "self'") (HsPParen mine)] (HsUnGuardedRhs $-                                  (HsDo ((:) (HsQualifier $-                                              pvar "putSize" $$-                                                (HsParen $ foldl' HsApp (pvar "wireSize") [ my11-                                                                                          , lvar "self'"]))-                                             putStmts))) noWhere])-        , HsInsDecl (HsFunBind [HsMatch src (HsIdent "wireGet") [myP11] (HsUnGuardedRhs $-                                  (pvar "getMessage" $$ lvar "update'Self")-                                  ) whereUpdateSelf])-                                        -        ]----------------------------------------------------------------------derives :: [HsQName]-derives = map private ["Show","Read","Eq","Ord","Data","Typeable"]--useType :: Type -> Maybe String-useType TYPE_DOUBLE   = Just "Double"-useType TYPE_FLOAT    = Just "Float"-useType TYPE_BOOL     = Just "Bool"-useType TYPE_STRING   = Just "ByteString"-useType TYPE_BYTES    = Just "ByteString"-useType TYPE_UINT32   = Just "Word32"-useType TYPE_FIXED32  = Just "Word32"-useType TYPE_UINT64   = Just "Word64"-useType TYPE_FIXED64  = Just "Word64"-useType TYPE_INT32    = Just "Int32"-useType TYPE_SINT32   = Just "Int32"-useType TYPE_SFIXED32 = Just "Int32"-useType TYPE_INT64    = Just "Int64"-useType TYPE_SINT64   = Just "Int64"-useType TYPE_SFIXED64 = Just "Int64"-useType TYPE_MESSAGE  = Nothing-useType TYPE_ENUM     = Nothing-useType TYPE_GROUP    = error "<TYPE_GROUP IS UNIMPLEMENTED>"--noWhere = (HsBDecls [])--test = putStrLn . prettyPrint . descriptorModule "Text" $ d--testDesc =  putStrLn . prettyPrint . descriptorModule "Text" $ genFieldOptions--testLabel = putStrLn . prettyPrint $ enumModule "Text" labelTest-testType = putStrLn . prettyPrint $ enumModule "Text" t---- try and generate a small replacement for my manual file-genFieldOptions :: D.DescriptorProto.DescriptorProto-genFieldOptions =-  defaultValue-  { D.DescriptorProto.name = Just (BSC.pack "DescriptorProtos.FieldOptions") -  , D.DescriptorProto.field = Seq.fromList-    [ defaultValue-      { D.FieldDescriptorProto.name = Just (BSC.pack "ctype")-      , D.FieldDescriptorProto.number = Just 1-      , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL-      , D.FieldDescriptorProto.type' = Just TYPE_ENUM-      , D.FieldDescriptorProto.type_name = Just (BSC.pack "DescriptorProtos.FieldOptions.CType")-      , D.FieldDescriptorProto.default_value = Nothing-      }-    , defaultValue-      { D.FieldDescriptorProto.name = Just (BSC.pack "experimental_map_key")-      , D.FieldDescriptorProto.number = Just 9-      , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL-      , D.FieldDescriptorProto.type' = Just TYPE_STRING-      , D.FieldDescriptorProto.default_value = Nothing-      }-    ]-  }---- test several features-d :: D.DescriptorProto.DescriptorProto-d = defaultValue-    { D.DescriptorProto.name = Just (BSC.pack "SomeMod.ServiceOptions") -    , D.DescriptorProto.field = Seq.fromList-       [ defaultValue-         { D.FieldDescriptorProto.name = Just (BSC.pack "fieldString")-         , D.FieldDescriptorProto.number = Just 1-         , D.FieldDescriptorProto.label = Just LABEL_REQUIRED-         , D.FieldDescriptorProto.type' = Just TYPE_STRING-         , D.FieldDescriptorProto.default_value = Just (BSC.pack "Hello World")-         }-       , defaultValue-         { D.FieldDescriptorProto.name = Just (BSC.pack "fieldDouble")-         , D.FieldDescriptorProto.number = Just 4-         , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL-         , D.FieldDescriptorProto.type' = Just TYPE_DOUBLE-         , D.FieldDescriptorProto.default_value = Just (BSC.pack "+5.5e-10")-        }-       , defaultValue-         { D.FieldDescriptorProto.name = Just (BSC.pack "fieldBytes")-         , D.FieldDescriptorProto.number = Just 2-         , D.FieldDescriptorProto.label = Just LABEL_REQUIRED-         , D.FieldDescriptorProto.type' = Just TYPE_STRING-         , D.FieldDescriptorProto.default_value = Just (BSC.pack . cEncode $ [0,5..255])-        }-       , defaultValue-         { D.FieldDescriptorProto.name = Just (BSC.pack "fieldInt64")-         , D.FieldDescriptorProto.number = Just 3-         , D.FieldDescriptorProto.label = Just LABEL_REQUIRED-         , D.FieldDescriptorProto.type' = Just TYPE_INT64-         , D.FieldDescriptorProto.default_value = Just (BSC.pack "-0x40")-        }-       , defaultValue-         { D.FieldDescriptorProto.name = Just (BSC.pack "fieldBool")-         , D.FieldDescriptorProto.number = Just 5-         , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL-         , D.FieldDescriptorProto.type' = Just TYPE_STRING-         , D.FieldDescriptorProto.default_value = Just (BSC.pack "False")-        }-       , defaultValue-         { D.FieldDescriptorProto.name = Just (BSC.pack "field2TestSelf")-         , D.FieldDescriptorProto.number = Just 6-         , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL-         , D.FieldDescriptorProto.type' = Just TYPE_MESSAGE-         , D.FieldDescriptorProto.type_name = Just (BSC.pack "ServiceOptions")-         }-       , defaultValue-         { D.FieldDescriptorProto.name = Just (BSC.pack "field3TestQualified")-         , D.FieldDescriptorProto.number = Just 7-         , D.FieldDescriptorProto.label = Just LABEL_REPEATED-         , D.FieldDescriptorProto.type' = Just TYPE_MESSAGE-         , D.FieldDescriptorProto.type_name = Just (BSC.pack "A.B.C.Label")-         }-       , defaultValue-         { D.FieldDescriptorProto.name = Just (BSC.pack "field4TestUnqualified")-         , D.FieldDescriptorProto.number = Just 8-         , D.FieldDescriptorProto.label = Just LABEL_REPEATED-         , D.FieldDescriptorProto.type' = Just TYPE_MESSAGE-         , D.FieldDescriptorProto.type_name = Just (BSC.pack "Maybe")-         }-       ]-    }--labelTest :: D.EnumDescriptorProto.EnumDescriptorProto-labelTest = defaultValue-    { D.EnumDescriptorProto.name = Just (BSC.pack "DescriptorProtos.FieldDescriptorProto.Label")-    , D.EnumDescriptorProto.value = Seq.fromList-      [ defaultValue { D.EnumValueDescriptorProto.name = Just (BSC.pack "LABEL_OPTIONAL")-                     , D.EnumValueDescriptorProto.number = Just 1 }-      , defaultValue { D.EnumValueDescriptorProto.name = Just (BSC.pack "LABEL_REQUIRED")-                     , D.EnumValueDescriptorProto.number = Just 2 }-      , defaultValue { D.EnumValueDescriptorProto.name = Just (BSC.pack "LABEL_REPEATED")-                     , D.EnumValueDescriptorProto.number = Just 3 }-      ]-    }--t :: D.EnumDescriptorProto.EnumDescriptorProto-t = defaultValue { D.EnumDescriptorProto.name = Just (BSC.pack "DescriptorProtos.FieldDescriptorProto.Type")-                 , D.EnumDescriptorProto.value = Seq.fromList . zipWith make [1..] $ names }-  where make :: Int32 -> String -> D.EnumValueDescriptorProto-        make i s = defaultValue { D.EnumValueDescriptorProto.name = Just (BSC.pack s)-                                , D.EnumValueDescriptorProto.number = Just i }-        names = ["TYPE_DOUBLE","TYPE_FLOAT","TYPE_INT64","TYPE_UINT64","TYPE_INT32"-                ,"TYPE_FIXED64","TYPE_FIXED32","TYPE_BOOL","TYPE_STRING","TYPE_GROUP"-                ,"TYPE_MESSAGE","TYPE_BYTES","TYPE_UINT32","TYPE_ENUM","TYPE_SFIXED32"-                ,"TYPE_SFIXED64","TYPE_SINT32","TYPE_SINT64"]--- {---- http://haskell.org/onlinereport/lexemes.html#sect2.4--- The .proto parser should have handled this-mangle :: String -> String-mangle s = fromMaybe s (M.lookup s m)-  where m = M.fromAscList . map (\t -> (t,t++"'") $ reserved-        reserved = ["case","class","data","default","deriving","do","else"-                   ,"if","import","in","infix","infixl","infixr","instance"-                   ,"let","module","newtype","of","then","type","where"]--}-
Text/ProtocolBuffers/Get.hs view
@@ -1,46 +1,634 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances-  , TypeSynonymInstances, PatternGuards #-}-module Get where+{-# LANGUAGE CPP,MagicHash,ScopedTypeVariables,FlexibleInstances,RankNTypes #-}+-- | By Chris Kuklewicz, drawing heavily from binary and binary-strict,+-- but all the bugs are my own.+--+-- This file is under the usual BSD3 licence, copyright 2008.+--+-- This started out as an improvement to+-- "Data.Binary.Strict.IncrementalGet" with slightly better internals.+-- The simplified 'Get', 'runGet', 'Result' trio with the+-- "Data.Binary.Strict.Class.BinaryParser" instance are an _untested_+-- upgrade from IncrementalGet.  Especially untested are the+-- strictness properties.+--+-- 'Get' usefully implements Applicative and Monad, MonadError,+-- Alternative and MonadPlus.  Unhandled errors are reported along+-- with the number of bytes successfully consumed.  Effects of+-- 'suspend' and 'putAvailable' are visible after+-- fail/throwError/mzero.+--+-- Each time the parser reaches the end of the input it will return a+-- Partial wrapped continuation which requests a (Maybe+-- Lazy.ByteString).  Passing (Just bs) will append bs to the input so+-- far and continue processing.  If you pass Nothing to the+-- continuation then you are declaring that there will never be more+-- input and that the parser should never again return a partial+-- contination; it should return failure or finished.+--+-- 'suspendUntilComplete' repeatedly uses a partial continuation to+-- ask for more input until Nothing is passed and then it proceeds+-- with parsing.+--+-- The 'getAvailable' command returns the lazy byte string the parser+-- has remaining before calling 'suspend'.  The 'putAvailable'+-- replaces this input and is a bit fancy: it also replaces the input+-- at the current offset for all the potential catchError/mplus+-- handlers.  This change is _not_ reverted by fail/throwError/mzero.+--+-- The three 'lookAhead' and 'lookAheadM' and 'lookAheadE' functions are+-- very similar to the ones in binary's Data.Binary.Get.+--+module Text.ProtocolBuffers.Get+    (Get,runGet,Result(..)+     -- main primitives+    ,ensureBytes,getStorable,getLazyByteString,suspendUntilComplete+     -- parser state manipulation+    ,getAvailable,putAvailable+     -- lookAhead capabilities+    ,lookAhead,lookAheadM,lookAheadE+     -- below is for implementation of BinaryParser (for Int64 and Lazy bytestrings)+    ,skip,bytesRead,isEmpty,isReallyEmpty,remaining,spanOf+    ,getWord8,getByteString+    ,getWord16be,getWord32be,getWord64be+    ,getWord16le,getWord32le,getWord64le+    ,getWordhost,getWord16host,getWord32host,getWord64host+    ) where ---import Text.ProtocolBuffers.Basic-import Data.ByteString.Lazy(ByteString,empty)-import Data.ByteString.Lazy.Char8(pack)-import Data.Sequence(Seq,empty,null)+-- The Get monad is an instance of binary-strict's BinaryParser:+-- import qualified Data.Binary.Strict.Class as P(BinaryParser(..))+-- The Get monad is an instance of all of these library classes:+import Control.Applicative(Applicative(pure,(<*>)),Alternative(empty,(<|>)))+import Control.Monad(MonadPlus(mzero,mplus))+import Control.Monad.Error.Class(MonadError(throwError,catchError),Error(strMsg))+-- It can be a MonadCont, but the semantics are too broken without a ton of work. -data Message = Message { number :: Int-                       , name :: Maybe ByteString -- [ default "Curry" ] in proto file-                       , children :: Seq Message-                       , parent :: Maybe Message }-  deriving (Show)+-- implementation imports+import Control.Monad(ap)                             -- instead of Functor.fmap; ap for Applicative+--import Control.Monad(replicateM,(>=>))               -- XXX testing+import Data.Bits(Bits((.|.)))+import qualified Data.ByteString as S(concat,length,null,splitAt)+--import qualified Data.ByteString as S(unpack) -- XXX testing+import qualified Data.ByteString.Internal as S(ByteString,toForeignPtr,inlinePerformIO)+import qualified Data.ByteString.Unsafe as S(unsafeIndex)+import qualified Data.ByteString.Lazy as L(take,drop,length,span,toChunks,fromChunks,null)+--import qualified Data.ByteString.Lazy as L(pack) -- XXX testing+import qualified Data.ByteString.Lazy.Internal as L(ByteString(..),chunk)+import qualified Data.Foldable as F(foldr,foldr1)    -- used with Seq+import Data.Int(Int64)                               -- index type for L.ByteString+import Data.Monoid(Monoid(mempty,mappend))           -- Writer has a Monoid contraint+import Data.Sequence(Seq,null,(|>))                  -- used for future queue in handler state+import Data.Word(Word,Word8,Word16,Word32,Word64)+import Foreign.ForeignPtr(withForeignPtr)+import Foreign.Ptr(castPtr,plusPtr)+import Foreign.Storable(Storable(peek,sizeOf))+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base(Int(..),uncheckedShiftL#)+import GHC.Word(Word16(..),Word32(..),Word64(..),uncheckedShiftL64#)+#endif -class Default a where defaultValue :: a+-- Simple external return type+data Result a = Failed {-# UNPACK #-} !Int64 String+              | Finished {-# UNPACK #-} !L.ByteString {-# UNPACK #-} !Int64 a+              | Partial (Maybe L.ByteString -> Result a) -class Default a => MessageGetter a b c | a b -> c where-   get :: (a -> b) -> a -> c-   isSet :: (a->b) -> a -> Bool-   isSet _ _ = True -- simplifies all required base types+-- Internal state type, not exposed to the user.+data S = S { top :: {-# UNPACK #-} !S.ByteString+           , current :: {-# UNPACK #-} !L.ByteString+           , consumed :: {-# UNPACK #-} !Int64+           } deriving Show ---When the proto file gives default values put them in this instance-instance Default Message where-    defaultValue = Message defaultValue-                           (Just (pack "Curry"))-                           defaultValue-                           defaultValue+-- Private Internal error handling stack type+-- This must NOT be exposed by this module+--+-- The ErrorFrame is the top-level error handler setup when execution begins.+-- It starts with the Bool set to True: meaning suspend can ask for more input.+-- Once suspend get 'Nothing' in reply the Bool is set to False, which means+-- that 'suspend' should no longer ask for input -- the input is finished.+-- Why store the Bool there?  It was handy when I needed to add it.+data FrameStack b = ErrorFrame (String -> S -> Result b) -- top level handler+                               Bool -- True at start, False if Nothing passed to suspend continuation+                  | HandlerFrame (Maybe ( S -> FrameStack b -> String -> Result b ))  -- encapsulated handler+                                 S  -- stored state to pass to handler+                                 (Seq L.ByteString)  -- additional input to hass to handler+                                 (FrameStack b)  -- earlier/deeper/outer handlers -instance Default a => Default (Maybe a) where defaultValue = Just defaultValue-instance Default (Seq a) where defaultValue = Data.Sequence.empty-instance Default ByteString where defaultValue = Data.ByteString.empty-instance Default Int where defaultValue = 0--- etc for all base type+type Success b a = (a -> S -> FrameStack b -> Result b) -instance MessageGetter Message (Maybe a) a where-   get f m | Just v <- f m = v-           | Just v <- f defaultValue = v-           | otherwise = error "Impossible case of get happened"-   isSet f m = maybe False (const True) (f m)-instance MessageGetter Message (Seq a) (Seq a) where-   get = ($)-   isSet f m = not (Data.Sequence.null (f m))-instance MessageGetter Message Int Int where get = ($)-instance MessageGetter Message ByteString ByteString where get = ($)--- etc for all base types+-- Internal monad type+newtype Get a = Get {+  unGet :: forall b.    -- the forall hides the CPS style (and prevents use of MonadCont)+           Success b a  -- main continuation+        -> S            -- parser state+        -> FrameStack b -- error handler stack+        -> Result b     -- operation+    }++-- These implement the checkponting needed to store and revive the+-- state for lookAhead.  They are fragile because the setCheckpoint+-- must preceed either useCheckpoint or clearCheckpoint but not both.+-- The FutureFrame must be the most recent handler, so the commands+-- must be in the same scope depth.  Because of these constraints, the reader+-- value 'r' does not need to be stored and can be taken from the Get+-- parameter.+--+-- IMPORTANT: Any FutureFrame at the top level(s) is discarded by throwError.+setCheckpoint,useCheckpoint,clearCheckpoint :: Get ()+setCheckpoint = Get $ \ sc s pc -> sc () s (HandlerFrame Nothing s mempty pc)+useCheckpoint = Get $ \ sc (S _ _ _) (HandlerFrame Nothing s future pc) ->+  let (S {top=ss, current=bs, consumed=n}) = collect s future+  in sc () (S ss bs n) pc+clearCheckpoint = Get $ \ sc s (HandlerFrame Nothing _s _future pc) -> sc () s pc++-- | 'lookAhead' runs the @todo@ action and then rewinds only the+-- BinaryParser state.  Any new input from 'suspend' or changes from+-- 'putAvailable' are kept.  Changes to the user state (MonadState)+-- are kept.  The MonadWriter output is retained.+--+-- If an error is thrown then the entire monad state is reset to last+-- catchError as usual.+lookAhead :: Get a -> Get a+lookAhead todo = do+  setCheckpoint+  a <- todo+  useCheckpoint+  return a++-- | 'lookAheadM' runs the @todo@ action. If the action returns 'Nothing' then the +-- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Just' then+-- the BinaryParser is not rewound, and lookAheadM acts as an identity.+--+-- If an error is thrown then the entire monad state is reset to last+-- catchError as usual.+lookAheadM :: Get (Maybe a) -> Get (Maybe a)+lookAheadM todo = do+  setCheckpoint+  a <- todo+  maybe useCheckpoint (\_ -> clearCheckpoint) a+  return a++-- | 'lookAheadE' runs the @todo@ action. If the action returns 'Left' then the +-- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Right' then+-- the BinaryParser is not rewound, and lookAheadE acts as an identity.+--+-- If an error is thrown then the entire monad state is reset to last+-- catchError as usual.+lookAheadE :: Get (Either a b) -> Get (Either a b)+lookAheadE todo = do+  setCheckpoint+  a <- todo+  either (\_ -> useCheckpoint) (\_ -> clearCheckpoint) a+  return a++-- 'collect' is used by 'putCheckpoint' and 'throwError'+collect :: S -> Seq L.ByteString -> S+collect s@(S ss bs n) future | Data.Sequence.null future = s+                             | otherwise = S ss (mappend bs (F.foldr1 mappend future)) n++-- Put the Show instances here++instance (Show a) => Show (Result a) where+  showsPrec _ (Failed n msg) = ("(Failed "++) . shows n . (' ':) . shows msg . (")"++)+  showsPrec _ (Finished bs n a) =+    ("(CFinished ("++) +    . shows bs . (") ("++)+    . shows n . (") ("++) +    . shows a . ("))"++)+  showsPrec _ (Partial {}) = ("(Partial <Maybe Data.ByteString.Lazy.ByteString-> Result a)"++)++instance Show (FrameStack b) where+  showsPrec _ (ErrorFrame _ p) =(++) "(ErrorFrame <e->s->m b> " . shows p . (")"++)+  showsPrec _ (HandlerFrame _ s future pc) = ("(HandlerFrame <> ("++)+                                     . shows s . (") ("++) . shows future . (") ("++)+                                     . shows pc . (")"++)++-- | 'runGet' is the simple executor+runGet :: Get a -> L.ByteString -> Result a+runGet (Get f) bsIn = f scIn sIn (ErrorFrame ec True)+  where scIn a (S ss bs n) _pc = Finished (L.chunk ss bs) n a+        sIn = case bsIn of L.Empty -> S mempty mempty 0+                           L.Chunk ss bs -> S ss bs 0+        ec msg sOut = Failed (consumed sOut) msg++-- | Get the input currently available to the parser.+getAvailable :: Get L.ByteString+getAvailable = Get $ \ sc s@(S ss bs _) pc -> sc (L.chunk ss bs) s pc++-- | 'putAvailable' replaces the bytestream past the current # of read+-- bytes.  This will also affect pending MonadError handler and+-- MonadPlus branches.  I think all pending branches have to have+-- fewer bytesRead than the current one.  If this is wrong then an+-- error will be thrown.+--+-- WARNING : 'putAvailable' is still untested.+putAvailable :: L.ByteString -> Get ()+putAvailable bsNew = Get $ \ sc (S _ss _bs n) pc ->+  let s' = case bsNew of+             L.Empty -> S mempty mempty n+             L.Chunk ss' bs' -> S ss' bs' n+      rebuild (HandlerFrame catcher (S ss1 bs1 n1) future pc') =+               HandlerFrame catcher sNew mempty (rebuild pc')+        where balance = n - n1+              whole | balance < 0 = error "Impossible? Cannot rebuild HandlerFrame in MyGet.putAvailable: balance is negative!"+                    | otherwise = L.take balance $ L.chunk ss1 bs1 `mappend` F.foldr mappend mempty future+              sNew | balance /= L.length whole = error "Impossible? MyGet.putAvailable.rebuild.sNew HandlerFrame assertion failed."+                   | otherwise = case mappend whole bsNew of+                                   L.Empty -> S mempty mempty n1+                                   L.Chunk ss2 bs2 -> S ss2 bs2 n1+      rebuild x@(ErrorFrame {}) = x+  in sc () s' (rebuild pc)++-- Internal access to full internal state, as helepr functions+getFull :: Get S+getFull = Get $ \ sc s pc -> sc s s pc+putFull :: S -> Get ()+putFull s = Get $ \ sc _s pc -> sc () s pc++-- | Keep calling 'suspend' until Nothing is passed to the 'Partial'+-- continuation.  This ensures all the data has been loaded into the+-- state of the parser.+suspendUntilComplete :: Get ()+suspendUntilComplete = do+  continue <- suspend+  if continue then suspendUntilComplete+    else return ()++-- | Call suspend and throw and error with the provided @msg@ if+-- Nothing has been passed to the 'Partial' continuation.  Otherwise+-- return ().+suspendMsg :: String -> Get ()+suspendMsg msg = do continue <- suspend+                    if continue then return ()+                      else throwError msg++-- | check that there are at least @n@ bytes available in the input.+-- This will suspend if there is to little data.+ensureBytes :: Int64 -> Get ()+ensureBytes n = do+  (S ss bs _read) <- getFull+  if n < fromIntegral (S.length ss)+    then return ()+    else do if n == L.length (L.take n (L.chunk ss bs))+              then return ()+              else suspendMsg "ensureBytes failed" >> ensureBytes n+{-# INLINE ensureBytes #-}++-- | Pull @n@ bytes from the unput, as a lazy ByteString.  This will+-- suspend if there is too little data.+getLazyByteString :: Int64 -> Get L.ByteString+getLazyByteString n | n<=0 = return mempty+                    | otherwise = do+  (S ss bs offset) <- getFull+  case splitAtOrDie n (L.chunk ss bs) of+    Just (consume,rest) ->do+       case rest of+         L.Empty -> putFull (S mempty mempty (offset + n))+         L.Chunk ss' bs' -> putFull (S ss' bs' (offset + n))+       return consume+    Nothing -> suspendMsg "getLazyByteString failed" >> getLazyByteString n+{-# INLINE getLazyByteString #-} -- important++-- | 'suspend' is supposed to allow the execution of the monad to be+-- halted, awaiting more input.  The computation is supposed to+-- continue normally if this returns True, and is supposed to halt+-- without calling suspend again if this returns False.  All future+-- calls to suspend will return False automatically and no nothing+-- else.+--+-- These semantics are too specialized to let this escape this module.+class MonadSuspend m where+  suspend :: m Bool++-- The instance here is fairly specific to the stack manipluation done+-- by 'addFuture' to ('S' user) and to the packaging of the resumption+-- function in 'IResult'('IPartial').+instance MonadSuspend Get where+    suspend = Get $ \ sc sIn pcIn ->+      if checkBool pcIn -- Has Nothing ever been given to a partial continuation?+        then let f Nothing = let pcOut = rememberFalse pcIn+                             in sc False sIn pcOut+                 f (Just bs') = let sOut = appendBS sIn bs'+                                    pcOut = addFuture bs' pcIn+                                in sc True sOut pcOut+             in Partial f+        else sc False sIn pcIn  -- once Nothing has been given suspend is a no-op+     where appendBS (S ss bs n) bs' = S ss (mappend bs bs') n+           -- addFuture puts the new data in 'future' where throwError's collect can find and use it+           addFuture bs (HandlerFrame catcher s future pc) =+                         HandlerFrame catcher s (future |> bs) (addFuture bs pc)+           addFuture _bs x@(ErrorFrame {}) = x+           -- Once suspend is given Nothing, it remembers this and always returns False+           checkBool (ErrorFrame _ b) = b+           checkBool (HandlerFrame _ _ _ pc) = checkBool pc+           rememberFalse (ErrorFrame ec _) = ErrorFrame ec False+           rememberFalse (HandlerFrame catcher s future pc) =+                          HandlerFrame catcher s future (rememberFalse pc)+          +-- A unique sort of command...++-- | 'discardInnerHandler' causes the most recent catchError to be+-- discarded, i.e. this reduces the stack of error handlers by removing+-- the top one.  These are the same handlers which Alternative((<|>)) and+-- MonadPlus(mplus) use.  This is useful to commit to the current branch and let+-- the garbage collector release the suspended handler and its hold on+-- the earlier input.+discardInnerHandler :: Get ()+discardInnerHandler = Get $ \ sc s pcIn ->+  let pcOut = case pcIn of ErrorFrame {} -> pcIn+                           HandlerFrame _ _ _ pc' -> pc'+  in sc () s pcOut+{-# INLINE discardInnerHandler #-}++{- Currently unused, commented out to satisfy -Wall++-- | 'discardAllHandlers' causes all catchError handler to be+-- discarded, i.e. this reduces the stack of error handlers to the top+-- level handler.  These are the same handlers which Alternative((<|>))+-- and MonadPlus(mplus) use.  This is useful to commit to the current+-- branch and let the garbage collector release the suspended handlers+-- and their hold on the earlier input.+discardAllHandlers :: Get ()+discardAllHandlers = Get $ \ sc s pcIn ->+  let base pc@(ErrorFrame {}) = pc+      base (HandlerFrame _ _ _ pc) = base pc+  in sc () s (base pcIn)+{-# INLINE discardAllHandlers #-}+-}+-- The BinaryParser instance:++-- | Discard the next @m@ bytes+skip :: Int64 -> Get ()+skip m | m <=0 = return ()+       | otherwise = do+  ensureBytes m+  (S ss bs n) <- getFull+  case L.drop m (L.chunk ss bs) of+    L.Empty -> putFull (S mempty mempty (n+m))+    L.Chunk ss' bs' -> putFull (S ss' bs' (n+m))++-- | Return the number of 'bytesRead' so far.  Initially 0, never negative.+bytesRead :: Get Int64+bytesRead = fmap consumed getFull++-- | Return the number of bytes 'remaining' before the current input+-- runs out and 'suspend' might be called.+remaining :: Get Int64+remaining = do (S ss bs _) <- getFull+               return $ fromIntegral (S.length ss) + (L.length bs)++-- | Return True if the number of bytes 'remaining' is 0.  Any futher+-- attempts to read an empty parser will call 'suspend' which might+-- result in more input to consume.+--+-- Compare with 'isReallyEmpty'+isEmpty :: Get Bool+isEmpty = do (S ss bs _n) <- getFull+             return $ (S.null ss) && (L.null bs)++-- | Return True if the input is exhausted and will never be added to.+-- Returns False if there is input left to consume.+--+-- Compare with 'isEmpty'+isReallyEmpty :: Get Bool+isReallyEmpty = do+  b <- isEmpty+  if not b then return b+    else loop+ where loop = do+         continue <- suspend+         b <- isEmpty+         if not b then return b+           else if continue then loop+                  else return False++spanOf :: (Word8 -> Bool) ->  Get (L.ByteString)+spanOf f = do let loop = do (S ss bs n) <- getFull+                            let (pre,post) = L.span f (L.chunk ss bs)+                            case post of+                              L.Empty -> putFull (S mempty mempty (n + L.length pre))+                              L.Chunk ss' bs' -> putFull (S ss' bs' (n + L.length pre))+                            if L.null post+                              then fmap ((L.toChunks pre)++) $ do+                                     continue <- suspend+                                     if continue then loop+                                       else return (L.toChunks pre)+                              else return (L.toChunks pre)+              fmap L.fromChunks loop+{-# INLINE spanOf #-}++-- | Pull @n@ bytes from the input, as a strict ByteString.  This will+-- suspend if there is too little data.  If the result spans multiple+-- lazy chunks then the result occupies a freshly allocated strict+-- bytestring, otherwise it fits in a single chunk and refers to the+-- same immutable memory block as the whole chunk.+getByteString :: Int -> Get S.ByteString+getByteString nIn | nIn <= 0 = return mempty+                  | otherwise = do+  (S ss bs n) <- getFull+  if nIn < S.length ss+    then do let (pre,post) = S.splitAt nIn ss+            putFull (S post bs (n+fromIntegral nIn))+            return pre+    -- Expect nIn to be less than S.length ss the vast majority of times+    -- so do not worry about doing anything fancy here.+    else fmap (S.concat . L.toChunks) (getLazyByteString (fromIntegral nIn))+{-# INLINE getByteString #-} -- important++getWordhost :: Get Word+getWordhost = getStorable+{-# INLINE getWordhost #-}++getWord8 :: Get Word8+getWord8 = getPtr 1+{-# INLINE getWord8 #-}++getWord16be,getWord16le,getWord16host :: Get Word16+getWord16be = do+    s <- getByteString 2+    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w16` 8) .|.+              (fromIntegral (s `S.unsafeIndex` 1))+{-# INLINE getWord16be #-}+getWord16le = do+    s <- getByteString 2+    return $! (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w16` 8) .|.+              (fromIntegral (s `S.unsafeIndex` 0) )+{-# INLINE getWord16le #-}+getWord16host = getStorable+{-# INLINE getWord16host #-}++getWord32be,getWord32le,getWord32host :: Get Word32+getWord32be = do+    s <- getByteString 4+    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w32` 24) .|.+              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w32` 16) .|.+              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w32`  8) .|.+              (fromIntegral (s `S.unsafeIndex` 3) )+{-# INLINE getWord32be #-}+getWord32le = do+    s <- getByteString 4+    return $! (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w32` 24) .|.+              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w32` 16) .|.+              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w32`  8) .|.+              (fromIntegral (s `S.unsafeIndex` 0) )+{-# INLINE getWord32le #-}+getWord32host = getStorable+{-# INLINE getWord32host #-}+++getWord64be,getWord64le,getWord64host :: Get Word64+getWord64be = do+    s <- getByteString 8+    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w64` 56) .|.+              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w64` 48) .|.+              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w64` 40) .|.+              (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w64` 32) .|.+              (fromIntegral (s `S.unsafeIndex` 4) `shiftl_w64` 24) .|.+              (fromIntegral (s `S.unsafeIndex` 5) `shiftl_w64` 16) .|.+              (fromIntegral (s `S.unsafeIndex` 6) `shiftl_w64`  8) .|.+              (fromIntegral (s `S.unsafeIndex` 7) )+{-# INLINE getWord64be #-}+getWord64le = do+    s <- getByteString 8+    return $! (fromIntegral (s `S.unsafeIndex` 7) `shiftl_w64` 56) .|.+              (fromIntegral (s `S.unsafeIndex` 6) `shiftl_w64` 48) .|.+              (fromIntegral (s `S.unsafeIndex` 5) `shiftl_w64` 40) .|.+              (fromIntegral (s `S.unsafeIndex` 4) `shiftl_w64` 32) .|.+              (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w64` 24) .|.+              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w64` 16) .|.+              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w64`  8) .|.+              (fromIntegral (s `S.unsafeIndex` 0) )+{-# INLINE getWord64le #-}+getWord64host = getStorable+{-# INLINE getWord64host #-}++{-++-- I no longer include the binary-strict package, but if one wants it+-- here is the instance:++instance P.BinaryParser Get where+  skip = skip . fromIntegral+  bytesRead = fmap fromIntegral bytesRead+  remaining = fmap fromIntegral remaining+  isEmpty = isEmpty+  spanOf = fmap (S.concat . L.toChunks) . spanOf++  getByteString = getByteString+  getWordhost = getWordhost+  getWord8 = getWord8++  getWord16be = getWord16be+  getWord32be = getWord32be+  getWord64be = getWord64be++  getWord16le = getWord16le+  getWord32le = getWord32le+  getWord64le = getWord64le++  getWord16host = getWord16host+  getWord32host = getWord32host+  getWord64host = getWord64host+-}++-- Below here are the class instances+    +instance Functor Get where+  fmap f m = Get (\sc -> unGet m (sc . f))+  {-# INLINE fmap #-}++instance Monad Get where+  return a = Get (\sc -> sc a)+  {-# INLINE return #-}+  m >>= k  = Get (\sc -> unGet m (\a -> unGet (k a) sc))+  {-# INLINE (>>=) #-}+  fail msg = throwError (strMsg msg)++instance MonadError String Get where+  throwError msg = Get $ \_sc  s pcIn ->+    let go (ErrorFrame ec _) = ec msg s+        go (HandlerFrame (Just catcher) s1 future pc1) = catcher (collect s1 future) pc1 msg+        go (HandlerFrame Nothing _s1 _future pc1) = go pc1+    in go pcIn++  catchError mayFail handler = Get $ \sc s pc ->+    let pcWithHandler = let catcher s1 pc1 e1 = unGet (handler e1) sc s1 pc1+                        in HandlerFrame (Just catcher) s mempty pc+        actionWithCleanup = mayFail >>= \a -> discardInnerHandler >> return a+    in unGet actionWithCleanup sc s pcWithHandler++instance MonadPlus Get where+  mzero = throwError (strMsg "[mzero:no message]")+  mplus m1 m2 = catchError m1 (const m2)++instance Applicative Get where+  pure = return+  (<*>) = ap++instance Alternative Get where+  empty = mzero+  (<|>) = mplus++-- | I use "splitAt" without tolerating too few bytes, so write a Maybe version.+-- This is the only place I invoke L.Chunk as constructor instead of pattern matching.+-- I claim that the first argument cannot be empty.+splitAtOrDie :: Int64 -> L.ByteString -> Maybe (L.ByteString, L.ByteString)+splitAtOrDie i ps | i <= 0 = Just (L.Empty, ps)+splitAtOrDie _i L.Empty = Nothing+splitAtOrDie i (L.Chunk x xs) | i < len = let (pre,post) = S.splitAt (fromIntegral i) x+                                          in Just (L.Chunk pre L.Empty+                                                  ,L.Chunk post xs)+                              | otherwise = case splitAtOrDie (i-len) xs of+                                              Nothing -> Nothing+                                              Just (y1,y2) -> Just (L.Chunk x y1,y2)+  where len = fromIntegral (S.length x)+{-# INLINE splitAtOrDie #-}++------------------------------------------------------------------------+-- getPtr copied from binary's Get.hs++-- helper, get a raw Ptr onto a strict ByteString copied out of the+-- underlying lazy byteString. So many indirections from the raw parser+-- state that my head hurts...++getPtr :: (Storable a) => Int -> Get a+getPtr n = do+    (fp,o,_) <- fmap S.toForeignPtr (getByteString n)+    return . S.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)+{-# INLINE getPtr #-}++-- I pushed the sizeOf into here (uses ScopedTypeVariables)+getStorable :: forall a. (Storable a) => Get a+getStorable = do+    (fp,o,_) <- fmap S.toForeignPtr (getByteString (sizeOf (undefined :: a)))+    return . S.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)+{-# INLINE getStorable #-}++------------------------------------------------------------------------+------------------------------------------------------------------------+-- Unchecked shifts copied from binary's Get.hs++shiftl_w16 :: Word16 -> Int -> Word16+shiftl_w32 :: Word32 -> Int -> Word32+shiftl_w64 :: Word64 -> Int -> Word64++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#`   i)+shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#`   i)++#if WORD_SIZE_IN_BITS < 64+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)++#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftL64"+    uncheckedShiftL64#     :: Word64# -> Int# -> Word64#+#endif++#else+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)+#endif++#else+shiftl_w16 = shiftL+shiftl_w32 = shiftL+shiftl_w64 = shiftL+#endif
Text/ProtocolBuffers/Header.hs view
@@ -1,6 +1,6 @@--- This provides much that is needed for the output of Gen.hs to compile against.--- It will be imported qualified as P'--- The prime ensuring no name conflicts are possible.+-- | 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. module Text.ProtocolBuffers.Header     ( -- needed for Gen.hs output       emptyBS@@ -10,44 +10,32 @@     , module Data.Generics     , module Data.Typeable     , module Text.ProtocolBuffers.Basic-    , module Text.ProtocolBuffers.Default-    , module Text.ProtocolBuffers.Mergeable+    , module Text.ProtocolBuffers.Extensions     , module Text.ProtocolBuffers.Reflections     , module Text.ProtocolBuffers.WireMessage-    -- deprecated below-    , module Data.Monoid-    , module Data.DeriveTH-    , module Text.ProtocolBuffers.DeriveMergeable     ) where  import Control.Monad(ap) import Data.ByteString.Lazy(empty) import Data.ByteString.Lazy.Char8(pack)-import Data.Dynamic(Dynamic) import Data.Generics(Data(..))-import Data.Monoid(Monoid(..))+import Data.Sequence((|>)) -- for append, see below import Data.Typeable(Typeable(..))  import Text.ProtocolBuffers.Basic -- all-import Text.ProtocolBuffers.Default(Default(..))-import Text.ProtocolBuffers.Mergeable(Mergeable(..))-import Text.ProtocolBuffers.Reflections(ReflectDescriptor(..),ReflectEnum(..),EnumInfo(..),ProtoName(..))-import Text.ProtocolBuffers.WireMessage(Wire(..)-                                       , size,lenSize,putSize+import Text.ProtocolBuffers.Default()+import Text.ProtocolBuffers.Extensions(wireSizeExtField,wirePutExtField,GPB,getMessageExt,getBareMessageExt,Key(..),ExtField,ExtendMessage(..),MessageAPI(..),ExtKey(wireGetKey))+import Text.ProtocolBuffers.Mergeable()+import Text.ProtocolBuffers.Reflections(ReflectDescriptor(..),ReflectEnum(..),EnumInfo(..),ProtoName(..),DescriptorInfo(extRanges))+import Text.ProtocolBuffers.WireMessage( prependMessageSize,putSize                                        , wireSizeReq,wireSizeOpt,wireSizeRep                                        , wirePutReq,wirePutOpt,wirePutRep                                        , getMessage,getBareMessage+                                       , wireSizeErr,wirePutErr,wireGetErr                                        , unknownField)-import Data.Sequence((|>)) --- deprecated imports-import Data.DeriveTH-import Text.ProtocolBuffers.DeriveMergeable(makeMergeable,makeMergeableEnum)-- append :: Seq a -> a -> Seq a append = (|>)  emptyBS :: ByteString emptyBS = Data.ByteString.Lazy.empty-
− Text/ProtocolBuffers/Instances.hs 
@@ -1,79 +0,0 @@-module Text.ProtocolBuffers.Instances(showsType,parseType,showsLabel,parseLabel) where--import Text.ParserCombinators.ReadP-import Text.DescriptorProtos.FieldDescriptorProto.Type(Type(..))-import Text.DescriptorProtos.FieldDescriptorProto.Label(Label(..))--{--instance Show Type where-  showsPrec _ = showsType--instance Read Type where-  readsPrec _ = readP_to_S readType--}--showsLabel :: Label -> ShowS-showsLabel LABEL_OPTIONAL s = "optional" ++ s-showsLabel LABEL_REQUIRED s = "required" ++ s-showsLabel LABEL_REPEATED s = "repeated" ++ s--showsType :: Type -> ShowS-showsType TYPE_DOUBLE s = "double" ++ s-showsType TYPE_FLOAT s = "float" ++ s-showsType TYPE_INT64 s = "int64" ++ s-showsType TYPE_UINT64 s = "uint64" ++ s-showsType TYPE_INT32  s = "int32" ++ s-showsType TYPE_FIXED64 s = "fixed64" ++ s-showsType TYPE_FIXED32 s = "fixed32" ++ s-showsType TYPE_BOOL s = "bool" ++ s-showsType TYPE_STRING s = "string" ++ s-showsType TYPE_GROUP s = "group" ++ s-showsType TYPE_MESSAGE s = "message" ++ s-showsType TYPE_BYTES s = "bytes" ++ s-showsType TYPE_UINT32 s = "uint32" ++ s-showsType TYPE_ENUM s = "enum" ++ s-showsType TYPE_SFIXED32 s = "sfixed32" ++ s-showsType TYPE_SFIXED64 s = "sfixed64" ++ s-showsType TYPE_SINT32 s = "sint32" ++ s-showsType TYPE_SINT64 s = "sint64" ++ s--parseType :: String -> Maybe Type-parseType s = case readP_to_S readType s of-                [(val,[])] -> Just val-                _ -> Nothing--parseLabel :: String -> Maybe Label-parseLabel s = case readP_to_S readLabel s of-                [(val,[])] -> Just val-                _ -> Nothing--readLabel :: ReadP Label-readLabel = choice [ return LABEL_OPTIONAL << string "optional"-                   , return LABEL_REQUIRED << string "required"-                   , return LABEL_REPEATED << string "repeated"-                   ]--readType :: ReadP Type-readType = choice [ return TYPE_DOUBLE << string "double"-                  , return TYPE_FLOAT << string "float"-                  , return TYPE_INT64 << string "int64"-                  , return TYPE_UINT64 << string "uint64"-                  , return TYPE_INT32  << string "int32"-                  , return TYPE_FIXED64 << string "fixed64"-                  , return TYPE_FIXED32 << string "fixed32"-                  , return TYPE_BOOL << string "bool"-                  , return TYPE_STRING << string "string"-                  , return TYPE_GROUP << string "group"-                  , return TYPE_MESSAGE << string "message"-                  , return TYPE_BYTES << string "bytes"-                  , return TYPE_UINT32 << string "uint32"-                  , return TYPE_ENUM << string "enum"-                  , return TYPE_SFIXED32 << string "sfixed32"-                  , return TYPE_SFIXED64 << string "sfixed64"-                  , return TYPE_SINT32 << string "sint32"-                  , return TYPE_SINT64 << string "sint64"-                  ]--(<<) :: Monad m => m a -> m b -> m a-(<<) = flip (>>)-
− Text/ProtocolBuffers/Lexer.hs 
@@ -1,443 +0,0 @@-{-# OPTIONS -cpp #-}-{-# LINE 1 "Text/ProtocolBuffers/Lexer.x" #-}--module Text.ProtocolBuffers.Lexer (Lexed(..), alexScanTokens,getLinePos)  where--import Control.Monad.Error()-import Codec.Binary.UTF8.String(encode)-import qualified Data.ByteString.Lazy as L-import Data.Char(ord,chr,isHexDigit,isOctDigit,toLower)-import Data.List(sort,unfoldr)-import Data.Word(Word8)-import Numeric(readHex,readOct,readDec,showOct,readSigned,readFloat)---#if __GLASGOW_HASKELL__ >= 603-#include "ghcconfig.h"-#elif defined(__GLASGOW_HASKELL__)-#include "config.h"-#endif-#if __GLASGOW_HASKELL__ >= 503-import Data.Array-import Data.Char (ord)-import Data.Array.Base (unsafeAt)-#else-import Array-import Char (ord)-#endif-{-# LINE 1 "templates/wrappers.hs" #-}-{-# LINE 1 "templates/wrappers.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command line>" #-}-{-# LINE 1 "templates/wrappers.hs" #-}--- -------------------------------------------------------------------------------- Alex wrapper code.------ This code is in the PUBLIC DOMAIN; you may copy it freely and use--- it for any purpose whatsoever.----import qualified Data.ByteString.Lazy.Char8 as ByteString------ -------------------------------------------------------------------------------- The input type--{-# LINE 29 "templates/wrappers.hs" #-}---type AlexInput = (AlexPosn, 	-- current position,-		  Char,		-- previous char-		  ByteString.ByteString)	-- current input string--alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar (p,c,s) = c--alexGetChar :: AlexInput -> Maybe (Char,AlexInput)-alexGetChar (p,_,cs) | ByteString.null cs = Nothing-                     | otherwise = let c   = ByteString.head cs-                                       cs' = ByteString.tail cs-                                       p'  = alexMove p c-                                    in p' `seq` cs' `seq` Just (c, (p', c, cs'))----- -------------------------------------------------------------------------------- Token positions---- `Posn' records the location of a token in the input text.  It has three--- fields: the address (number of chacaters preceding the token), line number--- and column of a token within the file. `start_pos' gives the position of the--- start of the file and `eof_pos' a standard encoding for the end of file.--- `move_pos' calculates the new position after traversing a given character,--- assuming the usual eight character tab stops.---data AlexPosn = AlexPn !Int !Int !Int-	deriving (Eq,Show)--alexStartPos :: AlexPosn-alexStartPos = AlexPn 0 1 1--alexMove :: AlexPosn -> Char -> AlexPosn-alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+7) `div` 8)*8+1)-alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1)   1-alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)----- -------------------------------------------------------------------------------- Default monad--{-# LINE 150 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Monad (with ByteString input)--{-# LINE 233 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper--{-# LINE 255 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper, ByteString version--{-# LINE 277 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper---- Adds text positions to the basic model.--{-# LINE 294 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper, ByteString version-----alexScanTokens :: ByteString -> [token]-alexScanTokens str = go (alexStartPos,'\n',str)-  where go inp@(pos,_,str) =-          case alexScan inp 0 of-                AlexEOF -> []-                AlexError _ -> error "lexical error"-                AlexSkip  inp' len     -> go inp'-                AlexToken inp' len act -> act pos (ByteString.take (fromIntegral len) str) : go inp'------ -------------------------------------------------------------------------------- GScan wrapper---- For compatibility with previous versions of Alex, and because we can.--alex_base :: Array Int Int-alex_base = listArray (0,71) [-8,-3,2,109,6,7,-24,9,10,12,42,46,106,77,108,133,118,170,0,247,269,323,377,0,452,475,536,0,613,623,143,257,345,355,677,0,0,137,327,329,343,800,823,879,344,903,950,972,996,1018,346,330,331,1029,1090,1101,381,1163,1174,1185,1196,1231,537,1259,1336,1413,1490,1567,1625,1683,0,0]--alex_table :: Array Int Int-alex_table = listArray (0,1938) [0,3,2,3,3,3,2,2,2,2,2,2,2,2,2,2,-1,-1,10,-1,-1,0,-1,4,3,0,51,7,0,2,0,39,70,70,2,0,70,16,68,6,20,14,14,14,14,14,14,14,14,14,0,70,-1,70,12,0,-1,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,70,12,70,0,64,12,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,70,-1,70,2,2,2,2,2,31,0,15,15,15,15,15,15,15,15,15,15,0,0,-1,0,0,0,2,0,0,0,0,32,-1,12,0,0,0,0,9,31,0,15,15,15,15,15,15,15,15,15,15,19,13,13,13,13,13,13,13,13,13,36,32,32,31,-1,15,15,15,15,15,15,15,15,15,15,30,30,30,30,30,30,30,30,30,30,0,32,0,0,0,0,0,0,32,0,0,0,0,0,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,42,0,0,0,0,32,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,-1,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,31,0,21,21,21,21,21,21,21,21,28,28,29,29,29,29,29,29,29,29,29,29,31,32,21,21,21,21,21,21,21,21,28,28,-1,0,-1,-1,-1,0,0,0,25,0,-1,32,-1,-1,-1,0,-1,-1,0,-1,0,32,0,0,0,0,-1,-1,0,-1,25,0,0,0,36,0,0,36,36,0,25,36,31,32,21,21,21,21,21,21,21,21,28,28,-1,36,36,0,36,0,-1,33,25,33,-1,32,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,0,0,36,0,0,0,54,0,42,54,54,32,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,42,42,0,42,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,-1,54,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,24,24,24,24,24,24,24,24,24,24,0,0,0,0,0,0,0,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,0,0,0,0,-1,0,0,24,24,24,24,24,24,-1,-1,0,24,24,24,24,24,24,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,36,24,24,24,24,24,24,0,0,0,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,54,0,-1,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,31,0,28,28,28,28,28,28,28,28,28,28,29,29,29,29,29,29,29,29,29,29,0,32,0,0,0,0,-1,0,0,0,0,32,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32,0,0,0,0,0,0,0,0,0,32,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,-1,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,36,0,0,0,0,0,0,0,0,43,43,43,43,43,43,43,43,43,43,0,0,0,0,37,0,0,43,43,43,43,43,43,45,46,46,46,46,46,46,46,-1,0,0,0,0,0,0,0,0,0,-1,0,0,42,0,0,0,0,43,43,43,43,43,43,-1,0,0,0,0,0,0,0,41,0,-1,0,42,0,0,36,0,0,0,0,0,0,0,0,44,44,44,44,44,44,44,44,44,44,0,0,0,0,0,36,41,44,44,44,44,44,44,-1,47,47,47,47,47,47,47,47,0,-1,0,0,0,0,0,0,0,0,0,0,42,-1,0,0,0,44,44,44,44,44,44,-1,0,0,0,0,0,0,36,0,0,0,0,0,42,-1,0,48,48,48,48,48,48,48,48,-1,0,0,0,0,36,0,0,0,0,0,0,-1,0,49,49,49,49,49,49,49,49,-1,-1,0,0,0,0,0,36,0,0,0,-1,0,0,42,0,50,50,50,50,50,50,50,50,0,0,0,0,0,36,0,0,0,0,0,36,42,0,50,50,50,50,50,50,50,50,0,0,0,55,55,55,55,55,55,55,55,55,55,0,42,0,-1,0,0,0,55,55,55,55,55,55,-1,-1,0,0,0,0,0,0,0,0,42,-1,0,0,0,0,0,0,0,0,0,54,0,0,38,0,55,55,55,55,55,55,0,0,0,36,0,0,57,58,58,58,58,58,58,58,0,0,0,56,56,56,56,56,56,56,56,56,56,0,0,0,0,-1,0,0,56,56,56,56,56,56,0,-1,-1,0,0,0,53,0,0,0,54,0,-1,-1,0,0,0,0,0,0,0,54,0,-1,-1,36,56,56,56,56,56,56,0,0,-1,0,36,0,53,59,59,59,59,59,59,59,59,36,0,0,60,60,60,60,60,60,60,60,36,-1,0,61,61,61,61,61,61,61,61,-1,0,0,62,62,62,62,62,62,62,62,0,0,0,54,0,0,0,0,0,0,0,0,0,36,54,0,0,0,0,0,0,0,0,0,0,54,0,62,62,62,62,62,62,62,62,0,54,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,69,0,65,65,65,65,65,65,65,65,65,65,0,0,0,0,0,0,54,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,0,0,0,0,65,0,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,69,0,65,65,65,65,65,65,65,65,65,65,0,0,0,0,0,0,0,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,0,0,0,0,65,0,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,69,0,65,65,65,65,65,65,65,65,65,65,0,0,0,0,0,0,0,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,0,0,0,0,65,0,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,65,69,0,67,67,67,67,67,67,67,67,67,67,0,0,0,0,0,0,0,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,0,0,0,0,67,0,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,69,0,67,67,67,67,67,67,67,67,67,67,0,0,0,0,0,0,0,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,0,0,0,0,67,0,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,0,0,0,0,63,0,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,0,0,0,0,66,0,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]--alex_check :: Array Int Int-alex_check = listArray (0,1938) [-1,9,10,11,12,13,9,10,11,12,13,9,10,11,12,13,10,10,42,10,10,-1,10,47,32,-1,34,35,-1,32,-1,39,40,41,32,-1,44,45,46,47,48,49,50,51,52,53,54,55,56,57,-1,59,10,61,42,-1,10,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,42,93,-1,95,42,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,10,125,9,10,11,12,13,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,0,-1,-1,-1,32,-1,-1,-1,-1,69,10,42,-1,-1,-1,-1,47,46,-1,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,39,69,101,46,10,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,-1,69,-1,-1,-1,-1,-1,-1,101,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,92,-1,-1,-1,-1,101,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,46,69,48,49,50,51,52,53,54,55,56,57,0,-1,0,0,0,-1,-1,-1,88,-1,10,69,10,10,10,-1,0,0,-1,0,-1,101,-1,-1,-1,-1,10,10,-1,10,88,-1,-1,-1,34,-1,-1,34,34,-1,120,39,46,101,48,49,50,51,52,53,54,55,56,57,0,39,39,-1,39,-1,10,43,120,45,10,69,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,-1,-1,34,-1,-1,-1,92,-1,92,92,92,101,48,49,50,51,52,53,54,55,56,57,92,92,-1,92,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,92,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,0,-1,-1,65,66,67,68,69,70,10,10,-1,97,98,99,100,101,102,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,97,98,99,100,101,102,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,92,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,-1,69,-1,-1,-1,-1,10,-1,-1,-1,-1,69,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,101,-1,-1,-1,-1,-1,-1,-1,-1,-1,101,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,39,-1,-1,65,66,67,68,69,70,48,49,50,51,52,53,54,55,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,92,-1,-1,-1,-1,97,98,99,100,101,102,0,-1,-1,-1,-1,-1,-1,-1,88,-1,10,-1,92,-1,-1,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,39,120,65,66,67,68,69,70,0,48,49,50,51,52,53,54,55,-1,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,92,0,-1,-1,-1,97,98,99,100,101,102,10,-1,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,92,0,-1,48,49,50,51,52,53,54,55,10,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,-1,0,-1,48,49,50,51,52,53,54,55,10,0,-1,-1,-1,-1,-1,39,-1,-1,-1,10,-1,-1,92,-1,48,49,50,51,52,53,54,55,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,34,92,-1,48,49,50,51,52,53,54,55,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,92,-1,0,-1,-1,-1,65,66,67,68,69,70,10,0,-1,-1,-1,-1,-1,-1,-1,-1,92,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,92,-1,-1,34,-1,97,98,99,100,101,102,-1,-1,-1,34,-1,-1,48,49,50,51,52,53,54,55,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,0,-1,-1,65,66,67,68,69,70,-1,10,0,-1,-1,-1,88,-1,-1,-1,92,-1,10,0,-1,-1,-1,-1,-1,-1,-1,92,-1,10,0,34,97,98,99,100,101,102,-1,-1,10,-1,34,-1,120,48,49,50,51,52,53,54,55,34,-1,-1,48,49,50,51,52,53,54,55,34,0,-1,48,49,50,51,52,53,54,55,10,-1,-1,48,49,50,51,52,53,54,55,-1,-1,-1,92,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,92,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,92,-1,48,49,50,51,52,53,54,55,-1,92,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,92,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]--alex_deflt :: Array Int Int-alex_deflt = listArray (0,71) [71,-1,-1,-1,5,5,-1,8,8,11,11,11,11,-1,-1,-1,-1,18,-1,-1,-1,-1,23,-1,-1,-1,27,-1,-1,-1,-1,-1,-1,-1,35,-1,-1,40,52,40,40,40,40,40,40,40,40,40,40,40,40,52,52,52,52,52,52,52,52,52,52,52,52,-1,-1,-1,-1,-1,-1,-1,-1,-1]--alex_accept = listArray (0::Int,71) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_15))],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[(AlexAccPred  (alex_action_4) (alexRightContext 17)),(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_8))],[(AlexAccPred  (alex_action_4) (alexRightContext 17)),(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_8))],[(AlexAccPred  (alex_action_4) (alexRightContext 17)),(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_15))],[],[(AlexAccSkip)],[(AlexAccPred  (alex_action_5) (alexRightContext 22)),(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_9))],[(AlexAccPred  (alex_action_5) (alexRightContext 22)),(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_9))],[(AlexAccPred  (alex_action_5) (alexRightContext 22)),(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_9))],[],[(AlexAccSkip)],[(AlexAccPred  (alex_action_6) (alexRightContext 26)),(AlexAcc (alex_action_10))],[],[],[(AlexAccSkip)],[(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_11))],[(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_11))],[(AlexAccPred  (alex_action_7) (alexRightContext 34)),(AlexAcc (alex_action_11))],[],[],[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_15))],[],[],[],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_15))],[],[],[],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_15))],[],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_15))]]-{-# LINE 53 "Text/ProtocolBuffers/Lexer.x" #-}--line :: AlexPosn -> Int-line (AlexPn _byte line' _col) = line'-{-# INLINE line #-}--data Lexed = L_Integer !Int !Integer-           | L_Double !Int !Double-           | L_Name !Int !L.ByteString-           | L_String !Int !L.ByteString-           | L !Int !Char-           | L_Error !Int !String-  deriving (Show,Eq)--getLinePos :: Lexed -> Int-getLinePos x = case x of-                 L_Integer i _ -> i-                 L_Double  i _ -> i-                 L_Name    i _ -> i-                 L_String  i _ -> i-                 L         i _ -> i-                 L_Error   i _ -> i---- 'errAt' is the only access to L_Error, so I can see where it is created with pos-errAt pos msg =  L_Error (line pos) $ "Lexical error (in Text.ProtocolBuffers.Lexer): "++ msg ++ ", at "++see pos where-  see (AlexPn char line col) = "character "++show char++" line "++show line++" column "++show col++"."-dieAt msg pos _s = errAt pos msg-wtfAt pos s = errAt pos $ "unknown character "++show c++" (decimal "++show (ord c)++")"-  where (c:_) = ByteString.unpack s--{-# INLINE mayRead #-}-mayRead :: ReadS a -> String -> Maybe a-mayRead f s = case f s of [(a,"")] -> Just a; _ -> Nothing---- Given the regexps above, the "parse* failed" messages should be impossible.-parseDec pos s = maybe (errAt pos "parseDec failed") (L_Integer (line pos)) $ mayRead (readSigned readDec) (ByteString.unpack s)-parseOct pos s = maybe (errAt pos "parseOct failed") (L_Integer (line pos)) $ mayRead (readSigned readOct) (ByteString.unpack s)-parseHex pos s = maybe (errAt pos "parseHex failed") (L_Integer (line pos)) $ mayRead (readSigned (readHex . drop 2)) (ByteString.unpack s)-parseDouble pos s = maybe (errAt pos "parseDouble failed") (L_Double (line pos)) $ mayRead (readSigned readFloat) (ByteString.unpack s)-parseStr pos s = either (errAt pos) (L_String (line pos) . L.pack) $ sDecode . ByteString.unpack $ (ByteString.init (ByteString.tail s))-parseName pos s = L_Name (line pos) s-parseChar pos s = L (line pos) (ByteString.head s)---- Generalization of concat . unfoldr to monadic-Either form:-op :: ( [Char] -> Either String (Maybe ([Word8],[Char]))) -> [Char] -> Either String [Word8]-op one = go id where-  go f cs = case one cs of-              Left msg -> Left msg-              Right Nothing -> Right (f [])-              Right (Just (ws,cs)) -> go (f . (ws++)) cs---- Put this mess in the lexer, so the rest of the code can assume--- everything is saner.  The input is checked to really be "Char8"--- values in the range [0..255] and to be c-escaped (in order to--- render binary information printable).  This decodes the c-escaping--- and returns the binary data as Word8.--- --- A decoding error causes (Left msg) to be returned.-sDecode :: [Char] -> Either String [Word8]-sDecode = op one where-  one :: [Char] -> Either String (Maybe ([Word8],[Char]))-  one (x:xs) | x /= '\\' = do x' <- checkChar8 x-                              return $ Just (x',xs)  -- main case of unescaped value-  one [] = return Nothing-  one ('\\':[]) = Left "cannot understand a string that ends with a backslash"-  one ('\\':'0':ys) = return $ Just ([0],ys)-  one ('\\':ys) | 1 <= len =-      case mayRead readOct oct of-        Just w -> do w' <- checkByte w-                     return $ Just (w',rest)-        Nothing -> Left $ "failed to decode octal sequence "++ys-    where oct = takeWhile isOctDigit (take 3 ys)-          len = length oct-          rest = drop len ys-  one ('\\':x:ys) | 'x' == toLower x && 1 <= len =-      case mayRead readHex hex of-        Just w -> do w' <- checkByte w-                     return $ Just (w',rest)-        Nothing -> Left $ "failed to decode hex sequence "++ys-    where hex = takeWhile isHexDigit (take 2 ys)-          len = length hex-          rest = drop len ys          -  one ('\\':'u':ys) | ok =-      case mayRead readHex hex of-        Just w -> do w' <- checkUnicode w-                     return $ Just (w',rest)-        Nothing -> Left $ "failed to decode 4 char unicode sequence "++ys-    where ok = all isHexDigit hex && 4 == length hex-          (hex,rest) = splitAt 4 ys-  one ('\\':'U':ys) | ok =-      case mayRead readHex hex of-        Just w -> do w' <- checkUnicode w-                     return $ Just (w',rest)-        Nothing -> Left $ "failed to decode 8 char unicode sequence "++ys-    where ok = all isHexDigit hex && 8 == length hex-          (hex,rest) = splitAt 8 ys-  one ('\\':(x:xs)) = do x' <- decode x-                         return $ Just ([x'],xs)-  decode :: Char -> Either String Word8-  decode 'a' = return 7-  decode 'b' = return 8-  decode 't' = return 9-  decode 'n' = return 10-  decode 'v' = return 11-  decode 'f' = return 12-  decode 'r' = return 13-  decode '\"' = return 34-  decode '\'' = return 39-  decode '?' = return 63    -- C99 rule : "\?" is '?'-  decode '\\' = return 92-  decode x | toLower x == 'x' = Left "cannot understand your 'xX' hexadecimal escaped value"-  decode x | toLower x == 'u' = Left "cannot understand your 'uU' unicode UTF-8 hexadecimal escaped value"-  decode _ = Left "cannot understand your backslash-escaped value"-  checkChar8 :: Char -> Either String [Word8]-  checkChar8 c | (0 <= i) && (i <= 255) = Right [toEnum i]-               | otherwise = Left $ "found Char out of range 0..255, value="++show (ord c)-    where i = fromEnum c-  checkByte :: Integer -> Either String [Word8]-  checkByte i | (0 <= i) && (i <= 255) = Right [fromInteger i]-              | otherwise = Left $ "found Oct/Hex Int out of range 0..255, value="++show i-  checkUnicode :: Integer -> Either String [Word8]-  checkUnicode i | (0 <= i) && (i <= 127) = Right [fromInteger i]-                 | i <= maxChar = Right $ encode [ toEnum . fromInteger $ i ]-                 | otherwise = Left $ "found Unicode Char out of range 0..0x10FFFF, value="++show i-    where maxChar = toInteger (fromEnum (maxBound ::Char)) -- 0x10FFFF---alex_action_4 =  parseDec -alex_action_5 =  parseOct -alex_action_6 =  parseHex -alex_action_7 =  parseDouble -alex_action_8 =  dieAt "decimal followed by invalid character" -alex_action_9 =  dieAt "octal followed by invalid character" -alex_action_10 =  dieAt "hex followed by invalid character" -alex_action_11 =  dieAt "floating followed by invalid character" -alex_action_12 =  parseStr -alex_action_13 =  parseName -alex_action_14 =  parseChar -alex_action_15 =  wtfAt -{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command line>" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}--- -------------------------------------------------------------------------------- ALEX TEMPLATE------ This code is in the PUBLIC DOMAIN; you may copy it freely and use--- it for any purpose whatsoever.---- -------------------------------------------------------------------------------- INTERNALS and main scanner engine--{-# LINE 35 "templates/GenericTemplate.hs" #-}--{-# LINE 45 "templates/GenericTemplate.hs" #-}--{-# LINE 66 "templates/GenericTemplate.hs" #-}-alexIndexInt16OffAddr arr off = arr ! off---{-# LINE 87 "templates/GenericTemplate.hs" #-}-alexIndexInt32OffAddr arr off = arr ! off---{-# LINE 98 "templates/GenericTemplate.hs" #-}-quickIndex arr i = arr ! i----- -------------------------------------------------------------------------------- Main lexing routines--data AlexReturn a-  = AlexEOF-  | AlexError  !AlexInput-  | AlexSkip   !AlexInput !Int-  | AlexToken  !AlexInput !Int a---- alexScan :: AlexInput -> StartCode -> AlexReturn a-alexScan input (sc)-  = alexScanUser undefined input (sc)--alexScanUser user input (sc)-  = case alex_scan_tkn user input (0) input sc AlexNone of-	(AlexNone, input') ->-		case alexGetChar input of-			Nothing -> ----				   AlexEOF-			Just _ ->----				   AlexError input'--	(AlexLastSkip input len, _) ->----		AlexSkip input len--	(AlexLastAcc k input len, _) ->----		AlexToken input len k----- Push the input through the DFA, remembering the most recent accepting--- state it encountered.--alex_scan_tkn user orig_input len input s last_acc =-  input `seq` -- strict in the input-  let -	new_acc = check_accs (alex_accept `quickIndex` (s))-  in-  new_acc `seq`-  case alexGetChar input of-     Nothing -> (new_acc, input)-     Just (c, new_input) -> ----	let-		base   = alexIndexInt32OffAddr alex_base s-		(ord_c) = ord c-		offset = (base + ord_c)-		check  = alexIndexInt16OffAddr alex_check offset-		-		new_s = if (offset >= (0)) && (check == ord_c)-			  then alexIndexInt16OffAddr alex_table offset-			  else alexIndexInt16OffAddr alex_deflt s-	in-	case new_s of -	    (-1) -> (new_acc, input)-		-- on an error, we want to keep the input *before* the-		-- character that failed, not after.-    	    _ -> alex_scan_tkn user orig_input (len + (1)) -			new_input new_s new_acc--  where-	check_accs [] = last_acc-	check_accs (AlexAcc a : _) = AlexLastAcc a input (len)-	check_accs (AlexAccSkip : _)  = AlexLastSkip  input (len)-	check_accs (AlexAccPred a pred : rest)-	   | pred user orig_input (len) input-	   = AlexLastAcc a input (len)-	check_accs (AlexAccSkipPred pred : rest)-	   | pred user orig_input (len) input-	   = AlexLastSkip input (len)-	check_accs (_ : rest) = check_accs rest--data AlexLastAcc a-  = AlexNone-  | AlexLastAcc a !AlexInput !Int-  | AlexLastSkip  !AlexInput !Int--data AlexAcc a user-  = AlexAcc a-  | AlexAccSkip-  | AlexAccPred a (AlexAccPred user)-  | AlexAccSkipPred (AlexAccPred user)--type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool---- -------------------------------------------------------------------------------- Predicates on a rule--alexAndPred p1 p2 user in1 len in2-  = p1 user in1 len in2 && p2 user in1 len in2----alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input----alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input----alexRightContext :: Int -> AlexAccPred _-alexRightContext (sc) user _ _ input = -     case alex_scan_tkn user input (0) input sc AlexNone of-	  (AlexNone, _) -> False-	  _ -> True-	-- TODO: there's no need to find the longest-	-- match when checking the right context, just-	-- the first match will do.---- used by wrappers-iUnbox (i) = i
− Text/ProtocolBuffers/Lexer.x 
@@ -1,178 +0,0 @@-{-module Text.ProtocolBuffers.Lexer (Lexed(..), alexScanTokens,getLinePos)  where--import Control.Monad.Error()-import Codec.Binary.UTF8.String(encode)-import qualified Data.ByteString.Lazy as L-import Data.Char(ord,chr,isHexDigit,isOctDigit,toLower)-import Data.List(sort,unfoldr)-import Data.Word(Word8)-import Numeric(readHex,readOct,readDec,showOct,readSigned,readFloat)--}--%wrapper "posn-bytestring"--$d = [0-9]-@decInt = [\-]?[1-9]$d*-@hexInt = [\-]?0[xX]([A-Fa-f0-9])+-@octInt = [\-]?0[0-7]*-@doubleLit = [\-]?$d+(\.$d+)?([Ee][\+\-]?$d+)?--@ident1 = [A-Za-z_][A-Za-z0-9_]*-@ident = [\.]?@ident1([\.]@ident1)*-@notChar = [^A-Za-z0-9_]--@hexEscape = \\[Xx][A-Fa-f0-9]{1,2}-@octEscape = \\0?[0-7]{1,3}-@charEscape = \\[abfnrtv\\\?'\"]-@inStr = @hexEscape | @octEscape | @charEscape | [^'\"\0\n]-@strLit = ['] (@inStr | [\"])* ['] | [\"] (@inStr | ['])* [\"]--$special    = [=\(\)\,\;\[\]\{\}]--:---  $white+ ;-  "//".*  ;-  "#".*   ;-  "/*".*"*/" ;-  @decInt / @notChar    { parseDec }-  @octInt / @notChar    { parseOct }-  @hexInt / @notChar    { parseHex }-  @doubleLit / @notChar { parseDouble }-  @decInt               { dieAt "decimal followed by invalid character" }-  @octInt               { dieAt "octal followed by invalid character" }-  @hexInt               { dieAt "hex followed by invalid character" }-  @doubleLit            { dieAt "floating followed by invalid character" }-  @strLit               { parseStr }-  @ident                { parseName }-  $special              { parseChar }-  .                     { wtfAt }--{-line :: AlexPosn -> Int-line (AlexPn _byte line' _col) = line'-{-# INLINE line #-}--data Lexed = L_Integer !Int !Integer-           | L_Double !Int !Double-           | L_Name !Int !L.ByteString-           | L_String !Int !L.ByteString-           | L !Int !Char-           | L_Error !Int !String-  deriving (Show,Eq)--getLinePos :: Lexed -> Int-getLinePos x = case x of-                 L_Integer i _ -> i-                 L_Double  i _ -> i-                 L_Name    i _ -> i-                 L_String  i _ -> i-                 L         i _ -> i-                 L_Error   i _ -> i---- 'errAt' is the only access to L_Error, so I can see where it is created with pos-errAt pos msg =  L_Error (line pos) $ "Lexical error (in Text.ProtocolBuffers.Lexer): "++ msg ++ ", at "++see pos where-  see (AlexPn char line col) = "character "++show char++" line "++show line++" column "++show col++"."-dieAt msg pos _s = errAt pos msg-wtfAt pos s = errAt pos $ "unknown character "++show c++" (decimal "++show (ord c)++")"-  where (c:_) = ByteString.unpack s--{-# INLINE mayRead #-}-mayRead :: ReadS a -> String -> Maybe a-mayRead f s = case f s of [(a,"")] -> Just a; _ -> Nothing---- Given the regexps above, the "parse* failed" messages should be impossible.-parseDec pos s = maybe (errAt pos "parseDec failed") (L_Integer (line pos)) $ mayRead (readSigned readDec) (ByteString.unpack s)-parseOct pos s = maybe (errAt pos "parseOct failed") (L_Integer (line pos)) $ mayRead (readSigned readOct) (ByteString.unpack s)-parseHex pos s = maybe (errAt pos "parseHex failed") (L_Integer (line pos)) $ mayRead (readSigned (readHex . drop 2)) (ByteString.unpack s)-parseDouble pos s = maybe (errAt pos "parseDouble failed") (L_Double (line pos)) $ mayRead (readSigned readFloat) (ByteString.unpack s)-parseStr pos s = either (errAt pos) (L_String (line pos) . L.pack) $ sDecode . ByteString.unpack $ (ByteString.init (ByteString.tail s))-parseName pos s = L_Name (line pos) s-parseChar pos s = L (line pos) (ByteString.head s)---- Generalization of concat . unfoldr to monadic-Either form:-op :: ( [Char] -> Either String (Maybe ([Word8],[Char]))) -> [Char] -> Either String [Word8]-op one = go id where-  go f cs = case one cs of-              Left msg -> Left msg-              Right Nothing -> Right (f [])-              Right (Just (ws,cs)) -> go (f . (ws++)) cs---- Put this mess in the lexer, so the rest of the code can assume--- everything is saner.  The input is checked to really be "Char8"--- values in the range [0..255] and to be c-escaped (in order to--- render binary information printable).  This decodes the c-escaping--- and returns the binary data as Word8.--- --- A decoding error causes (Left msg) to be returned.-sDecode :: [Char] -> Either String [Word8]-sDecode = op one where-  one :: [Char] -> Either String (Maybe ([Word8],[Char]))-  one (x:xs) | x /= '\\' = do x' <- checkChar8 x-                              return $ Just (x',xs)  -- main case of unescaped value-  one [] = return Nothing-  one ('\\':[]) = Left "cannot understand a string that ends with a backslash"-  one ('\\':'0':ys) = return $ Just ([0],ys)-  one ('\\':ys) | 1 <= len =-      case mayRead readOct oct of-        Just w -> do w' <- checkByte w-                     return $ Just (w',rest)-        Nothing -> Left $ "failed to decode octal sequence "++ys-    where oct = takeWhile isOctDigit (take 3 ys)-          len = length oct-          rest = drop len ys-  one ('\\':x:ys) | 'x' == toLower x && 1 <= len =-      case mayRead readHex hex of-        Just w -> do w' <- checkByte w-                     return $ Just (w',rest)-        Nothing -> Left $ "failed to decode hex sequence "++ys-    where hex = takeWhile isHexDigit (take 2 ys)-          len = length hex-          rest = drop len ys          -  one ('\\':'u':ys) | ok =-      case mayRead readHex hex of-        Just w -> do w' <- checkUnicode w-                     return $ Just (w',rest)-        Nothing -> Left $ "failed to decode 4 char unicode sequence "++ys-    where ok = all isHexDigit hex && 4 == length hex-          (hex,rest) = splitAt 4 ys-  one ('\\':'U':ys) | ok =-      case mayRead readHex hex of-        Just w -> do w' <- checkUnicode w-                     return $ Just (w',rest)-        Nothing -> Left $ "failed to decode 8 char unicode sequence "++ys-    where ok = all isHexDigit hex && 8 == length hex-          (hex,rest) = splitAt 8 ys-  one ('\\':(x:xs)) = do x' <- decode x-                         return $ Just ([x'],xs)-  decode :: Char -> Either String Word8-  decode 'a' = return 7-  decode 'b' = return 8-  decode 't' = return 9-  decode 'n' = return 10-  decode 'v' = return 11-  decode 'f' = return 12-  decode 'r' = return 13-  decode '\"' = return 34-  decode '\'' = return 39-  decode '?' = return 63    -- C99 rule : "\?" is '?'-  decode '\\' = return 92-  decode x | toLower x == 'x' = Left "cannot understand your 'xX' hexadecimal escaped value"-  decode x | toLower x == 'u' = Left "cannot understand your 'uU' unicode UTF-8 hexadecimal escaped value"-  decode _ = Left "cannot understand your backslash-escaped value"-  checkChar8 :: Char -> Either String [Word8]-  checkChar8 c | (0 <= i) && (i <= 255) = Right [toEnum i]-               | otherwise = Left $ "found Char out of range 0..255, value="++show (ord c)-    where i = fromEnum c-  checkByte :: Integer -> Either String [Word8]-  checkByte i | (0 <= i) && (i <= 255) = Right [fromInteger i]-              | otherwise = Left $ "found Oct/Hex Int out of range 0..255, value="++show i-  checkUnicode :: Integer -> Either String [Word8]-  checkUnicode i | (0 <= i) && (i <= 127) = Right [fromInteger i]-                 | i <= maxChar = Right $ encode [ toEnum . fromInteger $ i ]-                 | otherwise = Left $ "found Unicode Char out of range 0..0x10FFFF, value="++show i-    where maxChar = toInteger (fromEnum (maxBound ::Char)) -- 0x10FFFF--}
Text/ProtocolBuffers/Mergeable.hs view
@@ -1,34 +1,28 @@-module Text.ProtocolBuffers.Mergeable(Mergeable(..),mayMerge) where--- This types are isomorphic to Monoid(mappend).  But the sematics are--- different, since mergeEmpty is likely only a left idenitity and not--- a right identity. The Mergeable class also has a default--- implementation to mergeAppend that take the second parameter.+-- | This provides instance of 'Mergeable' for the basic field types.+module Text.ProtocolBuffers.Mergeable() where  import Text.ProtocolBuffers.Basic-import qualified Data.Foldable as F(Foldable(foldr)) import Data.Monoid(mempty,mappend) -class Mergeable a where-  mergeEmpty :: a--- mergeEmpty = error "You did not define Mergeable.mergeEmpty!"--  mergeAppend :: a -> a -> a-  mergeAppend a b = b+-- Base types are not very mergeable, but their Maybe and Seq versions are:+instance Mergeable a => Mergeable (Maybe a) where+    mergeEmpty = Nothing+    mergeAppend = mayMerge -  mergeConcat :: F.Foldable t => t a -> a-  mergeConcat = F.foldr mergeAppend mergeEmpty+instance Mergeable (Seq a) where+    mergeEmpty = mempty+    mergeAppend = mappend --- Base types are not very mergeable, but their Maybe type are:-instance Mergeable a => Mergeable (Maybe a) where mergeEmpty = Nothing; mergeAppend = mayMerge-instance Mergeable (Seq a) where mergeEmpty = mempty; mergeAppend = mappend-instance Mergeable Bool where mergeEmpty = False-instance Mergeable ByteString where mergeEmpty = mempty-instance Mergeable Double where mergeEmpty = 0.0-instance Mergeable Float where mergeEmpty = 0.0-instance Mergeable Int32 where mergeEmpty = 0-instance Mergeable Int64 where mergeEmpty = 0-instance Mergeable Word32 where mergeEmpty = 0-instance Mergeable Word64 where mergeEmpty = 0+-- These all have errors as mergeEmpty and use the second paramater for mergeAppend+instance Mergeable Bool+instance Mergeable Utf8+instance Mergeable ByteString+instance Mergeable Double+instance Mergeable Float+instance Mergeable Int32+instance Mergeable Int64+instance Mergeable Word32+instance Mergeable Word64  {-# INLINE mayMerge #-} mayMerge :: (Mergeable b) => Maybe b -> Maybe b -> Maybe b
− Text/ProtocolBuffers/MyGet.hs 
@@ -1,876 +0,0 @@-{-# LANGUAGE CPP,MagicHash,ScopedTypeVariables,FlexibleInstances,MultiParamTypeClasses,TypeSynonymInstances,BangPatterns,FunctionalDependencies,RankNTypes #-}------ By Chris Kuklewicz, drawing heavily from binary and binary-strict.--- but all the bugs are my own.------ This file is under the usual BSD3 licence, copyright 2008.------ There is a sibling to this module (once called "MyGetW") that does--- have a MonadCont instances, and does not hide the "b" type variable--- with a forall.  In fact this file is a search-and-delete version of--- MyGetW.hs------ This started out as an improvement to Data.Binary.Strict.IncrementalGet with--- slightly better internals.  The simplified "get,runGet,Result" trio with the--- 'Data.Binary.Strict.Class.BinaryParser' instance are an _untested_--- upgrade from IncrementalGet.  Especially untested are the--- strictness properties.------ 'Get' implements usefully Applicative and Monad, MonadError,--- Alternative and MonadPlus.--- --- The 'CompGet' monad transformer has those and also useful MonadRead,--- MonadWriter, and MonadState implementations.  Output to the writer--- and changes to the State are thrown away when fail/throwError/mzero--- is called.--- --- The semantics of throwError interating with MonadState and--- MonadWriter and BinaryParser: an error reverts all changes to the--- state and drops all items tell'd.  The position in the input stream--- is rewound, but all items gotten from 'suspend' are kept.  Any--- changes from 'putAvailable' are kept.  Thus throwError aborts any--- 'listen' or 'pass' contexts.------ Top level errors are reported along with number of bytes successfully consumed.------ Each time the parser reaches the end of the input it will return a--- Partial or CPartial Left-wrapped continuation which requests a--- (Maybe Lazy.ByteString).  Passing (Just bs) will append bs to the--- input so far.  If you pass Nothing to the continuation, then you--- are declaring that there will never be more input and the parser--- should never again return a partial contination; it should return--- failure or finished.------ The newest feaature is the ability for the computation to return a--- stream of results.  The use of 'yieldItem' cannot be rolled back,--- no subsequenct throwError,mzero,fail,lookAhead, or use of callCC--- will lose any yielded value.  To report yielded value at an--- intermediate point, without asking for more input, use--- 'flushItems'.  To get a count of items yielded and not flushed, use--- 'pendingItems', which returns 0 immediately after 'flushItems'.------ 'suspendUntilComplete' repeatedly uses a partial continuation to--- ask for more input until Nothing is passed and then it proceeds--- with parsing.------ The 'getAvailable' command returns the lazy byte string the parser--- has remaining before calling 'suspend'.  The 'putAvailable'--- replaces this input and is a bit fancy: it also replaces the input--- at the current offset for all the potential catchError/mplus--- handlers.  This change is _not_ reverted by fail/throwError/mzero.------ The three 'lookAhead' and 'lookAheadM' and 'lookAheadE' functions are--- the same as the ones in binary's Data.Binary.Get.------ 'getCC' and 'getCC1' are handy wrapper of 'callCC' that I have included here.----module Text.ProtocolBuffers.MyGet-    (Get,runGet,Result(..)-    ,CompGet,runCompGet,CompResult(..)-     -- main primitives to parse items-    ,ensureBytes,getStorable,getLazyByteString,getByteString,suspendUntilComplete-     -- observe or replace the remaining BinaryParser input-    ,getAvailable,putAvailable-     -- return a Sequence of items.-    ,yieldItem,flushItems,pendingItems-     -- lookAhead capabilities-    ,lookAhead,lookAheadM,lookAheadE-     -- below is for implementation of BinaryParser (for Int64 and Lazy bytestrings)-    ,bytesRead,isEmpty,remaining-    ,skip,spanOf-    ,getWord8,getWordhost-    ,getWord16be,getWord32be,getWord64be-    ,getWord16le,getWord32le,getWord64le-    ,getWord16host,getWord32host,getWord64host-    ) where---- import Debug.Trace(trace)---- The InternalGet monad is an instance of binary-strict's BinaryParser:-import qualified Data.Binary.Strict.Class as P(BinaryParser(..))--- The InternalGet monad is an instance of all of these...-import Control.Applicative(Alternative(..),Applicative(..))-import Control.Monad.Error.Class(MonadError(throwError,catchError),Error(strMsg,noMsg))-import Control.Monad.Reader.Class(MonadReader(ask,local))-import Control.Monad.Writer.Class(MonadWriter(tell,listen,pass))-import Control.Monad.State.Class(MonadState(get,put))-import Control.Monad.Trans(MonadTrans(lift),MonadIO(liftIO))-import Control.Monad(MonadPlus(mzero,mplus))--import Data.Char---- implementation imports-import Control.Monad(liftM,ap)                       -- instead of Functor.fmap; ap for Applicative-import Control.Monad(replicateM)                      -- XXX testing-import Control.Monad((>=>)) -- XX testing-import Control.Monad.Identity(Identity,runIdentity)  -- Get is a transformed Identity monad-import Data.Bits(Bits((.|.)))-import qualified Data.ByteString as S(concat,length,null,splitAt)-import qualified Data.ByteString as S(pack,unpack) -- XXX testing-import qualified Data.ByteString.Internal as S(ByteString,toForeignPtr,inlinePerformIO)-import qualified Data.ByteString.Unsafe as S(unsafeIndex)-import qualified Data.ByteString.Lazy as L(take,drop,length,span,toChunks,fromChunks,null,empty)-import qualified Data.ByteString.Lazy as L(pack,unpack) -- XXX testing-import qualified Data.ByteString.Lazy.Internal as L(ByteString(..),chunk)-import qualified Data.Foldable as F(foldr1)          -- used with Seq-import Data.Function(fix)                            -- used in clever definition of getCC-import Data.Int(Int64)                               -- index type for L.ByteString-import Data.Monoid(Monoid(mempty,mappend))           -- Writer has a Monoid contraint-import Data.Sequence(Seq,length,null,(|>))           -- used for future queue in handler state-import Data.Word(Word,Word8,Word16,Word32,Word64)-import Foreign.ForeignPtr(withForeignPtr)-import Foreign.Ptr(castPtr,plusPtr)-import Foreign.Storable(Storable(peek,sizeOf))-#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-import GHC.Base(Int(..),uncheckedShiftL#)-import GHC.Word(Word16(..),Word32(..),Word64(..),uncheckedShiftL64#)-#endif--default()---- Simple external return type-data Result y a = Failed !(Seq y) {-# UNPACK #-} !Int64 String-                | Finished !(Seq y) {-# UNPACK #-} !L.ByteString {-# UNPACK #-} !Int64 a-                | Partial !(Seq y) !(Either ( Result y a  )  -- use laziness-                                            ( Maybe L.ByteString -> Result y a ))---- Complex external return type-data CompResult y w user m a =-    CFailed !(Seq y) {-# UNPACK #-} !Int64 String-  | CFinished  !(Seq y) {-# UNPACK #-} !L.ByteString {-# UNPACK #-} !Int64 w user a-  | CPartial !(Seq y) !(Either ( m (CompResult y w user m a) ) -- use laziness-                                   ( Maybe L.ByteString -> m (CompResult y w user m a) ))---- Internal type, converted to an external type before returning to caller.-data IResult y e w user m a =-    IFailed !(Seq y) {-# UNPACK #-} !Int64 e-  | IFinished !(Seq y) w {-# UNPACK #-} !(S user) a-  | IPartial !(Seq y) !(Either ( m (IResult y e w user m a) )-                               ( Maybe L.ByteString -> m (IResult y e w user m a) ))---- Internal state type, not exposed to the user.-data S user = S { top :: {-# UNPACK #-} !S.ByteString-                , current :: {-# UNPACK #-} !L.ByteString-                , consumed :: {-# UNPACK #-} !Int64-                , user_field :: user-                }-  deriving Show---- easier names-type SuccessContinuation b y e r w user m a =-  (a -> r -> w -> (S user) -> TopFrame b y e w user m -> m (IResult y e w user m b))--type ErrorHandler b y e w user m =-  ( (S user) -> TopFrame b y e w user m -> e -> m (IResult y e w user m b))---- Private Internal error handling stack type--- This must NOT be exposed by this module-data FrameStack b y e w user m =-    ErrorFrame { top_error_handler :: ErrorHandler b y e w user m -- top level handler-               , input_continues :: {-# UNPACK #-} !Bool -- True at start, False if Nothing passed to suspend continuation-               }-  | HandlerFrame { error_handler :: !(Maybe (ErrorHandler b y e w user m))  -- encapsulated handler-                 , stored_state :: {-# UNPACK #-} !(S user)  -- stored state to pass to handler-                 , future_input :: {-# UNPACK #-} !(Seq L.ByteString)  -- additiona input to hass to handler-                 , older_frame :: !(FrameStack b y e w user m)  -- older handlers-                 }---- TopFrame is used as storage for a unique counter (Word64) that is--- used to label the HanderFrames in increasing order as they are--- created.  This is only needed so that callCC can distinguish the age--- of items in the FrameStack as being present at the original use of --- callCC or being newer.------ TopFrame's unique value is used and incremented when a new--- HandlerFrame is allocated by catchError.  It will start at 1.------ The (Seq y) of of yielded values in the TopFrame are the yielded--- results which are waiting to be put in the next IReturn value.-data TopFrame b y e w user m  = TopFrame (Seq y) (FrameStack b y e w user m)-  deriving Show---- Internal monad type-newtype InternalGet y e r w user m a = InternalGet {-      unInternalGet :: forall b.-                 SuccessContinuation b y e r w user m a-              -> r                          -- reader-              -> w                          -- log so far-              -> (S user)                   -- state-              -> TopFrame b y e w user m    -- error handler stack-              -> m (IResult y e w user m b) -- operation-      }---- Complex external monad type, but errors are String-type CompGet y r w user m = InternalGet y String r w user m---- Simple external monad type-type Get y = CompGet y () () () Identity---- These implement the checkponting needed to store and revive the--- state for lookAhead.  They are fragile because the setCheckpoint--- must preceed either useCheckpoint or clearCheckpoint but not both.--- The FutureFrame must be the most recent handler, so the commands--- must be in the same scope depth.  Because of these constraints, the reader--- value 'r' does not need to be stored and can be taken from the InternalGet--- parameter.------ IMPORTANT: Any FutureFrame at the top level(s) is discarded by throwError.-setCheckpoint,useCheckpoint,clearCheckpoint :: InternalGet y e r w user m ()-setCheckpoint = InternalGet $ \ sc r w s (TopFrame ys pc) ->-  sc () r w s (TopFrame ys (HandlerFrame Nothing s mempty pc))-useCheckpoint = InternalGet $ \ sc r w sIn (TopFrame ys (HandlerFrame catcher sOld future pc)) ->-  case catcher of-    Just {} -> error "Impossible: Bad use of useCheckpoint, error_handler was Just instead of Nothing"-    Nothing -> let sOut = (collect sOld future) { user_field = user_field sIn }-               in sc () r w sOut (TopFrame ys pc)-clearCheckpoint = InternalGet $ \ sc r w s (TopFrame ys (HandlerFrame catcher _s _future pc)) ->-  case catcher of-    Just {} -> error "Impossible: Bad use of clearCheckpoint, error_handler was Just instead of Nothing"-    Nothing -> sc () r w s (TopFrame ys pc)---- | 'lookAhead' runs the @todo@ action and then rewinds only the--- BinaryParser state.  Any new input from 'suspend' or changes from--- 'putAvailable' are kept.  Changes to the user state (MonadState)--- are kept.  The MonadWriter output is retained.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAhead :: (Monad m, Error e)-          => InternalGet y e r w user m a-          -> InternalGet y e r w user m a-lookAhead todo = do-  setCheckpoint-  a <- todo-  useCheckpoint-  return a---- | 'lookAheadM' runs the @todo@ action. If the action returns 'Nothing' then the --- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Just' then--- the BinaryParser is not rewound, and lookAheadM acts as an identity.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAheadM :: (Monad m, Error e)-           => InternalGet y e r w user m (Maybe a)-           -> InternalGet y e r w user m (Maybe a)-lookAheadM todo = do-  setCheckpoint-  a <- todo-  maybe useCheckpoint (\_ -> clearCheckpoint) a-  return a---- | 'lookAheadE' runs the @todo@ action. If the action returns 'Left' then the --- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Right' then--- the BinaryParser is not rewound, and lookAheadE acts as an identity.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAheadE :: (Monad m, Error e)-           => InternalGet y e r w user m (Either a b)-           -> InternalGet y e r w user m (Either a b)-lookAheadE todo = do-  setCheckpoint-  a <- todo-  either (\_ -> useCheckpoint) (\_ -> clearCheckpoint) a-  return a---- 'collect' is used by 'putCheckpoint' and 'throwError'-collect :: (S user) -> Seq L.ByteString -> (S user)-collect sIn future | Data.Sequence.null future = sIn-                   | otherwise = sIn { current = mappend (current sIn) (F.foldr1 mappend future) }--instance (Show a,Show y) => Show (Result y a) where-  showsPrec _ (Failed ys n msg) = scon "Failed" $ sparen ys . sshows n . sshows msg-  showsPrec _ (Finished ys bs n a) = scon "Finished" $ sparen ys . sparen bs . sshows n . sparen a-  showsPrec _ (Partial ys c) = scon "Partial" $ sparen ys . showsEither c--instance (Show w, Show user, Show a,Show y) => Show (CompResult y w user m a) where-  showsPrec _ (CFailed ys n msg) = scon "CFailed" $ sparen ys . sshows n . sshows msg-  showsPrec _ (CFinished ys bs n w user a) = scon "CFinished" $ sparen ys . sparen bs . sshows n . sparen w . sparen user . sparen a-  showsPrec _ (CPartial ys c) = scon "CPartial" $ sparen ys . showsEither c--instance (Show user, Show a, Show w,Show y,Show e) => Show (IResult y e w user m a) where-  showsPrec _ (IFailed ys n msg) = scon "IFailed" $ sparen ys . sshows n . sshows msg-  showsPrec _ (IFinished ys w s a) = scon "CFinished" $ sparen ys . sparen w . sparen s . sparen a-  showsPrec _ (IPartial ys c) = scon "CPartial" $ sparen ys . showsEither c--instance (Show s,Show y) => Show (FrameStack b y e w s m) where-  showsPrec _ (ErrorFrame _ec p) = scon "ErrorFrame <>" $ sshows p-  showsPrec _ (HandlerFrame _catcher s future pc) = scon "(HandlerFrame " $ (" <>"++) . sparen s . sparen future . ('\n':) . indent . shows pc--scon :: String -> ShowS -> ShowS-scon c s = ("("++) . (c++) . (' ':) . s . (')':)-sparen :: (Show x) => x -> ShowS-sparen s = (" ("++) . shows s . (')':)-sshows :: (Show x) => x -> ShowS-sshows s = (' ':) . shows s -indent :: String -> String-indent = unlines . map ("  "++) . lines-showsEither :: Either a b -> ShowS-showsEither (Left {}) = shows " (Left <>)"-showsEither (Right {}) = shows " (Right <>)"--chunk :: S user -> L.ByteString-chunk s = L.chunk (top s) (current s)---- | 'runCompGet' is the complex executor-runCompGet :: (Monad m,Monoid w)-            => CompGet y r w user m a-            -> r -> user -> L.ByteString-            -> m (CompResult y w user m a)-runCompGet g rIn userIn bsIn = liftM convert (unInternalGet g scIn rIn mempty sIn (TopFrame mempty (ErrorFrame ecIn True)))-  where sIn = case bsIn of L.Empty -> S mempty mempty 0 userIn-                           L.Chunk ss bs -> S ss bs 0 userIn-        scIn a _r w sOut (TopFrame ys _pc) = return (IFinished ys w sOut a)-        ecIn sOut (TopFrame ys _pc) msg = return (IFailed ys (consumed sOut) msg)--        convert :: (Monad m) => IResult y String w user m a -> CompResult y w user m a-        convert (IFailed ys n msg) = CFailed ys n msg-        convert (IFinished ys w (S ss bs n user) a) = CFinished ys (L.chunk ss bs) n w user a-        convert (IPartial ys f) = CPartial ys (case f of-                                                 Left f' -> Left $ liftM convert f'-                                                 Right f' -> Right $ \bs -> liftM convert (f' bs) )---- | 'runGet' is the simple executor-runGet :: Get y a -> L.ByteString -> Result y a-runGet g bsIn = convert (runIdentity (unInternalGet g scIn () mempty sIn (TopFrame mempty (ErrorFrame ecIn True))))-  where sIn = case bsIn of L.Empty -> S mempty mempty 0 ()-                           L.Chunk ss bs -> S ss bs 0 ()-        scIn a _r w sOut (TopFrame ys _pc) = return (IFinished ys w sOut a)-        ecIn sOut (TopFrame ys _pc) msg = return (IFailed ys (consumed sOut) msg)--        convert :: IResult y String () () Identity a -> Result y a-        convert (IFailed ys n msg) = Failed ys n msg-        convert (IFinished ys _w (S ss bs n _user) a) = Finished ys (L.chunk ss bs) n a-        convert (IPartial ys f) = Partial ys (case f of-                                                Left f' -> Left $ convert (runIdentity f')-                                                Right f' -> Right $ \bs -> convert (runIdentity (f' bs)))---- | Get the input currently available to the parser.  If this is--- preceded by 'suspendUntilComplete' then this will definitely by the--- complete length.-getAvailable :: InternalGet y e r w user m L.ByteString-getAvailable = InternalGet $ \ sc r w s pc -> sc (chunk s) r w s pc---- | 'putAvailable' replaces the bytestream past the current # of read--- bytes.  This will also affect pending MonadError handler and--- MonadPlus branches.  I think all pending branches have to have--- fewer bytesRead than the current one.  If this is wrong then an--- error will be thrown.------ Currently this does not change the flag which indicates whether--- Nothing has ever been passed to a continuation to indicate the hard--- end of input.  This poperty is subject to change.------ WARNING : 'putAvailable' is still untested.-putAvailable :: L.ByteString -> InternalGet y e r w user m ()-putAvailable bsNew = InternalGet $ \ sc r w (S _ss _bs n user) (TopFrame ys pc) ->-  let s' = case bsNew of-             L.Empty -> S mempty mempty n user-             L.Chunk ss' bs' -> S ss' bs' n user-      rebuild (HandlerFrame catcher sOld@(S _ss1 _bs1 n1 user1) future pc') =-               HandlerFrame catcher sNew mempty (rebuild pc')-        where balance = n - n1-              whole | balance < 0 = error "Impossible? Cannot rebuild HandlerFrame in MyGetW.putAvailable: balance is negative!"-                    | otherwise = L.take balance . chunk $ collect sOld future-              sNew | balance /= L.length whole = error "Impossible? MyGetW.putAvailable.rebuild.sNew HandlerFrame assertion failed."-                   | otherwise = case mappend whole bsNew of-                                   L.Empty -> S mempty mempty n1 user1-                                   L.Chunk ss2 bs2 -> S ss2 bs2 n1 user1-      rebuild x@(ErrorFrame {}) = x-  in sc () r w s' (TopFrame ys (rebuild pc))---- Internal access to full internal state, as helepr functions-getFull :: InternalGet y e r w user m (S user)-getFull = InternalGet $ \ sc r w s pc -> sc s r w s pc-putFull :: (S user) -> InternalGet y e r w user m ()-putFull s = InternalGet $ \ sc r w _s pc -> sc () r w s pc---- | Keep calling 'suspend' until Nothing is passed to the 'Partial'--- continuation.  This ensures all the data has been loaded into the--- state of the parser.-suspendUntilComplete :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m ()-suspendUntilComplete = do-  continue <- suspend-  if continue then suspendUntilComplete-    else return ()---- | Call suspend and throw and error with the provided @msg@ if--- Nothing has been passed to the 'Partial' continuation.  Otherwise--- return ().-suspendMsg :: ({-Show user,-} Error e, Monad m) => e -> InternalGet y e r w user m ()-suspendMsg msg = do continue <- suspend-                    if continue then return ()-                      else throwError msg-{-# INLINE suspendMsg #-}---- | check that there are at least @n@ bytes available in the input.--- This will suspend if there is to little data.-ensureBytes :: ({-Show user,-} Error e, Monad m) => Int64 -> InternalGet y e r w user m ()-ensureBytes n = do-  (S ss bs _offset _user) <- getFull-  if n < fromIntegral (S.length ss)-    then return ()-    else do if n == L.length (L.take n (L.chunk ss bs))-              then return ()-              else suspendMsg (strMsg "ensureBytes failed") >> ensureBytes n-{-# INLINE ensureBytes #-}---- | Pull @n@ bytes from the unput, as a lazy ByteString.  This will--- suspend if there is too little data.  -getLazyByteString :: ({-Show user,-} Error e, Monad m) => Int64 -> InternalGet y e r w user m L.ByteString-getLazyByteString n = do-  (S ss bs offset user) <- getFull-  case splitAtOrDie n (L.chunk ss bs) of-    Just (consume,rest) -> do case rest of-                                L.Empty -> putFull (S mempty mempty (offset + n) user)-                                L.Chunk ss' bs' -> putFull (S ss' bs' (offset + n) user)-                              return consume-    Nothing -> suspendMsg (strMsg "getLazyByteString failed") >> getLazyByteString n-{-# INLINE getLazyByteString #-} -- important---- | 'suspend' is supposed to allow the execution of the monad to be--- halted, awaiting more input.  The computation is supposed to--- continue normally if this returns True, and is supposed to halt--- without calling suspend again if this returns False.  All future--- calls to suspend will return False automatically and no nothing--- else.------ These semantics are too specialized to let this escape this module.-class MonadSuspend y m | m -> y where-  suspend :: m Bool-  yieldItem :: y -> m ()-  flushItems :: m ()-  pendingItems :: m Int---- The instance here is fairly specific to the stack manipluation done--- by 'addFuture' to ('S' user) and to the packaging of the resumption--- function in 'IResult'('IPartial').-instance ({-Show user,-} Error e, Monad m) => MonadSuspend y (InternalGet y e r w user m) where-  suspend = InternalGet $ \ sc r w sIn pcIn@(TopFrame ys pcInside) ->-    if checkBool pcInside -- Has Nothing ever been given to a partial continuation?-      then let f Nothing = let pcOut = TopFrame mempty (rememberFalse pcInside)-                           in sc False r w sIn pcOut-               f (Just bs') | L.null bs' = let pcOut = TopFrame mempty pcInside-                                           in sc True r w sIn pcOut-                            | otherwise = let sOut = appendBS sIn bs'-                                              pcOut = TopFrame mempty (addFuture bs' pcInside)-                                          in sc True r w sOut pcOut-           in return (IPartial ys (Right f))-      else sc False r w sIn pcIn  -- once Nothing has been given suspend is a no-op-   where appendBS s@(S {current=bs}) bs' = s { current=mappend bs bs' }-         -- addFuture puts the new data in 'future' where throwError's collect can find and use it-         addFuture _bs x@(ErrorFrame {}) = x-         addFuture bs x@(HandlerFrame {future_input=future, older_frame=pc}) =-           x { future_input=future |> bs, older_frame= addFuture bs pc }-         -- Once suspend is given Nothing, it remembers this and always returns False-         checkBool (HandlerFrame {older_frame=pc}) = checkBool pc-         checkBool (ErrorFrame {input_continues=b}) = b-         rememberFalse x@(ErrorFrame {}) = x { input_continues=False }-         rememberFalse x@(HandlerFrame {older_frame=pc}) = x { older_frame=rememberFalse pc }--  yieldItem y = InternalGet $ \sc r w s (TopFrame ys pc) ->-                  let ys' = ys |> y-                  in sc () r w s (TopFrame ys' pc)--  -- This does nothing when there are no items pending, otherwise it-  -- returns IPartial (Seq y) (Left ...)-  flushItems = InternalGet $ \sc r w s tf@(TopFrame ys pc) ->-                 if Data.Sequence.null ys then sc () r w s tf-                   else let lazy'rest = sc () r w s (TopFrame mempty pc)-                        in return (IPartial ys (Left lazy'rest))--  pendingItems = InternalGet $ \sc r w s pc@(TopFrame ys _pc) -> sc (Data.Sequence.length ys) r w s pc--          --- A unique sort of command...---- | 'discardInnerHandler' causes the most recent catchError to be--- discarded, i.e. this reduces the stack of error handlers by removing--- the top one.  These are the same handlers which Alternative((<|>)) and--- MonadPlus(mplus) use.  This is useful to commit to the current branch and let--- the garbage collector release the suspended handler and its hold on--- the earlier input.-discardInnerHandler :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m ()-discardInnerHandler = InternalGet $ \ sc r w s (TopFrame ys pcIn) ->-  let pcOut = case pcIn of ErrorFrame {} -> pcIn-                           HandlerFrame _catcher _s _future pc' -> pc'-  in sc () r w s (TopFrame ys pcOut)-{-# INLINE discardInnerHandler #-}---- The BinaryParser instance:---- INTERNALS :--- the getWord*,getPtr,getStorable functions call getByteString--- getByteString works with the first strict bytestring if the request fits---   otherwise it call getLazyByteString and allocates a new strict bytestring for the result--- getLazyByteString calls splitAtOrDie and---   on Nothing it suspends and if that returns True then it tries again else throwError---   on Just it returns the desired length lazy bytestring result and advances the parser---- | Discard the next @m@ bytes-skip :: ({-Show user,-} Error e, Monad m) => Int64 -> InternalGet y e r w user m ()-skip m | m <=0 = return ()-       | otherwise = do-  ensureBytes m-  (S ss bs n user) <- getFull-  case L.drop m (L.chunk ss bs) of-    L.Empty -> putFull (S mempty mempty (n+m) user)-    L.Chunk ss' bs' -> putFull (S ss' bs' (n+m) user)---- | Return the number of 'bytesRead' so far.  Initially 0, never negative.-bytesRead :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m Int64-bytesRead = fmap consumed getFull---- | 'remaining' returns the number of bytes available before the--- current input runs out and 'suspend' might be called (this is the--- length of the lazy bytestring returned by 'getAvailable').  If this--- is preceded by 'suspendUntilComplete' then this will definitely by--- the complete length.-remaining :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m Int64-remaining = do (S ss bs _n _user) <- getFull-               return $ fromIntegral (S.length ss) + (L.length bs)---- | Return True if the number of bytes 'remaining' is 0.  Any futher--- attempts to read an empty parser will cal 'suspend'.-isEmpty :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m Bool-isEmpty = do (S ss bs _n _user) <- getFull-             return $ (S.null ss) && (L.null bs)--spanOf :: ({-Show user,-} Error e, Monad m) => (Word8 -> Bool) ->  InternalGet y e r w user m (L.ByteString)-spanOf f = do let loop = do (S ss bs n user) <- getFull-                            let (pre,post) = L.span f (L.chunk ss bs)-                            case post of-                              L.Empty -> putFull (S mempty mempty (n + L.length pre) user)-                              L.Chunk ss' bs' -> putFull (S ss' bs' (n + L.length pre) user)-                            if L.null post-                              then fmap ((L.toChunks pre)++) $ do-                                     continue <- suspend-                                     if continue then loop-                                       else return (L.toChunks pre)-                              else return (L.toChunks pre)-              fmap L.fromChunks loop-{-# INLINE spanOf #-}---- | Pull @n@ bytes from the input, as a strict ByteString.  This will--- suspend if there is too little data.  If the result spans multiple--- lazy chunks then the result occupies a freshly allocated strict--- bytestring, otherwise it fits in a single chunk and refers to the--- same immutable memory block as the whole chunk.-getByteString :: ({-Show user,-} Error e, Monad m) => Int -> InternalGet y e r w user m S.ByteString-getByteString nIn = do-  (S ss bs n user) <- getFull-  if nIn < S.length ss-    then do let (pre,post) = S.splitAt nIn ss-            putFull (S post bs (n+fromIntegral nIn) user)-            return pre-    -- Expect nIn to be less than S.length ss the vast majority of times-    -- so do not worry about doing anything fancy here.-    else fmap (S.concat . L.toChunks) (getLazyByteString (fromIntegral nIn))-{-# INLINE getByteString #-} -- important--getWordhost :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m Word-getWordhost = getStorable-{-# INLINE getWordhost #-}--getWord8 :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m Word8-getWord8 = getPtr 1-{-# INLINE getWord8 #-}--getWord16be,getWord16le,getWord16host :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m Word16-getWord16be = do-    s <- getByteString 2-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w16` 8) .|.-              (fromIntegral (s `S.unsafeIndex` 1))-{-# INLINE getWord16be #-}-getWord16le = do-    s <- getByteString 2-    return $! (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w16` 8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord16le #-}-getWord16host = getStorable-{-# INLINE getWord16host #-}--getWord32be,getWord32le,getWord32host :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m Word32-getWord32be = do-    s <- getByteString 4-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w32` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w32` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w32`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 3) )-{-# INLINE getWord32be #-}-getWord32le = do-    s <- getByteString 4-    return $! (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w32` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w32` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w32`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord32le #-}-getWord32host = getStorable-{-# INLINE getWord32host #-}---getWord64be,getWord64le,getWord64host :: ({-Show user,-} Error e, Monad m) => InternalGet y e r w user m Word64-getWord64be = do-    s <- getByteString 8-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w64` 56) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w64` 48) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w64` 40) .|.-              (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w64` 32) .|.-              (fromIntegral (s `S.unsafeIndex` 4) `shiftl_w64` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 5) `shiftl_w64` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 6) `shiftl_w64`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 7) )-{-# INLINE getWord64be #-}-getWord64le = do-    s <- getByteString 8-    return $! (fromIntegral (s `S.unsafeIndex` 7) `shiftl_w64` 56) .|.-              (fromIntegral (s `S.unsafeIndex` 6) `shiftl_w64` 48) .|.-              (fromIntegral (s `S.unsafeIndex` 5) `shiftl_w64` 40) .|.-              (fromIntegral (s `S.unsafeIndex` 4) `shiftl_w64` 32) .|.-              (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w64` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w64` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w64`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord64le #-}-getWord64host = getStorable-{-# INLINE getWord64host #-}--instance ({-Show user,-} Error e, Monad m) => P.BinaryParser (InternalGet y e r w user m) where-  skip = skip . fromIntegral-  bytesRead = fmap fromIntegral bytesRead-  remaining = fmap fromIntegral remaining-  isEmpty = isEmpty-  spanOf = fmap (S.concat . L.toChunks) . spanOf--  getByteString = getByteString-  getWordhost = getWordhost-  getWord8 = getWord8--  getWord16be = getWord16be-  getWord32be = getWord32be-  getWord64be = getWord64be--  getWord16le = getWord16le-  getWord32le = getWord32le-  getWord64le = getWord64le--  getWord16host = getWord16host-  getWord32host = getWord32host-  getWord64host = getWord64host---- Below here are the class instances-    -instance ({-Show user,-} Error e, Monad m) => Functor (InternalGet y e r w user m) where-  fmap f m = InternalGet (\sc -> unInternalGet m (sc . f))-  {-# INLINE fmap #-}--instance ({-Show user,-} Monad m,Error e) => Monad (InternalGet y e r w user m) where-  return a = InternalGet (\sc -> sc a)-  {-# INLINE return #-}-  m >>= k  = InternalGet (\sc -> unInternalGet m (\a -> unInternalGet (k a) sc))-  {-# INLINE (>>=) #-}-  fail msg = throwError (strMsg msg)--instance MonadTrans (InternalGet y e r w user) where-  lift m = InternalGet (\sc r w s pc -> m >>= \a -> sc a r w s pc)--instance ({-Show user,-} MonadIO m,Error e) => MonadIO (InternalGet y e r w user m) where-  liftIO = lift . liftIO--instance ({-Show user,-} Monad m,Error e) => MonadError e (InternalGet y e r w user m) where-  throwError msg = InternalGet $ \_sc _r _w s tf@(TopFrame ys pcIn) ->-    let go (ErrorFrame ec _b) = ec s tf msg-        go (HandlerFrame (Just catcher) s1 future pc1) = catcher (collect s1 future) (TopFrame ys pc1) msg-        go (HandlerFrame Nothing _s _future pc1) = go pc1-    in go pcIn--  catchError mayFail handler = InternalGet $ \scCaptured rCaptured wCaptured s (TopFrame ys pc) ->-    let pcWithHandler = let catcher s1 pc1 e1 = unInternalGet (handler e1) scCaptured rCaptured wCaptured s1 pc1-                        in TopFrame ys (HandlerFrame (Just catcher) s mempty pc)-        actionWithCleanup = mayFail >>= \a -> discardInnerHandler >> return a-    in unInternalGet actionWithCleanup scCaptured rCaptured wCaptured s pcWithHandler--instance ({-Show user,-} Monad m, Error e, Monoid w) => MonadWriter w (InternalGet y e r w user m) where-  tell w'  = InternalGet (\sc r w -> sc () r (mappend w w'))-  listen m = InternalGet (\sc r w -> let sc' a r' w'= sc (a,w') r' (mappend w w')-                                     in unInternalGet m sc' r mempty)-  pass m   = InternalGet (\sc r w s pc -> let sc' (a,f) r' w' s' pc' = sc a r' (mappend w (f w')) s' pc'-                                          in unInternalGet m sc' r mempty s pc)--instance ({-Show user,-} Monad m, Error e) => MonadReader r (InternalGet y e r w user m) where-  ask = InternalGet (\sc r -> sc r r)-  local f m = InternalGet (\sc r -> let sc' a _r = sc a r-                              in unInternalGet m sc' (f r))-              -instance ({-Show user,-} Monad m,Error e) => MonadState user (InternalGet y e r w user m) where-  get   = InternalGet (\sc r w s -> sc (user_field s) r w s)-  put u = InternalGet (\sc r w s -> let s' = s {user_field=u}-                              in sc () r w s')--instance ({-Show user,-} Monad m, Error e) => MonadPlus (InternalGet y e r w user m) where-  mzero = throwError noMsg-  mplus m1 m2 = catchError m1 (const m2)--instance ({-Show user,-} Monad m,Error e) => Applicative (InternalGet y e r w user m) where-  pure = return-  (<*>) = ap--instance ({-Show user,-} Monad m,Error e) => Alternative (InternalGet y e r w user m) where-  empty = mzero-  (<|>) = mplus---- | I use splitAt without tolerating too few bytes, so write a Maybe version.--- This is the only place I invoke L.Chunk as constructor instead of pattern matching.--- I claim that the first argument cannot be empty.-splitAtOrDie :: Int64 -> L.ByteString -> Maybe (L.ByteString, L.ByteString)-splitAtOrDie i ps | i <= 0 = Just (L.Empty, ps)-splitAtOrDie _i L.Empty = Nothing-splitAtOrDie i (L.Chunk x xs) | i < len = let (pre,post) = S.splitAt (fromIntegral i) x-                                          in Just (L.Chunk pre L.Empty-                                                  ,L.Chunk post xs)-                              | otherwise = case splitAtOrDie (i-len) xs of-                                              Nothing -> Nothing-                                              Just (y1,y2) -> Just (L.Chunk x y1,y2)-  where len = fromIntegral (S.length x)-{-# INLINE splitAtOrDie #-}---- getPtr copied from binary's Get.hs---------------------------------------------------------------------------- Primtives---- helper, get a raw Ptr onto a strict ByteString copied out of the--- underlying lazy byteString. So many indirections from the raw parser--- state that my head hurts...--getPtr :: ({-Show user,-} Error e, Monad m,Storable a) => Int -> InternalGet y e r w user m a-getPtr n = do-    (fp,o,_) <- fmap S.toForeignPtr (getByteString n)-    return . S.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)-{-# INLINE getPtr #-}--getStorable :: forall y e r w user m a. ({-Show user,-} Error e, Monad m,Storable a) => InternalGet y e r w user m a-getStorable = do-    (fp,o,_) <- fmap S.toForeignPtr (getByteString (sizeOf (undefined :: a)))-    return . S.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)-{-# INLINE getStorable #-}---- Unchecked shifts copied from binary's Get.hs----------------------------------------------------------------------------------------------------------------------------------------------------- Unchecked shifts--shiftl_w16 :: Word16 -> Int -> Word16-shiftl_w32 :: Word32 -> Int -> Word32-shiftl_w64 :: Word64 -> Int -> Word64--#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#`   i)-shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#`   i)--#if WORD_SIZE_IN_BITS < 64-shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)--#if __GLASGOW_HASKELL__ <= 606--- Exported by GHC.Word in GHC 6.8 and higher-foreign import ccall unsafe "stg_uncheckedShiftL64"-    uncheckedShiftL64#     :: Word64# -> Int# -> Word64#-#endif--#else-shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)-#endif--#else-shiftl_w16 = shiftL-shiftl_w32 = shiftL-shiftl_w64 = shiftL-#endif----------------------------------------------------------------------------{- TESTING -}---------------------------------------------------------------------------chomp :: CompGet y () String () IO ()-chomp = getByteString 1 >>= \w -> tell (map (toEnum . fromEnum) (S.unpack w))--feed :: (Monad t) => Word8 -> CompResult y t1 t2 t t3 -> t (CompResult y t1 t2 t t3)-feed x (CPartial _ys (Left q)) = q-feed x (CPartial _ys (Right q)) = q (Just (L.pack [x]))-feed _x y = return y--test :: (Monoid w, Monad m) => CompGet y () w () m a -> [Word8] -> m (CompResult y w () m a)-test g bs = runCompGet g () () (L.pack bs)--test10 :: IO (CompResult () String () IO [()])-test10 = test (mplus (pr "go" >> replicateM 5 chomp >> pr "die" >> mzero) (pr "reborn" >> replicateM 10 chomp)) [1] >>= feed 2 >>= feed 3 >>= feed 4 >>= feed 5 >>= feed 6 >>= feed 7 >>=feed 8 >>= feed 9 >>= feed 10--pr :: (MonadIO m, Show a) => a -> m ()-pr = liftIO . Prelude.print--countPC :: ({-Show user,-} Monad m) => CompGet y r w user m Int-countPC = InternalGet $ \ sc r w s (TopFrame ys pc) ->-  let go (ErrorFrame {}) i = i-      go (HandlerFrame _ _ _ pc') i = go pc' $! succ i-  in sc (go pc 0) r w s (TopFrame ys pc)--{- testDepth result on my machine:--*Text.ProtocolBuffers.MyGet> testDepth-("stack depth",0,"bytes read",0,"bytes remaining",0,"begin")-("feed1",[48,49])-("stack depth",1,"bytes read",1,"bytes remaining",1,"mayFail")-("stack depth",2,"bytes read",1,"bytes remaining",1,"depth2")-("feed1",[50,51])-("stack depth",2,"bytes read",4,"bytes remaining",0,"about to mzero")-("stack depth",1,"bytes read",1,"bytes remaining",3,"middle")-("stack depth",1,"bytes read",2,"bytes remaining",2,"about to mzero again")-("stack depth",0,"bytes read",1,"bytes remaining",3,"handler")-("feed1",[52,53])-("feed1",[54,55])-("stack depth",0,"bytes read",7,"bytes remaining",1,"got 6, now suspendUntilComplete")-("feed1",[56,57])-("feed1",[58,59])-("feed1",[60,61])-("stack depth",0,"bytes read",7,"bytes remaining",7,"end")-(CFinished (Chunk "7" (Chunk "89" (Chunk ":;" (Chunk "<=" Empty)))) 7 ("0") (()) ("123456"))--The first chomp tell's "0".-All other tell's are thrown away by the error handling.-The stack depth returns to 0 as it should.-The "bytes read" is reset along with the input on each throwError/mzero/fail.-The (getByteString 6) reads "123456", leaving the "7" chunk on the input.-suspendUntilComplete loads the rest of the "89" ":;" and "<=" chunks.---}---- Ensure the stack fixing in catchError play words well:-testDepth :: IO (CompResult () String () IO S.ByteString)-testDepth = test depth [] >>= feed12 >>= feedNothing where-  p s = countPC >>= \d -> bytesRead >>= \ b -> remaining >>= \r ->-         pr ("stack depth",d,"bytes read",b,"bytes remaining",r,s)-  depth = do-    p "begin"-    chomp-    catchError ( p "mayFail" >>-                 ((p "depth2" >> replicateM 3 chomp >> p "about to mzero" >> mzero) <|> return ()) >>-                 p "middle" >>-                 chomp >> p "about to mzero again" >> mzero)-               (\_ -> p "handler")-    a <- getByteString 6-    p "got 6, now suspendUntilComplete"-    suspendUntilComplete-    p "end"-    return a--feed12 :: CompResult y w user IO a -> IO (CompResult y w user IO a)-feed12 = foldr1 (>=>) . map feeds $ [ [2*i,2*i+1]  | i <- [24..30]]-  where feeds x (CPartial _ys (Right q)) = print ("feed1",x)  >> q (Just (L.pack x))-        feeds x (CPartial _ys (Left q)) = print ("feed1 - no request")  >> q-        feeds _x y = return y--feedNothing :: (Monad t) => CompResult y t1 t2 t t3 -> t (CompResult y t1 t2 t t3)-feedNothing (CPartial _ys (Right q)) = q Nothing-feedNothing (CPartial _ys (Left q)) = q-feedNothing x = return x
− Text/ProtocolBuffers/MyGetSimplified.hs 
@@ -1,719 +0,0 @@-{-# LANGUAGE CPP,MagicHash,ScopedTypeVariables,FlexibleInstances,MultiParamTypeClasses,TypeSynonymInstances,RankNTypes #-}------ By Chris Kuklewicz, drawing heavily from binary and binary-strict,--- but all the bugs are my own.------ This file is under the usual BSD3 licence, copyright 2008.------ There is a streamlined version of MyGet.hs------ This started out as an improvement to--- Data.Binary.Stric.IncrementalGet with slightly better internals.--- The simplified 'Get', 'runGet', 'Result' trio with the--- 'Data.Binary.Strict.Class.BinaryParser' instance are an _untested_--- upgrade from IncrementalGet.  Especially untested are the--- strictness properties.------ 'Get' usefully implements Applicative and Monad, MonadError,--- Alternative and MonadPlus.  Unhandled errors are reported along--- with the number of bytes successfully consumed.  Effects of--- 'suspend' and 'putAvailable' are visible after--- fail/throwError/mzero.------ Each time the parser reaches the end of the input it will return a--- Partial wrapped continuation which requests a (Maybe--- Lazy.ByteString).  Passing (Just bs) will append bs to the input so--- far and continue processing.  If you pass Nothing to the--- continuation then you are declaring that there will never be more--- input and that the parser should never again return a partial--- contination; it should return failure or finished.------ 'suspendUntilComplete' repeatedly uses a partial continuation to--- ask for more input until Nothing is passed and then it proceeds--- with parsing.------ The 'getAvailable' command returns the lazy byte string the parser--- has remaining before calling 'suspend'.  The 'putAvailable'--- replaces this input and is a bit fancy: it also replaces the input--- at the current offset for all the potential catchError/mplus--- handlers.  This change is _not_ reverted by fail/throwError/mzero.------ The three 'lookAhead' and 'lookAheadM' and 'lookAheadE' functions are--- the same as the ones in binary's Data.Binary.Get.----module Text.ProtocolBuffers.MyGet-    (Get,runGet,Result(..)-     -- main primitives-    ,ensureBytes,getStorable,getLazyByteString,suspendUntilComplete-     -- parser state manipulation-    ,getAvailable,putAvailable-     -- lookAhead capabilities-    ,lookAhead,lookAheadM,lookAheadE-     -- below is for implementation of BinaryParser (for Int64 and Lazy bytestrings)-    ,skip,bytesRead,isEmpty,remaining,spanOf-    ,getWord8,getByteString-    ,getWord16be,getWord32be,getWord64be-    ,getWord16le,getWord32le,getWord64le-    ,getWordhost,getWord16host,getWord32host,getWord64host-    ) where---- The Get monad is an instance of binary-strict's BinaryParser:-import qualified Data.Binary.Strict.Class as P(BinaryParser(..))--- The Get monad is an instance of all of these library classes:-import Control.Applicative(Applicative(pure,(<*>)),Alternative(empty,(<|>)))-import Control.Monad(MonadPlus(mzero,mplus))-import Control.Monad.Error.Class(MonadError(throwError,catchError),Error(strMsg))--- It can be a MonadCont, but the semantics are too broken without a ton of work.---- implementation imports-import Control.Monad(ap)                             -- instead of Functor.fmap; ap for Applicative-import Control.Monad(replicateM,(>=>))               -- XXX testing-import Data.Bits(Bits((.|.)))-import qualified Data.ByteString as S(concat,length,null,splitAt)-import qualified Data.ByteString as S(unpack) -- XXX testing-import qualified Data.ByteString.Internal as S(ByteString,toForeignPtr,inlinePerformIO)-import qualified Data.ByteString.Unsafe as S(unsafeIndex)-import qualified Data.ByteString.Lazy as L(take,drop,length,span,toChunks,fromChunks,null)-import qualified Data.ByteString.Lazy as L(pack) -- XXX testing-import qualified Data.ByteString.Lazy.Internal as L(ByteString(..),chunk)-import qualified Data.Foldable as F(foldr,foldr1)    -- used with Seq-import Data.Int(Int64)                               -- index type for L.ByteString-import Data.Monoid(Monoid(mempty,mappend))           -- Writer has a Monoid contraint-import Data.Sequence(Seq,null,(|>))                  -- used for future queue in handler state-import Data.Word(Word,Word8,Word16,Word32,Word64)-import Foreign.ForeignPtr(withForeignPtr)-import Foreign.Ptr(castPtr,plusPtr)-import Foreign.Storable(Storable(peek,sizeOf))-#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-import GHC.Base(Int(..),uncheckedShiftL#)-import GHC.Word(Word16(..),Word32(..),Word64(..),uncheckedShiftL64#)-#endif---- Simple external return type-data Result a = Failed {-# UNPACK #-} !Int64 String-              | Finished {-# UNPACK #-} !L.ByteString {-# UNPACK #-} !Int64 a-              | Partial (Maybe L.ByteString -> Result a)---- Internal state type, not exposed to the user.-data S = S { top :: {-# UNPACK #-} !S.ByteString-           , current :: {-# UNPACK #-} !L.ByteString-           , consumed :: {-# UNPACK #-} !Int64-           } deriving Show---- Private Internal error handling stack type--- This must NOT be exposed by this module------ The ErrorFrame is the top-level error handler setup when execution begins.--- It starts with the Bool set to True: meaning suspend can ask for more input.--- Once suspend get 'Nothing' in reply the Bool is set to False, which means--- that 'suspend' should no longer ask for input -- the input is finished.--- Why store the Bool there?  It was handy when I needed to add it.-data FrameStack b = ErrorFrame (String -> S -> Result b) -- top level handler-                               Bool -- True at start, False if Nothing passed to suspend continuation-                  | HandlerFrame (Maybe ( S -> FrameStack b -> String -> Result b ))  -- encapsulated handler-                                 S  -- stored state to pass to handler-                                 (Seq L.ByteString)  -- additional input to hass to handler-                                 (FrameStack b)  -- earlier/deeper/outer handlers-                  | FutureFrame S (Seq L.ByteString) (FrameStack b) -- for look ahead--type Success b a = (a -> S -> FrameStack b -> Result b)---- Internal monad type-newtype Get a = Get {-  unGet :: forall b.    -- the forall hides the CPS style (and prevents use of MonadCont)-           Success b a  -- main continuation-        -> S            -- parser state-        -> FrameStack b -- error handler stack-        -> Result b     -- operation-    }---- These implement the checkponting needed to store and revive the--- state for lookAhead.  They are fragile because the setCheckpoint--- must preceed either useCheckpoint or clearCheckpoint but not both.--- The FutureFrame must be the most recent handler, so the commands--- must be in the same scope depth.  Because of these constraints, the reader--- value 'r' does not need to be stored and can be taken from the Get--- parameter.------ IMPORTANT: Any FutureFrame at the top level(s) is discarded by throwError.-setCheckpoint,useCheckpoint,clearCheckpoint :: Get ()-setCheckpoint = Get $ \ sc s pc -> sc () s (FutureFrame s mempty pc)-useCheckpoint = Get $ \ sc (S _ _ _) (FutureFrame s future pc) ->-  let (S ss bs n) = collect s future-  in sc () (S ss bs n) pc-clearCheckpoint = Get $ \ sc s (FutureFrame _s _future pc) -> sc () s pc---- | 'lookAhead' runs the @todo@ action and then rewinds only the--- BinaryParser state.  Any new input from 'suspend' or changes from--- 'putAvailable' are kept.  Changes to the user state (MonadState)--- are kept.  The MonadWriter output is retained.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAhead :: Get a -> Get a-lookAhead todo = do-  setCheckpoint-  a <- todo-  useCheckpoint-  return a---- | 'lookAheadM' runs the @todo@ action. If the action returns 'Nothing' then the --- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Just' then--- the BinaryParser is not rewound, and lookAheadM acts as an identity.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAheadM :: Get (Maybe a) -> Get (Maybe a)-lookAheadM todo = do-  setCheckpoint-  a <- todo-  maybe useCheckpoint (\_ -> clearCheckpoint) a-  return a---- | 'lookAheadE' runs the @todo@ action. If the action returns 'Left' then the --- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Right' then--- the BinaryParser is not rewound, and lookAheadE acts as an identity.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAheadE :: Get (Either a b) -> Get (Either a b)-lookAheadE todo = do-  setCheckpoint-  a <- todo-  either (\_ -> useCheckpoint) (\_ -> clearCheckpoint) a-  return a---- 'collect' is used by 'putCheckpoint' and 'throwError'-collect :: S -> Seq L.ByteString -> S-collect s@(S ss bs n) future | Data.Sequence.null future = s-                             | otherwise = S ss (mappend bs (F.foldr1 mappend future)) n---- Put the Show instances here--instance (Show a) => Show (Result a) where-  showsPrec _ (Failed n msg) = ("(Failed "++) . shows n . (' ':) . shows msg . (")"++)-  showsPrec _ (Finished bs n a) =-    ("(CFinished ("++) -    . shows bs . (") ("++)-    . shows n . (") ("++) -    . shows a . ("))"++)-  showsPrec _ (Partial {}) = ("(Partial <Maybe Data.ByteString.Lazy.ByteString-> Result a)"++)--instance Show (FrameStack b) where-  showsPrec _ (ErrorFrame _ p) =(++) "(ErrorFrame <e->s->m b> " . shows p . (")"++)-  showsPrec _ (HandlerFrame _ s future pc) = ("(HandlerFrame <> ("++)-                                     . shows s . (") ("++) . shows future . (") ("++)-                                     . shows pc . (")"++)-  showsPrec _ (FutureFrame s future pc) =  ("(FutureFrame <s->FrameStack b e s m->e->m b> ("++)-                                     . shows s . (") ("++) . shows future . (") ("++)-                                     . shows pc . (")"++)---- | 'runGet' is the simple executor-runGet :: Get a -> L.ByteString -> Result a-runGet (Get f) bsIn = f scIn sIn (ErrorFrame ec True)-  where scIn a (S ss bs n) _pc = Finished (L.chunk ss bs) n a-        sIn = case bsIn of L.Empty -> S mempty mempty 0-                           L.Chunk ss bs -> S ss bs 0-        ec msg sOut = Failed (consumed sOut) msg---- | Get the input currently available to the parser.-getAvailable :: Get L.ByteString-getAvailable = Get $ \ sc s@(S ss bs _) pc -> sc (L.chunk ss bs) s pc---- | 'putAvailable' replaces the bytestream past the current # of read--- bytes.  This will also affect pending MonadError handler and--- MonadPlus branches.  I think all pending branches have to have--- fewer bytesRead than the current one.  If this is wrong then an--- error will be thrown.------ WARNING : 'putAvailable' is still untested.-putAvailable :: L.ByteString -> Get ()-putAvailable bsNew = Get $ \ sc (S _ss _bs n) pc ->-  let s' = case bsNew of-             L.Empty -> S mempty mempty n-             L.Chunk ss' bs' -> S ss' bs' n-      rebuild (HandlerFrame catcher (S ss1 bs1 n1) future pc') =-               HandlerFrame catcher sNew mempty (rebuild pc')-        where balance = n - n1-              whole | balance < 0 = error "Impossible? Cannot rebuild HandlerFrame in MyGet.putAvailable: balance is negative!"-                    | otherwise = L.take balance $ L.chunk ss1 bs1 `mappend` F.foldr mappend mempty future-              sNew | balance /= L.length whole = error "Impossible? MyGet.putAvailable.rebuild.sNew HandlerFrame assertion failed."-                   | otherwise = case mappend whole bsNew of-                                   L.Empty -> S mempty mempty n1-                                   L.Chunk ss2 bs2 -> S ss2 bs2 n1-      rebuild (FutureFrame (S ss1 bs1 n1) future pc') =-               FutureFrame sNew mempty (rebuild pc')-        where balance = n - n1-              whole | balance < 0 = error "Impossible? Cannot rebuild FutureFrame in MyGet.putAvailable: balance is negative!"-                    | otherwise = L.take balance $ L.chunk ss1 bs1 `mappend` F.foldr mappend mempty future-              sNew | balance /= L.length whole = error "Impossible? MyGet.putAvailable.rebuild.sNew FutureFrame assertion failed."-                   | otherwise = case mappend whole bsNew of-                                   L.Empty -> S mempty mempty n1-                                   L.Chunk ss2 bs2 -> S ss2 bs2 n1-      rebuild x@(ErrorFrame {}) = x-  in sc () s' (rebuild pc)---- Internal access to full internal state, as helepr functions-getFull :: Get S-getFull = Get $ \ sc s pc -> sc s s pc-putFull :: S -> Get ()-putFull s = Get $ \ sc _s pc -> sc () s pc---- | Keep calling 'suspend' until Nothing is passed to the 'Partial'--- continuation.  This ensures all the data has been loaded into the--- state of the parser.-suspendUntilComplete :: Get ()-suspendUntilComplete = do-  continue <- suspend-  if continue then suspendUntilComplete-    else return ()---- | Call suspend and throw and error with the provided @msg@ if--- Nothing has been passed to the 'Partial' continuation.  Otherwise--- return ().-suspendMsg :: String -> Get ()-suspendMsg msg = do continue <- suspend-                    if continue then return ()-                      else throwError msg---- | check that there are at least @n@ bytes available in the input.--- This will suspend if there is to little data.-ensureBytes :: Int64 -> Get ()-ensureBytes n = do-  (S ss bs _read) <- getFull-  if n < fromIntegral (S.length ss)-    then return ()-    else do if n == L.length (L.take n (L.chunk ss bs))-              then return ()-              else suspendMsg "ensureBytes failed" >> ensureBytes n-{-# INLINE ensureBytes #-}---- | Pull @n@ bytes from the unput, as a lazy ByteString.  This will--- suspend if there is too little data.-getLazyByteString :: Int64 -> Get L.ByteString-getLazyByteString n | n<=0 = return mempty-                    | otherwise = do-  (S ss bs offset) <- getFull-  case splitAtOrDie n (L.chunk ss bs) of-    Just (consume,rest) ->do-       case rest of-         L.Empty -> putFull (S mempty mempty (offset + n))-         L.Chunk ss' bs' -> putFull (S ss' bs' (offset + n))-       return consume-    Nothing -> suspendMsg "getLazyByteString failed" >> getLazyByteString n-{-# INLINE getLazyByteString #-} -- important---- | 'suspend' is supposed to allow the execution of the monad to be--- halted, awaiting more input.  The computation is supposed to--- continue normally if this returns True, and is supposed to halt--- without calling suspend again if this returns False.  All future--- calls to suspend will return False automatically and no nothing--- else.------ These semantics are too specialized to let this escape this module.-class MonadSuspend m where-  suspend :: m Bool---- The instance here is fairly specific to the stack manipluation done--- by 'addFuture' to ('S' user) and to the packaging of the resumption--- function in 'IResult'('IPartial').-instance MonadSuspend Get where-    suspend = Get $ \ sc sIn pcIn ->-      if checkBool pcIn -- Has Nothing ever been given to a partial continuation?-        then let f Nothing = let pcOut = rememberFalse pcIn-                             in sc False sIn pcOut-                 f (Just bs') = let sOut = appendBS sIn bs'-                                    pcOut = addFuture bs' pcIn-                                in sc True sOut pcOut-             in Partial f-        else sc False sIn pcIn  -- once Nothing has been given suspend is a no-op-     where appendBS (S ss bs n) bs' = S ss (mappend bs bs') n-           -- addFuture puts the new data in 'future' where throwError's collect can find and use it-           addFuture bs (HandlerFrame catcher s future pc) =-                         HandlerFrame catcher s (future |> bs) (addFuture bs pc)-           addFuture bs (FutureFrame s future pc) =-                         FutureFrame s (future |> bs) (addFuture bs pc)-           addFuture _bs x@(ErrorFrame {}) = x-           -- Once suspend is given Nothing, it remembers this and always returns False-           checkBool (ErrorFrame _ b) = b-           checkBool (HandlerFrame _ _ _ pc) = checkBool pc-           checkBool (FutureFrame _ _ pc) = checkBool pc-           rememberFalse (ErrorFrame ec _) = ErrorFrame ec False-           rememberFalse (HandlerFrame catcher s future pc) =-                          HandlerFrame catcher s future (rememberFalse pc)-           rememberFalse (FutureFrame s future pc) =-                          FutureFrame s future (rememberFalse pc)-          --- A unique sort of command...---- | 'discardInnerHandler' causes the most recent catchError to be--- discarded, i.e. this reduces the stack of error handlers by removing--- the top one.  These are the same handlers which Alternative((<|>)) and--- MonadPlus(mplus) use.  This is useful to commit to the current branch and let--- the garbage collector release the suspended handler and its hold on--- the earlier input.-discardInnerHandler :: Get ()-discardInnerHandler = Get $ \ sc s pcIn ->-  let pcOut = case pcIn of ErrorFrame {} -> pcIn-                           HandlerFrame _ _ _ pc' -> pc'-                           FutureFrame _ _ pc' -> pc'-  in sc () s pcOut-{-# INLINE discardInnerHandler #-}--{- Currently unused, commented out to satisfy -Wall---- | 'discardAllHandlers' causes all catchError handler to be--- discarded, i.e. this reduces the stack of error handlers to the top--- level handler.  These are the same handlers which Alternative((<|>))--- and MonadPlus(mplus) use.  This is useful to commit to the current--- branch and let the garbage collector release the suspended handlers--- and their hold on the earlier input.-discardAllHandlers :: Get ()-discardAllHandlers = Get $ \ sc s pcIn ->-  let base pc@(ErrorFrame {}) = pc-      base (HandlerFrame _ _ _ pc) = base pc-      base (FutureFrame _ _ pc) = base pc-  in sc () s (base pcIn)-{-# INLINE discardAllHandlers #-}--}--- The BinaryParser instance:---- | Discard the next @m@ bytes-skip :: Int64 -> Get ()-skip m | m <=0 = return ()-       | otherwise = do-  ensureBytes m-  (S ss bs n) <- getFull-  case L.drop m (L.chunk ss bs) of-    L.Empty -> putFull (S mempty mempty (n+m))-    L.Chunk ss' bs' -> putFull (S ss' bs' (n+m))---- | Return the number of 'bytesRead' so far.  Initially 0, never negative.-bytesRead :: Get Int64-bytesRead = fmap consumed getFull---- | Return the number of bytes 'remaining' before the current input--- runs out and 'suspend' might be called.-remaining :: Get Int64-remaining = do (S ss bs _) <- getFull-               return $ fromIntegral (S.length ss) + (L.length bs)---- | Return True if the number of bytes 'remaining' is 0.  Any futher--- attempts to read an empty parser will cal 'suspend'.-isEmpty :: Get Bool-isEmpty = do (S ss bs _n) <- getFull-             return $ (S.null ss) && (L.null bs)--spanOf :: (Word8 -> Bool) ->  Get (L.ByteString)-spanOf f = do let loop = do (S ss bs n) <- getFull-                            let (pre,post) = L.span f (L.chunk ss bs)-                            case post of-                              L.Empty -> putFull (S mempty mempty (n + L.length pre))-                              L.Chunk ss' bs' -> putFull (S ss' bs' (n + L.length pre))-                            if L.null post-                              then fmap ((L.toChunks pre)++) $ do-                                     continue <- suspend-                                     if continue then loop-                                       else return (L.toChunks pre)-                              else return (L.toChunks pre)-              fmap L.fromChunks loop-{-# INLINE spanOf #-}---- | Pull @n@ bytes from the input, as a strict ByteString.  This will--- suspend if there is too little data.  If the result spans multiple--- lazy chunks then the result occupies a freshly allocated strict--- bytestring, otherwise it fits in a single chunk and refers to the--- same immutable memory block as the whole chunk.-getByteString :: Int -> Get S.ByteString-getByteString nIn | nIn <= 0 = return mempty-                  | otherwise = do-  (S ss bs n) <- getFull-  if nIn < S.length ss-    then do let (pre,post) = S.splitAt nIn ss-            putFull (S post bs (n+fromIntegral nIn))-            return pre-    -- Expect nIn to be less than S.length ss the vast majority of times-    -- so do not worry about doing anything fancy here.-    else fmap (S.concat . L.toChunks) (getLazyByteString (fromIntegral nIn))-{-# INLINE getByteString #-} -- important--getWordhost :: Get Word-getWordhost = getStorable-{-# INLINE getWordhost #-}--getWord8 :: Get Word8-getWord8 = getPtr 1-{-# INLINE getWord8 #-}--getWord16be,getWord16le,getWord16host :: Get Word16-getWord16be = do-    s <- getByteString 2-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w16` 8) .|.-              (fromIntegral (s `S.unsafeIndex` 1))-{-# INLINE getWord16be #-}-getWord16le = do-    s <- getByteString 2-    return $! (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w16` 8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord16le #-}-getWord16host = getStorable-{-# INLINE getWord16host #-}--getWord32be,getWord32le,getWord32host :: Get Word32-getWord32be = do-    s <- getByteString 4-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w32` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w32` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w32`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 3) )-{-# INLINE getWord32be #-}-getWord32le = do-    s <- getByteString 4-    return $! (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w32` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w32` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w32`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord32le #-}-getWord32host = getStorable-{-# INLINE getWord32host #-}---getWord64be,getWord64le,getWord64host :: Get Word64-getWord64be = do-    s <- getByteString 8-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w64` 56) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w64` 48) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w64` 40) .|.-              (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w64` 32) .|.-              (fromIntegral (s `S.unsafeIndex` 4) `shiftl_w64` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 5) `shiftl_w64` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 6) `shiftl_w64`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 7) )-{-# INLINE getWord64be #-}-getWord64le = do-    s <- getByteString 8-    return $! (fromIntegral (s `S.unsafeIndex` 7) `shiftl_w64` 56) .|.-              (fromIntegral (s `S.unsafeIndex` 6) `shiftl_w64` 48) .|.-              (fromIntegral (s `S.unsafeIndex` 5) `shiftl_w64` 40) .|.-              (fromIntegral (s `S.unsafeIndex` 4) `shiftl_w64` 32) .|.-              (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w64` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w64` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w64`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord64le #-}-getWord64host = getStorable-{-# INLINE getWord64host #-}--instance P.BinaryParser Get where-  skip = skip . fromIntegral-  bytesRead = fmap fromIntegral bytesRead-  remaining = fmap fromIntegral remaining-  isEmpty = isEmpty-  spanOf = fmap (S.concat . L.toChunks) . spanOf--  getByteString = getByteString-  getWordhost = getWordhost-  getWord8 = getWord8--  getWord16be = getWord16be-  getWord32be = getWord32be-  getWord64be = getWord64be--  getWord16le = getWord16le-  getWord32le = getWord32le-  getWord64le = getWord64le--  getWord16host = getWord16host-  getWord32host = getWord32host-  getWord64host = getWord64host---- Below here are the class instances-    -instance Functor Get where-  fmap f m = Get (\sc -> unGet m (sc . f))-  {-# INLINE fmap #-}--instance Monad Get where-  return a = Get (\sc -> sc a)-  {-# INLINE return #-}-  m >>= k  = Get (\sc -> unGet m (\a -> unGet (k a) sc))-  {-# INLINE (>>=) #-}-  fail msg = throwError (strMsg msg)--instance MonadError String Get where-  throwError msg = Get $ \_sc  s pcIn ->-    let go (ErrorFrame ec _) = ec msg s-        go (HandlerFrame catcher s1 future pc1) = catcher (collect s1 future) pc1 msg-        go (FutureFrame _ _ pc1) = go pc1 -- discard FutureFrame(s) between inner scope and a handler or error frame-    in go pcIn--  catchError mayFail handler = Get $ \sc s pc ->-    let pcWithHandler = let catcher s1 pc1 e1 = unGet (handler e1) sc s1 pc1-                        in HandlerFrame catcher s mempty pc-        actionWithCleanup = mayFail >>= \a -> discardInnerHandler >> return a-    in unGet actionWithCleanup sc s pcWithHandler--instance MonadPlus Get where-  mzero = throwError (strMsg "[mzero:no message]")-  mplus m1 m2 = catchError m1 (const m2)--instance Applicative Get where-  pure = return-  (<*>) = ap--instance Alternative Get where-  empty = mzero-  (<|>) = mplus---- | I use "splitAt" without tolerating too few bytes, so write a Maybe version.--- This is the only place I invoke L.Chunk as constructor instead of pattern matching.--- I claim that the first argument cannot be empty.-splitAtOrDie :: Int64 -> L.ByteString -> Maybe (L.ByteString, L.ByteString)-splitAtOrDie i ps | i <= 0 = Just (L.Empty, ps)-splitAtOrDie _i L.Empty = Nothing-splitAtOrDie i (L.Chunk x xs) | i < len = let (pre,post) = S.splitAt (fromIntegral i) x-                                          in Just (L.Chunk pre L.Empty-                                                  ,L.Chunk post xs)-                              | otherwise = case splitAtOrDie (i-len) xs of-                                              Nothing -> Nothing-                                              Just (y1,y2) -> Just (L.Chunk x y1,y2)-  where len = fromIntegral (S.length x)-{-# INLINE splitAtOrDie #-}----------------------------------------------------------------------------- getPtr copied from binary's Get.hs---- helper, get a raw Ptr onto a strict ByteString copied out of the--- underlying lazy byteString. So many indirections from the raw parser--- state that my head hurts...--getPtr :: (Storable a) => Int -> Get a-getPtr n = do-    (fp,o,_) <- fmap S.toForeignPtr (getByteString n)-    return . S.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)-{-# INLINE getPtr #-}---- I pushed the sizeOf into here (uses ScopedTypeVariables)-getStorable :: forall a. (Storable a) => Get a-getStorable = do-    (fp,o,_) <- fmap S.toForeignPtr (getByteString (sizeOf (undefined :: a)))-    return . S.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)-{-# INLINE getStorable #-}------------------------------------------------------------------------------------------------------------------------------------------------------ Unchecked shifts copied from binary's Get.hs--shiftl_w16 :: Word16 -> Int -> Word16-shiftl_w32 :: Word32 -> Int -> Word32-shiftl_w64 :: Word64 -> Int -> Word64--#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#`   i)-shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#`   i)--#if WORD_SIZE_IN_BITS < 64-shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)--#if __GLASGOW_HASKELL__ <= 606--- Exported by GHC.Word in GHC 6.8 and higher-foreign import ccall unsafe "stg_uncheckedShiftL64"-    uncheckedShiftL64#     :: Word64# -> Int# -> Word64#-#endif--#else-shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)-#endif--#else-shiftl_w16 = shiftL-shiftl_w32 = shiftL-shiftl_w64 = shiftL-#endif--{---------------------------------------------------------------------------{- TESTING:  This predate conversion to Simplified form -}---------------------------------------------------------------------------chomp :: Get () String () IO ()-chomp = getByteString 1 >>= \w -> tell (map (toEnum . fromEnum) (S.unpack w))--feed :: (Monad t) => Word8 -> CompResult t1 t2 t t3 -> t (CompResult t1 t2 t t3)-feed x (CPartial q) = q (Just (L.pack [x]))-feed _x y = return y--test :: Get a -> [Word8] -> Result a-test g bs = runGet g () () (L.pack bs)--test10 :: IO (CompResult String () IO [()])-test10 = test (mplus (pr "go" >> replicateM 5 chomp >> pr "die" >> mzero) (pr "reborn" >> replicateM 10 chomp)) [1] >>= feed 2 >>= feed 3 >>= feed 4 >>= feed 5 >>= feed 6 >>= feed 7 >>=feed 8 >>= feed 9 >>= feed 10--pr :: (Show a) => a -> Get () String () IO ()-pr = liftIO . Prelude.print--countPC :: ({-Show user,-} Monad m) => Get Int-countPC = Get $ \ sc s pc ->-  let go (ErrorFrame {}) i = i-      go (HandlerFrame _ _ _ pc') i = go pc' $! succ i-      go (FutureFrame _ _ pc') i = go pc' $! succ i-  in sc (go pc 0) s pc--{- testDepth result on my machine:--*Text.ProtocolBuffers.MyGet> testDepth-("stack depth",0,"bytes read",0,"bytes remaining",0,"begin")-("feed1",[48,49])-("stack depth",1,"bytes read",1,"bytes remaining",1,"mayFail")-("stack depth",2,"bytes read",1,"bytes remaining",1,"depth2")-("feed1",[50,51])-("stack depth",2,"bytes read",4,"bytes remaining",0,"about to mzero")-("stack depth",1,"bytes read",1,"bytes remaining",3,"middle")-("stack depth",1,"bytes read",2,"bytes remaining",2,"about to mzero again")-("stack depth",0,"bytes read",1,"bytes remaining",3,"handler")-("feed1",[52,53])-("feed1",[54,55])-("stack depth",0,"bytes read",7,"bytes remaining",1,"got 6, now suspendUntilComplete")-("feed1",[56,57])-("feed1",[58,59])-("feed1",[60,61])-("stack depth",0,"bytes read",7,"bytes remaining",7,"end")-(CFinished (Chunk "7" (Chunk "89" (Chunk ":;" (Chunk "<=" Empty)))) 7 ("0") (()) ("123456"))--The first chomp tell's "0".-All other tell's are thrown away by the error handling.-The stack depth returns to 0 as it should.-The "bytes read" is reset along with the input on each throwError/mzero/fail.-The (getByteString 6) reads "123456", leaving the "7" chunk on the input.-suspendUntilComplete loads the rest of the "89" ":;" and "<=" chunks.---}---- Ensure the stack fixing in catchError play words well:-testDepth :: IO (CompResult String () IO S.ByteString)-testDepth = test depth [] >>= feed12 >>= feedNothing where-  p s = countPC >>= \d -> bytesRead >>= \ b -> remaining >>= \r ->-         pr ("stack depth",d,"bytes read",b,"bytes remaining",r,s)-  depth = do-    p "begin"-    chomp-    catchError ( p "mayFail" >>-                 ((p "depth2" >> replicateM 3 chomp >> p "about to mzero" >> mzero) <|> return ()) >>-                 p "middle" >>-                 chomp >> p "about to mzero again" >> mzero)-               (\_ -> p "handler")-    a <- getByteString 6-    p "got 6, now suspendUntilComplete"-    suspendUntilComplete-    p "end"-    return a--feed12 :: CompResult w user IO a -> IO (CompResult w user IO a)-feed12 = foldr1 (>=>) . map feeds $ [ [2*i,2*i+1]  | i <- [24..30]]-  where feeds x (CPartial q) = print ("feed1",x)  >> q (Just (L.pack x))-        feeds _x y = return y--feedNothing :: (Monad t) => CompResult t1 t2 t t3 -> t (CompResult t1 t2 t t3)-feedNothing (CPartial q) = q Nothing-feedNothing x = return x--}
− Text/ProtocolBuffers/MyGetW.hs 
@@ -1,1078 +0,0 @@-{-# LANGUAGE CPP,MagicHash,ScopedTypeVariables,FlexibleInstances,MultiParamTypeClasses,TypeSynonymInstances,BangPatterns,FunctionalDependencies #-}------ By Chris Kuklewicz, drawing heavily from binary and binary-strict.--- but all the bugs are my own.------ This file is under the usual BSD3 licence, copyright 2008.------ There is a sibling to this module (once called "MyGet") that does not have--- the MonadCont instances or machinery, and hides the "b" type variable with--- a forall.------ This started out as an improvement to Data.Binary.Strict.IncrementalGet with--- slightly better internals.  The simplified "get,runGet,Result" trio with the--- 'Data.Binary.Strict.Class.BinaryParser' instance are an _untested_--- upgrade from IncrementalGet.  Especially untested are the--- strictness properties.------ 'Get' implements usefully Applicative and Monad, MonadError,--- Alternative and MonadPlus, and MonadCont.--- --- The 'CompGet' monad transformer has those and also useful MonadRead,--- MonadWriter, and MonadState implementations.  Output to the writer--- and changes to the State are thrown away when fail/throwError/mzero--- is called.--- --- The semantics of throwError interating with MonadState and--- MonadWriter and BinaryParser: an error reverts all changes to the--- state and drops all items tell'd.  The position in the input stream--- is rewound, but all items gotten from 'suspend' are kept.  Any--- changes from 'putAvailable' are kept.  Thus throwError aborts any--- 'listen' or 'pass' contexts.------ Using a continuation from callCC does restore the reader and writer--- environment and value to that present when callCC was used.  Thus--- holding a continuation keeps the old reader and writer values--- alive. Using a continuation does not restore the BinaryParser input--- or the user state.  Holding a continuation does not keep the older--- values of these alive.  'callCC' has a very selective memory.------ The semantics of callCC with catchError: If you leave the scope of--- a catchError handler via a continuation then it counts as a--- success and the handler is not run.  If you capture the continuation inside the scope--- of a catchError handler and return to this later then one of two things will happen:---   (*) If execution has never left the scope then there is no effect on the handler or scope.---       Thus uses of callCC and its continuation wholly inside such a scope do not interfere---       with MonadError.---   (*) If execution has left the scope then the scope and its handler are reinstanted but---       with the current MonadState and BinaryParser being the new checkpoint.--- The net result of calling a continuation is to restore the same chain of error handlers--- as existed when callCC captured it.  The oldest scopes which are still in effect are unchanged,--- while newer scopes are restored with new checkpoint data.------ The semantics of callCC with lookAhead*: Same behaviour as--- catchError.  Leaving succeeds and returning reinstates the--- lookAhead with the current input on return as fallback.------ The semantics of callCC interating with MonadWriter are identical to (WriterT w (ContT r m)):---    The writer state is captured by callCC and restored when resuming, discarding changes.---    Any 'listen' and 'pass' contexts present when the continuation was captured are restored.---    This avoids sorting out what to do about the aborted 'listen' and 'pass' contexts---    at the site where the continuation was called.--- Note that (ContT r (WriterT w m)) is NOT a MonadWriter instance in the library.------ The semantics of callCC interating with MonadState and BinaryParser:---    The state and input when a continuaton is called is kept, it is not restored to---    the state and input present when the continuaton was captured by callCC.------ Top level errors are reported along with number of bytes successfully consumed.------ Each time the parser reaches the end of the input it will return a--- Partial or CPartial Left-wrapped continuation which requests a--- (Maybe Lazy.ByteString).  Passing (Just bs) will append bs to the--- input so far.  If you pass Nothing to the continuation, then you--- are declaring that there will never be more input and the parser--- should never again return a partial contination; it should return--- failure or finished.------ The newest feaature is the ability for the computation to return a--- stream of results.  The use of 'yieldItem' cannot be rolled back,--- no subsequenct throwError,mzero,fail,lookAhead, or use of callCC--- will lose any yielded value.  To report yielded value at an--- intermediate point, without asking for more input, use--- 'flushItems'.  To get a count of items yielded and not flushed, use--- 'pendingItems', which returns 0 immediately after 'flushItems'.------ 'suspendUntilComplete' repeatedly uses a partial continuation to--- ask for more input until Nothing is passed and then it proceeds--- with parsing.------ The 'getAvailable' command returns the lazy byte string the parser--- has remaining before calling 'suspend'.  The 'putAvailable'--- replaces this input and is a bit fancy: it also replaces the input--- at the current offset for all the potential catchError/mplus--- handlers.  This change is _not_ reverted by fail/throwError/mzero.------ The three 'lookAhead' and 'lookAheadM' and 'lookAheadE' functions are--- the same as the ones in binary's Data.Binary.Get.------ 'getCC' and 'getCC1' are handy wrapper of 'callCC' that I have included here.----module Text.ProtocolBuffers.MyGetW-    (Get,runGet,Result(..)-    ,CompGet,runCompGet,CompResult(..)-     -- main primitives to parse items-    ,ensureBytes,getStorable,getLazyByteString,getByteString,suspendUntilComplete-     -- observe or replace the remaining BinaryParser input-    ,getAvailable,putAvailable-     -- return a Sequence of items.-    ,yieldItem,flushItems,pendingItems-     -- lookAhead capabilities-    ,lookAhead,lookAheadM,lookAheadE-     -- too good not to include with this MonadCont-    ,getCC,getCC1-     -- below is for implementation of BinaryParser (for Int64 and Lazy bytestrings)-    ,bytesRead,isEmpty,remaining-    ,skip,spanOf-    ,getWord8,getWordhost-    ,getWord16be,getWord32be,getWord64be-    ,getWord16le,getWord32le,getWord64le-    ,getWord16host,getWord32host,getWord64host-    ) where---- import Debug.Trace(trace)---- The InternalGet monad is an instance of binary-strict's BinaryParser:-import qualified Data.Binary.Strict.Class as P(BinaryParser(..))--- The InternalGet monad is an instance of all of these...-import Control.Applicative(Alternative(..),Applicative(..))-import Control.Monad.Cont.Class(MonadCont(callCC))-import Control.Monad.Error.Class(MonadError(throwError,catchError),Error(strMsg,noMsg))-import Control.Monad.Reader.Class(MonadReader(ask,local))-import Control.Monad.Writer.Class(MonadWriter(tell,listen,pass))-import Control.Monad.State.Class(MonadState(get,put))-import Control.Monad.Trans(MonadTrans(lift),MonadIO(liftIO))-import Control.Monad(MonadPlus(mzero,mplus))--import Data.Char---- implementation imports-import Control.Monad(liftM,ap)                       -- instead of Functor.fmap; ap for Applicative-import Control.Monad(replicateM)                      -- XXX testing-import Control.Monad((>=>)) -- XX testing-import Control.Monad.Identity(Identity,runIdentity)  -- Get is a transformed Identity monad-import Data.Bits(Bits((.|.)))-import qualified Data.ByteString as S(concat,length,null,splitAt)-import qualified Data.ByteString as S(pack,unpack) -- XXX testing-import qualified Data.ByteString.Internal as S(ByteString,toForeignPtr,inlinePerformIO)-import qualified Data.ByteString.Unsafe as S(unsafeIndex)-import qualified Data.ByteString.Lazy as L(take,drop,length,span,toChunks,fromChunks,null,empty)-import qualified Data.ByteString.Lazy as L(pack,unpack) -- XXX testing-import qualified Data.ByteString.Lazy.Internal as L(ByteString(..),chunk)-import qualified Data.Foldable as F(foldr1)          -- used with Seq-import Data.Function(fix)                            -- used in clever definition of getCC-import Data.Int(Int64)                               -- index type for L.ByteString-import Data.Monoid(Monoid(mempty,mappend))           -- Writer has a Monoid contraint-import Data.Sequence(Seq,length,null,(|>))           -- used for future queue in handler state-import Data.Word(Word,Word8,Word16,Word32,Word64)-import Foreign.ForeignPtr(withForeignPtr)-import Foreign.Ptr(castPtr,plusPtr)-import Foreign.Storable(Storable(peek,sizeOf))-#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-import GHC.Base(Int(..),uncheckedShiftL#)-import GHC.Word(Word16(..),Word32(..),Word64(..),uncheckedShiftL64#)-#endif--default()---- Simple external return type-data Result y a = Failed !(Seq y) {-# UNPACK #-} !Int64 String-                | Finished !(Seq y) {-# UNPACK #-} !L.ByteString {-# UNPACK #-} !Int64 a-                | Partial !(Seq y) !(Either ( Result y a  )  -- use laziness-                                            ( Maybe L.ByteString -> Result y a ))---- Complex external return type-data CompResult y w user m a =-    CFailed !(Seq y) {-# UNPACK #-} !Int64 String-  | CFinished  !(Seq y) {-# UNPACK #-} !L.ByteString {-# UNPACK #-} !Int64 w user a-  | CPartial !(Seq y) !(Either ( m (CompResult y w user m a) ) -- use laziness-                                   ( Maybe L.ByteString -> m (CompResult y w user m a) ))---- Internal type, converted to an external type before returning to caller.-data IResult y e w user m a =-    IFailed !(Seq y) {-# UNPACK #-} !Int64 e-  | IFinished !(Seq y) w {-# UNPACK #-} !(S user) a-  | IPartial !(Seq y) !(Either ( m (IResult y e w user m a) )-                               ( Maybe L.ByteString -> m (IResult y e w user m a) ))---- Internal state type, not exposed to the user.-data S user = S { top :: {-# UNPACK #-} !S.ByteString-                , current :: {-# UNPACK #-} !L.ByteString-                , consumed :: {-# UNPACK #-} !Int64-                , user_field :: user-                }-  deriving Show---- easier names-type SuccessContinuation b y e r w user m a =-  (a -> r -> w -> (S user) -> TopFrame b y e w user m -> m (IResult y e w user m b))--type ErrorHandler b y e w user m =-  ( (S user) -> TopFrame b y e w user m -> e -> m (IResult y e w user m b))---- Private Internal error handling stack type--- This must NOT be exposed by this module-data FrameStack b y e w user m =-    ErrorFrame { top_error_handler :: ErrorHandler b y e w user m -- top level handler-               , input_continues :: {-# UNPACK #-} !Bool -- True at start, False if Nothing passed to suspend continuation-               }-  | HandlerFrame { frame_id :: {-# UNPACK #-} !Word64 -- needed for MonadCont(callCC)-                 , error_handler :: !(Maybe (ErrorHandler b y e w user m))  -- encapsulated handler-                 , stored_state :: {-# UNPACK #-} !(S user)  -- stored state to pass to handler-                 , future_input :: {-# UNPACK #-} !(Seq L.ByteString)  -- additiona input to hass to handler-                 , older_frame :: !(FrameStack b y e w user m)  -- older handlers-                 }---- This is a version of FrameStack that does not retain the state, and--- is used by MonadCont.-data CallCCStack b y e w user m =-    CC_ErrorFrame-  | CC_HandlerFrame {-# UNPACK #-} !Word64-                    !(Maybe (ErrorHandler b y e w user m))-                    !(CallCCStack b y e w user m)  -- older handlers---- TopFrame is used as storage for a unique counter (Word64) that is--- used to label the HanderFrames in increasing order as they are--- created.  This is only needed so that callCC can distinguish the age--- of items in the FrameStack as being present at the original use of --- callCC or being newer.------ TopFrame's unique value is used and incremented when a new--- HandlerFrame is allocated by catchError.  It will start at 1.------ The (Seq y) of of yielded values in the TopFrame are the yielded--- results which are waiting to be put in the next IReturn value.-data TopFrame b y e w user m  = TopFrame Word64 (Seq y) (FrameStack b y e w user m)-  deriving Show---- Internal monad type-newtype InternalGet b y e r w user m a = InternalGet {-      unInternalGet :: SuccessContinuation b y e r w user m a-              -> r                          -- reader-              -> w                          -- log so far-              -> (S user)                   -- state-              -> TopFrame b y e w user m    -- error handler stack-              -> m (IResult y e w user m b) -- operation-      }---- Complex external monad type, but errors are String-type CompGet b y r w user m = InternalGet b y String r w user m---- Simple external monad type-type Get b y = CompGet b y () () () Identity---- These implement the checkponting needed to store and revive the--- state for lookAhead.  They are fragile because the setCheckpoint--- must preceed either useCheckpoint or clearCheckpoint but not both.--- The FutureFrame must be the most recent handler, so the commands--- must be in the same scope depth.  Because of these constraints, the reader--- value 'r' does not need to be stored and can be taken from the InternalGet--- parameter.------ IMPORTANT: Any FutureFrame at the top level(s) is discarded by throwError.-setCheckpoint,useCheckpoint,clearCheckpoint :: InternalGet b y e r w user m ()-setCheckpoint = InternalGet $ \ sc r w s (TopFrame u ys pc) ->-  sc () r w s (TopFrame (succ u) ys (HandlerFrame u Nothing s mempty pc))-clearCheckpoint = InternalGet $ \ sc r w s (TopFrame u ys (HandlerFrame _u catcher _s _future pc)) ->-  case catcher of-    Just {} -> error "Impossible: Bad use of clearCheckpoint, error_handler was Just instead of Nothing"-    Nothing -> sc () r w s (TopFrame u ys pc)---- | 'lookAhead' runs the @todo@ action and then rewinds only the--- BinaryParser state.  Any new input from 'suspend' or changes from--- 'putAvailable' are kept.  Changes to the user state (MonadState)--- are kept.  The MonadWriter output is retained.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAhead :: (Monad m, Error e)-          => InternalGet b y e r w user m a-          -> InternalGet b y e r w user m a-lookAhead todo = do-  setCheckpoint-  a <- todo-  useCheckpoint-  return a---- | 'lookAheadM' runs the @todo@ action. If the action returns 'Nothing' then the --- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Just' then--- the BinaryParser is not rewound, and lookAheadM acts as an identity.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAheadM :: (Monad m, Error e)-           => InternalGet b y e r w user m (Maybe a)-           -> InternalGet b y e r w user m (Maybe a)-lookAheadM todo = do-  setCheckpoint-  a <- todo-  maybe useCheckpoint (\_ -> clearCheckpoint) a-  return a---- | 'lookAheadE' runs the @todo@ action. If the action returns 'Left' then the --- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Right' then--- the BinaryParser is not rewound, and lookAheadE acts as an identity.------ If an error is thrown then the entire monad state is reset to last--- catchError as usual.-lookAheadE :: (Monad m, Error e)-           => InternalGet b y e r w user m (Either a b)-           -> InternalGet b y e r w user m (Either a b)-lookAheadE todo = do-  setCheckpoint-  a <- todo-  either (\_ -> useCheckpoint) (\_ -> clearCheckpoint) a-  return a---- 'collect' is used by 'putCheckpoint' and 'throwError'-collect :: (S user) -> Seq L.ByteString -> (S user)-collect sIn future | Data.Sequence.null future = sIn-                   | otherwise = sIn { current = mappend (current sIn) (F.foldr1 mappend future) }--instance (Show a,Show y) => Show (Result y a) where-  showsPrec _ (Failed ys n msg) = scon "Failed" $ sparen ys . sshows n . sshows msg-  showsPrec _ (Finished ys bs n a) = scon "Finished" $ sparen ys . sparen bs . sshows n . sparen a-  showsPrec _ (Partial ys c) = scon "Partial" $ sparen ys . showsEither c--instance (Show w, Show user, Show a,Show y) => Show (CompResult y w user m a) where-  showsPrec _ (CFailed ys n msg) = scon "CFailed" $ sparen ys . sshows n . sshows msg-  showsPrec _ (CFinished ys bs n w user a) = scon "CFinished" $ sparen ys . sparen bs . sshows n . sparen w . sparen user . sparen a-  showsPrec _ (CPartial ys c) = scon "CPartial" $ sparen ys . showsEither c--instance (Show user, Show a, Show w,Show y,Show e) => Show (IResult y e w user m a) where-  showsPrec _ (IFailed ys n msg) = scon "IFailed" $ sparen ys . sshows n . sshows msg-  showsPrec _ (IFinished ys w s a) = scon "CFinished" $ sparen ys . sparen w . sparen s . sparen a-  showsPrec _ (IPartial ys c) = scon "CPartial" $ sparen ys . showsEither c--instance (Show s,Show y) => Show (FrameStack b y e w s m) where-  showsPrec _ (ErrorFrame _ p) = scon "ErrorFrame <>" $ sshows p-  showsPrec _ (HandlerFrame u _ s future pc) = scon "(HandlerFrame " $ sshows u . (" <>"++) . sparen s . sparen future . ('\n':) . indent . shows pc--scon :: String -> ShowS -> ShowS-scon c s = ("("++) . (c++) . (' ':) . s . (')':)-sparen :: (Show x) => x -> ShowS-sparen s = (" ("++) . shows s . (')':)-sshows :: (Show x) => x -> ShowS-sshows s = (' ':) . shows s -indent :: String -> String-indent = unlines . map ("  "++) . lines-showsEither :: Either a b -> ShowS-showsEither (Left _) = shows " (Left <>)"-showsEither (Right _) = shows " (Right <>)"--chunk :: S user -> L.ByteString-chunk s = L.chunk (top s) (current s)---- | 'runCompGet' is the complex executor-runCompGet :: (Monad m,Monoid w)-            => CompGet a y r w user m a-            -> r -> user -> L.ByteString-            -> m (CompResult y w user m a)-runCompGet g rIn userIn bsIn = liftM convert (unInternalGet g scIn rIn mempty sIn (TopFrame 1 mempty (ErrorFrame ecIn True)))-  where sIn = case bsIn of L.Empty -> S mempty mempty 0 userIn-                           L.Chunk ss bs -> S ss bs 0 userIn-        scIn a _r w sOut (TopFrame _u ys _pc) = return (IFinished ys w sOut a)-        ecIn sOut (TopFrame _u ys _pc) msg = return (IFailed ys (consumed sOut) msg)--        convert :: (Monad m) => IResult y String w user m a -> CompResult y w user m a-        convert (IFailed ys n msg) = CFailed ys n msg-        convert (IFinished ys w (S ss bs n user) a) = CFinished ys (L.chunk ss bs) n w user a-        convert (IPartial ys f) = CPartial ys (case f of-                                                 Left f' -> Left $ liftM convert f'-                                                 Right f' -> Right $ \bs -> liftM convert (f' bs) )---- | 'runGet' is the simple executor-runGet :: Get a y a -> L.ByteString -> Result y a-runGet g bsIn = convert (runIdentity (unInternalGet g scIn () mempty sIn (TopFrame 1 mempty (ErrorFrame ecIn True))))-  where sIn = case bsIn of L.Empty -> S mempty mempty 0 ()-                           L.Chunk ss bs -> S ss bs 0 ()-        scIn a _r w sOut (TopFrame _u ys _pc) = return (IFinished ys w sOut a)-        ecIn sOut (TopFrame _u ys _pc) msg = return (IFailed ys (consumed sOut) msg)--        convert :: IResult y String () () Identity a -> Result y a-        convert (IFailed ys n msg) = Failed ys n msg-        convert (IFinished ys _ (S ss bs n _) a) = Finished ys (L.chunk ss bs) n a-        convert (IPartial ys f) = Partial ys (case f of-                                                Left f' -> Left $ convert (runIdentity f')-                                                Right f' -> Right $ \bs -> convert (runIdentity (f' bs)))---- | Get the input currently available to the parser.  If this is--- preceded by 'suspendUntilComplete' then this will definitely by the--- complete length.-getAvailable :: InternalGet b y e r w user m L.ByteString-getAvailable = InternalGet $ \ sc r w s pc -> sc (chunk s) r w s pc---- | 'putAvailable' replaces the bytestream past the current # of read--- bytes.  This will also affect pending MonadError handler and--- MonadPlus branches.  I think all pending branches have to have--- fewer bytesRead than the current one.  If this is wrong then an--- error will be thrown.------ Currently this does not change the flag which indicates whether--- Nothing has ever been passed to a continuation to indicate the hard--- end of input.  This poperty is subject to change.------ WARNING : 'putAvailable' is still untested.-putAvailable :: L.ByteString -> InternalGet b y e r w user m ()-putAvailable bsNew = InternalGet $ \ sc r w (S _ss _bs n user) (TopFrame uIn ys pc) ->-  let s' = case bsNew of-             L.Empty -> S mempty mempty n user-             L.Chunk ss' bs' -> S ss' bs' n user-      rebuild (HandlerFrame u catcher sOld@(S _ss1 _bs1 n1 user1) future pc') =-               HandlerFrame u catcher sNew mempty (rebuild pc')-        where balance = n - n1-              whole | balance < 0 = error "Impossible? Cannot rebuild HandlerFrame in MyGetW.putAvailable: balance is negative!"-                    | otherwise = L.take balance . chunk $ collect sOld future-              sNew | balance /= L.length whole = error "Impossible? MyGetW.putAvailable.rebuild.sNew HandlerFrame assertion failed."-                   | otherwise = case mappend whole bsNew of-                                   L.Empty -> S mempty mempty n1 user1-                                   L.Chunk ss2 bs2 -> S ss2 bs2 n1 user1-      rebuild x@(ErrorFrame {}) = x-  in sc () r w s' (TopFrame uIn ys (rebuild pc))---- Internal access to full internal state, as helepr functions-getFull :: InternalGet b y e r w user m (S user)-getFull = InternalGet $ \ sc r w s pc -> sc s r w s pc-putFull :: (S user) -> InternalGet b y e r w user m ()-putFull s = InternalGet $ \ sc r w _ pc -> sc () r w s pc---- | Keep calling 'suspend' until Nothing is passed to the 'Partial'--- continuation.  This ensures all the data has been loaded into the--- state of the parser.-suspendUntilComplete :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m ()-suspendUntilComplete = do-  continue <- suspend-  if continue then suspendUntilComplete-    else return ()---- | Call suspend and throw and error with the provided @msg@ if--- Nothing has been passed to the 'Partial' continuation.  Otherwise--- return ().-suspendMsg :: ({-Show user,-} Error e, Monad m) => e -> InternalGet b y e r w user m ()-suspendMsg msg = do continue <- suspend-                    if continue then return ()-                      else throwError msg-{-# INLINE suspendMsg #-}---- | check that there are at least @n@ bytes available in the input.--- This will suspend if there is to little data.-ensureBytes :: ({-Show user,-} Error e, Monad m) => Int64 -> InternalGet b y e r w user m ()-ensureBytes n = do-  (S ss bs _offset _user) <- getFull-  if n < fromIntegral (S.length ss)-    then return ()-    else do if n == L.length (L.take n (L.chunk ss bs))-              then return ()-              else suspendMsg (strMsg "ensureBytes failed") >> ensureBytes n-{-# INLINE ensureBytes #-}---- | Pull @n@ bytes from the unput, as a lazy ByteString.  This will--- suspend if there is too little data.  -getLazyByteString :: ({-Show user,-} Error e, Monad m) => Int64 -> InternalGet b y e r w user m L.ByteString-getLazyByteString n = do-  (S ss bs offset user) <- getFull-  case splitAtOrDie n (L.chunk ss bs) of-    Just (consume,rest) -> do case rest of-                                L.Empty -> putFull (S mempty mempty (offset + n) user)-                                L.Chunk ss' bs' -> putFull (S ss' bs' (offset + n) user)-                              return consume-    Nothing -> suspendMsg (strMsg "getLazyByteString failed") >> getLazyByteString n-{-# INLINE getLazyByteString #-} -- important---- | 'suspend' is supposed to allow the execution of the monad to be--- halted, awaiting more input.  The computation is supposed to--- continue normally if this returns True, and is supposed to halt--- without calling suspend again if this returns False.  All future--- calls to suspend will return False automatically and no nothing--- else.------ These semantics are too specialized to let this escape this module.-class MonadSuspend y m | m -> y where-  suspend :: m Bool-  yieldItem :: y -> m ()-  flushItems :: m ()-  pendingItems :: m Int---- The instance here is fairly specific to the stack manipluation done--- by 'addFuture' to ('S' user) and to the packaging of the resumption--- function in 'IResult'('IPartial').-instance ({-Show user,-} Error e, Monad m) => MonadSuspend y (InternalGet b y e r w user m) where-  suspend = InternalGet $ \ sc r w sIn pcIn@(TopFrame u ys pcInside) ->-    if checkBool pcInside -- Has Nothing ever been given to a partial continuation?-      then let f Nothing = let pcOut = TopFrame u mempty (rememberFalse pcInside)-                           in sc False r w sIn pcOut-               f (Just bs') | L.null bs' = let pcOut = TopFrame u mempty pcInside-                                           in sc True r w sIn pcOut-                            | otherwise = let sOut = appendBS sIn bs'-                                              pcOut = TopFrame u mempty (addFuture bs' pcInside)-                                          in sc True r w sOut pcOut-           in return (IPartial ys (Right f))-      else sc False r w sIn pcIn  -- once Nothing has been given suspend is a no-op-   where appendBS s@(S {current=bs}) bs' = s { current=mappend bs bs' }-         -- addFuture puts the new data in 'future' where throwError's collect can find and use it-         addFuture _bs x@(ErrorFrame {}) = x-         addFuture bs x@(HandlerFrame {future_input=future, older_frame=pc}) =-           x { future_input=future |> bs, older_frame= addFuture bs pc }-         -- Once suspend is given Nothing, it remembers this and always returns False-         checkBool (HandlerFrame {older_frame=pc}) = checkBool pc-         checkBool (ErrorFrame {input_continues=b}) = b-         rememberFalse x@(ErrorFrame {}) = x { input_continues=False }-         rememberFalse x@(HandlerFrame {older_frame=pc}) = x { older_frame=rememberFalse pc }--  yieldItem y = InternalGet $ \sc r w s (TopFrame u ys pc) ->-                  let ys' = ys |> y-                  in sc () r w s (TopFrame u ys' pc)--  -- This does nothing when there are no items pending, otherwise it-  -- returns IPartial (Seq y) (Left ...)-  flushItems = InternalGet $ \sc r w s tf@(TopFrame u ys pc) ->-                 if Data.Sequence.null ys then sc () r w s tf-                   else let lazy'rest = sc () r w s (TopFrame u mempty pc)-                        in return (IPartial ys (Left lazy'rest))--  pendingItems = InternalGet $ \sc r w s pc@(TopFrame _ ys _) -> sc (Data.Sequence.length ys) r w s pc--          --- Useful wrappers around callCC--getCC :: (MonadCont m) => m (m a)-getCC = callCC (return . fix)-{-# INLINE getCC #-}--getCC1 :: (MonadCont m) => a -> m ( a -> m b ,  a  )-getCC1 x = callCC $ \k -> let jump a = k (jump,a) in return (jump,x)-{-# INLINE getCC1 #-}---- A unique sort of command...---- | 'discardInnerHandler' causes the most recent catchError to be--- discarded, i.e. this reduces the stack of error handlers by removing--- the top one.  These are the same handlers which Alternative((<|>)) and--- MonadPlus(mplus) use.  This is useful to commit to the current branch and let--- the garbage collector release the suspended handler and its hold on--- the earlier input.-discardInnerHandler :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m ()-discardInnerHandler = InternalGet $ \ sc r w s (TopFrame u ys pcIn) ->-  let pcOut = case pcIn of ErrorFrame {} -> pcIn-                           HandlerFrame _ _ _ _ pc' -> pc'-  in sc () r w s (TopFrame u ys pcOut)-{-# INLINE discardInnerHandler #-}---- | 'discardAllHandlers' causes all catchError handler to be--- discarded, i.e. this reduces the stack of error handlers to the top--- level handler.  These are the same handlers which Alternative((<|>))--- and MonadPlus(mplus) use.  This is useful to commit to the current--- branch and let the garbage collector release the suspended handlers--- and their hold on the earlier input.-discardAllHandlers :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m ()-discardAllHandlers = InternalGet $ \ sc r w s (TopFrame u ys pcIn) ->-  let base pc@(ErrorFrame {}) = pc-      base (HandlerFrame _ _ _ _ pc) = base pc-  in sc () r w s (TopFrame u ys (base pcIn))-{-# INLINE discardAllHandlers #-}---- The BinaryParser instance:---- INTERNALS :--- the getWord*,getPtr,getStorable functions call getByteString--- getByteString works with the first strict bytestring if the request fits---   otherwise it call getLazyByteString and allocates a new strict bytestring for the result--- getLazyByteString calls splitAtOrDie and---   on Nothing it suspends and if that returns True then it tries again else throwError---   on Just it returns the desired length lazy bytestring result and advances the parser---- | Discard the next @m@ bytes-skip :: ({-Show user,-} Error e, Monad m) => Int64 -> InternalGet b y e r w user m ()-skip m | m <=0 = return ()-       | otherwise = do-  ensureBytes m-  (S ss bs n user) <- getFull-  case L.drop m (L.chunk ss bs) of-    L.Empty -> putFull (S mempty mempty (n+m) user)-    L.Chunk ss' bs' -> putFull (S ss' bs' (n+m) user)---- | Return the number of 'bytesRead' so far.  Initially 0, never negative.-bytesRead :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m Int64-bytesRead = fmap consumed getFull---- | 'remaining' returns the number of bytes available before the--- current input runs out and 'suspend' might be called (this is the--- length of the lazy bytestring returned by 'getAvailable').  If this--- is preceded by 'suspendUntilComplete' then this will definitely by--- the complete length.-remaining :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m Int64-remaining = do (S ss bs _ _) <- getFull-               return $ fromIntegral (S.length ss) + (L.length bs)---- | Return True if the number of bytes 'remaining' is 0.  Any futher--- attempts to read an empty parser will cal 'suspend'.-isEmpty :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m Bool-isEmpty = do (S ss bs _ _) <- getFull-             return $ (S.null ss) && (L.null bs)--spanOf :: ({-Show user,-} Error e, Monad m) => (Word8 -> Bool) ->  InternalGet b y e r w user m (L.ByteString)-spanOf f = do let loop = do (S ss bs n user) <- getFull-                            let (pre,post) = L.span f (L.chunk ss bs)-                            case post of-                              L.Empty -> putFull (S mempty mempty (n + L.length pre) user)-                              L.Chunk ss' bs' -> putFull (S ss' bs' (n + L.length pre) user)-                            if L.null post-                              then fmap ((L.toChunks pre)++) $ do-                                     continue <- suspend-                                     if continue then loop-                                       else return (L.toChunks pre)-                              else return (L.toChunks pre)-              fmap L.fromChunks loop-{-# INLINE spanOf #-}---- | Pull @n@ bytes from the input, as a strict ByteString.  This will--- suspend if there is too little data.  If the result spans multiple--- lazy chunks then the result occupies a freshly allocated strict--- bytestring, otherwise it fits in a single chunk and refers to the--- same immutable memory block as the whole chunk.-getByteString :: ({-Show user,-} Error e, Monad m) => Int -> InternalGet b y e r w user m S.ByteString-getByteString nIn = do-  (S ss bs n user) <- getFull-  if nIn < S.length ss-    then do let (pre,post) = S.splitAt nIn ss-            putFull (S post bs (n+fromIntegral nIn) user)-            return pre-    -- Expect nIn to be less than S.length ss the vast majority of times-    -- so do not worry about doing anything fancy here.-    else fmap (S.concat . L.toChunks) (getLazyByteString (fromIntegral nIn))-{-# INLINE getByteString #-} -- important--getWordhost :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m Word-getWordhost = getStorable-{-# INLINE getWordhost #-}--getWord8 :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m Word8-getWord8 = getPtr 1-{-# INLINE getWord8 #-}--getWord16be,getWord16le,getWord16host :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m Word16-getWord16be = do-    s <- getByteString 2-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w16` 8) .|.-              (fromIntegral (s `S.unsafeIndex` 1))-{-# INLINE getWord16be #-}-getWord16le = do-    s <- getByteString 2-    return $! (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w16` 8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord16le #-}-getWord16host = getStorable-{-# INLINE getWord16host #-}--getWord32be,getWord32le,getWord32host :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m Word32-getWord32be = do-    s <- getByteString 4-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w32` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w32` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w32`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 3) )-{-# INLINE getWord32be #-}-getWord32le = do-    s <- getByteString 4-    return $! (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w32` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w32` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w32`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord32le #-}-getWord32host = getStorable-{-# INLINE getWord32host #-}---getWord64be,getWord64le,getWord64host :: ({-Show user,-} Error e, Monad m) => InternalGet b y e r w user m Word64-getWord64be = do-    s <- getByteString 8-    return $! (fromIntegral (s `S.unsafeIndex` 0) `shiftl_w64` 56) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w64` 48) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w64` 40) .|.-              (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w64` 32) .|.-              (fromIntegral (s `S.unsafeIndex` 4) `shiftl_w64` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 5) `shiftl_w64` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 6) `shiftl_w64`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 7) )-{-# INLINE getWord64be #-}-getWord64le = do-    s <- getByteString 8-    return $! (fromIntegral (s `S.unsafeIndex` 7) `shiftl_w64` 56) .|.-              (fromIntegral (s `S.unsafeIndex` 6) `shiftl_w64` 48) .|.-              (fromIntegral (s `S.unsafeIndex` 5) `shiftl_w64` 40) .|.-              (fromIntegral (s `S.unsafeIndex` 4) `shiftl_w64` 32) .|.-              (fromIntegral (s `S.unsafeIndex` 3) `shiftl_w64` 24) .|.-              (fromIntegral (s `S.unsafeIndex` 2) `shiftl_w64` 16) .|.-              (fromIntegral (s `S.unsafeIndex` 1) `shiftl_w64`  8) .|.-              (fromIntegral (s `S.unsafeIndex` 0) )-{-# INLINE getWord64le #-}-getWord64host = getStorable-{-# INLINE getWord64host #-}--instance ({-Show user,-} Error e, Monad m) => P.BinaryParser (InternalGet b y e r w user m) where-  skip = skip . fromIntegral-  bytesRead = fmap fromIntegral bytesRead-  remaining = fmap fromIntegral remaining-  isEmpty = isEmpty-  spanOf = fmap (S.concat . L.toChunks) . spanOf--  getByteString = getByteString-  getWordhost = getWordhost-  getWord8 = getWord8--  getWord16be = getWord16be-  getWord32be = getWord32be-  getWord64be = getWord64be--  getWord16le = getWord16le-  getWord32le = getWord32le-  getWord64le = getWord64le--  getWord16host = getWord16host-  getWord32host = getWord32host-  getWord64host = getWord64host---- Below here are the class instances-    -instance ({-Show user,-} Error e, Monad m) => Functor (InternalGet b y e r w user m) where-  fmap f m = InternalGet (\sc -> unInternalGet m (sc . f))-  {-# INLINE fmap #-}--instance ({-Show user,-} Monad m,Error e) => Monad (InternalGet b y e r w user m) where-  return a = InternalGet (\sc -> sc a)-  {-# INLINE return #-}-  m >>= k  = InternalGet (\sc -> unInternalGet m (\a -> unInternalGet (k a) sc))-  {-# INLINE (>>=) #-}-  fail msg = throwError (strMsg msg)--instance MonadTrans (InternalGet b y e r w user) where-  lift m = InternalGet (\sc r w s pc -> m >>= \a -> sc a r w s pc)--instance ({-Show user,-} MonadIO m,Error e) => MonadIO (InternalGet b y e r w user m) where-  liftIO = lift . liftIO--getPC :: InternalGet b y e r w user m (TopFrame b y e w user m)-getPC = InternalGet $ \ sc r w s pc -> sc pc r w s pc--putPC :: TopFrame b y e w user m -> InternalGet b y e r w user m (TopFrame b y e w user m)-putPC pc = InternalGet $ \ sc r w s _pc -> sc pc r w s pc----countPC :: ({-Show user,-} Monad m) => InternalGet b y e r w user m Int-countPC :: (Monad m,Error e) => InternalGet b y e r w user m Int-countPC = do-  let go (ErrorFrame {}) i = i-      go (HandlerFrame _ _ _ _ pc) i = go pc $! succ i-  (TopFrame _ _ pc) <- getPC-  return (go pc 0)----instance ({-Show user,-} Monad m, Error e) => MonadCont (InternalGet b y e r w user m) where-instance (Show user, Error e) => MonadCont (InternalGet b y e r w user IO) where-  callCC receiver = InternalGet $ \scCaptured rCaptured wCaptured sIn pcIn@(TopFrame _u _ys pcCaptured) ->-    let -- cleanPC is a version of the stack that does not retain the user state or BinaryParser state-        cleanedPC = cleanPC pcCaptured-          where cleanPC (ErrorFrame {}) = CC_ErrorFrame-                cleanPC (HandlerFrame u f _ _ pc) = CC_HandlerFrame u f (cleanPC pc)-        -- kont is the continuation captured and passed to the receiver. It refers to cleanedPC-        -- and used this to 'rebuild' a new stack with the data & stack at the usage site.-        -- It also refers to rCaptured and wCaptured.-        kont a = InternalGet $ \_sc _r _w sDyn (TopFrame uDyn ysDyn pcDyn) -> seq cleanedPC $-          scCaptured a rCaptured wCaptured sDyn (TopFrame uDyn ysDyn (rebuild sDyn pcDyn cleanedPC))-  -- Error vs any-        rebuild _sNew new@(ErrorFrame {}) (CC_ErrorFrame) = new  -- adopt new version of shared dynamic root-        rebuild sNew (HandlerFrame _ _ _ _ pcNew) old@(CC_ErrorFrame) = rebuild sNew pcNew old-        rebuild sNew new@(ErrorFrame {}) (CC_HandlerFrame uOld catcherOld pcOld)-            = HandlerFrame uOld catcherOld sNew mempty (rebuild sNew new pcOld)-  -- Two Handlers or Futures-        rebuild sNew new@(HandlerFrame uNew _ _ _ pcNew) old@(CC_HandlerFrame uOld catcherOld pcOld) =-          case compare uNew uOld of-            GT -> rebuild sNew pcNew old    -- discard newer frame with larger uNew-            EQ -> new  -- adopt new version of shared dynamic root-            LT -> HandlerFrame uOld catcherOld sNew mempty (rebuild sNew new pcOld)-                  -- above updates and re-instantiates the old context, and proceeds deeper-    in unInternalGet (receiver kont) scCaptured rCaptured wCaptured sIn pcIn--instance ({-Show user,-} Monad m,Error e) => MonadError e (InternalGet b y e r w user m) where-  throwError msg = InternalGet $ \_sc _r _w s tf@(TopFrame u ys pcIn) ->-    let go (ErrorFrame ec _) = ec s tf msg-        go (HandlerFrame _ (Just catcher) s1 future pc1) = catcher (collect s1 future) (TopFrame u ys pc1) msg-        go (HandlerFrame _ Nothing _ _ pc1) = go pc1-    in go pcIn--  catchError mayFail handler = InternalGet $ \scCaptured rCaptured wCaptured s (TopFrame u ys pc) ->-    let pcWithHandler = let catcher s1 pc1 e1 = unInternalGet (handler e1) scCaptured rCaptured wCaptured s1 pc1-                        in TopFrame (succ u) ys (HandlerFrame u (Just catcher) s mempty pc)-        actionWithCleanup = mayFail >>= \a -> discardInnerHandler >> return a-    in unInternalGet actionWithCleanup scCaptured rCaptured wCaptured s pcWithHandler--instance ({-Show user,-} Monad m, Error e, Monoid w) => MonadWriter w (InternalGet b y e r w user m) where-  tell w'  = InternalGet (\sc r w -> sc () r (mappend w w'))-  listen m = InternalGet (\sc r w -> let sc' a r' w'= sc (a,w') r' (mappend w w')-                                     in unInternalGet m sc' r mempty)-  pass m   = InternalGet (\sc r w s pc -> let sc' (a,f) r' w' s' pc' = sc a r' (mappend w (f w')) s' pc'-                                          in unInternalGet m sc' r mempty s pc)--instance ({-Show user,-} Monad m, Error e) => MonadReader r (InternalGet b y e r w user m) where-  ask = InternalGet (\sc r -> sc r r)-  local f m = InternalGet (\sc r -> let sc' a _ = sc a r-                              in unInternalGet m sc' (f r))-              -instance ({-Show user,-} Monad m,Error e) => MonadState user (InternalGet b y e r w user m) where-  get   = InternalGet (\sc r w s -> sc (user_field s) r w s)-  put u = InternalGet (\sc r w s -> let s' = s {user_field=u}-                              in sc () r w s')--instance ({-Show user,-} Monad m, Error e) => MonadPlus (InternalGet b y e r w user m) where-  mzero = throwError noMsg-  mplus m1 m2 = catchError m1 (const m2)--instance ({-Show user,-} Monad m,Error e) => Applicative (InternalGet b y e r w user m) where-  pure = return-  (<*>) = ap--instance ({-Show user,-} Monad m,Error e) => Alternative (InternalGet b y e r w user m) where-  empty = mzero-  (<|>) = mplus---- | I use splitAt without tolerating too few bytes, so write a Maybe version.--- This is the only place I invoke L.Chunk as constructor instead of pattern matching.--- I claim that the first argument cannot be empty.-splitAtOrDie :: Int64 -> L.ByteString -> Maybe (L.ByteString, L.ByteString)-splitAtOrDie i ps | i <= 0 = Just (L.Empty, ps)-splitAtOrDie _i L.Empty = Nothing-splitAtOrDie i (L.Chunk x xs) | i < len = let (pre,post) = S.splitAt (fromIntegral i) x-                                          in Just (L.Chunk pre L.Empty-                                                  ,L.Chunk post xs)-                              | otherwise = case splitAtOrDie (i-len) xs of-                                              Nothing -> Nothing-                                              Just (y1,y2) -> Just (L.Chunk x y1,y2)-  where len = fromIntegral (S.length x)-{-# INLINE splitAtOrDie #-}---- getPtr copied from binary's Get.hs---------------------------------------------------------------------------- Primtives---- helper, get a raw Ptr onto a strict ByteString copied out of the--- underlying lazy byteString. So many indirections from the raw parser--- state that my head hurts...--getPtr :: ({-Show user,-} Error e, Monad m,Storable a) => Int -> InternalGet b y e r w user m a-getPtr n = do-    (fp,o,_) <- fmap S.toForeignPtr (getByteString n)-    return . S.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)-{-# INLINE getPtr #-}--getStorable :: forall b y e r w user m a. ({-Show user,-} Error e, Monad m,Storable a) => InternalGet b y e r w user m a-getStorable = do-    (fp,o,_) <- fmap S.toForeignPtr (getByteString (sizeOf (undefined :: a)))-    return . S.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)-{-# INLINE getStorable #-}---- Unchecked shifts copied from binary's Get.hs----------------------------------------------------------------------------------------------------------------------------------------------------- Unchecked shifts--shiftl_w16 :: Word16 -> Int -> Word16-shiftl_w32 :: Word32 -> Int -> Word32-shiftl_w64 :: Word64 -> Int -> Word64--#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#`   i)-shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#`   i)--#if WORD_SIZE_IN_BITS < 64-shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)--#if __GLASGOW_HASKELL__ <= 606--- Exported by GHC.Word in GHC 6.8 and higher-foreign import ccall unsafe "stg_uncheckedShiftL64"-    uncheckedShiftL64#     :: Word64# -> Int# -> Word64#-#endif--#else-shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)-#endif--#else-shiftl_w16 = shiftL-shiftl_w32 = shiftL-shiftl_w64 = shiftL-#endif--{- TESTING -}--chomp :: CompGet b y () String () IO ()-chomp = getByteString 1 >>= \w -> let string = map (toEnum . fromEnum) (S.unpack w)-                                  in tell string >> pr ("chomp "++show (S.unpack w)++" <"++string++">")--feed x (CPartial _ q) = either id ($ (Just (L.pack [x]))) q-feed x y = return y--test g bs = runCompGet g () () (L.pack bs)--test10 :: IO (CompResult () String () IO [()])-test10 = test (mplus (pr "go" >> replicateM 5 chomp >> pr "die" >> mzero) (pr "reborn" >> replicateM 10 chomp)) [1] >>= feed 2 >>= feed 3 >>= feed 4 >>= feed 5 >>= feed 6 >>= feed 7 >>=feed 8 >>= feed 9 >>= feed 10--pr :: (Show a) => a -> CompGet b y () String () IO ()-pr = liftIO . Prelude.print---- Ensure the stack fixing in getCC and catchError play well together:-testDepth :: IO (CompResult () String () IO S.ByteString)-testDepth = test depth [] >>= feed12 >>= feedNothing where-  p s = do countPC >>= \d -> bytesRead >>= \ b -> remaining >>= \r -> pr ("stack depth",d,"bytes read",b,"bytes remaining",r,s)-           pr =<< getPC -  depth = do-    p "begin"-    catchError (p "mayFail" >> return () >> mzero)-               (\_ -> p "handler")-    p "middle"-    (_,w) <- listen $ do-      chomp-      flip catchError (\_ -> p "handler before getCC1") $ do-        (jumpWith,i) <- getCC1 (0 :: Int)                  -- jump into first handler from nested scope-        pr ("after jump and with "++show i)-        p "after getCC1, inside 1 handler"-        flip catchError (\_ -> p "handler after getCC1" >> mzero) $ do-          p "after getCC1, inside 2 handlers, before chomp"-          chomp-          p "after getCC1, inside 2 handlers, after chomp"-          mplus (p "in mplus left" >> if i<3 then jumpWith (succ i) else mzero) -- jump from nested scope to outer scope-                (p "in mplus right" >> mzero)-    pr ("listen",w)-    p "another middle"-    j2 <- flip catchError (\_ -> p "last handler" >> return Nothing) $ do-            chomp-            p "before inner jump2"-            (jump2,j) <- getCC1 (0 :: Int)                -- jump2 to inside this scope from afterwards-            p ("after inner jump2 with "++ show j)-            chomp-            if odd j then throwError "Ouch"-              else return (Just jump2)-    chomp-    p "after catchError scope of jump2"-    chomp-    maybe (pr "Nothing") (\j2->pr "jump2" >> j2 1) j2     -- jump2 back into previously left scope--    p "end"-    a <- getByteString 6-    p "got 6, now suspendUntilComplete"-    suspendUntilComplete-    return a--feed12 :: CompResult y w user IO a -> IO (CompResult y w user IO a)-feed12 = foldr1 (>=>) . map feeds $ [ [2*i,2*i+1]  | i <- [24..45]]-  where feeds x (CPartial _ q) = print ("feed1",x)  >> either id ($ (Just (L.pack x))) q-        feeds x y = return y--feedNothing :: CompResult y w user IO a -> IO (CompResult y w user IO a)-feedNothing (CPartial _ f) = case f of-                               Left g -> g-                               Right f' -> f' Nothing-feedNothing x = return x--runWCI todo = runCompGet todo () () mempty--lpl :: (MonadWriter w m, Monoid w) => m (a,w->w) -> m ((a,w),w)-lpl todo = listen . pass $ do-  ((a,f),w1) <- listen todo-  return ((a,w1),f)--flipCase a | isUpper a = toLower a-           | otherwise = toUpper a--wci,wci2,wci3 ::  IO (CompResult () String () IO ())-wci = runWCI $ do-  tell "a"-  x <- listen (tell "b")-  pr ("listen",x)-  y <- lpl $ do-         tell "c"-         return ("pass",map flipCase)-  pr y-  tell "d"-  return ()--{--("listen",((),"b"))-(("pass","c"),"C")-(CFinished (Empty) (0) ("abCd") (()) (()))--}--wci2 = runWCI $ do-  tell "a"-  (jump,i) <- getCC1 (0 :: Int)-  pr ("I see ",i)-  if i < 3-    then do-      x <- listen (tell "b")-      pr ("listen",x)-      y <- lpl $ do-             tell "c"-             if even i then jump (succ i) else return ()-             return ("pass",map flipCase)-      pr y-      tell "d"-      jump (succ i)-    else tell "e"-  tell "f"-  return ()--{--("I see ",0)-("listen",((),"b"))-("I see ",1)-("listen",((),"b"))-(("pass","c"),"C")-("I see ",2)-("listen",((),"b"))-("I see ",3)-(CFinished (Empty) (0) ("aef") (()) (()))--}---- Test jumping into and out of the 'lpl : listen . pass .listen scope:-wci3 = runWCI $ do-  tell "a0"-  (top,j) <- getCC1 (0 :: Int)-  pr ("top sees",j)-  x <- listen (tell ",b1")-  pr ("listen",x)-  (((msg,jump,i),w1),w2) <- lpl $ do-         tell ",c2"-         (jump,i) <- getCC1 j-         pr ("jump sees",i)-         tell ",e100"-         if even i then top (succ i) else return ()-         return (("pass",jump,i),map flipCase)-  pr ((msg,i),w1,w2)-  tell ",d3"-  if i < 3 then jump (succ i) else return ()-  tell ",f1024"-  return ()- where tell s = Control.Monad.Writer.Class.tell s >> pr ("told "++s)-{--Annotated run of wci3 shows WriterT w (ContT r IO) semantics:--"told a0"                 -- "a0" is part of final log-                            -- ### no final log entries from the next section-("top sees",0)-"told ,b1"-("listen",((),",b1"))-"told ,c2"-("jump sees",0)-"told ,e100"-                             -- the use of 'top' erases the b1 c2 e100 above-("top sees",1) -"told ,b1"-("listen",((),",b1"))-"told ,c2"-("jump sees",1)-"told ,e100"-(("pass",1),",c2,e100",",C2,E100")-"told ,d3"-                              -- the use of 'jump' erases the b1 C2 E100 d3-("jump sees",2)         -"told ,e100"-                              -- the use of 'top' erases the e100-                          -- ### final log entries from here down-("top sees",3)-"told ,b1"-("listen",((),",b1"))-"told ,c2"-("jump sees",3)-"told ,e100"-(("pass",3),",c2,e100",",C2,E100")-"told ,d3"-"told ,f1024"-(CFinished (Empty) (0) ("a0,b1,C2,E100,d3,f1024") (()) (()))--}
− Text/ProtocolBuffers/Option.hs 
@@ -1,47 +0,0 @@-module Text.ProtocolBuffers.Option(Option(..),OptionFlag(..),Optional,Require,NotRequired,Required,op'Last,op'Merge) where--import Data.Monoid(Monoid(..))--class OptionFlag a where-  isValid :: Option a b -> Bool--instance OptionFlag NotRequired where-  isValid _ = True-instance OptionFlag Required where-  isValid Absent = False-  isValid _ = True--data NotRequired-data Required--type Optional b = Option NotRequired b-type Require b = Option Required b--data Option a b where -  Absent :: OptionFlag a => Option a b-  Present :: OptionFlag a => b -> Option a b--op'Last :: Option a b -> Option a b -> Option a b-op'Last Absent y = y-op'Last x Absent = x-op'Last x y = y--op'Merge :: (Monoid b) => Option a b -> Option a b -> Option a b-op'Merge Absent y = y-op'Merge x Absent = x-op'Merge (Present x) (Present y) = Present (mappend x y)--instance (OptionFlag a,Show b) => Show (Option a b) where-  show Absent = "Absent"-  show (Present b) = "Present ("++show b++")"--instance (OptionFlag a,Eq b) => Eq (Option a b) where-  (==) Absent Absent = True-  (==) (Present x) (Present y) = (==) x y-  (==) _ _ = False--instance (OptionFlag a,Ord b) => Ord (Option a b) where-  compare Absent Absent = EQ-  compare Absent _ = LT-  compare _ Absent = GT-  compare (Present x) (Present y) = compare x y
− Text/ProtocolBuffers/Parser.hs 
@@ -1,364 +0,0 @@-module Text.ProtocolBuffers.Parser(pbParse,parseProto,filename1,filename2) where--import qualified Text.DescriptorProtos.DescriptorProto                as D(DescriptorProto)-import qualified Text.DescriptorProtos.DescriptorProto                as D.DescriptorProto(DescriptorProto(..))-import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D(ExtensionRange(ExtensionRange))-import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.ExtensionRange(ExtensionRange(..))-import qualified Text.DescriptorProtos.EnumDescriptorProto            as D(EnumDescriptorProto)-import qualified Text.DescriptorProtos.EnumDescriptorProto            as D.EnumDescriptorProto(EnumDescriptorProto(..))-import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D(EnumValueDescriptorProto(EnumValueDescriptorProto))-import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D.EnumValueDescriptorProto(EnumValueDescriptorProto(..))-import qualified Text.DescriptorProtos.FieldDescriptorProto           as D(FieldDescriptorProto(FieldDescriptorProto))-import qualified Text.DescriptorProtos.FieldDescriptorProto           as D.FieldDescriptorProto(FieldDescriptorProto(..))-import qualified Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto(Type)-import           Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto.Type(Type(..))-import qualified Text.DescriptorProtos.FieldOptions                   as D(FieldOptions)-import qualified Text.DescriptorProtos.FieldOptions                   as D.FieldOptions(FieldOptions(..))-import qualified Text.DescriptorProtos.FileDescriptorProto            as D(FileDescriptorProto)-import qualified Text.DescriptorProtos.FileDescriptorProto            as D.FileDescriptorProto(FileDescriptorProto(..))-import qualified Text.DescriptorProtos.FileOptions                    as D.FileOptions(FileOptions(..))-import qualified Text.DescriptorProtos.MessageOptions                 as D.MessageOptions(MessageOptions(..))-import qualified Text.DescriptorProtos.MethodDescriptorProto          as D(MethodDescriptorProto(MethodDescriptorProto))-import qualified Text.DescriptorProtos.MethodDescriptorProto          as D.MethodDescriptorProto(MethodDescriptorProto(..))-import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D.ServiceDescriptorProto(ServiceDescriptorProto(..))--import Text.ProtocolBuffers.Lexer(Lexed(..),alexScanTokens,getLinePos)-import Text.ProtocolBuffers.Header(ByteString,Int32,Int64,Word32,Word64-                                  ,mergeEmpty,ReflectEnum(reflectEnumInfo),enumName)-import Text.ProtocolBuffers.Instances(parseLabel,parseType)-import Control.Monad(when,liftM3)-import qualified Data.ByteString.Lazy.Char8 as LC(unpack,pack,notElem,head,readFile)-import Data.Char(isUpper)-import Data.Ix(inRange)-import Data.Sequence((|>))-import Text.ParserCombinators.Parsec(GenParser,ParseError,runParser,sourceName-                                    ,getInput,setInput,getPosition,setPosition,getState,setState-                                    ,(<?>),(<|>),option,token,choice,between,eof,unexpected)-import Text.ParserCombinators.Parsec.Pos(newPos)--type P = GenParser Lexed--pbParse :: String -> IO (Either ParseError D.FileDescriptorProto)-pbParse filename = fmap (parseProto filename) (LC.readFile filename)--parseProto :: String -> ByteString -> Either ParseError D.FileDescriptorProto-parseProto filename file = do-  let lexed = alexScanTokens file-      ipos = case lexed of-               [] -> setPosition (newPos filename 0 0)-               (l:_) -> setPosition (newPos filename (getLinePos l) 0)-  runParser (ipos >> parser) (initState filename) filename lexed--filename1,filename2 :: String-filename1 = "/tmp/unittest.proto"-filename2 = "/tmp/descriptor.proto"--initState :: String -> D.FileDescriptorProto-initState filename = mergeEmpty {D.FileDescriptorProto.name=Just (LC.pack filename)}--{-# INLINE mayRead #-}-mayRead :: ReadS a -> String -> Maybe a-mayRead f s = case f s of [(a,"")] -> Just a; _ -> Nothing--true,false :: ByteString-true = LC.pack "true"-false = LC.pack "false"---- Use 'token' via 'tok' to make all the parsers for the Lexed values-tok :: (Lexed -> Maybe a) -> P s a-tok f = token show (\lexed -> newPos "" (getLinePos lexed) 0) f--pChar :: Char -> P s ()-pChar c = tok (\l-> case l of L _ x -> if (x==c) then return () else Nothing-                              _ -> Nothing) <?> ("character "++show c)--eol :: P s ()-eol = pChar ';'--pName :: ByteString -> P s ByteString-pName name = tok (\l-> case l of L_Name _ x -> if (x==name) then return x else Nothing-                                 _ -> Nothing) <?> ("name "++show (LC.unpack name))--strLit :: P s ByteString-strLit = tok (\l-> case l of L_String _ x -> return x-                             _ -> Nothing) <?> "quoted bytes or string literal"--intLit :: (Num a) => P s a-intLit = tok (\l-> case l of L_Integer _ x -> return (fromInteger x)-                             _ -> Nothing) <?> "integer literal"--fieldInt :: (Num a) => P s a-fieldInt = tok (\l-> case l of L_Integer _ x | inRange validRange x && not (inRange reservedRange x) -> return (fromInteger x)-                               _ -> Nothing) <?> "field number (from 0 to 2^29-1 and not in 19000 to 19999)"-  where validRange = (0,(2^(29::Int))-1)-        reservedRange = (19000,19999)--enumInt :: (Num a) => P s a-enumInt = tok (\l-> case l of L_Integer _ x | inRange validRange x -> return (fromInteger x)-                              _ -> Nothing) <?> "enum value (from 0 to 2^31-1)"-  where validRange = (0,(2^(31::Int))-1)--doubleLit :: P s Double-doubleLit = tok (\l-> case l of L_Double _ x -> return x-                                L_Integer _ x -> return (fromInteger x)-                                _ -> Nothing) <?> "double (or integer) literal"--ident,ident1,ident_package :: P s ByteString-ident = tok (\l-> case l of L_Name _ x -> return x-                            _ -> Nothing) <?> "identifier (perhaps dotted)"--ident1 = tok (\l-> case l of L_Name _ x | LC.notElem '.' x -> return x-                             _ -> Nothing) <?> "identifier (not dotted)"--ident_package = tok (\l-> case l of L_Name _ x | LC.head x /= '.' -> return x-                                    _ -> Nothing) <?> "package name (no leading dot)"--boolLit :: P s Bool-boolLit = tok (\l-> case l of L_Name _ x | x == true -> return True-                                         | x == false -> return False-                              _ -> Nothing) <?> "boolean literal ('true' or 'false')"--enumLit :: forall s a. (Read a,ReflectEnum a) => P s a -- This is very polymorphic, and with a good error message-enumLit = do-  s <- fmap' LC.unpack ident1-  case mayRead reads s of-    Just x -> return x-    Nothing -> let self = enumName (reflectEnumInfo (undefined :: a))-               in unexpected $ "Enum value not recognized: "++show s++", wanted enum value of type "++show self---- subParser changes the user state. It is a bit of a hack and is used--- to define an interesting style of parsing below.-subParser :: GenParser t sSub a -> sSub -> GenParser t s sSub-subParser doSub inSub = do-  in1 <- getInput-  pos1 <- getPosition-  let out = runParser (setPosition pos1 >> doSub >> getStatus) inSub (sourceName pos1) in1-  case out of Left pe -> fail ("the error message from the nested subParser was:\n"++indent (show pe))-              Right (outSub,in2,pos2) -> setInput in2 >> setPosition pos2 >> return outSub- where getStatus = liftM3 (,,) getState getInput getPosition-       indent = unlines . map (\s -> ' ':' ':s) . lines--{-# INLINE return' #-}-return' :: (Monad m) => a -> m a-return' a = return $! a--{-# INLINE fmap' #-}-fmap' :: (Monad m) => (a->b) -> m a -> m b-fmap' f m = m >>= \a -> seq a (return $! (f a))--type Update s = (s -> s) -> P s ()-update' :: Update s-update' f = getState >>= \s -> setState $! (f s)--parser :: P D.FileDescriptorProto D.FileDescriptorProto -parser = proto >> getState-  where proto = eof <|> (choice [ eol-                                , importFile-                                , package-                                , fileOption-                                , message upTopMsg-                                , enum upTopEnum-                                , extend upTopMsg upTopField-                                , service] >> proto)-        upTopMsg msg = update' (\s -> s {D.FileDescriptorProto.message_type=D.FileDescriptorProto.message_type s |> msg})-        upTopEnum e  = update' (\s -> s {D.FileDescriptorProto.enum_type=D.FileDescriptorProto.enum_type s |> e})-        upTopField f = update' (\s -> s {D.FileDescriptorProto.extension=D.FileDescriptorProto.extension s |> f})--importFile = pName (LC.pack "import") >> strLit >>= \p -> eol >> update' (\s -> s {D.FileDescriptorProto.dependency=(D.FileDescriptorProto.dependency s) |> p})--package = pName (LC.pack "package") >> ident_package >>= \p -> eol >> update' (\s -> s {D.FileDescriptorProto.package=Just p})--pOption :: P s String-pOption = pName (LC.pack "option") >> fmap LC.unpack ident1 >>= \optName -> pChar '=' >> return optName--fileOption = pOption >>= setOption >>= \p -> eol >> update' (\s -> s {D.FileDescriptorProto.options=Just p})-  where-    setOption optName = do-      old <- fmap (maybe mergeEmpty id . D.FileDescriptorProto.options) getState-      case optName of-        "java_package"         -> strLit >>= \p -> return' (old {D.FileOptions.java_package=Just p})-        "java_outer_classname" -> strLit >>= \p -> return' (old {D.FileOptions.java_outer_classname=Just p})-        "java_multiple_files"  -> boolLit >>= \p -> return' (old {D.FileOptions.java_multiple_files=Just p})-        "optimize_for"         -> enumLit >>= \p -> return' (old {D.FileOptions.optimize_for=Just p})-        s -> unexpected $ "option name "++s--message :: (D.DescriptorProto -> P s ()) -> P s ()-message up = pName (LC.pack "message") >> do-  self <- ident1-  up =<< subParser (pChar '{' >> subMessage) (mergeEmpty {D.DescriptorProto.name=Just self})---- subMessage is also used to parse group declarations-subMessage = (pChar '}') <|> (choice [ eol -                                     , field upNestedMsg Nothing >>= upMsgField-                                     , message upNestedMsg-                                     , enum upNestedEnum-                                     , extensions-                                     , extend upNestedMsg upMsgField-                                     , messageOption] >> subMessage)-  where upNestedMsg msg = update' (\s -> s {D.DescriptorProto.nested_type=D.DescriptorProto.nested_type s |> msg})-        upNestedEnum e  = update' (\s -> s {D.DescriptorProto.enum_type=D.DescriptorProto.enum_type s |> e})-        upMsgField f    = update' (\s -> s {D.DescriptorProto.field=D.DescriptorProto.field s |> f})--messageOption = pOption >>= setOption >>= \p -> eol >> update' (\s -> s {D.DescriptorProto.options=Just p}) -  where-    setOption optName = do-      old <- fmap (maybe mergeEmpty id . D.DescriptorProto.options) getState-      case optName of-        "message_set_wire_format" -> boolLit >>= \p -> return' (old {D.MessageOptions.message_set_wire_format=Just p})-        s -> unexpected $ "option name "++s--extend :: (D.DescriptorProto -> P s ()) -> (D.FieldDescriptorProto -> P s ())-       -> P s ()-extend upGroup upField = pName (LC.pack "extend") >> do-  typeExtendee <- ident-  let first = (eol >> first) <|> ((field upGroup (Just typeExtendee) >>= upField) >> rest)-      rest = pChar '}' <|> ((eol <|> (field upGroup (Just typeExtendee) >>= upField)) >> rest)-  pChar '{' >> first-  -field :: (D.DescriptorProto -> P s ()) -> Maybe ByteString-      -> P s D.FieldDescriptorProto-field upGroup maybeExtendee = do -  sLabel <- choice . map (pName . LC.pack) $ ["optional","repeated","required"]-  theLabel <- maybe (fail ("not a valid Label :"++show sLabel)) return (parseLabel (LC.unpack sLabel))-  sType <- ident-  let (maybeTypeCode,maybeTypeName) = case parseType (LC.unpack sType) of-                                        Just t -> (Just t,Nothing)-                                        Nothing -> (Nothing, Just sType)-  name <- ident1-  number <- pChar '=' >> fieldInt-  (maybeOptions,maybeDefault) <--    if maybeTypeCode == Just TYPE_GROUP-      then do when (not (isUpper (LC.head name)))-                   (fail $ "Group names must start with an upper case letter: "++show name)-              upGroup =<< subParser (pChar '{' >> subMessage) (mergeEmpty {D.DescriptorProto.name=Just name})-              return (Nothing,Nothing)-      else do hasBracket <- option False (pChar '[' >> return True)-              pair <- if not hasBracket then return (Nothing,Nothing)-                        else subParser (subBracketOptions maybeTypeCode) (Nothing,Nothing)-              eol-              return pair-  return $ D.FieldDescriptorProto-               { D.FieldDescriptorProto.name = Just name-               , D.FieldDescriptorProto.number = Just number-               , D.FieldDescriptorProto.label = Just theLabel-               , D.FieldDescriptorProto.type' = maybeTypeCode-               , D.FieldDescriptorProto.type_name = maybeTypeName-               , D.FieldDescriptorProto.extendee = maybeExtendee-               , D.FieldDescriptorProto.default_value = maybeDefault-               , D.FieldDescriptorProto.options = maybeOptions-               }--subBracketOptions :: Maybe Type-                  -> P (Maybe D.FieldOptions, Maybe ByteString) ()-subBracketOptions mt = (defaultConstant <|> fieldOptions) >> (pChar ']' <|> (pChar ',' >> subBracketOptions mt))-  where defaultConstant = do-          pName (LC.pack "default")-          x <- pChar '=' >> constant mt-          (a,_) <- getState-          setState $! (a,Just x)-        fieldOptions = do-          optName <- fmap LC.unpack ident1-          pChar '='-          (mOld,def) <- getState-          let old = maybe mergeEmpty id mOld-          case optName of-            "ctype" | (Just TYPE_STRING) == mt -> do-              enumLit >>= \p -> let new = old {D.FieldOptions.ctype=Just p}-                                in seq new $ setState $! (Just new,def)-            "experimental_map_key" | Nothing == mt -> do-              strLit >>= \p -> let new = old {D.FieldOptions.experimental_map_key=Just p}-                               in seq new $ setState $! (Just new,def)-            s -> unexpected $ "option name: "++s---- This does a type and range safe parsing of the default value,--- except for enum constants which cannot be checked (the definition--- may not have been parsed yet).------ Double and Float are checked to be not-Nan and not-Inf.  The--- int-like types are checked to be within the corresponding range.-constant :: Maybe Type -> P s ByteString-constant Nothing = ident1 -- hopefully a matching enum-constant (Just t) =-  case t of-    TYPE_DOUBLE  -> do d <- doubleLit-                       when (isNaN d || isInfinite d)-                            (fail $ "Floating point literal "++show d++" is out of range for type "++show t)-                       return' (LC.pack . show $ d)-    TYPE_FLOAT   -> do d <- doubleLit-                       let fl :: Float-                           fl = read (show d)-                       when (isNaN fl || isInfinite fl || (d==0) /= (fl==0))-                            (fail $ "Floating point literal "++show d++" is out of range for type "++show t)-                       return' (LC.pack . show $ d)-    TYPE_BOOL    -> boolLit >>= \b -> return' $ if b then true else false-    TYPE_STRING  -> strLit-    TYPE_BYTES   -> strLit-    TYPE_GROUP   -> unexpected $ "cannot have a constant literal for type "++show t-    TYPE_MESSAGE -> unexpected $ "cannot have a constant literal for type "++show t-    TYPE_ENUM    -> ident1 -- IMPOSSIBLE : SHOULD HAVE HAD Maybe Type PARAMETER match Nothing-    TYPE_SFIXED32 -> f (undefined :: Int32)-    TYPE_SINT32   -> f (undefined :: Int32)-    TYPE_INT32    -> f (undefined :: Int32)-    TYPE_SFIXED64 -> f (undefined :: Int64)-    TYPE_SINT64   -> f (undefined :: Int64)-    TYPE_INT64    -> f (undefined :: Int64)-    TYPE_FIXED32  -> f (undefined :: Word32)-    TYPE_UINT32   -> f (undefined :: Word32)-    TYPE_FIXED64  -> f (undefined :: Word64)-    TYPE_UINT64   -> f (undefined :: Word64)-  where f :: (Bounded a,Integral a) => a -> P s ByteString-        f u = do let range = (toInteger (minBound `asTypeOf` u),toInteger (maxBound `asTypeOf` u))-                 i <- intLit-                 when (not (inRange range i))-                      (fail $ "default value "++show i++" is out of range for type "++show t)-                 return' (LC.pack . show $ i)--enum :: (D.EnumDescriptorProto -> P s ()) -> P s ()-enum up = pName (LC.pack "enum") >> do-  self <- ident1-  up =<< subParser (pChar '{' >> subEnum) (mergeEmpty {D.EnumDescriptorProto.name=Just self})--subEnum = (pChar '}') <|> ((eol <|> enumVal <|> (pOption >>= setOption)) >> subEnum)-  where setOption = fail "There are no options for enumerations (when this parser was written)"-        enumVal :: P D.EnumDescriptorProto ()-        enumVal = do-          name <- ident1-          number <- pChar '=' >> enumInt-          eol-          let v = D.EnumValueDescriptorProto-                       { D.EnumValueDescriptorProto.name = Just name-                       , D.EnumValueDescriptorProto.number = Just number-                       , D.EnumValueDescriptorProto.options = Nothing-                       }-          update' (\s -> s {D.EnumDescriptorProto.value=D.EnumDescriptorProto.value s |> v})--extensions = pName (LC.pack "extensions") >> do-  start <- fmap Just fieldInt-  pName (LC.pack "to")-  end <- (fmap Just fieldInt <|> fmap (const Nothing) (pName (LC.pack "max")))-  let e = D.ExtensionRange-            { D.ExtensionRange.start = start-            , D.ExtensionRange.end = end-            }-  update' (\s -> s {D.DescriptorProto.extension_range=D.DescriptorProto.extension_range s |> e})--service = pName (LC.pack "service") >> do-  name <- ident1-  f <- subParser (pChar '{' >> subRpc) (mergeEmpty {D.ServiceDescriptorProto.name=Just name})-  update' (\s -> s {D.FileDescriptorProto.service=D.FileDescriptorProto.service s |> f})-       - where subRpc = pChar '}' <|> ((eol <|> rpc <|> (pOption >>= setOption)) >> subRpc)-       rpc = pName (LC.pack "rpc") >> do-               name <- ident1-               input <- between (pChar '(') (pChar ')') ident1-               pName (LC.pack "returns")-               output <- between (pChar '(') (pChar ')') ident1-               eol-               let m = D.MethodDescriptorProto-                         { D.MethodDescriptorProto.name=Just name-                         , D.MethodDescriptorProto.input_type=Just input-                         , D.MethodDescriptorProto.output_type=Just output-                         , D.MethodDescriptorProto.options=Nothing-                         }-               update' (\s -> s {D.ServiceDescriptorProto.method=D.ServiceDescriptorProto.method s |> m})-       setOption = fail "There are no options for services (when this parser was written)"
Text/ProtocolBuffers/Reflections.hs view
@@ -1,228 +1,129 @@--- To get the defaults working sanely, I need to encode at least some reflection information.--- The to-be-bootstrapped descriptor.proto structures are not parsed enough for sane default usage.--- So this is currently over-designed for the immediate need of DescriptorInfo -> number -> FieldInfo -> Maybe HsDefault.--- These data structures and API are quite likely to be rewritten.+-- | A strong feature of the protocol-buffers package is that it does+-- not contain any structures defined by descriptor.proto!  This+-- prevents me hitting any annoying circular dependencies.  The+-- structures defined here are included in each module created by+-- 'hprotoc'.  They are optimized for use in code generation. ----- A strong feature of this is that it does not contain any structures defined by descriptor.proto!--- This prevents me hitting any circular dependencies.+-- These values can be inspected at runtime by the user's code, but I+-- have yet to write much documentation.  Luckily the record field+-- names are somewhat descriptive. ----- -module Text.ProtocolBuffers.Reflections(ProtoName(..),DescriptorInfo(..),FieldInfo(..)-                                       ,HsDefault(..),EnumInfo(..),EnumInfoApp-                                       ,ReflectDescriptor(..),ReflectEnum(..),GetMessageInfo(..)-                                       ,parseDefDouble,parseDefFloat-                                       ,parseDefBool,parseDefInteger-                                       ,parseDefString,parseDefBytes-                                       ,cEncode,cDecode-                                       ) where+module Text.ProtocolBuffers.Reflections+  ( ProtoName(..),ProtoInfo(..),DescriptorInfo(..),FieldInfo(..),KeyInfo+  , HsDefault(..),EnumInfo(..),EnumInfoApp+  , ReflectDescriptor(..),ReflectEnum(..),GetMessageInfo(..)+  ) where  import Text.ProtocolBuffers.Basic -import qualified Data.ByteString.Lazy.UTF8 as U-import qualified Data.ByteString.Lazy as BS (null,pack,unpack)-import qualified Data.ByteString.Lazy.Char8 as BSC(pack,unpack)-import Numeric(readHex,readOct,readDec,showOct)-import Data.Char(ord,chr,isHexDigit,isOctDigit,toLower)-import Data.List(sort,unfoldr)+import Data.List(sort) import qualified Data.Foldable as F(toList)-import Data.Bits(Bits((.|.),shiftL))-import Data.Word(Word8) import Data.Set(Set)-import qualified Data.Set as Set+import qualified Data.Set as Set(fromDistinctAscList) import Data.Generics(Data) import Data.Typeable(Typeable)-import Test.QuickCheck(quickCheck)-import Codec.Binary.UTF8.String(encode)+import Data.Map(Map) -data ProtoName = ProtoName { haskellPrefix :: String  -- Haskell specific prefix to module hierarchy (e.g. Text)-                           , parentModule :: String   -- Proto specified namespace (like java)-                           , baseName :: String       -- unqualfied name of this thing+-- | This is fully qualified name data type for code generation.  The+-- 'haskellPrefix' was possibly specified on the 'hprotoc' command+-- line.  The 'parentModule' is a combination of the module prefix+-- from the '.proto' file and any nested levels of definition.+--+-- The name components are likely to have been mangled to ensure the+-- 'baseName' started with an uppercase letter, in @ ['A'..'Z'] @.+data ProtoName = ProtoName { haskellPrefix :: String  -- ^ Haskell specific prefix to module hierarchy (e.g. Text.Foo)+                           , parentModule :: String   -- ^ Proto specified namespace (like Com.Google.Bar)+                           , baseName :: String       -- ^ unqualfied name of this thing (with no periods)                            }   deriving (Show,Read,Eq,Ord,Data,Typeable) +data ProtoInfo = ProtoInfo { protoMod :: ProtoName+                           , protoFilePath :: [FilePath]+                           , protoSource :: String+                           , extensionKeys :: Seq KeyInfo+                           , messages :: [DescriptorInfo]+                           , enums :: [EnumInfo]+                           , knownKeyMap :: Map ProtoName (Seq FieldInfo)+                           }+  deriving (Show,Read,Eq,Ord,Data,Typeable)+ data DescriptorInfo = DescriptorInfo { descName :: ProtoName-                                     , fields :: Seq FieldInfo }+                                     , descFilePath :: [FilePath]+                                     , isGroup :: Bool+                                     , fields :: Seq FieldInfo +                                     , keys :: Seq KeyInfo+                                     , extRanges :: [(FieldId,FieldId)]+                                     , knownKeys :: Seq FieldInfo+                                     }   deriving (Show,Read,Eq,Ord,Data,Typeable) +-- | 'GetMessageInfo' is used in getting messages from the wire.  It+-- supplies the 'Set' of precomposed wire tags that must be found in+-- the message as well as a 'Set' of all allowed tags (including known+-- extension fields and all required wire tags).+--+-- Extension fields not in the allowedTags set are still loaded, but+-- only as 'ByteString' blobs that will have to interpreted later. data GetMessageInfo = GetMessageInfo { requiredTags :: Set WireTag                                      , allowedTags :: Set WireTag                                      }   deriving (Show,Read,Eq,Ord,Data,Typeable) -data FieldInfo = FieldInfo { fieldName :: String-                           , fieldNumber :: FieldId-                           , wireTag :: WireTag-                           , wireTagLength :: Int64           -- ^ Bytes required in the Varint formatted wireTag-                           , isRequired :: Bool-                           , canRepeat :: Bool-                           , typeCode :: FieldType            -- ^ fromEnum of Text.DescriptorProtos.FieldDescriptorProto.Type-                           , typeName :: Maybe String-                           , hsRawDefault :: Maybe ByteString -- ^ crappy, perhaps escaped, thing-                           , hsDefault :: Maybe HsDefault     -- ^ nice parsed thing+type KeyInfo = (ProtoName,FieldInfo)++data FieldInfo = FieldInfo { fieldName     :: ProtoName+                           , fieldNumber   :: FieldId+                           , wireTag       :: WireTag+                           , wireTagLength :: WireSize         -- ^ Bytes required in the Varint formatted wireTag+                           , isRequired    :: Bool+                           , canRepeat     :: Bool+                           , typeCode      :: FieldType        -- ^ fromEnum of Text.DescriptorProtos.FieldDescriptorProto.Type+                           , typeName      :: Maybe ProtoName  -- ^ Set for Messages,Groups,and Enums+                           , hsRawDefault  :: Maybe ByteString -- ^ crappy, but not escaped, thing+                           , hsDefault     :: Maybe HsDefault  -- ^ nice parsed thing                            }   deriving (Show,Read,Eq,Ord,Data,Typeable)  -- | 'HsDefault' stores the parsed default from the proto file in a -- form that will make a nice literal in the--- Language.Haskell.Exts.Syntax sense.+-- "Language.Haskell.Exts.Syntax" code generation by 'hprotoc'.+--+-- Note that Utf8 labeled byte sequences have been stripped to just+-- 'ByteString' here as this is sufficient for code generation. data HsDefault = HsDef'Bool Bool                | HsDef'ByteString ByteString                | HsDef'Rational Rational                | HsDef'Integer Integer+               | HsDef'Enum String   deriving (Show,Read,Eq,Ord,Data,Typeable)  data EnumInfo = EnumInfo { enumName :: ProtoName-                         , enumItems :: [(EnumCode,String)]+                         , enumFilePath :: [FilePath]+                         , enumValues :: [(EnumCode,String)]                          }   deriving (Show,Read,Eq,Ord,Data,Typeable)  type EnumInfoApp e = [(EnumCode,String,e)] -class ReflectDescriptor m where-  getMessageInfo :: m -> GetMessageInfo           -- Must not inspect argument-  getMessageInfo x = cached where cached = makeMessageInfo (reflectDescriptorInfo (undefined `asTypeOf` x))-  reflectDescriptorInfo :: m -> DescriptorInfo    -- Must not inspect argument-  parentOfDescriptor :: m -> Maybe DescriptorInfo -- Must not inspect argument-  parentOfDescriptor _ = Nothing- class ReflectEnum e where   reflectEnum :: EnumInfoApp e-  reflectEnumInfo :: e -> EnumInfo            -- Must not inspect argument-  parentOfEnum :: e -> Maybe DescriptorInfo   -- Must not inspect argument+  reflectEnumInfo :: e -> EnumInfo            -- ^ Must not inspect argument+  parentOfEnum :: e -> Maybe DescriptorInfo   -- ^ Must not inspect argument   parentOfEnum _ = Nothing -makeMessageInfo :: DescriptorInfo -> GetMessageInfo-makeMessageInfo di = GetMessageInfo { requiredTags = Set.fromDistinctAscList . sort $-                                        [ wireTag f | f <- F.toList (fields di), isRequired f]-                                    , allowedTags = Set.fromDistinctAscList . sort $-                                        [ wireTag f | f <- F.toList (fields di)]-                                    }----- From here down is code used to parse the format of the default values in the .proto files--{-# INLINE mayRead #-}-mayRead :: ReadS a -> String -> Maybe a-mayRead f s = case f s of [(a,"")] -> Just a; _ -> Nothing--parseDefDouble :: ByteString -> Maybe HsDefault-parseDefDouble bs = fmap (HsDef'Rational . toRational) -                    . mayRead reads' . U.toString $ bs-  where reads' :: ReadS Double-        reads' = readSigned' reads--parseDefFloat :: ByteString -> Maybe HsDefault-parseDefFloat bs = fmap  (HsDef'Rational . toRational) -                   . mayRead reads' . U.toString $ bs-  where reads' :: ReadS Float-        reads' = readSigned' reads--parseDefString :: ByteString -> Maybe HsDefault-parseDefString bs = Just (HsDef'ByteString bs)--parseDefBytes :: ByteString -> Maybe HsDefault-parseDefBytes bs = Just . HsDef'ByteString -                   . BS.pack . cDecode . BSC.unpack $ bs-parseDefInteger :: ByteString -> Maybe HsDefault-parseDefInteger bs = fmap HsDef'Integer . mayRead checkSign . U.toString $ bs-    where checkSign = readSigned' checkBase-          checkBase ('0':'x':xs) = readHex xs-          checkBase ('0':xs) = readOct xs-          checkBase xs = readDec xs--parseDefBool :: ByteString -> Maybe HsDefault-parseDefBool bs | bs == BSC.pack "true" = Just (HsDef'Bool True)-                | bs == BSC.pack "false" = Just (HsDef'Bool False)-                | otherwise = Nothing---- The Numeric.readSigned does not handle '+' for some odd reason-readSigned' f ('-':xs) = map (\(v,s) -> (-v,s)) . f $ xs-readSigned' f ('+':xs) = f xs-readSigned' f xs = f xs---- see google's stubs/strutil.cc lines 398-449/1121 and C99 specification--- This mainly targets three digit octal codes-cEncode :: [Word8] -> [Char]-cEncode = concatMap one where-  one :: Word8 -> [Char]-  one x | (32 < x) && (x < 127) = [toEnum .  fromEnum $  x]  -- main case of unescaped value-  one 9 = sl  't'-  one 10 = sl 'n'-  one 13 = sl 'r'-  one 34 = sl '"'-  one 39 = sl '\''-  one 92 = sl '\\'-  one 0 = '\\':"000"-  one x | x < 8 = '\\':'0':'0':(showOct x "")-        | x < 32 = '\\':'0':(showOct x "")-        | otherwise = '\\':(showOct x "")-  sl c = ['\\',c]---- Takes backslash encoded junk an retrieves the underlying bytes--- The \x is kosher, but \X is non-standard.  I recognize \X because google does--- Convert backslash-escaped \u and \U crap into UTF-8 (this is why we have to use concat!)--- It only works on characters and values in the range 0..255 (the Char8's returned by ByteString.Char.unpack)--- It ONLY consumes up to 3 octal digits when reading an escape sequence, the rest are left alone.-cDecode :: [Char] -> [Word8]-cDecode = concat . unfoldr one where-  one :: [Char] -> Maybe ([Word8],[Char])-  one (x:xs) | x /= '\\' = Just (checkChar8 x,xs)  -- main case of unescaped value-  one [] = Nothing-  one ('\\':[]) = error "Text.ProtocolBuffers.Reflections.cDecode cannot understand ending with a backslash"-  one ('\\':ys) | 1 <= len =-      case mayRead readOct oct of-        Just w -> Just (checkByte w,rest)-        Nothing -> error "Text.ProtocolBuffers.Reflections.cDecode failed to decode octal sequence"-    where oct = takeWhile isOctDigit (take 3 ys)-          len = length oct-          rest = drop len ys-  one ('\\':x:ys) | 'x' == toLower x && ok =-      case mayRead readHex hex of-        Just w -> Just (checkByte w,rest)-        Nothing -> error "Text.ProtocolBuffers.Reflections.cDecode failed to decode hex sequence"-    where ok = 1 <= length hex-          (hex,rest) = span isHexDigit ys-  one ('\\':'u':ys) | ok =-      case mayRead readHex hex of-        Just w -> Just (checkUnicode w,rest)-        Nothing -> error "Text.ProtocolBuffers.Reflections.cDecode failed to decode 4 char unicode sequence"-    where ok = all isHexDigit hex && 4 == length hex-          (hex,rest) = splitAt 4 ys-  one ('\\':'U':ys) | ok =-      case mayRead readHex hex of-        Just w -> Just (checkUnicode w,rest)-        Nothing -> error "Text.ProtocolBuffers.Reflections.cDecode failed to decode 8 char unicode sequence"-    where ok = all isHexDigit hex && 8 == length hex-          (hex,rest) = splitAt 8 ys-  one ('\\':(x:xs)) = Just ([decode x],xs)-  decode :: Char -> Word8-  decode 'a' = 7-  decode 'b' = 8-  decode 't' = 9-  decode 'n' = 10-  decode 'v' = 11-  decode 'f' = 12-  decode 'r' = 13-  decode '\"' = 34-  decode '\'' = 39-  decode '?' = 63    -- C99 rule : "\?" is '?'-  decode '\\' = 92-  decode x | toLower x == 'x' = error "Text.ProtocolBuffers.Reflections.cDecode cannot understand your 'xX' hexadecimal escaped value"-  decode x | toLower x == 'u' = error "Text.ProtocolBuffers.Reflections.cDecode cannot understand your 'uU' unicode UTF-8 hexadecimal escaped value"-  decode _ = error "Text.ProtocolBuffers.Reflections.cDecode cannot understand your backslash-escaped value"-  checkChar8 :: Char -> [Word8]-  checkChar8 c | (0 <= i) && (i <= 255) = [toEnum i]-               | otherwise = error "Text.ProtocolBuffers.Reflections.cDecode found Char out of range 0..255"-    where i = fromEnum c-  checkByte :: Integer -> [Word8]-  checkByte i | (0 <= i) && (i <= 255) = [fromInteger i]-              | otherwise = error "Text.ProtocolBuffers.Reflections.cDecode found Oct/Hex Int out of range 0..255"-  checkUnicode :: Integer -> [Word8]-  checkUnicode i | (0 <= i) && (i <= 127) = [fromInteger i]-                 | i <= maxChar = encode [ toEnum . fromInteger $ i ]-                 | otherwise = error "Text.ProtocolBuffers.Reflections.cDecode found Unicode Char out of range 0..0x10FFFF"-    where maxChar = toInteger (fromEnum (maxBound ::Char)) -- 0x10FFFF--testEncodeDecode = let q :: [Int] -> Bool-                       q =  (\y -> let x = map (\z->abs z `mod` 255) y-                                   in  x == (map fromEnum . cDecode . cEncode . map toEnum$ x))-                   in quickCheck q+class ReflectDescriptor m where+  -- | This is obtained via 'read' on the stored 'show' output of the 'DescriptorInfo' in+  -- the module file. It is used in getting messages from the wire.+  -- +  -- Must not inspect argument+  getMessageInfo :: m -> GetMessageInfo+  getMessageInfo x = cached+    where cached = makeMessageInfo (reflectDescriptorInfo (undefined `asTypeOf` x))+          makeMessageInfo :: DescriptorInfo -> GetMessageInfo+          makeMessageInfo di = GetMessageInfo { requiredTags = Set.fromDistinctAscList . sort $+                                                  [ wireTag f | f <- F.toList (fields di), isRequired f]+                                              , allowedTags = Set.fromDistinctAscList . sort $+                                                  [ wireTag f | f <- F.toList (fields di)] +++                                                  [ wireTag f | f <- F.toList (knownKeys di)]+                                              }+  reflectDescriptorInfo :: m -> DescriptorInfo    -- ^ Must not inspect argument
− Text/ProtocolBuffers/Resolve.hs 
@@ -1,200 +0,0 @@--- | Text.ProtocolBuffers.Resolve takes the output of Text.ProtocolBuffers.Parse and runs all--- the preprocessing and sanity checks that precede Text.ProtocolBuffers.Gen creating modules.------ Currently this involves mangling the names, building a NameSpace (or [NameSpace]), and making--- all the names fully qualified (and setting TYPE_MESSAGE or TYPE_ENUM) as appropriate.--- Field names are also checked against a list of reserved words, appending a single quote--- to disambiguate.--- All names from Parser should start with a letter, but _ is also handled by replacing with U' or u'.--- Anything else will trigger a "subborn ..." error.--- Name resolution failure are not handled elegantly: it will kill the system with a long error message.------ TODO: treat names with leading "." as already "fully-qualified"---       make sure the optional fields that will be needed are not Nothing-module Text.ProtocolBuffers.Resolve(resolveFDP) where--import qualified Text.DescriptorProtos.DescriptorProto                as D(DescriptorProto)-import qualified Text.DescriptorProtos.DescriptorProto                as D.DescriptorProto(DescriptorProto(..))-import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D(ExtensionRange(ExtensionRange))-import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.ExtensionRange(ExtensionRange(..))-import qualified Text.DescriptorProtos.EnumDescriptorProto            as D(EnumDescriptorProto)-import qualified Text.DescriptorProtos.EnumDescriptorProto            as D.EnumDescriptorProto(EnumDescriptorProto(..))-import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D(EnumValueDescriptorProto(EnumValueDescriptorProto))-import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D.EnumValueDescriptorProto(EnumValueDescriptorProto(..))-import qualified Text.DescriptorProtos.FieldDescriptorProto           as D(FieldDescriptorProto(FieldDescriptorProto))-import qualified Text.DescriptorProtos.FieldDescriptorProto           as D.FieldDescriptorProto(FieldDescriptorProto(..))-import qualified Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto(Type)-import           Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto.Type(Type(..))-import qualified Text.DescriptorProtos.FieldOptions                   as D(FieldOptions)-import qualified Text.DescriptorProtos.FieldOptions                   as D.FieldOptions(FieldOptions(..))-import qualified Text.DescriptorProtos.FileDescriptorProto            as D(FileDescriptorProto)-import qualified Text.DescriptorProtos.FileDescriptorProto            as D.FileDescriptorProto(FileDescriptorProto(..))-import qualified Text.DescriptorProtos.FileOptions                    as D.FileOptions(FileOptions(..))-import qualified Text.DescriptorProtos.MessageOptions                 as D.MessageOptions(MessageOptions(..))-import qualified Text.DescriptorProtos.MethodDescriptorProto          as D(MethodDescriptorProto(MethodDescriptorProto))-import qualified Text.DescriptorProtos.MethodDescriptorProto          as D.MethodDescriptorProto(MethodDescriptorProto(..))-import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D.ServiceDescriptorProto(ServiceDescriptorProto(..))--import Text.ProtocolBuffers.Header-import Text.ProtocolBuffers.Parser--import Control.Monad-import Data.Char-import qualified Data.Foldable as F-import qualified Data.Traversable as T-import Data.Maybe-import Data.Map(Map)-import qualified Data.Map as M-import Data.List(unfoldr,span,inits,foldl')-import qualified Data.ByteString.Lazy.UTF8 as U-import qualified Data.ByteString.Lazy.Char8 as LC--err s = error $ "Text.ProtocolBuffers.Resolve fatal error encountered, message:\n"++indent s-  where indent = unlines . map (\s -> ' ':' ':s) . lines--newlineBefore s = go where-  go [] = []-  go (x:xs) | x `elem` s = '\n':x:go xs-            | otherwise = x:go xs--encodeModuleNames :: [String] -> ByteString-encodeModuleNames [] = mempty-encodeModuleNames xs = U.fromString . foldr1 (\a b -> a ++ '.':b) $ xs--mangleModuleNames :: ByteString -> [String]-mangleModuleNames bs = map mangleModuleName . splitDot . U.toString $ bs --mangleCap :: Maybe ByteString -> [String]-mangleCap = mangleModuleNames . fromMaybe mempty--mangleCap1 :: Maybe ByteString -> String-mangleCap1 = mangleModuleName . U.toString . fromMaybe mempty--splitDot :: String -> [String]-splitDot = unfoldr s where-  s ('.':xs) = s xs-  s [] = Nothing-  s xs = Just (span ('.'/=) xs)--mangleModuleName :: String -> String-mangleModuleName [] = "Empty'Name"-mangleModuleName ('_':xs) = "U'"++xs-mangleModuleName (x:xs) | isLower x = let x' = toUpper x-                                      in if isLower x' then error ("subborn lower case"++show (x:xs))-                                           else x': xs-mangleModuleName xs = xs--mangleFieldName :: Maybe ByteString -> Maybe ByteString-mangleFieldName = fmap (U.fromString . fixname . U.toString)-  where fixname [] = "empty'name"-        fixname ('_':xs) = "u'"++xs-        fixname (x:xs) | isUpper x = let x' = toLower x-                                     in if isUpper x' then error ("stubborn upper case: "++show (x:xs))-                                          else fixname (x':xs)-        fixname xs | xs `elem` reserved = xs ++ "'"-        fixname xs = xs--reserved :: [String]-reserved = ["case","class","data","default","deriving","do","else"-           ,"if","import","in","infix","infixl","infixr","instance"-           ,"let","module","newtype","of","then","type","where"] -- also reserved is "_"--newtype NameSpace = NameSpace {unNameSpace::(Map String ([String],NameType,Maybe NameSpace))}-  deriving (Show,Read)-data NameType = Message | Enumeration | Void-  deriving (Show,Read)--type Context = [NameSpace]-type Resolver = Context -> ByteString -> ByteString--seeContext :: Context -> [String] -seeContext cx = map ((++"[]") . concatMap (\k -> show k ++ ", ") . M.keys . unNameSpace) cx--data Box a = Box a-instance Show (Box a) where show (Box {}) = "Box"-test = do-  (Right fdp) <- pbParse filename2-  return (Box (fdp,resolveFDP fdp))--resolveFDP :: D.FileDescriptorProto -> D.FileDescriptorProto-resolveFDP protoIn =-  let prefix = mangleCap . msum $-                 [ D.FileOptions.java_outer_classname =<< (D.FileDescriptorProto.options protoIn)-                 , D.FileOptions.java_package =<< (D.FileDescriptorProto.options protoIn)-                 , D.FileDescriptorProto.package protoIn]-      -- Make top-most root NameSpace-      nameSpace = fromMaybe (NameSpace mempty) $ foldr addPrefix protoNames $ zip prefix (tail (inits prefix))-        where addPrefix (s1,ss) ns = Just . NameSpace $ M.singleton s1 (ss,Void,ns)-              protoNames | null protoMsgs = Nothing-                         | otherwise = Just . NameSpace . M.fromList $ protoMsgs-                where protoMsgs = F.foldr ((:) . msgNames prefix) protoEnums (D.FileDescriptorProto.message_type protoIn)-                      protoEnums = F.foldr ((:) . enumNames prefix) [] (D.FileDescriptorProto.enum_type protoIn)-                      msgNames context dIn =-                        let s1 = mangleCap1 (D.DescriptorProto.name dIn)-                            ss' = context ++ [s1]-                            dNames | null dMsgs = Nothing-                                   | otherwise = Just . NameSpace . M.fromList $ dMsgs-                            dMsgs = F.foldr ((:) . msgNames ss') dEnums (D.DescriptorProto.nested_type dIn)-                            dEnums = F.foldr ((:) . enumNames ss') [] (D.DescriptorProto.enum_type dIn)-                        in ( s1 , (ss',Message,dNames) )-                      enumNames context eIn =-                        let s1 = mangleCap1 (D.EnumDescriptorProto.name eIn)-                        in ( s1 , (context ++ [s1],Enumeration,Nothing) )-      -- Context stack for resolving the top level declarations-      protoContext :: Context-      protoContext = foldl' (\nss@(NameSpace ns:_) pre -> case M.lookup pre ns of-                                                            Just (_,Void,Just ns1) -> (ns1:nss)-                                                            _ -> nss) [nameSpace] prefix-      descend :: Context -> Maybe ByteString -> Context-      descend cx@(NameSpace n:_) name =-        case M.lookup mangled n of-          Just (_,_,Nothing) -> cx-          Just (_,_,Just ns1) -> ns1:cx-          x -> error $ "Name resolution failed:\n"++unlines (mangled : show x : "KNOWN NAMES" : seeContext cx)-       where mangled = mangleCap1 name-      resolve :: Context -> Maybe ByteString -> Maybe ByteString-      resolve context bsIn = fmap fst (resolve2 context bsIn)-      resolve2 :: Context -> Maybe ByteString -> Maybe (ByteString,NameType)-      resolve2 context Nothing = Nothing-      resolve2 context bsIn = let nameIn = mangleCap bsIn-                                  resolver [] (NameSpace cx) = error $ "resolve2.resolver []\n"++unlines [show bsIn,show nameIn,show (M.keys cx)]-                                  resolver [name] (NameSpace cx) =-                                    case M.lookup name cx of-                                      Nothing -> Nothing-                                      Just (fqName,nameType,_) -> Just (encodeModuleNames fqName,nameType)-                                  resolver (name:rest) (NameSpace cx) =-                                    case M.lookup name cx of-                                      Nothing -> Nothing-                                      Just (_,_,Nothing) -> Nothing-                                      Just (_,_,Just cx') -> resolver rest cx'-                              in msum . map (resolver nameIn) $ context-      processFDP fdp = fdp-        { D.FileDescriptorProto.message_type=fmap (processMSG protoContext) (D.FileDescriptorProto.message_type fdp)-        , D.FileDescriptorProto.enum_type=fmap (processENM protoContext) (D.FileDescriptorProto.enum_type fdp)-        , D.FileDescriptorProto.service=fmap (processSRV protoContext) (D.FileDescriptorProto.service fdp)-        , D.FileDescriptorProto.extension=fmap (processFLD protoContext Nothing) (D.FileDescriptorProto.extension fdp) }-      processMSG cx msg = msg-        { D.DescriptorProto.name=self-        , D.DescriptorProto.field=fmap (processFLD cx' self) (D.DescriptorProto.field msg)-        , D.DescriptorProto.extension=fmap (processFLD cx' self) (D.DescriptorProto.extension msg)-        , D.DescriptorProto.nested_type=fmap (processMSG cx') (D.DescriptorProto.nested_type msg)-        , D.DescriptorProto.enum_type=fmap (processENM cx') (D.DescriptorProto.enum_type msg) }-       where cx' = descend cx (D.DescriptorProto.name msg)-             self = resolve cx (D.DescriptorProto.name msg)-      processFLD cx mp f = f { D.FieldDescriptorProto.name=mangleFieldName (D.FieldDescriptorProto.name f)-                             , D.FieldDescriptorProto.type'=(D.FieldDescriptorProto.type' f) `mplus` (fmap (t.snd) r2)-                             , D.FieldDescriptorProto.type_name=checkSelf mp (fmap fst r2)-                             , D.FieldDescriptorProto.extendee=resolve cx (D.FieldDescriptorProto.extendee f) }-       where r2 = resolve2 cx (D.FieldDescriptorProto.type_name f)-             t Message = TYPE_MESSAGE-             t Enumeration = TYPE_ENUM-             t Void = error "processFLD cannot resolve type_name to Void"-             checkSelf (Just parent) x@(Just name) = if parent==name then (D.FieldDescriptorProto.type_name f) else x-             checkSelf _ x = x-      processENM cx e = e { D.EnumDescriptorProto.name=resolve cx (D.EnumDescriptorProto.name e) }-      processSRV cx s = s { D.ServiceDescriptorProto.name=resolve cx (D.ServiceDescriptorProto.name s)-                          , D.ServiceDescriptorProto.method=fmap (processMTD cx) (D.ServiceDescriptorProto.method s) }-      processMTD cx m = m { D.MethodDescriptorProto.name=mangleFieldName (D.MethodDescriptorProto.name m)-                          , D.MethodDescriptorProto.input_type=resolve cx (D.MethodDescriptorProto.input_type m)-                          , D.MethodDescriptorProto.output_type=resolve cx (D.MethodDescriptorProto.output_type m) }-  in processFDP protoIn
Text/ProtocolBuffers/WireMessage.hs view
@@ -1,112 +1,249 @@--- http://code.google.com/apis/protocolbuffers/docs/encoding.html-{- | This module cooperates with the generated code to implement the-  Wire instances.  +{- | +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.  -} module Text.ProtocolBuffers.WireMessage-    ( LazyResult(..),runGetOnLazy,runPut,size'Varint+    ( -- * User API functions+      -- ** Main encoding and decoding operations (non-delimited message encoding)+      messageSize,messagePut,messageGet,messagePutM,messageGetM+      -- **  The author's home brewed encoding (length written first to delimit message)+    , 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,Get,runPut,runGet,runGetOnLazy,getFromBS+      -- * The Wire monad itself.  Users should beware that passing an incompatible 'FieldType' is a runtime error or fail     , Wire(..)-    , size,lenSize,putSize+      -- * The internal exports, for use by generated code and the "Text.ProtcolBuffer.Extensions" module+    , size'Varint,toWireType,toWireTag,mkWireTag+    , prependMessageSize,putSize,putVarUInt,getVarInt,putLazyByteString,splitWireTag     , wireSizeReq,wireSizeOpt,wireSizeRep     , wirePutReq,wirePutOpt,wirePutRep-    , getMessage,getBareMessage-    , unknownField) where--import Text.ProtocolBuffers.Basic-import Text.ProtocolBuffers.Reflections(ReflectDescriptor(reflectDescriptorInfo,getMessageInfo)-                                       ,DescriptorInfo(..),GetMessageInfo(..))-import Text.ProtocolBuffers.Mergeable(Mergeable(mergeEmpty))+    , wireSizeErr,wirePutErr,wireGetErr+    , getMessage,getBareMessage,getMessageWith,getBareMessageWith+    , unknownField,unknown+    , 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 Data.Bits (Bits(..))-import Data.Generics (Data(..),Typeable(..))-import Data.List (unfoldr,genericLength)-import Data.Map (Map,unionWith)-import Data.Monoid (Monoid(..))-import Data.Word (Word8)-import qualified Data.ByteString as Strict (ByteString)-import qualified Data.ByteString.Lazy as BS (length,pack,fromChunks)-import qualified Data.ByteString.Lazy.Internal as BS (ByteString(Empty,Chunk),chunk)+import qualified Data.ByteString.Lazy as BS (length) import qualified Data.Foldable as F(foldl',forM_)-import qualified Data.Sequence as Seq(length)+import Data.List (genericLength) import qualified Data.Set as Set(notMember,delete,null)--- GHC internals for getting at Double and Float representation as Word64 and Word32+import Data.Typeable (Typeable(..))+import Foreign(alloca,peek,poke,castPtr) import GHC.Exts (Double(D#),Float(F#),unsafeCoerce#)-import GHC.Word (Word64(W64#),Word32(W32#))+import GHC.Word (Word64(W64#)) -- ,Word32(W32#))+import System.IO.Unsafe(unsafePerformIO) -import Data.Binary.Put (Put,putWord8,putWord32be,putWord64be,putLazyByteString,runPut)-import Data.Binary.Builder (Builder)-import Data.Binary.Strict.Class (BinaryParser(getWord8,getWord32be,getWord64be,getByteString,bytesRead,isEmpty))-import qualified Data.Binary.Strict.IncrementalGet as Get (Get,runGet,Result(..))+-- binary package+import Data.Binary.Put (Put,runPut,putWord8,putWord32le,putWord64le,putLazyByteString) --- import qualified Data.ByteString.Lazy as BS (unpack)--- import Numeric+import Text.ProtocolBuffers.Basic+import Text.ProtocolBuffers.Get as Get (Result(..),Get,runGet,bytesRead,isReallyEmpty+                                       ,getWord8,getWord32le,getWord64le,getLazyByteString)+import Text.ProtocolBuffers.Mergeable()+import Text.ProtocolBuffers.Reflections(ReflectDescriptor(reflectDescriptorInfo,getMessageInfo)+                                       ,DescriptorInfo(..),GetMessageInfo(..)) --- Make IncrementalGet run on the Lazy ByteStrings-data LazyResult r = Failed String-                  | Finished ByteString r-                  | Partial (ByteString -> LazyResult r)+-- External user API for writing and reading messages -runGetOnLazy :: Get.Get r r -> ByteString -> LazyResult r-runGetOnLazy parser (BS.Chunk x rest) = resolve rest $ Get.runGet parser x-runGetOnLazy parser BS.Empty = resolve BS.Empty $ Get.runGet parser mempty+-- | 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 10 msg -resolve :: ByteString -> Get.Result r -> LazyResult r-resolve _rest (Get.Failed s)              = Failed s-resolve rest (Get.Finished b s)           = Finished (BS.chunk b rest) s-resolve (BS.Chunk x rest) (Get.Partial f) = resolve rest (f x)-resolve BS.Empty (Get.Partial f)          = newPartial-  where newPartial= Partial f'-        f' BS.Empty = newPartial-        f' (BS.Chunk x rest) = resolve rest (f x)+-- | 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 11 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 fi msg = let headerSize = size'Varint (getWireTag (toWireTag fi 11))+                            in headerSize + messageWithLengthSize msg -data WireSize = WireSize { childSize, internalSize :: !Int64 }+-- | 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 = runPut (messagePutM msg) --- The first Int argument is fromEnum on--- Text.DescriptorProtos.FieldDescriptorProto.Type.  The values of the--- Int parameters cannot change without breaking all serialized--- protocol buffers.-class Wire b where-  {-# INLINE wireSize #-}-  wireSize :: FieldType -> b -> WireSize-  {-# INLINE wirePut #-}-  wirePut :: FieldType -> b -> Put-  {-# INLINE wireGet #-}-  wireGet :: BinaryParser get => FieldType -> get b+-- | 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 = runPut (messageWithLengthPutM 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 = wirePut 10 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 = wirePut 11 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 fi msg = let wireTag = toWireTag fi 11+                            in wirePutReq wireTag 11 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 bs = runGetOnLazy (messageGetM) 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 bs = runGetOnLazy (messageWithLengthGetM) 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 = wireGet 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 = wireGet 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 = do+  wireTag <- fmap WireTag getVarInt+  let (fieldId,wireType) = splitWireTag wireTag+  when (wireType /= 2) (fail $ "messageAsFieldGetM: wireType was not 2 "++show (fieldId,wireType))+  msg <- wireGet 11+  return (fieldId,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 parser bs = case runGetOnLazy parser bs of+                        Left msg -> error msg+                        Right (r,_) -> r++-- This is like 'runGet' but any 'Result' of 'Partial' is converted in+-- a @ Left "Not enoguh input" @ error.  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 parser bs = resolve (runGet parser bs)+  where resolve :: Result r -> Either String (r,ByteString)+        resolve (Failed i s) = Left ("Failed at "++show i++" : "++s)+        resolve (Finished bsOut _i r) = Right (r,bsOut)+        resolve (Partial {}) = Left ("Not enough input")++-- | Used in generated code.+prependMessageSize :: WireSize -> WireSize+prependMessageSize n = n + size'Varint n+ {-# INLINE wirePutReq #-}+-- | Used in generated code. wirePutReq :: Wire b => WireTag -> FieldType -> b -> Put+wirePutReq wireTag 10 b = let startTag = getWireTag wireTag+                              endTag = succ startTag+                          in putVarUInt startTag >> wirePut 10 b >> putVarUInt endTag wirePutReq wireTag fieldType b = putVarUInt (getWireTag wireTag) >> wirePut fieldType b  {-# INLINE wirePutOpt #-}+-- | Used in generated code. wirePutOpt :: Wire b => WireTag -> FieldType -> Maybe b -> Put-wirePutOpt wireTag fieldType Nothing = return ()-wirePutOpt wireTag fieldType (Just b) = putVarUInt (getWireTag wireTag) >> wirePut fieldType b +wirePutOpt _wireTag _fieldType Nothing = return ()+wirePutOpt wireTag fieldType (Just b) = wirePutReq wireTag fieldType b   {-# INLINE wirePutRep #-}+-- | Used in generated code. wirePutRep :: Wire b => WireTag -> FieldType -> Seq b -> Put-wirePutRep wireTag fieldType bs = F.forM_ bs (\b -> putVarUInt (getWireTag wireTag) >> wirePut fieldType b)+wirePutRep wireTag fieldType bs = F.forM_ bs (\b -> wirePutReq wireTag fieldType b)  {-# INLINE wireSizeReq #-}+-- | Used in generated code. wireSizeReq :: Wire b => Int64 -> FieldType -> b -> Int64-wireSizeReq tagSize i v = tagSize + childSize (wireSize i v)+wireSizeReq tagSize 10 v = tagSize + wireSize 10 v + tagSize+wireSizeReq tagSize  i v = tagSize + wireSize i v  {-# INLINE wireSizeOpt #-}+-- | Used in generated code. wireSizeOpt :: Wire b => Int64 -> FieldType -> Maybe b -> Int64-wireSizeOpt tagSize i = maybe 0 (wireSizeReq tagSize i)+wireSizeOpt _tagSize _i Nothing = 0+wireSizeOpt tagSize i (Just v) = wireSizeReq tagSize i v  {-# INLINE wireSizeRep #-}+-- | Used in generated code. wireSizeRep :: Wire b => Int64 -> FieldType -> Seq b -> Int64-wireSizeRep tagSize i s = tagSize*(fromIntegral (Seq.length s)) + F.foldl' (\n v -> n+childSize(wireSize i v)) 0 s+wireSizeRep tagSize i s = F.foldl' (\n v -> n + wireSizeReq tagSize i v) 0 s +-- | Used in generated code. putSize :: WireSize -> Put-putSize (WireSize {internalSize = x}) = putVarUInt x+putSize = putVarUInt +toWireTag :: FieldId -> FieldType -> WireTag+toWireTag fieldId fieldType+    = ((fromIntegral . getFieldId $ fieldId) `shiftL` 3) .|. (fromIntegral . getWireType . toWireType $ fieldType)++mkWireTag :: FieldId -> WireType -> WireTag+mkWireTag fieldId fieldType+    = ((fromIntegral . getFieldId $ fieldId) `shiftL` 3) .|. (fromIntegral . getWireType $ fieldType)++splitWireTag :: WireTag -> (FieldId,WireType)+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.-getMessage :: forall get message. (BinaryParser get, Mergeable message, ReflectDescriptor message)-           => (FieldId -> message -> get message)-           -> get message-getMessage updater = do+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@@ -120,7 +257,8 @@           GT -> do             wireTag <- fmap WireTag getVarInt -- get tag off wire             let (fieldId,wireType) = splitWireTag wireTag-            if Set.notMember wireTag allowed then unknown fieldId wireType here+            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'       go' message = do@@ -131,19 +269,13 @@           GT -> do             wireTag <- fmap WireTag getVarInt -- get tag off wire             let (fieldId,wireType) = splitWireTag wireTag-            if Set.notMember wireTag allowed then unknown fieldId wireType here+            if Set.notMember wireTag allowed+              then punt fieldId wireType message >>= go'               else updater fieldId message >>= go'   go required initialMessage  where   initialMessage = mergeEmpty   (GetMessageInfo {requiredTags=required,allowedTags=allowed}) = getMessageInfo initialMessage-  splitWireTag :: WireTag -> (FieldId,WireType)-  splitWireTag (WireTag wireTag) = ( FieldId . fromIntegral $ wireTag `shiftR` 3-                                   , WireType . fromIntegral $ wireTag .&. 7 )-  unknown fieldId wireType here =-      fail ("Text.ProtocolBuffers.WireMessage.getMessage: Unknown wire tag read (fieldId,wireType,here) == "-            ++ show (fieldId,wireType,here) ++ " when processing "-            ++ (show . descName . reflectDescriptorInfo $ initialMessage))   notEnoughData messageLength start =       fail ("Text.ProtocolBuffers.WireMessage.getMessage: Required fields missing when processing "             ++ (show . descName . reflectDescriptorInfo $ initialMessage)@@ -153,141 +285,198 @@             ++ (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))++-- | 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.-getBareMessage :: forall get message. (BinaryParser get, Mergeable message, ReflectDescriptor message)-           => (FieldId -> message -> get message)-           -> get message-getBareMessage updater = go required initialMessage+-- 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 :: (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 <- isEmpty+    done <- isReallyEmpty     if done then notEnoughData       else do-        wireTag <- fmap WireTag getWord32be -- get tag off wire+        wireTag <- fmap WireTag getVarInt -- get tag off wire         let (fieldId,wireType) = splitWireTag wireTag-        if Set.notMember wireTag allowed then unknown fieldId wireTag-          else let reqs' = Set.delete wireTag reqs-               in updater fieldId message >>= go reqs'+        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'   go' message = do-    done <- isEmpty+    done <- isReallyEmpty     if done then return message       else do-        wireTag <- fmap WireTag getWord32be -- get tag off wire-        let (fieldId,wireType) = splitWireTag wireTag-        if Set.notMember wireTag allowed then unknown fieldId wireType-          else updater fieldId message >>= go'+        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 updater fieldId message >>= go'   initialMessage = mergeEmpty   (GetMessageInfo {requiredTags=required,allowedTags=allowed}) = getMessageInfo initialMessage-  splitWireTag :: WireTag -> (FieldId,WireType)-  splitWireTag (WireTag wireTag) = ( FieldId . fromIntegral $ wireTag `shiftR` 3-                                   , WireType . fromIntegral $ wireTag .&. 7 )-  unknown fieldId wireType = fail ("Text.ProtocolBuffers.WireMessage.getBareMessage: Unknown wire tag read: "-                                   ++ show (fieldId,wireType) ++ " when processing "-                                   ++ (show . descName . reflectDescriptorInfo $ initialMessage))   notEnoughData = fail ("Text.ProtocolBuffers.WireMessage.getBareMessage: Required fields missing when processing "                         ++ (show . descName . reflectDescriptorInfo $ initialMessage)) -unknownField :: (BinaryParser get) => FieldId -> get a+unknownField :: FieldId -> Get a unknownField 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) --- | 'size' takes the length of a primitive which is the same--- internally and as a child of a message-size :: Int64 -> WireSize-size n = WireSize {childSize = n, internalSize = n}+{-# INLINE castWord32ToFloat #-}+castWord32ToFloat :: Word32 -> Float+--castWord32ToFloat (W32# w) = F# (unsafeCoerce# w)+castWord32ToFloat x = unsafePerformIO $ alloca $ \p -> poke p x >> peek (castPtr p)+{-# INLINE castFloatToWord32 #-}+castFloatToWord32 :: Float -> Word32+--castFloatToWord32 (F# f) = W32# (unsafeCoerce# f)+castFloatToWord32 x = unsafePerformIO $ alloca $ \p -> poke p x >> peek (castPtr p)+{-# INLINE castWord64ToDouble #-}+castWord64ToDouble :: Word64 -> Double+castWord64ToDouble (W64# w) = D# (unsafeCoerce# w)+{-# INLINE castDoubleToWord64 #-}+castDoubleToWord64 :: Double -> Word64+castDoubleToWord64 (D# d) = W64# (unsafeCoerce# d) --- | 'lenSize' takes the length of a bare message and adds its encoded--- size as a header to get the 'childSize'.-lenSize :: Int64 -> WireSize-lenSize n = WireSize {childSize = n+size'Varint n, internalSize = n}+-- These error handlers are exported to the generated code+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 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+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)) ]+  typeHack :: Get a -> a+  typeHack = undefined  instance Wire Double where-  wireSize {- TYPE_DOUBLE -} 1     _ = size $ 8-  wirePut {- TYPE_DOUBLE -} 1 (D# d) = putWord64be (W64# (unsafeCoerce# d))-  wireGet {- TYPE_DOUBLE -} 1        = fmap (\(W64# w) -> D# (unsafeCoerce# w)) getWord64be+  wireSize {- TYPE_DOUBLE   -} 1      _ = 8+  wireSize ft x = wireSizeErr ft x+  wirePut  {- TYPE_DOUBLE   -} 1      x = putWord64le (castDoubleToWord64 x)+  wirePut ft x = wirePutErr ft x+  wireGet  {- TYPE_DOUBLE   -} 1        = fmap castWord64ToDouble getWord64le+  wireGet ft = wireGetErr ft  instance Wire Float where-  wireSize {- TYPE_FLOAT -} 2      _ = size $ 4-  wirePut {- TYPE_FLOAT -} 2  (F# f) = putWord32be (W32# (unsafeCoerce# f))-  wireGet {- TYPE_FLOAT -} 2         = fmap (\(W32# w) -> F# (unsafeCoerce# w)) getWord32be+  wireSize {- TYPE_FLOAT    -} 2      _ = 4+  wireSize ft x = wireSizeErr ft x+  wirePut  {- TYPE_FLOAT    -} 2      x = putWord32le (castFloatToWord32 x)+  wirePut ft x = wirePutErr ft x+  wireGet  {- TYPE_FLOAT    -} 2        = fmap castWord32ToFloat getWord32le+  wireGet ft = wireGetErr ft  instance Wire Int64 where-  wireSize {- TYPE_INT64 -} 3      x = size $ size'Varint x-  wireSize {- TYPE_SINT64 -} 18    x = size $ size'Varint (zzEncode64 x)-  wireSize {- TYPE_SFIXED64 -} 16  _ = size $ 8-  wirePut {- TYPE_INT64 -} 3       x = putVarSInt x-  wirePut {- TYPE_SINT64 -} 18     x = putVarUInt (zzEncode64 x)-  wirePut {- TYPE_SFIXED64 -} 16   x = putWord64be (fromIntegral x)-  wireGet {- TYPE_INT64 -} 3         = getVarInt-  wireGet {- TYPE_SINT64 -} 18       = fmap zzDecode64 getVarInt-  wireGet {- TYPE_SFIXED64 -} 16     = fmap fromIntegral getWord64be+  wireSize {- TYPE_INT64    -} 3      x = size'Varint x+  wireSize {- TYPE_SINT64   -} 18     x = size'Varint (zzEncode64 x)+  wireSize {- TYPE_SFIXED64 -} 16     _ = 8+  wireSize ft x = wireSizeErr ft x+  wirePut  {- TYPE_INT64    -} 3      x = putVarSInt x+  wirePut  {- TYPE_SINT64   -} 18     x = putVarUInt (zzEncode64 x)+  wirePut  {- TYPE_SFIXED64 -} 16     x = putWord64le (fromIntegral x)+  wirePut ft x = wirePutErr ft x+  wireGet  {- TYPE_INT64    -} 3        = getVarInt+  wireGet  {- TYPE_SINT64   -} 18       = fmap zzDecode64 getVarInt+  wireGet  {- TYPE_SFIXED64 -} 16       = fmap fromIntegral getWord64le+  wireGet ft = wireGetErr ft  instance Wire Int32 where-  wireSize {- TYPE_INT32 -} 5      x = size $ size'Varint x-  wireSize {- TYPE_SINT32 -} 17    x = size $ size'Varint (zzEncode32 x)-  wireSize {- TYPE_SFIXED32 -} 15  _ = size $ 4-  wirePut {- TYPE_INT32 -} 5       x = putVarSInt x-  wirePut {- TYPE_SINT32 -} 17     x = putVarUInt (zzEncode32 x)-  wirePut {- TYPE_SFIXED32 -} 15   x = putWord32be (fromIntegral x)-  wireGet {- TYPE_INT32 -} 5         = getVarInt-  wireGet {- TYPE_SINT32 -} 17       = fmap zzDecode32 getVarInt-  wireGet {- TYPE_SFIXED32 -} 15     = fmap fromIntegral getWord32be+  wireSize {- TYPE_INT32    -} 5      x = size'Varint x+  wireSize {- TYPE_SINT32   -} 17     x = size'Varint (zzEncode32 x)+  wireSize {- TYPE_SFIXED32 -} 15     _ = 4+  wireSize ft x = wireSizeErr ft x+  wirePut  {- TYPE_INT32    -} 5      x = putVarSInt x+  wirePut  {- TYPE_SINT32   -} 17     x = putVarUInt (zzEncode32 x)+  wirePut  {- TYPE_SFIXED32 -} 15     x = putWord32le (fromIntegral x)+  wirePut ft x = wirePutErr ft x+  wireGet  {- TYPE_INT32    -} 5        = getVarInt+  wireGet  {- TYPE_SINT32   -} 17       = fmap zzDecode32 getVarInt+  wireGet  {- TYPE_SFIXED32 -} 15       = fmap fromIntegral getWord32le+  wireGet ft = wireGetErr ft  instance Wire Word64 where-  wireSize {- TYPE_UINT64 -} 4     x = size $ size'Varint x-  wireSize {- TYPE_FIXED64 -} 6    _ = size $ 8-  wirePut {- TYPE_UINT64 -} 4      x = putVarUInt x-  wirePut {- TYPE_FIXED64 -} 6     x = putWord64be x-  wireGet {- TYPE_UINT64 -} 4        = getVarInt-  wireGet {- TYPE_FIXED64 -} 6       = getWord64be+  wireSize {- TYPE_UINT64   -} 4      x = size'Varint x+  wireSize {- TYPE_FIXED64  -} 6      _ = 8+  wireSize ft x = wireSizeErr ft x+  wirePut  {- TYPE_UINT64   -} 4      x = putVarUInt x+  wirePut  {- TYPE_FIXED64  -} 6      x = putWord64le x+  wirePut ft x = wirePutErr ft x+  wireGet  {- TYPE_FIXED64  -} 6        = getWord64le+  wireGet  {- TYPE_UINT64   -} 4        = getVarInt+  wireGet ft = wireGetErr ft  instance Wire Word32 where-  wireSize {- TYPE_UINT32 -} 13    x = size $ size'Varint x-  wireSize {- TYPE_FIXED32 -} 7    _ = size $ 4-  wirePut {- TYPE_UINT32 -} 13     x = putVarUInt x-  wirePut {- TYPE_FIXED32 -} 7     x = putWord32be x-  wireGet {- TYPE_UINT32 -} 13       = getVarInt-  wireGet {- TYPE_FIXED32 -} 7       = getWord32be+  wireSize {- TYPE_UINT32   -} 13     x = size'Varint x+  wireSize {- TYPE_FIXED32  -} 7      _ = 4+  wireSize ft x = wireSizeErr ft x+  wirePut  {- TYPE_UINT32   -} 13     x = putVarUInt x+  wirePut  {- TYPE_FIXED32  -} 7      x = putWord32le x+  wirePut ft x = wirePutErr ft x+  wireGet  {- TYPE_UINT32   -} 13       = getVarInt+  wireGet  {- TYPE_FIXED32  -} 7        = getWord32le+  wireGet ft = wireGetErr ft  instance Wire Bool where-  wireSize {- TYPE_BOOL -} 8       _ = size $ 1-  wirePut {- TYPE_BOOL -} 8    False = putWord8 0-  wirePut {- TYPE_BOOL -} 8    True  = putWord8 1 -- google's wire_format_inl.h-  wireGet {- TYPE_BOOL -} 8          = do-    (x :: Word32) <- getVarInt -- google's wire_format_inl.h line 97+  wireSize {- TYPE_BOOL     -} 8      _ = 1+  wireSize ft x = wireSizeErr ft x+  wirePut  {- TYPE_BOOL     -} 8  False = putWord8 0+  wirePut  {- TYPE_BOOL     -} 8  True  = putWord8 1 -- google's wire_format_inl.h+  wirePut ft x = wirePutErr ft x+  wireGet  {- TYPE_BOOL     -} 8        = do+    x <- getVarInt :: Get Int32 -- google's wire_format_inl.h line 97     case x of       0 -> return False-      x | x < 128 -> return True+      x' | x' < 128 -> return True       _ -> fail ("TYPE_BOOL read failure : " ++ show x)+  wireGet ft = wireGetErr ft -instance Wire ByteString where+instance Wire Utf8 where -- items of TYPE_STRING is already in a UTF8 encoded Data.ByteString.Lazy+  wireSize {- TYPE_STRING   -} 9      x = prependMessageSize $ BS.length (utf8 x)+  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 ft = wireGetErr ft++instance Wire ByteString where -- items of TYPE_BYTES is an untyped binary Data.ByteString.Lazy-  wireSize {- TYPE_STRING -} 9     x = lenSize $ BS.length x-  wireSize {- TYPE_BYTES -} 12     x = lenSize $ BS.length x-  wirePut {- TYPE_STRING -} 9      x = putVarUInt (BS.length x) >> putLazyByteString x-  wirePut {- TYPE_BYTES -} 12      x = putVarUInt (BS.length x) >> putLazyByteString x-  wireGet {- TYPE_STRING -} 9        = getVarInt >>= getByteString >>= return . toLazy --getLazyByteString -  wireGet {- TYPE_BYTES -} 12        = getVarInt >>= getByteString >>= return . toLazy --getLazyByteString+  wireSize {- TYPE_BYTES    -} 12     x = prependMessageSize $ BS.length x+  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 ft = wireGetErr ft  -- Wrap a protocol-buffer Enum in fromEnum or toEnum and serialize the Int: instance Wire Int where-  wireSize {- TYPE_ENUM -} 14      x = size $ size'Varint x-  wirePut {- TYPE_ENUM -} 14       x = putVarUInt x-  wireGet {- TYPE_ENUM -} 14         = getVarInt--toLazy :: Strict.ByteString -> ByteString-toLazy = BS.fromChunks . (:[])---- TYPE_GROUP 10--- TYPE_MESSAGE 11--- -- +  wireSize {- TYPE_ENUM    -} 14      x = size'Varint x+  wireSize ft x = wireSizeErr ft x+  wirePut  {- TYPE_ENUM    -} 14      x = putVarUInt x+  wirePut ft x = wirePutErr ft x+  wireGet  {- TYPE_ENUM    -} 14        = getVarInt+  wireGet ft = wireGetErr ft  -- This will have to examine the value of positive numbers to get the size {-# INLINE size'Varint #-}@@ -312,7 +501,9 @@ zzDecode64 :: Word64 -> Int64 zzDecode64 w = (fromIntegral (w `shiftR` 1)) `xor` (negate (fromIntegral (w .&. 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@@ -328,9 +519,10 @@                     ] ]         values :: (Bounded a,Integral a) => [a]         values = [minBound,div minBound 2,-3,-2,-1,0,1,2,3,div maxBound 2, maxBound]+-}  {-# INLINE getVarInt #-}-getVarInt :: (Integral a, Bits a, BinaryParser get) => get a+getVarInt :: (Integral a, Bits a) => Get a getVarInt = do -- optimize first read instead of calling (go 0 0)   b <- getWord8   if testBit b 7 then go 7 (fromIntegral (b .&. 0x7F))@@ -362,155 +554,52 @@                         | otherwise = putWord8 (fromIntegral (i .&. 0x7F) .|. 0x80) >> go (i `shiftR` 7)                in go b -{---- copied from Data.Binary.Builder--- copied from Data.ByteString.Lazy----defaultSize :: Int-defaultSize = 32 * k - overhead-    where k = 1024-          overhead = 2 * sizeOf (undefined :: Int)---- | /O(n)./ Extract a lazy 'L.ByteString' from a 'Builder'.--- The construction work takes place if and when the relevant part of--- the lazy 'L.ByteString' is demanded.----toLazyByteStringSized :: Int64 -> Builder -> ByteString-toLazyByteStringSized m bytes = BS.fromChunks $ unsafePerformIO $ do-    buf <- newBuffer bytes-    return (runBuilder (m `append` flush) (const []) buf)--newBuffer :: Int -> IO Buffer-newBuffer size = do-    fp <- S.mallocByteString size-    return $! Buffer fp 0 0 size-{-# INLINE newBuffer #-}--runSizedPut :: Int64 -> Put -> ByteString-runSizedPut bytes | bytes<0 = error "runSizedPut : size cannot be negative"-                  | bytes==0 = const mempty-                  | defaultSize<=bytes = runPut-                  | otherwise = toLazyByteStringSized bytes . sndS  . unPut $ put--}--{---{- Useful for testing -}--testVarInt :: (Integral a, Enum a, Ord a, Bits a) => a -> (Bool,[Word8],Either String a)-testVarInt i = let w = toVarInt i-               in case fromVarInt w of-                    r@(Right v) -> (v==i,w,r)-                    l -> (False,w,l)--fromVarInt :: (Integral a, Bits a) => [Word8] -> Either String a-fromVarInt [] = Left "No bytes!"-fromVarInt (b:bs) = do-  if testBit b 7 then go bs 7 (fromIntegral (b .&. 0x7F))-    else if null bs then Right (fromIntegral b)-           else Left ("Excess bytes: " ++ show (b,bs))- where-  go [] n val = Left ("Not enough bytes: " ++ show (n,val))-  go (b:bs) n val = do-    if testBit b 7 then go bs (n+7) (val .|. ((fromIntegral (b .&. 0x7F)) `shiftL` n))-      else if null bs then Right (val .|. ((fromIntegral b) `shiftL` n))-             else Left ("Excess bytes: " ++ show (b,bs,n,val))--toVarInt :: (Integral a, Bits a) => a -> [Word8]-toVarInt b = case compare b 0 of-               LT -> let len = divBy (bitSize b) 7-                         last'Size = (bitSize b) - ((pred len)*7)-                         last'Mask = pred (1 `shiftL` last'Size)-                         go i 1 = [fromIntegral i .&. last'Mask]-                         go i n = (fromIntegral (i .&. 0x7F) .|. 0x80) : go (i `shiftR` 7) (pred n)-                     in go b len-               EQ -> [0]-               GT -> let go i | i < 0x80 = [fromIntegral i]-                              | otherwise = (fromIntegral (i .&. 0x7F) .|. 0x80) : go (i `shiftR` 7)-                     in go b-{-  On my G4 (big endian) powerbook:--le is the protocol-buffer standard (x86 optimized)--*Text.ProtocolBuffers.WireMessage Data.Int Data.Word Numeric> gle . cw $ fle pi-("182d4454fb210940",("word",4614256656552045848,"400921fb54442d18"),("double",3.141592653589793))--be is the network byte order standard (and native for my G4)--*Text.ProtocolBuffers.WireMessage Data.Int Data.Word Numeric> gbe . cw $ fbe pi-("400921fb54442d18",("word",4614256656552045848,"400921fb54442d18"),("double",3.141592653589793))---}-padL n c s = let l = length s-             in replicate (n-l) c ++ s--cw = concatMap (padL 2 '0')--fbe :: Double -> [String]-fbe (D# d) = let w = W64# (unsafeCoerce# d)-                 b = Build.toLazyByteString (Build.putWord64be w)-             in map (flip showHex "") $  BS.unpack  b--fle :: Double -> [String]-fle (D# d) = let w = W64# (unsafeCoerce# d)-                 b = Build.toLazyByteString (Build.putWord64le w)-             in map (flip showHex "") $ BS.unpack  b--gbe :: [Char] -> ([Char], ([Char], Word64, String), ([Char], Double))-gbe s = let pairs = Data.List.unfoldr (\a -> if Prelude.null a then Nothing-                                               else Just (splitAt 2 a)) s-            words = map (fst . head . readHex) pairs-            w@(W64# w64) = Get.runGet Get.getWord64be (BS.pack words)-            d = D# (unsafeCoerce# w64)-        in (s,("word",w,showHex w ""),("double",d))--gle :: [Char] -> ([Char], ([Char], Word64, String), ([Char], Double))-gle s = let pairs = Data.List.unfoldr (\a -> if Prelude.null a then Nothing-                                               else Just (splitAt 2 a)) s-            words = map (fst . head . readHex) pairs-            w@(W64# w64) = Get.runGet Get.getWord64le (BS.pack words)-            d = D# (unsafeCoerce# w64)-        in (s,("word",w,showHex w ""),("double",d))---}--+           {---- Some to-be-reviewed-for-sanity prototypes for the bytestream reader--data WireData = VarInt ByteString -- the 128 bit variable encoding (least significant first)-              | Fix8 ByteString -- 4 and 8 byte fixed length types, lsb first on wire-              | VarString ByteString -- length of contents as a VarInt-              |           ByteString -- the contents on the wire-              | StartGroup-              | StopGroup-              | Fix4 ByteString-  deriving (Eq,Ord,Show,Data,Typeable)--newtype WireMessage = WireMessage (Map FieldId (Seq WireData))--instance Monoid WireMessage where-  mempty = WireMessage mempty-  mappend (WireMessage a) (WireMessage b) = WireMessage (unionWith mappend a b)--wireId :: WireData -> WireType-wireId (VarInt {})    = WireType 0-wireId (Fix8 {})      = WireType 1-wireId (VarString {}) = WireType 2-wireId  StartGroup    = WireType 3-wireId  StopGroup     = WireType 4-wireId (Fix4 {})      = WireType 5--composeFieldWire :: FieldId -> WireType -> Word32-composeFieldWire (FieldId f) (WireType w) = ((fromIntegral f) `shiftL` 3) .|. w--decomposeFieldWire :: Word32 -> (FieldId,WireType)-decomposeFieldWire x = (FieldId (fromIntegral (x `shiftR` 3)), WireType (x .&. 7))--encodeWireMessage :: WireMessage -> ByteString-encodeWireMessage = undefined--decodeWireMessage :: ByteString -> WireMessage-decodeWireMessage = undefined+  enum WireType {+    WIRETYPE_VARINT           = 0,+    WIRETYPE_FIXED64          = 1,+    WIRETYPE_LENGTH_DELIMITED = 2,+    WIRETYPE_START_GROUP      = 3,+    WIRETYPE_END_GROUP        = 4,+    WIRETYPE_FIXED32          = 5, }; --}+    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  1 =  1+toWireType  2 =  5+toWireType  3 =  0+toWireType  4 =  0+toWireType  5 =  0+toWireType  6 =  1+toWireType  7 =  5+toWireType  8 =  0+toWireType  9 =  2+toWireType 10 =  3 -- START_GROUP+toWireType 11 =  2+toWireType 12 =  2+toWireType 13 =  0+toWireType 14 =  0+toWireType 15 =  5+toWireType 16 =  1+toWireType 17 =  5+toWireType 18 =  1+toWireType  x = error $ "Text.ProcolBuffers.Basic.toWireType: Bad FieldType: "++show x
− Text/ProtocolBuffers/testDepth 
@@ -1,204 +0,0 @@--- Annotated run of MyGetW.testDepth--[1 of 1] Compiling Text.ProtocolBuffers.MyGetW ( /Users/chrisk/Documents/projects/haskell/develop/protocol-buffers/Text/ProtocolBuffers/MyGetW.hs, interpreted )-Ok, modules loaded: Text.ProtocolBuffers.MyGetW.-*Text.ProtocolBuffers.MyGetW> testDepth-("stack depth",0,"bytes read",0,"bytes remaining",0,"begin")-TopFrame 1 (ErrorFrame <> True)-("stack depth",1,"bytes read",0,"bytes remaining",0,"mayFail")-TopFrame 2 (HandlerFrame 1 (S {top = "", current = Empty, consumed = 0, userField = ()}) (fromList [])-  (ErrorFrame <> True))--("stack depth",0,"bytes read",0,"bytes remaining",0,"handler")-TopFrame 2 (ErrorFrame <> True)-("stack depth",0,"bytes read",0,"bytes remaining",0,"middle")-TopFrame 2 (ErrorFrame <> True)-("feed1",[48,49])-"chomp [48] <0>"-"after jump and with 0"-("stack depth",1,"bytes read",1,"bytes remaining",1,"after getCC1, inside 1 handler")-TopFrame 3 (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-  (ErrorFrame <> True))--("stack depth",2,"bytes read",1,"bytes remaining",1,"after getCC1, inside 2 handlers, before chomp")-TopFrame 4 (HandlerFrame 3 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-    (ErrorFrame <> True)))--"chomp [49] <1>"-("stack depth",2,"bytes read",2,"bytes remaining",0,"after getCC1, inside 2 handlers, after chomp")-TopFrame 4 (HandlerFrame 3 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-    (ErrorFrame <> True)))--("stack depth",3,"bytes read",2,"bytes remaining",0,"in mplus left")-TopFrame 5 (HandlerFrame 4 (S {top = "", current = Empty, consumed = 2, userField = ()}) (fromList [])-  (HandlerFrame 3 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-    (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-      (ErrorFrame <> True))))---- The use of 'jump' here resets the writer to the chomp '1' is not in the writer output--"after jump and with 1"-("stack depth",1,"bytes read",2,"bytes remaining",0,"after getCC1, inside 1 handler")-TopFrame 5 (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-  (ErrorFrame <> True))--("stack depth",2,"bytes read",2,"bytes remaining",0,"after getCC1, inside 2 handlers, before chomp")-TopFrame 6 (HandlerFrame 5 (S {top = "", current = Empty, consumed = 2, userField = ()}) (fromList [])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [])-    (ErrorFrame <> True)))--("feed1",[50,51]) -- adds "23" to future of HandlerFrame 5 and HandlerFrame 2-"chomp [50] <2>"-("stack depth",2,"bytes read",3,"bytes remaining",1,"after getCC1, inside 2 handlers, after chomp")-TopFrame 6 (HandlerFrame 5 (S {top = "", current = Empty, consumed = 2, userField = ()}) (fromList [Chunk "23" Empty])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty])-    (ErrorFrame <> True)))--("stack depth",3,"bytes read",3,"bytes remaining",1,"in mplus left")-TopFrame 7 (HandlerFrame 6 (S {top = "3", current = Empty, consumed = 3, userField = ()}) (fromList [])-  (HandlerFrame 5 (S {top = "", current = Empty, consumed = 2, userField = ()}) (fromList [Chunk "23" Empty])-    (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty])-      (ErrorFrame <> True))))---- this use of 'jump' resets the writer again and the '2' is removed.--"after jump and with 2"-("stack depth",1,"bytes read",3,"bytes remaining",1,"after getCC1, inside 1 handler")-TopFrame 7 (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty])-  (ErrorFrame <> True))--("stack depth",2,"bytes read",3,"bytes remaining",1,"after getCC1, inside 2 handlers, before chomp")-TopFrame 8 (HandlerFrame 7 (S {top = "3", current = Empty, consumed = 3, userField = ()}) (fromList [])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty])-    (ErrorFrame <> True)))--"chomp [51] <3>"-("stack depth",2,"bytes read",4,"bytes remaining",0,"after getCC1, inside 2 handlers, after chomp")-TopFrame 8 (HandlerFrame 7 (S {top = "3", current = Empty, consumed = 3, userField = ()}) (fromList [])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty])-    (ErrorFrame <> True)))--("stack depth",3,"bytes read",4,"bytes remaining",0,"in mplus left")-TopFrame 9 (HandlerFrame 8 (S {top = "", current = Empty, consumed = 4, userField = ()}) (fromList [])-  (HandlerFrame 7 (S {top = "3", current = Empty, consumed = 3, userField = ()}) (fromList [])-    (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty])-      (ErrorFrame <> True))))--"after jump and with 3"---- The use of 'jump' takes the chomp '3' out of the writer log--("stack depth",1,"bytes read",4,"bytes remaining",0,"after getCC1, inside 1 handler")-TopFrame 9 (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty])-  (ErrorFrame <> True))--("stack depth",2,"bytes read",4,"bytes remaining",0,"after getCC1, inside 2 handlers, before chomp")-TopFrame 10 (HandlerFrame 9 (S {top = "", current = Empty, consumed = 4, userField = ()}) (fromList [])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty])-    (ErrorFrame <> True)))--("feed1",[52,53]) -- add "45" to future of HandlerFrame 9 and HandlerFrame 2-"chomp [52] <4>"-("stack depth",2,"bytes read",5,"bytes remaining",1,"after getCC1, inside 2 handlers, after chomp")-TopFrame 10 (HandlerFrame 9 (S {top = "", current = Empty, consumed = 4, userField = ()}) (fromList [Chunk "45" Empty])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty,Chunk "45" Empty])-    (ErrorFrame <> True)))--("stack depth",3,"bytes read",5,"bytes remaining",1,"in mplus left")-TopFrame 11 (HandlerFrame 10 (S {top = "5", current = Empty, consumed = 5, userField = ()}) (fromList [])-  (HandlerFrame 9 (S {top = "", current = Empty, consumed = 4, userField = ()}) (fromList [Chunk "45" Empty])-    (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty,Chunk "45" Empty])-      (ErrorFrame <> True))))---- At this point 'mzero' goes to state in HandlerFrame 10--- bytes read is still 5--("stack depth",2,"bytes read",5,"bytes remaining",1,"in mplus right")-TopFrame 11 (HandlerFrame 9 (S {top = "", current = Empty, consumed = 4, userField = ()}) (fromList [Chunk "45" Empty])-  (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty,Chunk "45" Empty])-    (ErrorFrame <> True)))---- At this point the next 'mzero' goes to state in HandlerFrame 9--- This loses chomp '4' from the writer log--- bytes read is reduced to 4--("stack depth",1,"bytes read",4,"bytes remaining",2,"handler after getCC1")-TopFrame 11 (HandlerFrame 2 (S {top = "1", current = Empty, consumed = 1, userField = ()}) (fromList [Chunk "23" Empty,Chunk "45" Empty])-  (ErrorFrame <> True))---- At this point the third 'mzero' goes to state in HandlerFrame 2--- bytes read is reduced to 1--- The last 3 mzeros have reset the input so that now all but chomp "0" have been undone--("stack depth",0,"bytes read",1,"bytes remaining",5,"handler before getCC1")-TopFrame 11 (ErrorFrame <> True)-("listen","0")-("stack depth",0,"bytes read",1,"bytes remaining",5,"another middle")-TopFrame 11 (ErrorFrame <> True)-"chomp [49] <1>"-("stack depth",1,"bytes read",2,"bytes remaining",4,"before inner jump2")-TopFrame 12 (HandlerFrame 11 (S {top = "1", current = Chunk "23" (Chunk "45" Empty), consumed = 1, userField = ()}) (fromList [])-  (ErrorFrame <> True))--("stack depth",1,"bytes read",2,"bytes remaining",4,"after inner jump2 with 0")-TopFrame 12 (HandlerFrame 11 (S {top = "1", current = Chunk "23" (Chunk "45" Empty), consumed = 1, userField = ()}) (fromList [])-  (ErrorFrame <> True))--"chomp [50] <2>"-"chomp [51] <3>"-("stack depth",0,"bytes read",4,"bytes remaining",2,"after catchError scope of jump2")-TopFrame 12 (ErrorFrame <> True)-"chomp [52] <4>"-"jump2"---- This use of 'jump2' resets the writer, so the chomp '1' '2' '3' and '4' are not in the writer output--("stack depth",1,"bytes read",5,"bytes remaining",1,"after inner jump2 with 1")-TopFrame 12 (HandlerFrame 11 (S {top = "5", current = Empty, consumed = 5, userField = ()}) (fromList [])-  (ErrorFrame <> True))--"chomp [53] <5>"---- At this point (throwError "Ouch") goes to HandlerFrame 11, so the last chomp "1" to "5" are out of the writer log--- the bytes read is reduced from 6 to 5--("stack depth",0,"bytes read",5,"bytes remaining",1,"last handler")-TopFrame 12 (ErrorFrame <> True)-"chomp [53] <5>"-("stack depth",0,"bytes read",6,"bytes remaining",0,"after catchError scope of jump2")-TopFrame 12 (ErrorFrame <> True)-("feed1",[54,55])-"chomp [54] <6>"-"Nothing"-("stack depth",0,"bytes read",7,"bytes remaining",1,"end")-TopFrame 12 (ErrorFrame <> True)-- -- getByteString 6 is called--("feed1",[56,57])-("feed1",[58,59])-("feed1",[60,61])---- getByteString 6 finishes, receiving [55..60] aka "789:;<"--("stack depth",0,"bytes read",13,"bytes remaining",1,"got 6, now suspendUntilComplete")-TopFrame 12 (ErrorFrame <> True)-("feed1",[62,63])-("feed1",[64,65])-("feed1",[66,67])-("feed1",[68,69])-("feed1",[70,71])-("feed1",[72,73])-("feed1",[74,75])-("feed1",[76,77])-("feed1",[78,79])-("feed1",[80,81])-("feed1",[82,83])-("feed1",[84,85])-("feed1",[86,87])-("feed1",[88,89])-("feed1",[90,91])-(CFinished (Chunk "=" (Chunk ">?" (Chunk "@A" (Chunk "BC" (Chunk "DE" (Chunk "FG" (Chunk "HI" (Chunk "JK" (Chunk "LM" (Chunk "NO" (Chunk "PQ" (Chunk "RS" (Chunk "TU" (Chunk "VW" (Chunk "XY" (Chunk "Z[" Empty)))))))))))))))) (13) ("056") (()) ("789:;<"))-*Text.ProtocolBuffers.MyGetW>
− descriptor.proto 
@@ -1,286 +0,0 @@-// Protocol Buffers - Google's data interchange format-// Copyright 2008 Google Inc.-// http://code.google.com/p/protobuf/-//-// Licensed under the Apache License, Version 2.0 (the "License");-// you may not use this file except in compliance with the License.-// You may obtain a copy of the License at-//-//      http://www.apache.org/licenses/LICENSE-2.0-//-// Unless required by applicable law or agreed to in writing, software-// distributed under the License is distributed on an "AS IS" BASIS,-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-// See the License for the specific language governing permissions and-// limitations under the License.--// Author: kenton@google.com (Kenton Varda)-//  Based on original Protocol Buffers design by-//  Sanjay Ghemawat, Jeff Dean, and others.-//-// The messages in this file describe the definitions found in .proto files.-// A valid .proto file can be translated directly to a FileDescriptorProto-// without any other information (e.g. without reading its imports).----package google.protobuf;-option java_package = "com.google.protobuf";-option java_outer_classname = "DescriptorProtos";--// descriptor.proto must be optimized for speed because reflection-based-// algorithms don't work during bootstrapping.-option optimize_for = SPEED;--// Describes a complete .proto file.-message FileDescriptorProto {-  optional string name = 1;       // file name, relative to root of source tree-  optional string package = 2;    // e.g. "foo", "foo.bar", etc.--  // Names of files imported by this file.-  repeated string dependency = 3;--  // All top-level definitions in this file.-  repeated DescriptorProto message_type = 4;-  repeated EnumDescriptorProto enum_type = 5;-  repeated ServiceDescriptorProto service = 6;-  repeated FieldDescriptorProto extension = 7;--  optional FileOptions options = 8;-}--// Describes a message type.-message DescriptorProto {-  optional string name = 1;--  repeated FieldDescriptorProto field = 2;-  repeated FieldDescriptorProto extension = 6;--  repeated DescriptorProto nested_type = 3;-  repeated EnumDescriptorProto enum_type = 4;--  message ExtensionRange {-    optional int32 start = 1;-    optional int32 end = 2;-  }-  repeated ExtensionRange extension_range = 5;--  optional MessageOptions options = 7;-}--// Describes a field within a message.-message FieldDescriptorProto {-  enum Type {-    // 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.-  };--  enum Label {-    // 0 is reserved for errors-    LABEL_OPTIONAL      = 1;-    LABEL_REQUIRED      = 2;-    LABEL_REPEATED      = 3;-    // TODO(sanjay): Should we add LABEL_MAP?-  };--  optional string name = 1;-  optional int32 number = 3;-  optional Label label = 4;--  // If type_name is set, this need not be set.  If both this and type_name-  // are set, this must be either TYPE_ENUM or TYPE_MESSAGE.-  optional Type type = 5;--  // For message and enum types, this is the name of the type.  If the name-  // starts with a '.', it is fully-qualified.  Otherwise, C++-like scoping-  // rules are used to find the type (i.e. first the nested types within this-  // message are searched, then within the parent, on up to the root-  // namespace).-  optional string type_name = 6;--  // For extensions, this is the name of the type being extended.  It is-  // resolved in the same manner as type_name.-  optional string extendee = 2;--  // For numeric types, contains the original text representation of the value.-  // For booleans, "true" or "false".-  // For strings, contains the default text contents (not escaped in any way).-  // For bytes, contains the C escaped value.  All bytes >= 128 are escaped.-  // TODO(kenton):  Base-64 encode?-  optional string default_value = 7;--  optional FieldOptions options = 8;-}--// Describes an enum type.-message EnumDescriptorProto {-  optional string name = 1;--  repeated EnumValueDescriptorProto value = 2;--  optional EnumOptions options = 3;-}--// Describes a value within an enum.-message EnumValueDescriptorProto {-  optional string name = 1;-  optional int32 number = 2;--  optional EnumValueOptions options = 3;-}--// Describes a service.-message ServiceDescriptorProto {-  optional string name = 1;-  repeated MethodDescriptorProto method = 2;--  optional ServiceOptions options = 3;-}--// Describes a method of a service.-message MethodDescriptorProto {-  optional string name = 1;--  // Input and output type names.  These are resolved in the same way as-  // FieldDescriptorProto.type_name, but must refer to a message type.-  optional string input_type = 2;-  optional string output_type = 3;--  optional MethodOptions options = 4;-}--// ===================================================================-// Options--// Each of the definitions above may have "options" attached.  These are-// just annotations which may cause code to be generated slightly differently-// or may contain hints for code that manipulates protocol messages.--// TODO(kenton):  Allow extensions to options.--message FileOptions {--  // Sets the Java package where classes generated from this .proto will be-  // placed.  By default, the proto package is used, but this is often-  // inappropriate because proto packages do not normally start with backwards-  // domain names.-  optional string java_package = 1;---  // If set, all the classes from the .proto file are wrapped in a single-  // outer class with the given name.  This applies to both Proto1-  // (equivalent to the old "--one_java_file" option) and Proto2 (where-  // a .proto always translates to a single class, but you may want to-  // explicitly choose the class name).-  optional string java_outer_classname = 8;--  // If set true, then the Java code generator will generate a separate .java-  // file for each top-level message, enum, and service defined in the .proto-  // file.  Thus, these types will *not* be nested inside the outer class-  // named by java_outer_classname.  However, the outer class will still be-  // generated to contain the file's getDescriptor() method as well as any-  // top-level extensions defined in the file.-  optional bool java_multiple_files = 10 [default=false];--  // Generated classes can be optimized for speed or code size.-  enum OptimizeMode {-    SPEED = 1;      // Generate complete code for parsing, serialization, etc.-    CODE_SIZE = 2;  // Use ReflectionOps to implement these methods.-  }-  optional OptimizeMode optimize_for = 9 [default=CODE_SIZE];-}--message MessageOptions {-  // Set true to use the old proto1 MessageSet wire format for extensions.-  // This is provided for backwards-compatibility with the MessageSet wire-  // format.  You should not use this for any other reason:  It's less-  // efficient, has fewer features, and is more complicated.-  //-  // The message must be defined exactly as follows:-  //   message Foo {-  //     option message_set_wire_format = true;-  //     extensions 4 to max;-  //   }-  // Note that the message cannot have any defined fields; MessageSets only-  // have extensions.-  //-  // All extensions of your type must be singular messages; e.g. they cannot-  // be int32s, enums, or repeated messages.-  //-  // Because this is an option, the above two restrictions are not enforced by-  // the protocol compiler.-  optional bool message_set_wire_format = 1 [default=false];-}--message FieldOptions {-  // The ctype option instructs the C++ code generator to use a different-  // representation of the field than it normally would.  See the specific-  // options below.  This option is not yet implemented in the open source-  // release -- sorry, we'll try to include it in a future version!-  optional CType ctype = 1;-  enum CType {-    CORD = 1;--    STRING_PIECE = 2;-  }--  // EXPERIMENTAL.  DO NOT USE.-  // For "map" fields, the name of the field in the enclosed type that-  // is the key for this map.  For example, suppose we have:-  //   message Item {-  //     required string name = 1;-  //     required string value = 2;-  //   }-  //   message Config {-  //     repeated Item items = 1 [experimental_map_key="name"];-  //   }-  // In this situation, the map key for Item will be set to "name".-  // TODO: Fully-implement this, then remove the "experimental_" prefix.-  optional string experimental_map_key = 9;-}--message EnumOptions {-}--message EnumValueOptions {-}--message ServiceOptions {--  // Note:  Field numbers 1 through 32 are reserved for Google's internal RPC-  //   framework.  We apologize for hoarding these numbers to ourselves, but-  //   we were already using them long before we decided to release Protocol-  //   Buffers.-}--message MethodOptions {--  // Note:  Field numbers 1 through 32 are reserved for Google's internal RPC-  //   framework.  We apologize for hoarding these numbers to ourselves, but-  //   we were already using them long before we decided to release Protocol-  //   Buffers.-}
+ descriptor/LICENSE view
@@ -0,0 +1,214 @@+Copyright (c) 2008, Christopher Edward Kuklewicz+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+    * Neither the name of the copyright holder nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++The descriptor.proto and unittest.proto files from google's code are under the Apache license (2.0):++                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright [yyyy] [name of copyright owner]++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
+ descriptor/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks
+ descriptor/Text/DescriptorProtos.hs view
@@ -0,0 +1,18 @@+module Text.DescriptorProtos (protoInfo, fileDescriptorProto) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import Text.DescriptorProtos.FileDescriptorProto (FileDescriptorProto)+import Text.ProtocolBuffers.Reflections (ProtoInfo)+import qualified Text.ProtocolBuffers.WireMessage as P' (wireGet,getFromBS)+ +protoInfo :: ProtoInfo+protoInfo+  = P'.read+      "ProtoInfo {protoMod = ProtoName {haskellPrefix = \"Text\", parentModule = \"\", baseName = \"DescriptorProtos\"}, protoFilePath = [\"Text\",\"DescriptorProtos.hs\"], protoSource = \"/Users/chrisk/Documents/projects/haskell/develop/protocol-buffers/descriptor/./descriptor.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FileDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FileDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"package\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"dependency\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"message_type\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"DescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"enum_type\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"service\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"extension\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FileOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"DescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"DescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"field\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"extension\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"nested_type\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"DescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"enum_type\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"extension_range\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"ExtensionRange\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MessageOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"ExtensionRange\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"DescriptorProto\",\"ExtensionRange.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto.ExtensionRange\", baseName = \"start\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto.ExtensionRange\", baseName = \"end\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FieldDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"number\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"label\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"Label\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"type'\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"Type\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"type_name\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"extendee\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"default_value\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumDescriptorProto\", baseName = \"value\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumValueDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumValueDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumValueDescriptorProto\", baseName = \"number\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumValueDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"ServiceDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.ServiceDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.ServiceDescriptorProto\", baseName = \"method\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.ServiceDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"MethodDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MethodDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MethodDescriptorProto\", baseName = \"input_type\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MethodDescriptorProto\", baseName = \"output_type\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MethodDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FileOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FileOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"java_package\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"java_outer_classname\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"java_multiple_files\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 80}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just (Chunk \"false\" Empty), hsDefault = Just (HsDef'Bool False)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"optimize_for\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 72}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"OptimizeMode\"}), hsRawDefault = Just (Chunk \"CODE_SIZE\" Empty), hsDefault = Just (HsDef'Enum \"CODE_SIZE\")}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MessageOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"MessageOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MessageOptions\", baseName = \"message_set_wire_format\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just (Chunk \"false\" Empty), hsDefault = Just (HsDef'Bool False)}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FieldOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldOptions\", baseName = \"ctype\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldOptions\", baseName = \"CType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldOptions\", baseName = \"experimental_map_key\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 74}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumOptions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumValueOptions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"ServiceOptions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []},DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"MethodOptions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}], enums = [EnumInfo {enumName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"Type\"}, enumFilePath = [\"Text\",\"DescriptorProtos\",\"FieldDescriptorProto\",\"Type.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"TYPE_DOUBLE\"),(EnumCode {getEnumCode = 2},\"TYPE_FLOAT\"),(EnumCode {getEnumCode = 3},\"TYPE_INT64\"),(EnumCode {getEnumCode = 4},\"TYPE_UINT64\"),(EnumCode {getEnumCode = 5},\"TYPE_INT32\"),(EnumCode {getEnumCode = 6},\"TYPE_FIXED64\"),(EnumCode {getEnumCode = 7},\"TYPE_FIXED32\"),(EnumCode {getEnumCode = 8},\"TYPE_BOOL\"),(EnumCode {getEnumCode = 9},\"TYPE_STRING\"),(EnumCode {getEnumCode = 10},\"TYPE_GROUP\"),(EnumCode {getEnumCode = 11},\"TYPE_MESSAGE\"),(EnumCode {getEnumCode = 12},\"TYPE_BYTES\"),(EnumCode {getEnumCode = 13},\"TYPE_UINT32\"),(EnumCode {getEnumCode = 14},\"TYPE_ENUM\"),(EnumCode {getEnumCode = 15},\"TYPE_SFIXED32\"),(EnumCode {getEnumCode = 16},\"TYPE_SFIXED64\"),(EnumCode {getEnumCode = 17},\"TYPE_SINT32\"),(EnumCode {getEnumCode = 18},\"TYPE_SINT64\")]},EnumInfo {enumName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"Label\"}, enumFilePath = [\"Text\",\"DescriptorProtos\",\"FieldDescriptorProto\",\"Label.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"LABEL_OPTIONAL\"),(EnumCode {getEnumCode = 2},\"LABEL_REQUIRED\"),(EnumCode {getEnumCode = 3},\"LABEL_REPEATED\")]},EnumInfo {enumName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"OptimizeMode\"}, enumFilePath = [\"Text\",\"DescriptorProtos\",\"FileOptions\",\"OptimizeMode.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"SPEED\"),(EnumCode {getEnumCode = 2},\"CODE_SIZE\")]},EnumInfo {enumName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldOptions\", baseName = \"CType\"}, enumFilePath = [\"Text\",\"DescriptorProtos\",\"FieldOptions\",\"CType.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"CORD\"),(EnumCode {getEnumCode = 2},\"STRING_PIECE\")]}], knownKeyMap = fromList []}"+ +fileDescriptorProto :: FileDescriptorProto+fileDescriptorProto+  = P'.getFromBS (P'.wireGet 11)+      (P'.pack+         "\235\SYN\n_/Users/chrisk/Documents/projects/haskell/develop/protocol-buffers/descriptor/./descriptor.proto\DC2\SIgoogle.protobuf\"\229\STX\n$DescriptorProtos.FileDescriptorProto\DC2\f\n\EOTname\CAN\SOH \SOH(\t\DC2\SI\n\apackage\CAN\STX \SOH(\t\DC2\DC2\n\ndependency\CAN\ETX \ETX(\t\DC26\n\fmessage_type\CAN\EOT \ETX(\v2 DescriptorProtos.DescriptorProto\DC27\n\tenum_type\CAN\ENQ \ETX(\v2$DescriptorProtos.EnumDescriptorProto\DC28\n\aservice\CAN\ACK \ETX(\v2'DescriptorProtos.ServiceDescriptorProto\DC28\n\textension\CAN\a \ETX(\v2%DescriptorProtos.FieldDescriptorProto\DC2-\n\aoptions\CAN\b \SOH(\v2\FSDescriptorProtos.FileOptions\"\209\ETX\n DescriptorProtos.DescriptorProto\DC2\f\n\EOTname\CAN\SOH \SOH(\t\DC24\n\ENQfield\CAN\STX \ETX(\v2%DescriptorProtos.FieldDescriptorProto\DC28\n\textension\CAN\ACK \ETX(\v2%DescriptorProtos.FieldDescriptorProto\DC25\n\vnested_type\CAN\ETX \ETX(\v2 DescriptorProtos.DescriptorProto\DC27\n\tenum_type\CAN\EOT \ETX(\v2$DescriptorProtos.EnumDescriptorProto\DC2H\n\SIextension_range\CAN\ENQ \ETX(\v2/DescriptorProtos.DescriptorProto.ExtensionRange\DC20\n\aoptions\CAN\a \SOH(\v2\USDescriptorProtos.MessageOptions\SUBK\n/DescriptorProtos.DescriptorProto.ExtensionRange\DC2\r\n\ENQstart\CAN\SOH \SOH(\ENQ\DC2\v\n\ETXend\CAN\STX \SOH(\ENQ\"\210\ENQ\n%DescriptorProtos.FieldDescriptorProto\DC2\f\n\EOTname\CAN\SOH \SOH(\t\DC2\SO\n\ACKnumber\CAN\ETX \SOH(\ENQ\DC2:\n\ENQlabel\CAN\EOT \SOH(\SO2+DescriptorProtos.FieldDescriptorProto.Label\DC29\n\ENQtype'\CAN\ENQ \SOH(\SO2*DescriptorProtos.FieldDescriptorProto.Type\DC2\DC1\n\ttype_name\CAN\ACK \SOH(\t\DC2\DLE\n\bextendee\CAN\STX \SOH(\t\DC2\NAK\n\rdefault_value\CAN\a \SOH(\t\DC2.\n\aoptions\CAN\b \SOH(\v2\GSDescriptorProtos.FieldOptions\"\202\STX\n*DescriptorProtos.FieldDescriptorProto.Type\DC2\SI\n\vTYPE_DOUBLE\DLE\SOH\DC2\SO\n\nTYPE_FLOAT\DLE\STX\DC2\SO\n\nTYPE_INT64\DLE\ETX\DC2\SI\n\vTYPE_UINT64\DLE\EOT\DC2\SO\n\nTYPE_INT32\DLE\ENQ\DC2\DLE\n\fTYPE_FIXED64\DLE\ACK\DC2\DLE\n\fTYPE_FIXED32\DLE\a\DC2\r\n\tTYPE_BOOL\DLE\b\DC2\SI\n\vTYPE_STRING\DLE\t\DC2\SO\n\nTYPE_GROUP\DLE\n\DC2\DLE\n\fTYPE_MESSAGE\DLE\v\DC2\SO\n\nTYPE_BYTES\DLE\f\DC2\SI\n\vTYPE_UINT32\DLE\r\DC2\r\n\tTYPE_ENUM\DLE\SO\DC2\DC1\n\rTYPE_SFIXED32\DLE\SI\DC2\DC1\n\rTYPE_SFIXED64\DLE\DLE\DC2\SI\n\vTYPE_SINT32\DLE\DC1\DC2\SI\n\vTYPE_SINT64\DLE\DC2\"f\n+DescriptorProtos.FieldDescriptorProto.Label\DC2\DC2\n\SOLABEL_OPTIONAL\DLE\SOH\DC2\DC2\n\SOLABEL_REQUIRED\DLE\STX\DC2\DC2\n\SOLABEL_REPEATED\DLE\ETX\"\154\SOH\n$DescriptorProtos.EnumDescriptorProto\DC2\f\n\EOTname\CAN\SOH \SOH(\t\DC28\n\ENQvalue\CAN\STX \ETX(\v2)DescriptorProtos.EnumValueDescriptorProto\DC2-\n\aoptions\CAN\ETX \SOH(\v2\FSDescriptorProtos.EnumOptions\"z\n)DescriptorProtos.EnumValueDescriptorProto\DC2\f\n\EOTname\CAN\SOH \SOH(\t\DC2\SO\n\ACKnumber\CAN\STX \SOH(\ENQ\DC22\n\aoptions\CAN\ETX \SOH(\v2!DescriptorProtos.EnumValueOptions\"\158\SOH\n'DescriptorProtos.ServiceDescriptorProto\DC2\f\n\EOTname\CAN\SOH \SOH(\t\DC26\n\ACKmethod\CAN\STX \ETX(\v2&DescriptorProtos.MethodDescriptorProto\DC20\n\aoptions\CAN\ETX \SOH(\v2\USDescriptorProtos.ServiceOptions\"\140\SOH\n&DescriptorProtos.MethodDescriptorProto\DC2\f\n\EOTname\CAN\SOH \SOH(\t\DC2\DC2\n\ninput_type\CAN\STX \SOH(\t\DC2\DC3\n\voutput_type\CAN\ETX \SOH(\t\DC2/\n\aoptions\CAN\EOT \SOH(\v2\RSDescriptorProtos.MethodOptions\"\130\STX\n\FSDescriptorProtos.FileOptions\DC2\DC4\n\fjava_package\CAN\SOH \SOH(\t\DC2\FS\n\DC4java_outer_classname\CAN\b \SOH(\t\DC2\"\n\DC3java_multiple_files\CAN\n \SOH(\b:\ENQfalse\DC2J\n\foptimize_for\CAN\t \SOH(\SO2)DescriptorProtos.FileOptions.OptimizeMode:\tCODE_SIZE\"C\n)DescriptorProtos.FileOptions.OptimizeMode\DC2\t\n\ENQSPEED\DLE\SOH\DC2\r\n\tCODE_SIZE\DLE\STX\"H\n\USDescriptorProtos.MessageOptions\DC2&\n\ETBmessage_set_wire_format\CAN\SOH \SOH(\b:\ENQfalse\"\175\SOH\n\GSDescriptorProtos.FieldOptions\DC22\n\ENQctype\CAN\SOH \SOH(\SO2#DescriptorProtos.FieldOptions.CType\DC2\FS\n\DC4experimental_map_key\CAN\t \SOH(\t\"?\n#DescriptorProtos.FieldOptions.CType\DC2\b\n\EOTCORD\DLE\SOH\DC2\DLE\n\fSTRING_PIECE\DLE\STX\"\RS\n\FSDescriptorProtos.EnumOptions\"#\n!DescriptorProtos.EnumValueOptions\"!\n\USDescriptorProtos.ServiceOptions\" \n\RSDescriptorProtos.MethodOptionsB)\n\DC3com.google.protobufB\DLEDescriptorProtosH\SOH")
+ descriptor/Text/DescriptorProtos/DescriptorProto.hs view
@@ -0,0 +1,88 @@+module Text.DescriptorProtos.DescriptorProto (DescriptorProto(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as DescriptorProtos.DescriptorProto (ExtensionRange)+import qualified Text.DescriptorProtos.EnumDescriptorProto as DescriptorProtos (EnumDescriptorProto)+import qualified Text.DescriptorProtos.FieldDescriptorProto as DescriptorProtos (FieldDescriptorProto)+import qualified Text.DescriptorProtos.MessageOptions as DescriptorProtos (MessageOptions)+ +data DescriptorProto = DescriptorProto{name :: P'.Maybe P'.Utf8, field :: P'.Seq DescriptorProtos.FieldDescriptorProto,+                                       extension :: P'.Seq DescriptorProtos.FieldDescriptorProto,+                                       nested_type :: P'.Seq DescriptorProto,+                                       enum_type :: P'.Seq DescriptorProtos.EnumDescriptorProto,+                                       extension_range :: P'.Seq DescriptorProtos.DescriptorProto.ExtensionRange,+                                       options :: P'.Maybe DescriptorProtos.MessageOptions}+                     deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable DescriptorProto where+  mergeEmpty = DescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (DescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7) (DescriptorProto y'1 y'2 y'3 y'4 y'5 y'6 y'7)+    = DescriptorProto (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+        (P'.mergeAppend x'5 y'5)+        (P'.mergeAppend x'6 y'6)+        (P'.mergeAppend x'7 y'7)+ +instance P'.Default DescriptorProto where+  defaultValue+    = DescriptorProto (P'.Just P'.defaultValue) P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+        (P'.Just P'.defaultValue)+ +instance P'.Wire DescriptorProto where+  wireSize ft' self'@(DescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+          = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeRep 1 11 x'2 + P'.wireSizeRep 1 11 x'3 + P'.wireSizeRep 1 11 x'4 ++               P'.wireSizeRep 1 11 x'5+               + P'.wireSizeRep 1 11 x'6+               + P'.wireSizeOpt 1 11 x'7)+  wirePut ft' self'@(DescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 9 x'1+              P'.wirePutRep 18 11 x'2+              P'.wirePutRep 26 11 x'4+              P'.wirePutRep 34 11 x'5+              P'.wirePutRep 42 11 x'6+              P'.wirePutRep 50 11 x'3+              P'.wirePutOpt 58 11 x'7+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field}) (P'.wireGet 9)+              2 -> P'.fmap (\ new'Field -> old'Self{field = P'.append (field old'Self) new'Field}) (P'.wireGet 11)+              6 -> P'.fmap (\ new'Field -> old'Self{extension = P'.append (extension old'Self) new'Field}) (P'.wireGet 11)+              3 -> P'.fmap (\ new'Field -> old'Self{nested_type = P'.append (nested_type old'Self) new'Field}) (P'.wireGet 11)+              4 -> P'.fmap (\ new'Field -> old'Self{enum_type = P'.append (enum_type old'Self) new'Field}) (P'.wireGet 11)+              5 -> P'.fmap (\ new'Field -> old'Self{extension_range = P'.append (extension_range old'Self) new'Field})+                     (P'.wireGet 11)+              7 -> P'.fmap (\ new'Field -> old'Self{options = P'.mergeAppend (options old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> DescriptorProto) DescriptorProto where+  getVal m' f' = f' m'+ +instance P'.GPB DescriptorProto+ +instance P'.ReflectDescriptor DescriptorProto where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"DescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"DescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"field\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"extension\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"nested_type\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"DescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"enum_type\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"extension_range\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"ExtensionRange\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MessageOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/DescriptorProto/ExtensionRange.hs view
@@ -0,0 +1,57 @@+module Text.DescriptorProtos.DescriptorProto.ExtensionRange (ExtensionRange(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ExtensionRange = ExtensionRange{start :: P'.Maybe P'.Int32, end :: P'.Maybe P'.Int32}+                    deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ExtensionRange where+  mergeEmpty = ExtensionRange P'.mergeEmpty P'.mergeEmpty+  mergeAppend (ExtensionRange x'1 x'2) (ExtensionRange y'1 y'2) = ExtensionRange (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default ExtensionRange where+  defaultValue = ExtensionRange (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)+ +instance P'.Wire ExtensionRange where+  wireSize ft' self'@(ExtensionRange x'1 x'2)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 5 x'1 + P'.wireSizeOpt 1 5 x'2)+  wirePut ft' self'@(ExtensionRange x'1 x'2)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+              P'.wirePutOpt 16 5 x'2+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{start = P'.Just new'Field}) (P'.wireGet 5)+              2 -> P'.fmap (\ new'Field -> old'Self{end = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> ExtensionRange) ExtensionRange where+  getVal m' f' = f' m'+ +instance P'.GPB ExtensionRange+ +instance P'.ReflectDescriptor ExtensionRange where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto\", baseName = \"ExtensionRange\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"DescriptorProto\",\"ExtensionRange.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto.ExtensionRange\", baseName = \"start\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.DescriptorProto.ExtensionRange\", baseName = \"end\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/EnumDescriptorProto.hs view
@@ -0,0 +1,64 @@+module Text.DescriptorProtos.EnumDescriptorProto (EnumDescriptorProto(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.EnumOptions as DescriptorProtos (EnumOptions)+import qualified Text.DescriptorProtos.EnumValueDescriptorProto as DescriptorProtos (EnumValueDescriptorProto)+ +data EnumDescriptorProto = EnumDescriptorProto{name :: P'.Maybe P'.Utf8, value :: P'.Seq DescriptorProtos.EnumValueDescriptorProto,+                                               options :: P'.Maybe DescriptorProtos.EnumOptions}+                         deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable EnumDescriptorProto where+  mergeEmpty = EnumDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (EnumDescriptorProto x'1 x'2 x'3) (EnumDescriptorProto y'1 y'2 y'3)+    = EnumDescriptorProto (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default EnumDescriptorProto where+  defaultValue = EnumDescriptorProto (P'.Just P'.defaultValue) P'.defaultValue (P'.Just P'.defaultValue)+ +instance P'.Wire EnumDescriptorProto where+  wireSize ft' self'@(EnumDescriptorProto x'1 x'2 x'3)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeRep 1 11 x'2 + P'.wireSizeOpt 1 11 x'3)+  wirePut ft' self'@(EnumDescriptorProto x'1 x'2 x'3)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 9 x'1+              P'.wirePutRep 18 11 x'2+              P'.wirePutOpt 26 11 x'3+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field}) (P'.wireGet 9)+              2 -> P'.fmap (\ new'Field -> old'Self{value = P'.append (value old'Self) new'Field}) (P'.wireGet 11)+              3 -> P'.fmap (\ new'Field -> old'Self{options = P'.mergeAppend (options old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> EnumDescriptorProto) EnumDescriptorProto where+  getVal m' f' = f' m'+ +instance P'.GPB EnumDescriptorProto+ +instance P'.ReflectDescriptor EnumDescriptorProto where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumDescriptorProto\", baseName = \"value\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/EnumOptions.hs view
@@ -0,0 +1,54 @@+module Text.DescriptorProtos.EnumOptions (EnumOptions(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data EnumOptions = EnumOptions{}+                 deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable EnumOptions where+  mergeEmpty = EnumOptions+  mergeAppend (EnumOptions) (EnumOptions) = EnumOptions+ +instance P'.Default EnumOptions where+  defaultValue = EnumOptions+ +instance P'.Wire EnumOptions where+  wireSize ft' self'@(EnumOptions)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(EnumOptions)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> EnumOptions) EnumOptions where+  getVal m' f' = f' m'+ +instance P'.GPB EnumOptions+ +instance P'.ReflectDescriptor EnumOptions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumOptions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/EnumValueDescriptorProto.hs view
@@ -0,0 +1,63 @@+module Text.DescriptorProtos.EnumValueDescriptorProto (EnumValueDescriptorProto(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.EnumValueOptions as DescriptorProtos (EnumValueOptions)+ +data EnumValueDescriptorProto = EnumValueDescriptorProto{name :: P'.Maybe P'.Utf8, number :: P'.Maybe P'.Int32,+                                                         options :: P'.Maybe DescriptorProtos.EnumValueOptions}+                              deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable EnumValueDescriptorProto where+  mergeEmpty = EnumValueDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (EnumValueDescriptorProto x'1 x'2 x'3) (EnumValueDescriptorProto y'1 y'2 y'3)+    = EnumValueDescriptorProto (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default EnumValueDescriptorProto where+  defaultValue = EnumValueDescriptorProto (P'.Just P'.defaultValue) (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)+ +instance P'.Wire EnumValueDescriptorProto where+  wireSize ft' self'@(EnumValueDescriptorProto x'1 x'2 x'3)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 5 x'2 + P'.wireSizeOpt 1 11 x'3)+  wirePut ft' self'@(EnumValueDescriptorProto x'1 x'2 x'3)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 9 x'1+              P'.wirePutOpt 16 5 x'2+              P'.wirePutOpt 26 11 x'3+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field}) (P'.wireGet 9)+              2 -> P'.fmap (\ new'Field -> old'Self{number = P'.Just new'Field}) (P'.wireGet 5)+              3 -> P'.fmap (\ new'Field -> old'Self{options = P'.mergeAppend (options old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> EnumValueDescriptorProto) EnumValueDescriptorProto where+  getVal m' f' = f' m'+ +instance P'.GPB EnumValueDescriptorProto+ +instance P'.ReflectDescriptor EnumValueDescriptorProto where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumValueDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumValueDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumValueDescriptorProto\", baseName = \"number\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.EnumValueDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/EnumValueOptions.hs view
@@ -0,0 +1,54 @@+module Text.DescriptorProtos.EnumValueOptions (EnumValueOptions(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data EnumValueOptions = EnumValueOptions{}+                      deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable EnumValueOptions where+  mergeEmpty = EnumValueOptions+  mergeAppend (EnumValueOptions) (EnumValueOptions) = EnumValueOptions+ +instance P'.Default EnumValueOptions where+  defaultValue = EnumValueOptions+ +instance P'.Wire EnumValueOptions where+  wireSize ft' self'@(EnumValueOptions)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(EnumValueOptions)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> EnumValueOptions) EnumValueOptions where+  getVal m' f' = f' m'+ +instance P'.GPB EnumValueOptions+ +instance P'.ReflectDescriptor EnumValueOptions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumValueOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"EnumValueOptions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/FieldDescriptorProto.hs view
@@ -0,0 +1,95 @@+module Text.DescriptorProtos.FieldDescriptorProto (FieldDescriptorProto(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.FieldDescriptorProto.Label as DescriptorProtos.FieldDescriptorProto (Label)+import qualified Text.DescriptorProtos.FieldDescriptorProto.Type as DescriptorProtos.FieldDescriptorProto (Type)+import qualified Text.DescriptorProtos.FieldOptions as DescriptorProtos (FieldOptions)+ +data FieldDescriptorProto = FieldDescriptorProto{name :: P'.Maybe P'.Utf8, number :: P'.Maybe P'.Int32,+                                                 label :: P'.Maybe DescriptorProtos.FieldDescriptorProto.Label,+                                                 type' :: P'.Maybe DescriptorProtos.FieldDescriptorProto.Type,+                                                 type_name :: P'.Maybe P'.Utf8, extendee :: P'.Maybe P'.Utf8,+                                                 default_value :: P'.Maybe P'.Utf8,+                                                 options :: P'.Maybe DescriptorProtos.FieldOptions}+                          deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable FieldDescriptorProto where+  mergeEmpty+    = FieldDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+        P'.mergeEmpty+  mergeAppend (FieldDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8) (FieldDescriptorProto y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8)+    = FieldDescriptorProto (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+        (P'.mergeAppend x'5 y'5)+        (P'.mergeAppend x'6 y'6)+        (P'.mergeAppend x'7 y'7)+        (P'.mergeAppend x'8 y'8)+ +instance P'.Default FieldDescriptorProto where+  defaultValue+    = FieldDescriptorProto (P'.Just P'.defaultValue) (P'.Just P'.defaultValue) (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)+        (P'.Just P'.defaultValue)+        (P'.Just P'.defaultValue)+        (P'.Just P'.defaultValue)+        (P'.Just P'.defaultValue)+ +instance P'.Wire FieldDescriptorProto where+  wireSize ft' self'@(FieldDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+          = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 5 x'2 + P'.wireSizeOpt 1 14 x'3 + P'.wireSizeOpt 1 14 x'4 ++               P'.wireSizeOpt 1 9 x'5+               + P'.wireSizeOpt 1 9 x'6+               + P'.wireSizeOpt 1 9 x'7+               + P'.wireSizeOpt 1 11 x'8)+  wirePut ft' self'@(FieldDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 9 x'1+              P'.wirePutOpt 18 9 x'6+              P'.wirePutOpt 24 5 x'2+              P'.wirePutOpt 32 14 x'3+              P'.wirePutOpt 40 14 x'4+              P'.wirePutOpt 50 9 x'5+              P'.wirePutOpt 58 9 x'7+              P'.wirePutOpt 66 11 x'8+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field}) (P'.wireGet 9)+              3 -> P'.fmap (\ new'Field -> old'Self{number = P'.Just new'Field}) (P'.wireGet 5)+              4 -> P'.fmap (\ new'Field -> old'Self{label = P'.Just new'Field}) (P'.wireGet 14)+              5 -> P'.fmap (\ new'Field -> old'Self{type' = P'.Just new'Field}) (P'.wireGet 14)+              6 -> P'.fmap (\ new'Field -> old'Self{type_name = P'.Just new'Field}) (P'.wireGet 9)+              2 -> P'.fmap (\ new'Field -> old'Self{extendee = P'.Just new'Field}) (P'.wireGet 9)+              7 -> P'.fmap (\ new'Field -> old'Self{default_value = P'.Just new'Field}) (P'.wireGet 9)+              8 -> P'.fmap (\ new'Field -> old'Self{options = P'.mergeAppend (options old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> FieldDescriptorProto) FieldDescriptorProto where+  getVal m' f' = f' m'+ +instance P'.GPB FieldDescriptorProto+ +instance P'.ReflectDescriptor FieldDescriptorProto where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FieldDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"number\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"label\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"Label\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"type'\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"Type\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"type_name\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"extendee\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"default_value\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/FieldDescriptorProto/Label.hs view
@@ -0,0 +1,48 @@+module Text.DescriptorProtos.FieldDescriptorProto.Label (Label(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data Label = LABEL_OPTIONAL+           | LABEL_REQUIRED+           | LABEL_REPEATED+           deriving (P'.Read, P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable Label+ +instance P'.Bounded Label where+  minBound = LABEL_OPTIONAL+  maxBound = LABEL_REPEATED+ +instance P'.Default Label where+  defaultValue = LABEL_OPTIONAL+ +instance P'.Enum Label where+  fromEnum (LABEL_OPTIONAL) = 1+  fromEnum (LABEL_REQUIRED) = 2+  fromEnum (LABEL_REPEATED) = 3+  toEnum 1 = LABEL_OPTIONAL+  toEnum 2 = LABEL_REQUIRED+  toEnum 3 = LABEL_REPEATED+  succ (LABEL_OPTIONAL) = LABEL_REQUIRED+  succ (LABEL_REQUIRED) = LABEL_REPEATED+  pred (LABEL_REQUIRED) = LABEL_OPTIONAL+  pred (LABEL_REPEATED) = LABEL_REQUIRED+ +instance P'.Wire Label where+  wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)+  wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)+  wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)+ +instance P'.GPB Label+ +instance P'.MessageAPI msg' (msg' -> Label) Label where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum Label where+  reflectEnum+    = [(1, "LABEL_OPTIONAL", LABEL_OPTIONAL), (2, "LABEL_REQUIRED", LABEL_REQUIRED), (3, "LABEL_REPEATED", LABEL_REPEATED)]+  reflectEnumInfo _+    = P'.EnumInfo (P'.ProtoName "Text" "DescriptorProtos.FieldDescriptorProto" "Label")+        ["Text", "DescriptorProtos", "FieldDescriptorProto", "Label.hs"]+        [(1, "LABEL_OPTIONAL"), (2, "LABEL_REQUIRED"), (3, "LABEL_REPEATED")]
+ descriptor/Text/DescriptorProtos/FieldDescriptorProto/Type.hs view
@@ -0,0 +1,131 @@+module Text.DescriptorProtos.FieldDescriptorProto.Type (Type(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data Type = TYPE_DOUBLE+          | TYPE_FLOAT+          | TYPE_INT64+          | TYPE_UINT64+          | TYPE_INT32+          | TYPE_FIXED64+          | TYPE_FIXED32+          | TYPE_BOOL+          | TYPE_STRING+          | TYPE_GROUP+          | TYPE_MESSAGE+          | TYPE_BYTES+          | TYPE_UINT32+          | TYPE_ENUM+          | TYPE_SFIXED32+          | TYPE_SFIXED64+          | TYPE_SINT32+          | TYPE_SINT64+          deriving (P'.Read, P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable Type+ +instance P'.Bounded Type where+  minBound = TYPE_DOUBLE+  maxBound = TYPE_SINT64+ +instance P'.Default Type where+  defaultValue = TYPE_DOUBLE+ +instance P'.Enum Type where+  fromEnum (TYPE_DOUBLE) = 1+  fromEnum (TYPE_FLOAT) = 2+  fromEnum (TYPE_INT64) = 3+  fromEnum (TYPE_UINT64) = 4+  fromEnum (TYPE_INT32) = 5+  fromEnum (TYPE_FIXED64) = 6+  fromEnum (TYPE_FIXED32) = 7+  fromEnum (TYPE_BOOL) = 8+  fromEnum (TYPE_STRING) = 9+  fromEnum (TYPE_GROUP) = 10+  fromEnum (TYPE_MESSAGE) = 11+  fromEnum (TYPE_BYTES) = 12+  fromEnum (TYPE_UINT32) = 13+  fromEnum (TYPE_ENUM) = 14+  fromEnum (TYPE_SFIXED32) = 15+  fromEnum (TYPE_SFIXED64) = 16+  fromEnum (TYPE_SINT32) = 17+  fromEnum (TYPE_SINT64) = 18+  toEnum 1 = TYPE_DOUBLE+  toEnum 2 = TYPE_FLOAT+  toEnum 3 = TYPE_INT64+  toEnum 4 = TYPE_UINT64+  toEnum 5 = TYPE_INT32+  toEnum 6 = TYPE_FIXED64+  toEnum 7 = TYPE_FIXED32+  toEnum 8 = TYPE_BOOL+  toEnum 9 = TYPE_STRING+  toEnum 10 = TYPE_GROUP+  toEnum 11 = TYPE_MESSAGE+  toEnum 12 = TYPE_BYTES+  toEnum 13 = TYPE_UINT32+  toEnum 14 = TYPE_ENUM+  toEnum 15 = TYPE_SFIXED32+  toEnum 16 = TYPE_SFIXED64+  toEnum 17 = TYPE_SINT32+  toEnum 18 = TYPE_SINT64+  succ (TYPE_DOUBLE) = TYPE_FLOAT+  succ (TYPE_FLOAT) = TYPE_INT64+  succ (TYPE_INT64) = TYPE_UINT64+  succ (TYPE_UINT64) = TYPE_INT32+  succ (TYPE_INT32) = TYPE_FIXED64+  succ (TYPE_FIXED64) = TYPE_FIXED32+  succ (TYPE_FIXED32) = TYPE_BOOL+  succ (TYPE_BOOL) = TYPE_STRING+  succ (TYPE_STRING) = TYPE_GROUP+  succ (TYPE_GROUP) = TYPE_MESSAGE+  succ (TYPE_MESSAGE) = TYPE_BYTES+  succ (TYPE_BYTES) = TYPE_UINT32+  succ (TYPE_UINT32) = TYPE_ENUM+  succ (TYPE_ENUM) = TYPE_SFIXED32+  succ (TYPE_SFIXED32) = TYPE_SFIXED64+  succ (TYPE_SFIXED64) = TYPE_SINT32+  succ (TYPE_SINT32) = TYPE_SINT64+  pred (TYPE_FLOAT) = TYPE_DOUBLE+  pred (TYPE_INT64) = TYPE_FLOAT+  pred (TYPE_UINT64) = TYPE_INT64+  pred (TYPE_INT32) = TYPE_UINT64+  pred (TYPE_FIXED64) = TYPE_INT32+  pred (TYPE_FIXED32) = TYPE_FIXED64+  pred (TYPE_BOOL) = TYPE_FIXED32+  pred (TYPE_STRING) = TYPE_BOOL+  pred (TYPE_GROUP) = TYPE_STRING+  pred (TYPE_MESSAGE) = TYPE_GROUP+  pred (TYPE_BYTES) = TYPE_MESSAGE+  pred (TYPE_UINT32) = TYPE_BYTES+  pred (TYPE_ENUM) = TYPE_UINT32+  pred (TYPE_SFIXED32) = TYPE_ENUM+  pred (TYPE_SFIXED64) = TYPE_SFIXED32+  pred (TYPE_SINT32) = TYPE_SFIXED64+  pred (TYPE_SINT64) = TYPE_SINT32+ +instance P'.Wire Type where+  wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)+  wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)+  wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)+ +instance P'.GPB Type+ +instance P'.MessageAPI msg' (msg' -> Type) Type where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum Type where+  reflectEnum+    = [(1, "TYPE_DOUBLE", TYPE_DOUBLE), (2, "TYPE_FLOAT", TYPE_FLOAT), (3, "TYPE_INT64", TYPE_INT64),+       (4, "TYPE_UINT64", TYPE_UINT64), (5, "TYPE_INT32", TYPE_INT32), (6, "TYPE_FIXED64", TYPE_FIXED64),+       (7, "TYPE_FIXED32", TYPE_FIXED32), (8, "TYPE_BOOL", TYPE_BOOL), (9, "TYPE_STRING", TYPE_STRING),+       (10, "TYPE_GROUP", TYPE_GROUP), (11, "TYPE_MESSAGE", TYPE_MESSAGE), (12, "TYPE_BYTES", TYPE_BYTES),+       (13, "TYPE_UINT32", TYPE_UINT32), (14, "TYPE_ENUM", TYPE_ENUM), (15, "TYPE_SFIXED32", TYPE_SFIXED32),+       (16, "TYPE_SFIXED64", TYPE_SFIXED64), (17, "TYPE_SINT32", TYPE_SINT32), (18, "TYPE_SINT64", TYPE_SINT64)]+  reflectEnumInfo _+    = P'.EnumInfo (P'.ProtoName "Text" "DescriptorProtos.FieldDescriptorProto" "Type")+        ["Text", "DescriptorProtos", "FieldDescriptorProto", "Type.hs"]+        [(1, "TYPE_DOUBLE"), (2, "TYPE_FLOAT"), (3, "TYPE_INT64"), (4, "TYPE_UINT64"), (5, "TYPE_INT32"), (6, "TYPE_FIXED64"),+         (7, "TYPE_FIXED32"), (8, "TYPE_BOOL"), (9, "TYPE_STRING"), (10, "TYPE_GROUP"), (11, "TYPE_MESSAGE"), (12, "TYPE_BYTES"),+         (13, "TYPE_UINT32"), (14, "TYPE_ENUM"), (15, "TYPE_SFIXED32"), (16, "TYPE_SFIXED64"), (17, "TYPE_SINT32"),+         (18, "TYPE_SINT64")]
+ descriptor/Text/DescriptorProtos/FieldOptions.hs view
@@ -0,0 +1,58 @@+module Text.DescriptorProtos.FieldOptions (FieldOptions(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.FieldOptions.CType as DescriptorProtos.FieldOptions (CType)+ +data FieldOptions = FieldOptions{ctype :: P'.Maybe DescriptorProtos.FieldOptions.CType, experimental_map_key :: P'.Maybe P'.Utf8}+                  deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable FieldOptions where+  mergeEmpty = FieldOptions P'.mergeEmpty P'.mergeEmpty+  mergeAppend (FieldOptions x'1 x'2) (FieldOptions y'1 y'2) = FieldOptions (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default FieldOptions where+  defaultValue = FieldOptions (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)+ +instance P'.Wire FieldOptions where+  wireSize ft' self'@(FieldOptions x'1 x'2)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 14 x'1 + P'.wireSizeOpt 1 9 x'2)+  wirePut ft' self'@(FieldOptions x'1 x'2)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 14 x'1+              P'.wirePutOpt 74 9 x'2+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{ctype = P'.Just new'Field}) (P'.wireGet 14)+              9 -> P'.fmap (\ new'Field -> old'Self{experimental_map_key = P'.Just new'Field}) (P'.wireGet 9)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> FieldOptions) FieldOptions where+  getVal m' f' = f' m'+ +instance P'.GPB FieldOptions+ +instance P'.ReflectDescriptor FieldOptions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FieldOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldOptions\", baseName = \"ctype\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldOptions\", baseName = \"CType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FieldOptions\", baseName = \"experimental_map_key\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 74}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/FieldOptions/CType.hs view
@@ -0,0 +1,42 @@+module Text.DescriptorProtos.FieldOptions.CType (CType(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data CType = CORD+           | STRING_PIECE+           deriving (P'.Read, P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable CType+ +instance P'.Bounded CType where+  minBound = CORD+  maxBound = STRING_PIECE+ +instance P'.Default CType where+  defaultValue = CORD+ +instance P'.Enum CType where+  fromEnum (CORD) = 1+  fromEnum (STRING_PIECE) = 2+  toEnum 1 = CORD+  toEnum 2 = STRING_PIECE+  succ (CORD) = STRING_PIECE+  pred (STRING_PIECE) = CORD+ +instance P'.Wire CType where+  wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)+  wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)+  wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)+ +instance P'.GPB CType+ +instance P'.MessageAPI msg' (msg' -> CType) CType where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum CType where+  reflectEnum = [(1, "CORD", CORD), (2, "STRING_PIECE", STRING_PIECE)]+  reflectEnumInfo _+    = P'.EnumInfo (P'.ProtoName "Text" "DescriptorProtos.FieldOptions" "CType")+        ["Text", "DescriptorProtos", "FieldOptions", "CType.hs"]+        [(1, "CORD"), (2, "STRING_PIECE")]
+ descriptor/Text/DescriptorProtos/FileDescriptorProto.hs view
@@ -0,0 +1,96 @@+module Text.DescriptorProtos.FileDescriptorProto (FileDescriptorProto(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.DescriptorProto as DescriptorProtos (DescriptorProto)+import qualified Text.DescriptorProtos.EnumDescriptorProto as DescriptorProtos (EnumDescriptorProto)+import qualified Text.DescriptorProtos.FieldDescriptorProto as DescriptorProtos (FieldDescriptorProto)+import qualified Text.DescriptorProtos.FileOptions as DescriptorProtos (FileOptions)+import qualified Text.DescriptorProtos.ServiceDescriptorProto as DescriptorProtos (ServiceDescriptorProto)+ +data FileDescriptorProto = FileDescriptorProto{name :: P'.Maybe P'.Utf8, package :: P'.Maybe P'.Utf8, dependency :: P'.Seq P'.Utf8,+                                               message_type :: P'.Seq DescriptorProtos.DescriptorProto,+                                               enum_type :: P'.Seq DescriptorProtos.EnumDescriptorProto,+                                               service :: P'.Seq DescriptorProtos.ServiceDescriptorProto,+                                               extension :: P'.Seq DescriptorProtos.FieldDescriptorProto,+                                               options :: P'.Maybe DescriptorProtos.FileOptions}+                         deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable FileDescriptorProto where+  mergeEmpty+    = FileDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+        P'.mergeEmpty+  mergeAppend (FileDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8) (FileDescriptorProto y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8)+    = FileDescriptorProto (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+        (P'.mergeAppend x'5 y'5)+        (P'.mergeAppend x'6 y'6)+        (P'.mergeAppend x'7 y'7)+        (P'.mergeAppend x'8 y'8)+ +instance P'.Default FileDescriptorProto where+  defaultValue+    = FileDescriptorProto (P'.Just P'.defaultValue) (P'.Just P'.defaultValue) P'.defaultValue P'.defaultValue P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        (P'.Just P'.defaultValue)+ +instance P'.Wire FileDescriptorProto where+  wireSize ft' self'@(FileDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+          = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeRep 1 9 x'3 + P'.wireSizeRep 1 11 x'4 ++               P'.wireSizeRep 1 11 x'5+               + P'.wireSizeRep 1 11 x'6+               + P'.wireSizeRep 1 11 x'7+               + P'.wireSizeOpt 1 11 x'8)+  wirePut ft' self'@(FileDescriptorProto x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 9 x'1+              P'.wirePutOpt 18 9 x'2+              P'.wirePutRep 26 9 x'3+              P'.wirePutRep 34 11 x'4+              P'.wirePutRep 42 11 x'5+              P'.wirePutRep 50 11 x'6+              P'.wirePutRep 58 11 x'7+              P'.wirePutOpt 66 11 x'8+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field}) (P'.wireGet 9)+              2 -> P'.fmap (\ new'Field -> old'Self{package = P'.Just new'Field}) (P'.wireGet 9)+              3 -> P'.fmap (\ new'Field -> old'Self{dependency = P'.append (dependency old'Self) new'Field}) (P'.wireGet 9)+              4 -> P'.fmap (\ new'Field -> old'Self{message_type = P'.append (message_type old'Self) new'Field}) (P'.wireGet 11)+              5 -> P'.fmap (\ new'Field -> old'Self{enum_type = P'.append (enum_type old'Self) new'Field}) (P'.wireGet 11)+              6 -> P'.fmap (\ new'Field -> old'Self{service = P'.append (service old'Self) new'Field}) (P'.wireGet 11)+              7 -> P'.fmap (\ new'Field -> old'Self{extension = P'.append (extension old'Self) new'Field}) (P'.wireGet 11)+              8 -> P'.fmap (\ new'Field -> old'Self{options = P'.mergeAppend (options old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> FileDescriptorProto) FileDescriptorProto where+  getVal m' f' = f' m'+ +instance P'.GPB FileDescriptorProto+ +instance P'.ReflectDescriptor FileDescriptorProto where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FileDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FileDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"package\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"dependency\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"message_type\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"DescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"enum_type\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"EnumDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"service\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"extension\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FieldDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FileOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/FileOptions.hs view
@@ -0,0 +1,65 @@+module Text.DescriptorProtos.FileOptions (FileOptions(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.FileOptions.OptimizeMode as DescriptorProtos.FileOptions (OptimizeMode)+ +data FileOptions = FileOptions{java_package :: P'.Maybe P'.Utf8, java_outer_classname :: P'.Maybe P'.Utf8,+                               java_multiple_files :: P'.Maybe P'.Bool,+                               optimize_for :: P'.Maybe DescriptorProtos.FileOptions.OptimizeMode}+                 deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable FileOptions where+  mergeEmpty = FileOptions P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (FileOptions x'1 x'2 x'3 x'4) (FileOptions y'1 y'2 y'3 y'4)+    = FileOptions (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+ +instance P'.Default FileOptions where+  defaultValue = FileOptions (P'.Just P'.defaultValue) (P'.Just P'.defaultValue) (P'.Just P'.False) (P'.Just (P'.read "CODE_SIZE"))+ +instance P'.Wire FileOptions where+  wireSize ft' self'@(FileOptions x'1 x'2 x'3 x'4)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeOpt 1 8 x'3 + P'.wireSizeOpt 1 14 x'4)+  wirePut ft' self'@(FileOptions x'1 x'2 x'3 x'4)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 9 x'1+              P'.wirePutOpt 66 9 x'2+              P'.wirePutOpt 72 14 x'4+              P'.wirePutOpt 80 8 x'3+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{java_package = P'.Just new'Field}) (P'.wireGet 9)+              8 -> P'.fmap (\ new'Field -> old'Self{java_outer_classname = P'.Just new'Field}) (P'.wireGet 9)+              10 -> P'.fmap (\ new'Field -> old'Self{java_multiple_files = P'.Just new'Field}) (P'.wireGet 8)+              9 -> P'.fmap (\ new'Field -> old'Self{optimize_for = P'.Just new'Field}) (P'.wireGet 14)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> FileOptions) FileOptions where+  getVal m' f' = f' m'+ +instance P'.GPB FileOptions+ +instance P'.ReflectDescriptor FileOptions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"FileOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"FileOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"java_package\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"java_outer_classname\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"java_multiple_files\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 80}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just (Chunk \"false\" Empty), hsDefault = Just (HsDef'Bool False)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"optimize_for\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 72}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.FileOptions\", baseName = \"OptimizeMode\"}), hsRawDefault = Just (Chunk \"CODE_SIZE\" Empty), hsDefault = Just (HsDef'Enum \"CODE_SIZE\")}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/FileOptions/OptimizeMode.hs view
@@ -0,0 +1,42 @@+module Text.DescriptorProtos.FileOptions.OptimizeMode (OptimizeMode(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data OptimizeMode = SPEED+                  | CODE_SIZE+                  deriving (P'.Read, P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable OptimizeMode+ +instance P'.Bounded OptimizeMode where+  minBound = SPEED+  maxBound = CODE_SIZE+ +instance P'.Default OptimizeMode where+  defaultValue = SPEED+ +instance P'.Enum OptimizeMode where+  fromEnum (SPEED) = 1+  fromEnum (CODE_SIZE) = 2+  toEnum 1 = SPEED+  toEnum 2 = CODE_SIZE+  succ (SPEED) = CODE_SIZE+  pred (CODE_SIZE) = SPEED+ +instance P'.Wire OptimizeMode where+  wireSize 14 enum = P'.wireSize 14 (P'.fromEnum enum)+  wirePut 14 enum = P'.wirePut 14 (P'.fromEnum enum)+  wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)+ +instance P'.GPB OptimizeMode+ +instance P'.MessageAPI msg' (msg' -> OptimizeMode) OptimizeMode where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum OptimizeMode where+  reflectEnum = [(1, "SPEED", SPEED), (2, "CODE_SIZE", CODE_SIZE)]+  reflectEnumInfo _+    = P'.EnumInfo (P'.ProtoName "Text" "DescriptorProtos.FileOptions" "OptimizeMode")+        ["Text", "DescriptorProtos", "FileOptions", "OptimizeMode.hs"]+        [(1, "SPEED"), (2, "CODE_SIZE")]
+ descriptor/Text/DescriptorProtos/MessageOptions.hs view
@@ -0,0 +1,55 @@+module Text.DescriptorProtos.MessageOptions (MessageOptions(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data MessageOptions = MessageOptions{message_set_wire_format :: P'.Maybe P'.Bool}+                    deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable MessageOptions where+  mergeEmpty = MessageOptions P'.mergeEmpty+  mergeAppend (MessageOptions x'1) (MessageOptions y'1) = MessageOptions (P'.mergeAppend x'1 y'1)+ +instance P'.Default MessageOptions where+  defaultValue = MessageOptions (P'.Just P'.False)+ +instance P'.Wire MessageOptions where+  wireSize ft' self'@(MessageOptions x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 8 x'1)+  wirePut ft' self'@(MessageOptions x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 8 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{message_set_wire_format = P'.Just new'Field}) (P'.wireGet 8)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> MessageOptions) MessageOptions where+  getVal m' f' = f' m'+ +instance P'.GPB MessageOptions+ +instance P'.ReflectDescriptor MessageOptions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MessageOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"MessageOptions.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MessageOptions\", baseName = \"message_set_wire_format\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just (Chunk \"false\" Empty), hsDefault = Just (HsDef'Bool False)}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/MethodDescriptorProto.hs view
@@ -0,0 +1,67 @@+module Text.DescriptorProtos.MethodDescriptorProto (MethodDescriptorProto(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.MethodOptions as DescriptorProtos (MethodOptions)+ +data MethodDescriptorProto = MethodDescriptorProto{name :: P'.Maybe P'.Utf8, input_type :: P'.Maybe P'.Utf8,+                                                   output_type :: P'.Maybe P'.Utf8,+                                                   options :: P'.Maybe DescriptorProtos.MethodOptions}+                           deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable MethodDescriptorProto where+  mergeEmpty = MethodDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (MethodDescriptorProto x'1 x'2 x'3 x'4) (MethodDescriptorProto y'1 y'2 y'3 y'4)+    = MethodDescriptorProto (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+ +instance P'.Default MethodDescriptorProto where+  defaultValue+    = MethodDescriptorProto (P'.Just P'.defaultValue) (P'.Just P'.defaultValue) (P'.Just P'.defaultValue) (P'.Just P'.defaultValue)+ +instance P'.Wire MethodDescriptorProto where+  wireSize ft' self'@(MethodDescriptorProto x'1 x'2 x'3 x'4)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeOpt 1 9 x'3 + P'.wireSizeOpt 1 11 x'4)+  wirePut ft' self'@(MethodDescriptorProto x'1 x'2 x'3 x'4)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 9 x'1+              P'.wirePutOpt 18 9 x'2+              P'.wirePutOpt 26 9 x'3+              P'.wirePutOpt 34 11 x'4+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field}) (P'.wireGet 9)+              2 -> P'.fmap (\ new'Field -> old'Self{input_type = P'.Just new'Field}) (P'.wireGet 9)+              3 -> P'.fmap (\ new'Field -> old'Self{output_type = P'.Just new'Field}) (P'.wireGet 9)+              4 -> P'.fmap (\ new'Field -> old'Self{options = P'.mergeAppend (options old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> MethodDescriptorProto) MethodDescriptorProto where+  getVal m' f' = f' m'+ +instance P'.GPB MethodDescriptorProto+ +instance P'.ReflectDescriptor MethodDescriptorProto where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"MethodDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MethodDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MethodDescriptorProto\", baseName = \"input_type\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MethodDescriptorProto\", baseName = \"output_type\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.MethodDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/MethodOptions.hs view
@@ -0,0 +1,54 @@+module Text.DescriptorProtos.MethodOptions (MethodOptions(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data MethodOptions = MethodOptions{}+                   deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable MethodOptions where+  mergeEmpty = MethodOptions+  mergeAppend (MethodOptions) (MethodOptions) = MethodOptions+ +instance P'.Default MethodOptions where+  defaultValue = MethodOptions+ +instance P'.Wire MethodOptions where+  wireSize ft' self'@(MethodOptions)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(MethodOptions)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> MethodOptions) MethodOptions where+  getVal m' f' = f' m'+ +instance P'.GPB MethodOptions+ +instance P'.ReflectDescriptor MethodOptions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"MethodOptions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/ServiceDescriptorProto.hs view
@@ -0,0 +1,65 @@+module Text.DescriptorProtos.ServiceDescriptorProto (ServiceDescriptorProto(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.DescriptorProtos.MethodDescriptorProto as DescriptorProtos (MethodDescriptorProto)+import qualified Text.DescriptorProtos.ServiceOptions as DescriptorProtos (ServiceOptions)+ +data ServiceDescriptorProto = ServiceDescriptorProto{name :: P'.Maybe P'.Utf8,+                                                     method :: P'.Seq DescriptorProtos.MethodDescriptorProto,+                                                     options :: P'.Maybe DescriptorProtos.ServiceOptions}+                            deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ServiceDescriptorProto where+  mergeEmpty = ServiceDescriptorProto P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (ServiceDescriptorProto x'1 x'2 x'3) (ServiceDescriptorProto y'1 y'2 y'3)+    = ServiceDescriptorProto (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default ServiceDescriptorProto where+  defaultValue = ServiceDescriptorProto (P'.Just P'.defaultValue) P'.defaultValue (P'.Just P'.defaultValue)+ +instance P'.Wire ServiceDescriptorProto where+  wireSize ft' self'@(ServiceDescriptorProto x'1 x'2 x'3)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeRep 1 11 x'2 + P'.wireSizeOpt 1 11 x'3)+  wirePut ft' self'@(ServiceDescriptorProto x'1 x'2 x'3)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 9 x'1+              P'.wirePutRep 18 11 x'2+              P'.wirePutOpt 26 11 x'3+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{name = P'.Just new'Field}) (P'.wireGet 9)+              2 -> P'.fmap (\ new'Field -> old'Self{method = P'.append (method old'Self) new'Field}) (P'.wireGet 11)+              3 -> P'.fmap (\ new'Field -> old'Self{options = P'.mergeAppend (options old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> ServiceDescriptorProto) ServiceDescriptorProto where+  getVal m' f' = f' m'+ +instance P'.GPB ServiceDescriptorProto+ +instance P'.ReflectDescriptor ServiceDescriptorProto where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceDescriptorProto\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"ServiceDescriptorProto.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.ServiceDescriptorProto\", baseName = \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.ServiceDescriptorProto\", baseName = \"method\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"MethodDescriptorProto\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos.ServiceDescriptorProto\", baseName = \"options\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceOptions\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/Text/DescriptorProtos/ServiceOptions.hs view
@@ -0,0 +1,54 @@+module Text.DescriptorProtos.ServiceOptions (ServiceOptions(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ServiceOptions = ServiceOptions{}+                    deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ServiceOptions where+  mergeEmpty = ServiceOptions+  mergeAppend (ServiceOptions) (ServiceOptions) = ServiceOptions+ +instance P'.Default ServiceOptions where+  defaultValue = ServiceOptions+ +instance P'.Wire ServiceOptions where+  wireSize ft' self'@(ServiceOptions)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(ServiceOptions)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 11 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> ServiceOptions) ServiceOptions where+  getVal m' f' = f' m'+ +instance P'.GPB ServiceOptions+ +instance P'.ReflectDescriptor ServiceOptions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"Text\", parentModule = \"DescriptorProtos\", baseName = \"ServiceOptions\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"ServiceOptions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ descriptor/descriptor.proto view
@@ -0,0 +1,286 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// The messages in this file describe the definitions found in .proto files.+// A valid .proto file can be translated directly to a FileDescriptorProto+// without any other information (e.g. without reading its imports).++++package google.protobuf;+option java_package = "com.google.protobuf";+option java_outer_classname = "DescriptorProtos";++// descriptor.proto must be optimized for speed because reflection-based+// algorithms don't work during bootstrapping.+option optimize_for = SPEED;++// Describes a complete .proto file.+message FileDescriptorProto {+  optional string name = 1;       // file name, relative to root of source tree+  optional string package = 2;    // e.g. "foo", "foo.bar", etc.++  // Names of files imported by this file.+  repeated string dependency = 3;++  // All top-level definitions in this file.+  repeated DescriptorProto message_type = 4;+  repeated EnumDescriptorProto enum_type = 5;+  repeated ServiceDescriptorProto service = 6;+  repeated FieldDescriptorProto extension = 7;++  optional FileOptions options = 8;+}++// Describes a message type.+message DescriptorProto {+  optional string name = 1;++  repeated FieldDescriptorProto field = 2;+  repeated FieldDescriptorProto extension = 6;++  repeated DescriptorProto nested_type = 3;+  repeated EnumDescriptorProto enum_type = 4;++  message ExtensionRange {+    optional int32 start = 1;+    optional int32 end = 2;+  }+  repeated ExtensionRange extension_range = 5;++  optional MessageOptions options = 7;+}++// Describes a field within a message.+message FieldDescriptorProto {+  enum Type {+    // 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.+  };++  enum Label {+    // 0 is reserved for errors+    LABEL_OPTIONAL      = 1;+    LABEL_REQUIRED      = 2;+    LABEL_REPEATED      = 3;+    // TODO(sanjay): Should we add LABEL_MAP?+  };++  optional string name = 1;+  optional int32 number = 3;+  optional Label label = 4;++  // If type_name is set, this need not be set.  If both this and type_name+  // are set, this must be either TYPE_ENUM or TYPE_MESSAGE.+  optional Type type = 5;++  // For message and enum types, this is the name of the type.  If the name+  // starts with a '.', it is fully-qualified.  Otherwise, C++-like scoping+  // rules are used to find the type (i.e. first the nested types within this+  // message are searched, then within the parent, on up to the root+  // namespace).+  optional string type_name = 6;++  // For extensions, this is the name of the type being extended.  It is+  // resolved in the same manner as type_name.+  optional string extendee = 2;++  // For numeric types, contains the original text representation of the value.+  // For booleans, "true" or "false".+  // For strings, contains the default text contents (not escaped in any way).+  // For bytes, contains the C escaped value.  All bytes >= 128 are escaped.+  // TODO(kenton):  Base-64 encode?+  optional string default_value = 7;++  optional FieldOptions options = 8;+}++// Describes an enum type.+message EnumDescriptorProto {+  optional string name = 1;++  repeated EnumValueDescriptorProto value = 2;++  optional EnumOptions options = 3;+}++// Describes a value within an enum.+message EnumValueDescriptorProto {+  optional string name = 1;+  optional int32 number = 2;++  optional EnumValueOptions options = 3;+}++// Describes a service.+message ServiceDescriptorProto {+  optional string name = 1;+  repeated MethodDescriptorProto method = 2;++  optional ServiceOptions options = 3;+}++// Describes a method of a service.+message MethodDescriptorProto {+  optional string name = 1;++  // Input and output type names.  These are resolved in the same way as+  // FieldDescriptorProto.type_name, but must refer to a message type.+  optional string input_type = 2;+  optional string output_type = 3;++  optional MethodOptions options = 4;+}++// ===================================================================+// Options++// Each of the definitions above may have "options" attached.  These are+// just annotations which may cause code to be generated slightly differently+// or may contain hints for code that manipulates protocol messages.++// TODO(kenton):  Allow extensions to options.++message FileOptions {++  // Sets the Java package where classes generated from this .proto will be+  // placed.  By default, the proto package is used, but this is often+  // inappropriate because proto packages do not normally start with backwards+  // domain names.+  optional string java_package = 1;+++  // If set, all the classes from the .proto file are wrapped in a single+  // outer class with the given name.  This applies to both Proto1+  // (equivalent to the old "--one_java_file" option) and Proto2 (where+  // a .proto always translates to a single class, but you may want to+  // explicitly choose the class name).+  optional string java_outer_classname = 8;++  // If set true, then the Java code generator will generate a separate .java+  // file for each top-level message, enum, and service defined in the .proto+  // file.  Thus, these types will *not* be nested inside the outer class+  // named by java_outer_classname.  However, the outer class will still be+  // generated to contain the file's getDescriptor() method as well as any+  // top-level extensions defined in the file.+  optional bool java_multiple_files = 10 [default=false];++  // Generated classes can be optimized for speed or code size.+  enum OptimizeMode {+    SPEED = 1;      // Generate complete code for parsing, serialization, etc.+    CODE_SIZE = 2;  // Use ReflectionOps to implement these methods.+  }+  optional OptimizeMode optimize_for = 9 [default=CODE_SIZE];+}++message MessageOptions {+  // Set true to use the old proto1 MessageSet wire format for extensions.+  // This is provided for backwards-compatibility with the MessageSet wire+  // format.  You should not use this for any other reason:  It's less+  // efficient, has fewer features, and is more complicated.+  //+  // The message must be defined exactly as follows:+  //   message Foo {+  //     option message_set_wire_format = true;+  //     extensions 4 to max;+  //   }+  // Note that the message cannot have any defined fields; MessageSets only+  // have extensions.+  //+  // All extensions of your type must be singular messages; e.g. they cannot+  // be int32s, enums, or repeated messages.+  //+  // Because this is an option, the above two restrictions are not enforced by+  // the protocol compiler.+  optional bool message_set_wire_format = 1 [default=false];+}++message FieldOptions {+  // The ctype option instructs the C++ code generator to use a different+  // representation of the field than it normally would.  See the specific+  // options below.  This option is not yet implemented in the open source+  // release -- sorry, we'll try to include it in a future version!+  optional CType ctype = 1;+  enum CType {+    CORD = 1;++    STRING_PIECE = 2;+  }++  // EXPERIMENTAL.  DO NOT USE.+  // For "map" fields, the name of the field in the enclosed type that+  // is the key for this map.  For example, suppose we have:+  //   message Item {+  //     required string name = 1;+  //     required string value = 2;+  //   }+  //   message Config {+  //     repeated Item items = 1 [experimental_map_key="name"];+  //   }+  // In this situation, the map key for Item will be set to "name".+  // TODO: Fully-implement this, then remove the "experimental_" prefix.+  optional string experimental_map_key = 9;+}++message EnumOptions {+}++message EnumValueOptions {+}++message ServiceOptions {++  // Note:  Field numbers 1 through 32 are reserved for Google's internal RPC+  //   framework.  We apologize for hoarding these numbers to ourselves, but+  //   we were already using them long before we decided to release Protocol+  //   Buffers.+}++message MethodOptions {++  // Note:  Field numbers 1 through 32 are reserved for Google's internal RPC+  //   framework.  We apologize for hoarding these numbers to ourselves, but+  //   we were already using them long before we decided to release Protocol+  //   Buffers.+}
+ descriptor/protocol-buffers-descriptor.cabal view
@@ -0,0 +1,77 @@+name:           protocol-buffers-descriptor+version:        0.2.8+cabal-version:  >= 1.2+build-type:     Simple+license:        BSD3+license-file:   LICENSE+copyright:      (c) 2008 Christopher Edward Kuklewicz+author:         Christopher Edward Kuklewicz+maintainer:     Chris Kuklewicz <protobuf@personal.mightyreason.com>+stability:      Experimental+homepage:       http://hackage.haskell.org/cgi-bin/hackage-scripts/package/protocol-buffers+package-url:    http://darcs.haskell.org/packages/protocol-buffers2/+synopsis:       Self-description of Google Protocol Buffer specifications+description:    Uses protocol-buffers package+category:       Text+Tested-With:    GHC ==6.8.3+data-files:     descriptor.proto+extra-source-files: Setup.hs+                    doc.txt+                    TODO+                    README+                    Skeleton.hs-boot+                    google/protobuf/unittest.proto+                    google/protobuf/unittest_import.proto+-- extra-tmp-files:++flag small_base+    description: Choose the new smaller, split-up base package.++Library+  ghc-options:  -O2+  exposed-modules: Text.DescriptorProtos+                   Text.DescriptorProtos.DescriptorProto+                   Text.DescriptorProtos.DescriptorProto.ExtensionRange+                   Text.DescriptorProtos.EnumDescriptorProto+                   Text.DescriptorProtos.EnumOptions+                   Text.DescriptorProtos.EnumValueDescriptorProto+                   Text.DescriptorProtos.EnumValueOptions+                   Text.DescriptorProtos.FieldDescriptorProto+                   Text.DescriptorProtos.FieldDescriptorProto.Label+                   Text.DescriptorProtos.FieldDescriptorProto.Type+                   Text.DescriptorProtos.FieldOptions+                   Text.DescriptorProtos.FieldOptions.CType+                   Text.DescriptorProtos.FileDescriptorProto+                   Text.DescriptorProtos.FileOptions+                   Text.DescriptorProtos.FileOptions.OptimizeMode+                   Text.DescriptorProtos.MessageOptions+                   Text.DescriptorProtos.MethodDescriptorProto+                   Text.DescriptorProtos.MethodOptions+                   Text.DescriptorProtos.ServiceDescriptorProto+                   Text.DescriptorProtos.ServiceOptions++  if flag(small_base)+        build-depends: base >= 3,+                       containers,+                       bytestring,+                       array,+                       filepath,+                       directory,+                       mtl,+                       QuickCheck+  else+        build-depends: base < 3++  build-depends:   protocol-buffers == 0.2.8+  extensions:      DeriveDataTypeable,+                   EmptyDataDecls,+                   FlexibleInstances,+                   GADTs,+                   GeneralizedNewtypeDeriving,+                   MagicHash,+                   PatternGuards,+                   RankNTypes,+                   ScopedTypeVariables,+                   TypeSynonymInstances,+                   MultiParamTypeClasses,+                   FunctionalDependencies
+ examples/ABF view

binary file changed (absent → 98 bytes)

+ examples/ABF2 view

binary file changed (absent → 129 bytes)

+ examples/add_person_haskell.hs view
@@ -0,0 +1,50 @@+module Main where++import Control.Monad+import Text.ProtocolBuffers(messageGet,messagePut,Utf8(..),defaultValue)+import qualified Data.ByteString.Lazy as L(readFile,writeFile,null)+import System+import Data.Char+import Data.Maybe(fromMaybe)+import qualified Data.ByteString.Lazy.UTF8 as U(fromString)+import qualified System.IO.UTF8 as U(getLine,putStr)+import Data.Sequence((|>),empty)++import AddressBookProtos.AddressBook+import AddressBookProtos.Person as Person+import AddressBookProtos.Person.PhoneNumber+import AddressBookProtos.Person.PhoneType+++mayRead s = case reads s of ((x,_):_) -> Just x ; _ -> Nothing++main = do+  args <- getArgs+  file <- case args of+            [file] -> return file+            _ -> getProgName >>= \self -> error $ "Usage "++self++" ADDRESS_BOOK_FILE"+  f <- L.readFile file+  newBook <- case messageGet f of+               Left msg -> error ("Failed to parse address book.\n"++msg)+               Right (address_book,_) -> promptForAddress address_book+  seq newBook $ L.writeFile file (messagePut newBook)++inStr prompt = U.putStr prompt >> getLine+inUtf8 prompt = inStr prompt >>= return . Utf8 . U.fromString++promptForAddress :: AddressBook -> IO AddressBook+promptForAddress address_book = do+  p <- liftM3 (\i n e -> defaultValue { Person.id = i, name = n, email = if L.null (utf8 e) then Nothing else Just e})+              (fmap read  $ inStr "Enter person ID number: ")+              (inUtf8 "Enter name: ")+              (inUtf8 "Enter email address (blank for none): ")+  p' <- getPhone p+  return (address_book { person = person address_book |> p' })++getPhone :: Person -> IO Person+getPhone p' = do+  n <- inUtf8 "Enter a phone number (or leave blank to finish): "+  if L.null(utf8 n)+    then return p'+    else do t <- fmap (mayRead . map toUpper) (inStr "Is this a mobile, home, or work phone? ")+            getPhone (p' { phone = phone p' |> defaultValue { number = n, type' = t }})
+ examples/addressbook.proto view
@@ -0,0 +1,30 @@+// See README.txt for information and build instructions.++package tutorial;++option java_package = "com.example.tutorial";+option java_outer_classname = "AddressBookProtos";++message Person {+  required string name = 1;+  required int32 id = 2;        // Unique ID number for this person.+  optional string email = 3;++  enum PhoneType {+    MOBILE = 0;+    HOME = 1;+    WORK = 2;+  }++  message PhoneNumber {+    required string number = 1;+    optional PhoneType type = 2 [default = HOME];+  }++  repeated PhoneNumber phone = 4;+}++// Our address book file is just one of these.+message AddressBook {+  repeated Person person = 1;+}
+ examples/list_people_haskell.hs view
@@ -0,0 +1,39 @@+module Main where++import Control.Monad(when)+import qualified Data.ByteString.Lazy as L(readFile)+import qualified Data.Foldable as F(forM_)+import System.Environment(getArgs,getProgName)+import qualified Data.ByteString.Lazy.UTF8 as U(toString)+import qualified System.IO.UTF8 as U(putStrLn)++import Text.ProtocolBuffers(messageGet,utf8,isSet,getVal)++import AddressBookProtos.AddressBook(person)+import AddressBookProtos.Person as Person(id,name,email,phone)+import AddressBookProtos.Person.PhoneNumber(number,type')+import AddressBookProtos.Person.PhoneType(PhoneType(MOBILE,HOME,WORK))++outLn = U.putStrLn . U.toString . utf8++listPeople address_book =+  F.forM_ (person address_book) $ \person -> do+    putStr "Person ID: " >> print (Person.id person)+    putStr "  Name: " >> outLn (name person)+    when (isSet person email) $ do+      putStr "  E-mail address: " >> outLn (getVal person email)+    F.forM_ (phone person) $ \phone_number -> do+      putStr $ case getVal phone_number type' of+                 MOBILE -> "  Mobile phone #: "+                 HOME   -> "  Home phone #: "+                 WORK   -> "  Work phone #: "+      outLn (number phone_number)++main = do+  args <- getArgs+  f <- case args of+         [file] -> L.readFile file+         _ -> getProgName >>= \self -> error $ "Usage "++self++" ADDRESS_BOOK_FILE"+  case messageGet f of+    Left msg -> error ("Failed to parse address book.\n"++msg)+    Right (address_book,_) -> listPeople address_book
+ google/protobuf/unittest.proto view
@@ -0,0 +1,452 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// A proto file we will use for unit testing.+++import "google/protobuf/unittest_import.proto";++// We don't put this in a package within proto2 because we need to make sure+// that the generated code doesn't depend on being in the proto2 namespace.+// In test_util.h we do "using namespace unittest = protobuf_unittest".+package protobuf_unittest;++// Protos optimized for SPEED use a strict superset of the generated code+// of equivalent ones optimized for CODE_SIZE, so we should optimize all our+// tests for speed unless explicitly testing code size optimization.+option optimize_for = SPEED;++option java_outer_classname = "UnittestProto";++// This proto includes every type of field in both singular and repeated+// forms.+message TestAllTypes {+  message NestedMessage {+    // The field name "b" fails to compile in proto1 because it conflicts with+    // a local variable named "b" in one of the generated methods.  Doh.+    // This file needs to compile in proto1 to test backwards-compatibility.+    optional int32 bb = 1;+  }++  enum NestedEnum {+    FOO = 1;+    BAR = 2;+    BAZ = 3;+  }++  // Singular+  optional    int32 optional_int32    =  1;+  optional    int64 optional_int64    =  2;+  optional   uint32 optional_uint32   =  3;+  optional   uint64 optional_uint64   =  4;+  optional   sint32 optional_sint32   =  5;+  optional   sint64 optional_sint64   =  6;+  optional  fixed32 optional_fixed32  =  7;+  optional  fixed64 optional_fixed64  =  8;+  optional sfixed32 optional_sfixed32 =  9;+  optional sfixed64 optional_sfixed64 = 10;+  optional    float optional_float    = 11;+  optional   double optional_double   = 12;+  optional     bool optional_bool     = 13;+  optional   string optional_string   = 14;+  optional    bytes optional_bytes    = 15;++  optional group OptionalGroup = 16 {+    optional int32 a = 17;+  }++  optional NestedMessage                        optional_nested_message  = 18;+  optional ForeignMessage                       optional_foreign_message = 19;+  optional protobuf_unittest_import.ImportMessage optional_import_message  = 20;++  optional NestedEnum                           optional_nested_enum     = 21;+  optional ForeignEnum                          optional_foreign_enum    = 22;+  optional protobuf_unittest_import.ImportEnum    optional_import_enum     = 23;++  optional string optional_string_piece = 24 [ctype=STRING_PIECE];+  optional string optional_cord = 25 [ctype=CORD];++  // Repeated+  repeated    int32 repeated_int32    = 31;+  repeated    int64 repeated_int64    = 32;+  repeated   uint32 repeated_uint32   = 33;+  repeated   uint64 repeated_uint64   = 34;+  repeated   sint32 repeated_sint32   = 35;+  repeated   sint64 repeated_sint64   = 36;+  repeated  fixed32 repeated_fixed32  = 37;+  repeated  fixed64 repeated_fixed64  = 38;+  repeated sfixed32 repeated_sfixed32 = 39;+  repeated sfixed64 repeated_sfixed64 = 40;+  repeated    float repeated_float    = 41;+  repeated   double repeated_double   = 42;+  repeated     bool repeated_bool     = 43;+  repeated   string repeated_string   = 44;+  repeated    bytes repeated_bytes    = 45;++  repeated group RepeatedGroup = 46 {+    optional int32 a = 47;+  }++  repeated NestedMessage                        repeated_nested_message  = 48;+  repeated ForeignMessage                       repeated_foreign_message = 49;+  repeated protobuf_unittest_import.ImportMessage repeated_import_message  = 50;++  repeated NestedEnum                           repeated_nested_enum     = 51;+  repeated ForeignEnum                          repeated_foreign_enum    = 52;+  repeated protobuf_unittest_import.ImportEnum    repeated_import_enum     = 53;++  repeated string repeated_string_piece = 54 [ctype=STRING_PIECE];+  repeated string repeated_cord = 55 [ctype=CORD];++  // Singular with defaults+  optional    int32 default_int32    = 61 [default =  41    ];+  optional    int64 default_int64    = 62 [default =  42    ];+  optional   uint32 default_uint32   = 63 [default =  43    ];+  optional   uint64 default_uint64   = 64 [default =  44    ];+  optional   sint32 default_sint32   = 65 [default = -45    ];+  optional   sint64 default_sint64   = 66 [default =  46    ];+  optional  fixed32 default_fixed32  = 67 [default =  47    ];+  optional  fixed64 default_fixed64  = 68 [default =  48    ];+  optional sfixed32 default_sfixed32 = 69 [default =  49    ];+  optional sfixed64 default_sfixed64 = 70 [default = -50    ];+  optional    float default_float    = 71 [default =  51.5  ];+  optional   double default_double   = 72 [default =  52e3  ];+  optional     bool default_bool     = 73 [default = true   ];+  optional   string default_string   = 74 [default = "hello"];+  optional    bytes default_bytes    = 75 [default = "world"];++  optional NestedEnum  default_nested_enum  = 81 [default = BAR        ];+  optional ForeignEnum default_foreign_enum = 82 [default = FOREIGN_BAR];+  optional protobuf_unittest_import.ImportEnum+      default_import_enum = 83 [default = IMPORT_BAR];++  optional string default_string_piece = 84 [ctype=STRING_PIECE,default="abc"];+  optional string default_cord = 85 [ctype=CORD,default="123"];+}++// Define these after TestAllTypes to make sure the compiler can handle+// that.+message ForeignMessage {+  optional int32 c = 1;+}++enum ForeignEnum {+  FOREIGN_FOO = 4;+  FOREIGN_BAR = 5;+  FOREIGN_BAZ = 6;+}++message TestAllExtensions {+  extensions 1 to max;+}++extend TestAllExtensions {+  // Singular+  optional    int32 optional_int32_extension    =  1;+  optional    int64 optional_int64_extension    =  2;+  optional   uint32 optional_uint32_extension   =  3;+  optional   uint64 optional_uint64_extension   =  4;+  optional   sint32 optional_sint32_extension   =  5;+  optional   sint64 optional_sint64_extension   =  6;+  optional  fixed32 optional_fixed32_extension  =  7;+  optional  fixed64 optional_fixed64_extension  =  8;+  optional sfixed32 optional_sfixed32_extension =  9;+  optional sfixed64 optional_sfixed64_extension = 10;+  optional    float optional_float_extension    = 11;+  optional   double optional_double_extension   = 12;+  optional     bool optional_bool_extension     = 13;+  optional   string optional_string_extension   = 14;+  optional    bytes optional_bytes_extension    = 15;++  optional group OptionalGroup_extension = 16 {+    optional int32 a = 17;+  }++  optional TestAllTypes.NestedMessage optional_nested_message_extension = 18;+  optional ForeignMessage optional_foreign_message_extension = 19;+  optional protobuf_unittest_import.ImportMessage+    optional_import_message_extension = 20;++  optional TestAllTypes.NestedEnum optional_nested_enum_extension = 21;+  optional ForeignEnum optional_foreign_enum_extension = 22;+  optional protobuf_unittest_import.ImportEnum+    optional_import_enum_extension = 23;++  optional string optional_string_piece_extension = 24 [ctype=STRING_PIECE];+  optional string optional_cord_extension = 25 [ctype=CORD];++  // Repeated+  repeated    int32 repeated_int32_extension    = 31;+  repeated    int64 repeated_int64_extension    = 32;+  repeated   uint32 repeated_uint32_extension   = 33;+  repeated   uint64 repeated_uint64_extension   = 34;+  repeated   sint32 repeated_sint32_extension   = 35;+  repeated   sint64 repeated_sint64_extension   = 36;+  repeated  fixed32 repeated_fixed32_extension  = 37;+  repeated  fixed64 repeated_fixed64_extension  = 38;+  repeated sfixed32 repeated_sfixed32_extension = 39;+  repeated sfixed64 repeated_sfixed64_extension = 40;+  repeated    float repeated_float_extension    = 41;+  repeated   double repeated_double_extension   = 42;+  repeated     bool repeated_bool_extension     = 43;+  repeated   string repeated_string_extension   = 44;+  repeated    bytes repeated_bytes_extension    = 45;++  repeated group RepeatedGroup_extension = 46 {+    optional int32 a = 47;+  }++  repeated TestAllTypes.NestedMessage repeated_nested_message_extension = 48;+  repeated ForeignMessage repeated_foreign_message_extension = 49;+  repeated protobuf_unittest_import.ImportMessage+    repeated_import_message_extension = 50;++  repeated TestAllTypes.NestedEnum repeated_nested_enum_extension = 51;+  repeated ForeignEnum repeated_foreign_enum_extension = 52;+  repeated protobuf_unittest_import.ImportEnum+    repeated_import_enum_extension = 53;++  repeated string repeated_string_piece_extension = 54 [ctype=STRING_PIECE];+  repeated string repeated_cord_extension = 55 [ctype=CORD];++  // Singular with defaults+  optional    int32 default_int32_extension    = 61 [default =  41    ];+  optional    int64 default_int64_extension    = 62 [default =  42    ];+  optional   uint32 default_uint32_extension   = 63 [default =  43    ];+  optional   uint64 default_uint64_extension   = 64 [default =  44    ];+  optional   sint32 default_sint32_extension   = 65 [default = -45    ];+  optional   sint64 default_sint64_extension   = 66 [default =  46    ];+  optional  fixed32 default_fixed32_extension  = 67 [default =  47    ];+  optional  fixed64 default_fixed64_extension  = 68 [default =  48    ];+  optional sfixed32 default_sfixed32_extension = 69 [default =  49    ];+  optional sfixed64 default_sfixed64_extension = 70 [default = -50    ];+  optional    float default_float_extension    = 71 [default =  51.5  ];+  optional   double default_double_extension   = 72 [default =  52e3  ];+  optional     bool default_bool_extension     = 73 [default = true   ];+  optional   string default_string_extension   = 74 [default = "hello"];+  optional    bytes default_bytes_extension    = 75 [default = "world"];++  optional TestAllTypes.NestedEnum+    default_nested_enum_extension = 81 [default = BAR];+  optional ForeignEnum+    default_foreign_enum_extension = 82 [default = FOREIGN_BAR];+  optional protobuf_unittest_import.ImportEnum+    default_import_enum_extension = 83 [default = IMPORT_BAR];++  optional string default_string_piece_extension = 84 [ctype=STRING_PIECE,+                                                       default="abc"];+  optional string default_cord_extension = 85 [ctype=CORD, default="123"];+}++// We have separate messages for testing required fields because it's+// annoying to have to fill in required fields in TestProto in order to+// do anything with it.  Note that we don't need to test every type of+// required filed because the code output is basically identical to+// optional fields for all types.+message TestRequired {+  required int32 a = 1;+  optional int32 dummy2 = 2;+  required int32 b = 3;++  extend TestAllExtensions {+    optional TestRequired single = 1000;+    repeated TestRequired multi  = 1001;+  }++  // Pad the field count to 32 so that we can test that IsInitialized()+  // properly checks multiple elements of has_bits_.+  optional int32 dummy4  =  4;+  optional int32 dummy5  =  5;+  optional int32 dummy6  =  6;+  optional int32 dummy7  =  7;+  optional int32 dummy8  =  8;+  optional int32 dummy9  =  9;+  optional int32 dummy10 = 10;+  optional int32 dummy11 = 11;+  optional int32 dummy12 = 12;+  optional int32 dummy13 = 13;+  optional int32 dummy14 = 14;+  optional int32 dummy15 = 15;+  optional int32 dummy16 = 16;+  optional int32 dummy17 = 17;+  optional int32 dummy18 = 18;+  optional int32 dummy19 = 19;+  optional int32 dummy20 = 20;+  optional int32 dummy21 = 21;+  optional int32 dummy22 = 22;+  optional int32 dummy23 = 23;+  optional int32 dummy24 = 24;+  optional int32 dummy25 = 25;+  optional int32 dummy26 = 26;+  optional int32 dummy27 = 27;+  optional int32 dummy28 = 28;+  optional int32 dummy29 = 29;+  optional int32 dummy30 = 30;+  optional int32 dummy31 = 31;+  optional int32 dummy32 = 32;++  required int32 c = 33;+}++message TestRequiredForeign {+  optional TestRequired optional_message = 1;+  repeated TestRequired repeated_message = 2;+  optional int32 dummy = 3;+}++// Test that we can use NestedMessage from outside TestAllTypes.+message TestForeignNested {+  optional TestAllTypes.NestedMessage foreign_nested = 1;+}++// TestEmptyMessage is used to test unknown field support.+message TestEmptyMessage {+}++// Like above, but declare all field numbers as potential extensions.  No+// actual extensions should ever be defined for this type.+message TestEmptyMessageWithExtensions {+  extensions 1 to max;+}++// Test that really large tag numbers don't break anything.+message TestReallyLargeTagNumber {+  // The largest possible tag number is 2^28 - 1, since the wire format uses+  // three bits to communicate wire type.+  optional int32 a = 1;+  optional int32 bb = 268435455;+}++message TestRecursiveMessage {+  optional TestRecursiveMessage a = 1;+  optional int32 i = 2;+}++// Test that mutual recursion works.+message TestMutualRecursionA {+  optional TestMutualRecursionB bb = 1;+}++message TestMutualRecursionB {+  optional TestMutualRecursionA a = 1;+  optional int32 optional_int32 = 2;+}++// Test that groups have disjoint field numbers from their siblings and+// parents.  This is NOT possible in proto1; only proto2.  When outputting+// proto1, the dup fields should be dropped.+message TestDupFieldNumber {+  optional int32 a = 1;+  optional group Foo = 2 { optional int32 a = 1; }+  optional group Bar = 3 { optional int32 a = 1; }+}+++// Needed for a Python test.+message TestNestedMessageHasBits {+  message NestedMessage {+    repeated int32 nestedmessage_repeated_int32 = 1;+    repeated ForeignMessage nestedmessage_repeated_foreignmessage = 2;+  }+  optional NestedMessage optional_nested_message = 1;+}+++// Test an enum that has multiple values with the same number.+enum TestEnumWithDupValue {+  FOO1 = 1;+  BAR1 = 2;+  BAZ = 3;+  FOO2 = 1;+  BAR2 = 2;+}++// Test an enum with large, unordered values.+enum TestSparseEnum {+  SPARSE_A = 123;+  SPARSE_B = 62374;+  SPARSE_C = 12589234;+//  SPARSE_D = -15;+//  SPARSE_E = -53452;+  SPARSE_F = 0;+  SPARSE_G = 2;+}++// Test message with CamelCase field names.  This violates Protocol Buffer+// standard style.+message TestCamelCaseFieldNames {+  optional int32 PrimitiveField = 1;+  optional string StringField = 2;+  optional ForeignEnum EnumField = 3;+  optional ForeignMessage MessageField = 4;+  optional string StringPieceField = 5 [ctype=STRING_PIECE];+  optional string CordField = 6 [ctype=CORD];++  repeated int32 RepeatedPrimitiveField = 7;+  repeated string RepeatedStringField = 8;+  repeated ForeignEnum RepeatedEnumField = 9;+  repeated ForeignMessage RepeatedMessageField = 10;+  repeated string RepeatedStringPieceField = 11 [ctype=STRING_PIECE];+  repeated string RepeatedCordField = 12 [ctype=CORD];+}+++// We list fields out of order, to ensure that we're using field number and not+// field index to determine serialization order.+message TestFieldOrderings {+  optional string my_string = 11;+  extensions 2 to 10;+  optional int64 my_int = 1;+  extensions 12 to 100;+  optional float my_float = 101;+}+++extend TestFieldOrderings {+  optional string my_extension_string = 50;+  optional int32 my_extension_int = 5;+}+++message TestExtremeDefaultValues {+  optional bytes escaped_bytes = 1 [default = "\0\001\a\b\f\n\r\t\v\\\'\"\xfe"];+  optional uint32 large_uint32 = 2 [default = 0xFFFFFFFF];+  optional uint64 large_uint64 = 3 [default = 0xFFFFFFFFFFFFFFFF];+  optional  int32 small_int32  = 4 [default = -0x7FFFFFFF];+  optional  int64 small_int64  = 5 [default = -0x7FFFFFFFFFFFFFFF];++  // The default value here is UTF-8 for "\u1234".  (We could also just type+  // the UTF-8 text directly into this text file rather than escape it, but+  // lots of people use editors that would be confused by this.)+  optional string utf8_string = 6 [default = "\341\210\264"];+}++// Test that RPC services work.+message FooRequest  {}+message FooResponse {}++service TestService {+  rpc Foo(FooRequest) returns (FooResponse);+  rpc Bar(BarRequest) returns (BarResponse);+}+++message BarRequest  {}+message BarResponse {}
+ google/protobuf/unittest_import.proto view
@@ -0,0 +1,47 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// A proto file which is imported by unittest.proto to test importing.+++// We don't put this in a package within proto2 because we need to make sure+// that the generated code doesn't depend on being in the proto2 namespace.+// In test_util.h we do+// "using namespace unittest_import = protobuf_unittest_import".+package protobuf_unittest_import;++option optimize_for = SPEED;++// Excercise the java_package option.+option java_package = "com.google.protobuf.test";++// Do not set a java_outer_classname here to verify that Proto2 works without+// one.++message ImportMessage {+  optional int32 d = 1;+}++enum ImportEnum {+  IMPORT_FOO = 7;+  IMPORT_BAR = 8;+  IMPORT_BAZ = 9;+}+
+ hprotoc/LICENSE view
@@ -0,0 +1,10 @@+Copyright (c) 2008, Christopher Edward Kuklewicz+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+    * Neither the name of the copyright holder nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ hprotoc/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks
+ hprotoc/Text/ProtocolBuffers/ProtoCompile.hs view
@@ -0,0 +1,136 @@+-- | This is the Main module for the command line program+module Main where++import qualified Data.Map as M+import Data.Version+import Language.Haskell.Pretty(prettyPrintStyleMode,Style(..),Mode(..),PPHsMode(..),PPLayout(..))+import System.Console.GetOpt+import System.Environment+import System.Directory+import System.FilePath++import Text.ProtocolBuffers.Reflections(ProtoInfo(..),DescriptorInfo(..),EnumInfo(..))++import Text.ProtocolBuffers.ProtoCompile.Gen(protoModule,descriptorModule,enumModule)+import Text.ProtocolBuffers.ProtoCompile.Resolve(loadProto)+import Text.ProtocolBuffers.ProtoCompile.MakeReflections(makeProtoInfo,serializeFDP)++-- | Version of protocol-buffers.+-- The version tags that I have used are ["unreleased"]+version :: Version+version = Version { versionBranch = [0,2,8]+                  , versionTags = [] }++data Options = Options { optPrefix :: String+                       , optTarget :: FilePath+                       , optInclude :: [FilePath]+                       , optProto :: FilePath+                       , optVerbose :: Bool+                       , optUnkownFields :: Bool }+  deriving Show++setPrefix,setTarget,setInclude,setProto :: String -> Options -> Options+setVerbose,setUnknown :: Options -> Options+setPrefix   s o = o { optPrefix = s }+setTarget   s o = o { optTarget = s }+setInclude  s o = o { optInclude = s : optInclude o }+setProto    s o = o { optProto = s }+setVerbose    o = o { optVerbose = True }+setUnknown    o = o { optUnkownFields = True }++data OptionAction = Mutate (Options->Options) | Run (Options->Options) | Switch Flag++data Flag = VersionInfo++optionList :: [OptDescr OptionAction]+optionList =+  [ Option ['I'] ["proto_path"] (ReqArg (Mutate . setInclude) "DIR")+               "directory from which to search for imported proto files (default is pwd); all DIR searched"+  , Option ['o'] ["haskell_out"] (ReqArg (Mutate . setTarget) "DIR")+               "directory to use are root of generated files (default is pwd); last flag"+  , Option ['p'] ["prefix"] (ReqArg (Mutate . setPrefix) "MODULE")+               "dotted haskell MODULE name to use as prefix (default is none); last flag used"+  , Option ['u'] ["unknown-fields"] (NoArg (Mutate setUnknown))+               "UNIMPLEMENTED: generated messages and groups all support unknown fields"+  , Option ['v'] ["verbose"] (NoArg (Mutate  setVerbose))+               "increase amount of printed information"+  , Option [] ["version"]  (NoArg (Switch VersionInfo))+               "print out version information"+  ]++usageMsg,versionInfo :: String+usageMsg = usageInfo "Usage: protoCompile [OPTION..] path-to-file.proto ..." optionList++versionInfo = unlines $+  [ "Welcome to protocol-buffers version "++showVersion version+  , "Copyright (c) 2008, Christopher Kuklewicz."+  , "Released under BSD3 style license, see LICENSE file for details."+  , "Some proto files, such as descriptor.proto and unittest*.proto"+  , "are from google's code and are under an Apache 2.0 license."+  , ""+  , "This program reads a .proto file and generates haskell code files."+  , "See http://code.google.com/apis/protocolbuffers/docs/overview.html for more."+  ]++processOptions :: [String] -> Either String [OptionAction]+processOptions argv =+    case getOpt (ReturnInOrder (Run . setProto)) optionList argv of+    (opts,_,[]) -> Right opts+    (_,_,errs) -> Left (unlines errs ++ usageMsg)++defaultOptions :: IO Options+defaultOptions = do+  pwd <- getCurrentDirectory+  return $ Options { optPrefix = "", optTarget = pwd, optInclude = [pwd], optProto = "", optVerbose = False, optUnkownFields = False }++main :: IO ()+main = do+  defs <- defaultOptions+  args <- getArgs+  case processOptions args of+    Left msg -> putStrLn msg+    Right todo -> process defs todo++process :: Options -> [OptionAction] -> IO ()+process options [] = if null (optProto options)+                       then do putStrLn "No proto file specified (or empty proto file)"+                               putStrLn ""+                               putStrLn usageMsg+                       else putStrLn "Processing complete, have a nice day."+process options (Mutate f:rest) = process (f options) rest+process options (Run f:rest) = let options' = f options+                            in run options' >> process options' rest+process _options (Switch VersionInfo:_) = putStrLn versionInfo+  +mkdirFor :: FilePath -> IO ()+mkdirFor p = createDirectoryIfMissing True (takeDirectory p)++style :: Style+style = Style PageMode 132 0.5++myMode :: PPHsMode+myMode = PPHsMode 2 2 2 2 4 2 True PPOffsideRule False True++run :: Options -> IO ()+run options = do+  print options+  protos <- loadProto (optInclude options) (optProto options)+  let (Just (fdp,_,names)) = M.lookup (optProto options) protos+      protoInfo = makeProtoInfo (optPrefix options) names fdp+  let produceMSG di = do+        let file = combine (optTarget options) . joinPath . descFilePath $ di+        print file+        mkdirFor file+        writeFile file (prettyPrintStyleMode style myMode (descriptorModule di))+      produceENM ei = do+        let file = combine (optTarget options) . joinPath . enumFilePath $ ei+        print file+        mkdirFor file+        writeFile file (prettyPrintStyleMode style myMode (enumModule ei))+  mapM_ produceMSG (messages protoInfo)+  mapM_ produceENM (enums protoInfo)++  let file = combine (optTarget options) . joinPath . protoFilePath $ protoInfo+  print file+  writeFile file (prettyPrintStyleMode style myMode (protoModule protoInfo (serializeFDP fdp)))+
+ hprotoc/Text/ProtocolBuffers/ProtoCompile/Gen.hs view
@@ -0,0 +1,682 @@+-- try "test", "testDesc", and "testLabel" to see sample output+-- +-- Obsolete : Turn *Proto into Language.Haskell.Exts.Syntax from haskell-src-exts package+-- Now cut back to use just Language.Haskell.Syntax, see coments marked YYY for the Exts verision+-- +-- Note that this may eventually also generate hs-boot files to allow+-- for breaking mutual recursion.  This is ignored for getting+-- descriptor.proto running.+--+-- Mangling: For the current moment, assume the mangling is done in a prior pass:+--   (*) Uppercase all module names and type names and enum constants+--   (*) lowercase all field names+--   (*) add a prime after all field names than conflict with reserved words+--+-- The names are also assumed to have become fully-qualified, and all+-- the optional type codes have been set.+--+-- default values are an awful mess.  They are documented in descriptor.proto as+{-+  // For numeric types, contains the original text representation of the value.+  // For booleans, "true" or "false".+  // For strings, contains the default text contents (not escaped in any way).+  // For bytes, contains the C escaped value.  All bytes >= 128 are escaped.+  // TODO(kenton):  Base-64 encode?+  optional string default_value = 7;+-}+module Text.ProtocolBuffers.ProtoCompile.Gen(protoModule,descriptorModule,enumModule,prettyPrint) where++import Text.ProtocolBuffers.Basic+import Text.ProtocolBuffers.Reflections(KeyInfo,HsDefault(..),DescriptorInfo(..),ProtoInfo(..),EnumInfo(..),ProtoName(..),FieldInfo(..))++import qualified Data.ByteString.Lazy.Char8 as LC(unpack)+import Data.Char(isUpper)+import qualified Data.Foldable as F(foldr,toList)+import Data.List(sort,sortBy,group,foldl',foldl1')+import Data.Function(on)+import Language.Haskell.Pretty(prettyPrint)+import Language.Haskell.Syntax+import qualified Data.Map as M+import qualified Data.Sequence as Seq(null,length)+import qualified Data.Set as S++--import Debug.Trace(trace)++default (Int)++-- -- -- -- Helper functions++noWhere :: [HsDecl]+noWhere = [] -- YYY noWhere = (HsBDecls [])++($$) :: HsExp -> HsExp -> HsExp+($$) = HsApp++infixl 1 $$++dotPre :: String -> String -> String+dotPre "" x = x+dotPre x "" = x+dotPre s x@('.':xs)  | '.' == last s = s ++ xs+                     | otherwise = s ++ x+dotPre s x | '.' == last s = s++x+           | otherwise = s++('.':x)++src :: SrcLoc+src = SrcLoc "No SrcLoc" 0 0++litIntP :: Integral x => x -> HsPat+litIntP x | x<0 = HsPParen $ HsPLit (HsInt (toInteger x))+          | otherwise = HsPLit (HsInt (toInteger x))++litInt :: Integral x => x -> HsExp+litInt x | x<0 = HsParen $ HsLit (HsInt (toInteger x))+         | otherwise = HsLit (HsInt (toInteger x))++typeApp :: String -> HsType -> HsType+typeApp s =  HsTyApp (HsTyCon (private s))++pvar :: String -> HsExp+pvar t = HsVar (private t)++lvar :: String -> HsExp+lvar t = HsVar (UnQual (HsIdent t))++private :: String -> HsQName+private t = Qual (Module "P'") (HsIdent t)++inst :: String -> [HsPat] -> HsExp -> HsDecl+inst s p r  = HsFunBind [HsMatch src (HsIdent s) p (HsUnGuardedRhs r) noWhere]++fqName :: ProtoName -> String+fqName (ProtoName a b c) = dotPre a (dotPre b c)++qualName :: ProtoName -> HsQName+qualName (ProtoName _prefix "" base) = UnQual (HsIdent base)+qualName (ProtoName _prefix parent base) = Qual (Module parent) (HsIdent base)++unqualName :: ProtoName -> HsQName+unqualName (ProtoName _prefix _parent base) = UnQual (HsIdent base)++mayQualName :: ProtoName -> ProtoName -> HsQName+mayQualName context name@(ProtoName prefix modname base) =+  if fqName context == dotPre prefix modname then UnQual (HsIdent base)+    else qualName name++--------------------------------------------+-- EnumDescriptorProto module creation+--------------------------------------------+{-+enumModule :: String -> D.EnumDescriptorProto -> HsModule+enumModule prefix e+    = let ei = makeEnumInfo prefix e+-}+enumModule :: EnumInfo -> HsModule+enumModule ei+    = let protoName = enumName ei+      in HsModule src (Module (fqName protoName))+           (Just [HsEThingAll (UnQual (HsIdent (baseName protoName)))])+           (standardImports False) (enumDecls ei)++enumDecls :: EnumInfo -> [HsDecl]+enumDecls ei =  map ($ ei) [ enumX+                           , instanceMergeableEnum+                           , instanceBounded+                           , instanceDefaultEnum+                           , instanceEnum+                           , instanceWireEnum+                           , instanceGPB . enumName+                           , instanceMessageAPI . enumName+                           , instanceReflectEnum+                           ]++enumX :: EnumInfo -> HsDecl+enumX ei = HsDataDecl src [] (HsIdent (baseName (enumName ei))) [] (map enumValueX (enumValues ei)) derivesEnum+  where enumValueX (_,name) = HsConDecl src (HsIdent name) []++instanceMergeableEnum :: EnumInfo -> HsDecl+instanceMergeableEnum ei +  = HsInstDecl src [] (private "Mergeable") [HsTyCon (unqualName (enumName ei))] []++instanceBounded :: EnumInfo -> HsDecl+instanceBounded ei+    = HsInstDecl src [] (private "Bounded") [HsTyCon (unqualName (enumName ei))] +        [set "minBound" (head values),set "maxBound" (last values)]+  where values = enumValues ei+        set f (_,n) = inst f [] (HsCon (UnQual (HsIdent n)))++{- from google's descriptor.h, about line 346:++  // Get the field default value if cpp_type() == CPPTYPE_ENUM.  If no+  // explicit default was defined, the default is the first value defined+  // in the enum type (all enum types are required to have at least one value).+  // This never returns NULL.++-}+instanceDefaultEnum :: EnumInfo -> HsDecl+instanceDefaultEnum ei+    = HsInstDecl src [] (private "Default") [HsTyCon (unqualName (enumName ei))]+      [ inst "defaultValue" [] firstValue ]+  where firstValue :: HsExp+        firstValue = case enumValues ei of+                       (:) (_,n) _ -> HsCon (UnQual (HsIdent n))+                       [] -> error $ "Impossible? EnumDescriptorProto had empty sequence of EnumValueDescriptorProto.\n" ++ show ei++instanceEnum :: EnumInfo -> HsDecl+instanceEnum ei+    = HsInstDecl src [] (private "Enum") [HsTyCon (unqualName (enumName ei))]+        (map HsFunBind [fromEnum',toEnum',succ',pred'])+  where values = enumValues ei+        fromEnum' = map fromEnum'one values+        fromEnum'one (v,n) = HsMatch src (HsIdent "fromEnum") [HsPApp (UnQual (HsIdent n)) []]+                               (HsUnGuardedRhs (litInt (getEnumCode v))) noWhere+        toEnum' = map toEnum'one values+        toEnum'one (v,n) = HsMatch src (HsIdent "toEnum") [litIntP (getEnumCode v)] -- enums cannot be negative so no parenthesis are required to protect a negative sign+                             (HsUnGuardedRhs (HsCon (UnQual (HsIdent n)))) noWhere+        succ' = zipWith (equate "succ") values (tail values)+        pred' = zipWith (equate "pred") (tail values) values+        equate f (_,n1) (_,n2) = HsMatch src (HsIdent f) [HsPApp (UnQual (HsIdent n1)) []]+                                   (HsUnGuardedRhs (HsCon (UnQual (HsIdent n2)))) noWhere++-- fromEnum TYPE_ENUM == 14 :: Int+instanceWireEnum :: EnumInfo -> HsDecl+instanceWireEnum ei+    = HsInstDecl src [] (private "Wire") [HsTyCon (unqualName (enumName ei))]+        [ withName "wireSize", withName "wirePut", withGet, withGetErr ]+  where withName foo = inst foo [HsPVar (HsIdent "ft'"),HsPVar (HsIdent "enum")] rhs+          where rhs = pvar foo $$ lvar "ft'" $$+                        (HsParen $ pvar "fromEnum" $$ lvar "enum")+        withGet = inst "wireGet" [litIntP 14] rhs+          where rhs = pvar "fmap" $$ pvar "toEnum" $$+                        (HsParen $ pvar "wireGet" $$ HsLit (HsInt 14))+        withGetErr = inst "wireGet" [HsPVar (HsIdent "ft'")] rhs+          where rhs = pvar "wireGetErr" $$ lvar "ft'"++instanceGPB :: ProtoName -> HsDecl+instanceGPB protoName+    = HsInstDecl src [] (private "GPB") [HsTyCon (unqualName protoName)] []++instanceReflectEnum :: EnumInfo -> HsDecl+instanceReflectEnum ei+    = HsInstDecl src [] (private "ReflectEnum") [HsTyCon (unqualName (enumName ei))]+        [ inst "reflectEnum" [] ascList+        , inst "reflectEnumInfo" [ HsPWildCard ] ei' ]+  where (ProtoName a b c) = enumName ei+        values = enumValues ei+        ascList,ei',protoNameExp :: HsExp+        ascList = HsList (map one values)+          where one (v,ns) = HsTuple [litInt (getEnumCode v),HsLit (HsString ns),HsCon (UnQual (HsIdent ns))]+        ei' = foldl' HsApp (HsCon (private "EnumInfo")) [protoNameExp+                                                        ,HsList $ map (HsLit . HsString) (enumFilePath ei)+                                                        ,HsList (map two values)]+          where two (v,ns) = HsTuple [litInt (getEnumCode v),HsLit (HsString ns)]+        protoNameExp = HsParen $ foldl' HsApp (HsCon (private "ProtoName")) . map (HsLit . HsString) $ [a,b,c]++--------------------------------------------+-- DescriptorProto module creation is unfinished+--   There are difficult namespace issues+--------------------------------------------++hasExt :: DescriptorInfo -> Bool+hasExt di = not (null (extRanges di))++protoModule :: ProtoInfo -> ByteString -> HsModule+protoModule pri@(ProtoInfo protoName _ _ keyInfos _ _ _) fdpBS+  = let exportKeys = map (HsEVar . UnQual . HsIdent . baseName . fieldName . snd) (F.toList keyInfos)+        exportNames = map (HsEVar . UnQual . HsIdent) ["protoInfo","fileDescriptorProto"]+        imports = protoImports ++ map formatImport (protoImport pri)+    in HsModule src (Module (fqName protoName)) (Just (exportKeys++exportNames)) imports (keysX protoName keyInfos ++ embed'ProtoInfo pri ++ embed'fdpBS fdpBS)+  where protoImports = standardImports (not . Seq.null . extensionKeys $ pri) +++                       [ HsImportDecl src (Module "Text.DescriptorProtos.FileDescriptorProto") False Nothing+                           (Just (False,[HsIAbs (HsIdent "FileDescriptorProto")]))+                       , HsImportDecl src (Module "Text.ProtocolBuffers.Reflections") False Nothing+                           (Just (False,[HsIAbs (HsIdent "ProtoInfo")]))+                       , HsImportDecl src (Module "Text.ProtocolBuffers.WireMessage") True (Just (Module "P'"))+                           (Just (False,[HsIVar (HsIdent "wireGet,getFromBS")]))+                       ]+        formatImport (m,t) = HsImportDecl src (Module (dotPre (haskellPrefix protoName) (dotPre m t))) True+                               (Just (Module m)) (Just (False,[HsIAbs (HsIdent t)]))++protoImport :: ProtoInfo -> [(String,String)]+protoImport (ProtoInfo protoName _ _ keyInfos _ _ _)+    = map head . group . sort +      . filter (selfName /=)+      . concatMap withMod+      $ allNames+  where selfName = (parentModule protoName, baseName protoName)+        withMod (ProtoName _prefix "" _base) = []+        withMod (ProtoName _prefix modname base) = [(modname,base)]+        allNames = F.foldr (\(e,fi) rest -> e : addName fi rest) [] keyInfos+        addName fi rest = maybe rest (:rest) (typeName fi)++embed'ProtoInfo :: ProtoInfo -> [HsDecl]+embed'ProtoInfo pri = [ myType, myValue ]+  where myType = HsTypeSig src [ HsIdent "protoInfo" ] (HsQualType [] (HsTyCon (UnQual (HsIdent "ProtoInfo"))))+        myValue = HsPatBind src (HsPApp (UnQual (HsIdent "protoInfo")) []) (HsUnGuardedRhs $+                    pvar "read" $$ HsLit (HsString (show pri))) noWhere++embed'fdpBS :: ByteString -> [HsDecl]+embed'fdpBS bs = [ myType, myValue ]+  where myType = HsTypeSig src [ HsIdent "fileDescriptorProto" ] (HsQualType [] (HsTyCon (UnQual (HsIdent "FileDescriptorProto"))))+        myValue = HsPatBind src (HsPApp (UnQual (HsIdent "fileDescriptorProto")) []) (HsUnGuardedRhs $+                    pvar "getFromBS" $$+                      HsParen (pvar "wireGet" $$ litInt 11) $$ +                      HsParen (pvar "pack" $$ HsLit (HsString (LC.unpack bs)))) noWhere++descriptorModule :: DescriptorInfo -> HsModule+descriptorModule di+    = let protoName = descName di+          un = UnQual . HsIdent . baseName $ protoName+          imports = standardImports (hasExt di) ++ map formatImport (toImport di)+          exportKeys = map (HsEVar . UnQual . HsIdent . baseName . fieldName . snd) (F.toList (keys di))+          formatImport ((a,b),s) = HsImportDecl src (Module a) True (Just (Module b)) (Just (False,+                                      map (HsIAbs . HsIdent) (S.toList s)))+      in HsModule src (Module (fqName protoName))+           (Just (HsEThingAll un : exportKeys))+           imports (descriptorX di : (keysX protoName (keys di) ++ instancesDescriptor di))++standardImports :: Bool -> [HsImportDecl]+standardImports ext =+  [ HsImportDecl src (Module "Prelude") False Nothing (Just (False,ops))+  , HsImportDecl src (Module "Prelude") True (Just (Module "P'")) Nothing+  , HsImportDecl src (Module "Text.ProtocolBuffers.Header") True (Just (Module "P'")) Nothing ]+ where ops | ext = map (HsIVar . HsSymbol) ["+","<=","&&"," || "]+           | otherwise = map (HsIVar . HsSymbol) ["+"]++toImport :: DescriptorInfo -> [((String,String),S.Set String)]+toImport di+    = M.assocs . M.fromListWith S.union . filter isForeign . map withMod $ allNames+  where isForeign = let here = fqName protoName+                    in (\((a,_),_) -> a/=here)+        protoName = descName di+        withMod p@(ProtoName prefix modname base) | isUpper (head base) = ((fqName p,modname),S.singleton base)+                                                  | otherwise = ((dotPre prefix modname,modname),S.singleton base)+        allNames = F.foldr addName keyNames (fields di)+        keyNames = F.foldr (\(e,fi) rest -> e : addName fi rest) keysKnown (keys di)+        keysKnown = F.foldr (\fi rest -> fieldName fi : rest) [] (knownKeys di)+--      keysKnown = F.foldr (\fi rest -> addName fi (fieldName fi : rest)) [] (knownKeys di)+        addName fi rest = maybe rest (:rest) (typeName fi)++keysX :: ProtoName -> Seq KeyInfo -> [HsDecl]+keysX self i = concatMap (makeKey self) . F.toList $ i++makeKey :: ProtoName -> KeyInfo -> [HsDecl]+makeKey self (extendee,f) = [ keyType, keyVal ]+  where keyType = HsTypeSig src [ HsIdent (baseName . fieldName $ f) ] (HsQualType [] (foldl1 HsTyApp . map HsTyCon $+                    [ private "Key", private labeled+                    , if extendee /= self then qualName extendee else unqualName extendee+                    , typeQName ]))+        labeled | canRepeat f = "Seq"+                | otherwise = "Maybe"+        typeNumber = getFieldType . typeCode $ f+        typeQName :: HsQName+        typeQName = case useType typeNumber of+                      Just s -> private s+                      Nothing -> case typeName f of+                                   Just s | self /= s -> qualName s+                                          | otherwise -> unqualName s+                                   Nothing -> error $  "No Name for Field!\n" ++ show f+        keyVal = HsPatBind src (HsPApp (UnQual (HsIdent (baseName (fieldName f)))) []) (HsUnGuardedRhs+                   (pvar "Key" $$ litInt (getFieldId (fieldNumber f))+                               $$ litInt typeNumber+                               $$ maybe (pvar "Nothing") (HsParen . (pvar "Just" $$) . (defToSyntax (typeCode f))) (hsDefault f)+                   )) noWhere++defToSyntax :: FieldType -> HsDefault -> HsExp+defToSyntax tc x =+  case x of+    HsDef'Bool b -> HsCon (private (show b))+    HsDef'ByteString bs -> (if tc == 9 then (\xx -> HsParen (pvar "Utf8" $$ xx)) else id) $+                           (HsParen $ pvar "pack" $$ HsLit (HsString (LC.unpack bs)))+    HsDef'Rational r | r < 0 -> HsParen $ HsLit (HsFrac r)+                     | otherwise -> HsLit (HsFrac r)+    HsDef'Integer i | i < 0 -> HsParen $ HsLit (HsInt i)+                    | otherwise -> HsLit (HsInt i)+    HsDef'Enum s -> HsParen $ pvar "read" $$ HsLit (HsString s)++descriptorX :: DescriptorInfo -> HsDecl+descriptorX di = HsDataDecl src [] name [] [con] derives+  where self = descName di+        name = HsIdent (baseName self)+        con = HsRecDecl src name eFields+                where eFields = F.foldr ((:) . fieldX) end (fields di)+                      end = if hasExt di then [extfield] else []+        extfield :: ([HsName],HsBangType)+        extfield = ([HsIdent "ext'field"],HsUnBangedTy (HsTyCon (Qual (Module "P'") (HsIdent "ExtField"))))++        fieldX :: FieldInfo -> ([HsName],HsBangType)+        fieldX fi = ([HsIdent (baseName $ fieldName fi)],HsUnBangedTy (labeled (HsTyCon typed)))+          where labeled | canRepeat fi = typeApp "Seq"+                        | isRequired fi = id+                        | otherwise = typeApp "Maybe"+                typed :: HsQName+                typed = case useType (getFieldType (typeCode fi)) of+                          Just s -> private s+                          Nothing -> case typeName fi of+                                       Just s | self /= s -> qualName s+                                              | otherwise -> unqualName s+                                       Nothing -> error $  "No Name for Field!\n" ++ show fi++instancesDescriptor :: DescriptorInfo -> [HsDecl]+instancesDescriptor di = map ($ di) $+   (if hasExt di then (instanceExtendMessage:) else id) $+   [ instanceMergeable+   , instanceDefault+   , instanceWireDescriptor+   , instanceMessageAPI . descName+   , instanceGPB . descName                 +   , instanceReflectDescriptor+   ]++instanceExtendMessage :: DescriptorInfo -> HsDecl+instanceExtendMessage di+    = HsInstDecl src [] (private "ExtendMessage") [HsTyCon (UnQual (HsIdent (baseName (descName di))))]+        [ inst "getExtField" [] (lvar "ext'field")+        , inst "putExtField" [HsPVar (HsIdent "e'f"),HsPVar (HsIdent "msg")] putextfield+        , inst "validExtRanges" [ HsPVar (HsIdent "msg") ] (pvar "extRanges" $$ (HsParen $ pvar "reflectDescriptorInfo" $$ lvar "msg"))+        ]+  where putextfield = HsRecUpdate (lvar "msg") [ HsFieldUpdate (UnQual (HsIdent "ext'field")) (lvar "e'f") ]++instanceMergeable :: DescriptorInfo -> HsDecl+instanceMergeable di+    = HsInstDecl src [] (private "Mergeable") [HsTyCon un]+        [ inst "mergeEmpty" [] (foldl' HsApp (HsCon un) (replicate len (HsCon (private "mergeEmpty"))))+        , inst "mergeAppend" [HsPApp un patternVars1, HsPApp un patternVars2]+                             (foldl' HsApp (HsCon un) (zipWith append vars1 vars2))+        ]+  where un = UnQual (HsIdent (baseName (descName di)))+        len = (if hasExt di then succ else id) $ Seq.length (fields di)+        patternVars1,patternVars2 :: [HsPat]+        patternVars1 = take len inf+            where inf = map (\n -> HsPVar (HsIdent ("x'" ++ show n))) [1..]+        patternVars2 = take len inf+            where inf = map (\n -> HsPVar (HsIdent ("y'" ++ show n))) [1..]+        vars1,vars2 :: [HsExp]+        vars1 = take len inf+            where inf = map (\n -> lvar ("x'" ++ show n)) [1..]+        vars2 = take len inf+            where inf = map (\n -> lvar ("y'" ++ show n)) [1..]+        append x y = HsParen $ pvar "mergeAppend" $$ x $$ y++instanceDefault :: DescriptorInfo -> HsDecl+instanceDefault di+    = HsInstDecl src [] (private "Default") [HsTyCon un]+        [ inst "defaultValue" [] (foldl' HsApp (HsCon un) deflistExt) ]+  where un = UnQual (HsIdent (baseName (descName di)))+        deflistExt = F.foldr ((:) . defX) end (fields di)+        end = if hasExt di then [pvar "defaultValue"] else []++        defX :: FieldInfo -> HsExp+        defX fi | isRequired fi = dv1+                | otherwise = dv2+          where dv1 = case hsDefault fi of+                        Nothing -> pvar "defaultValue"+                        Just hsdef -> defToSyntax (typeCode fi) hsdef+                dv2 = case hsDefault fi of+                        Nothing -> pvar "defaultValue"+                        Just hsdef -> HsParen $ HsCon (private "Just") $$ defToSyntax (typeCode fi) hsdef++instanceMessageAPI :: ProtoName -> HsDecl+instanceMessageAPI protoName+    = HsInstDecl src [] (private "MessageAPI") [HsTyVar (HsIdent "msg'"), HsTyFun (HsTyVar (HsIdent "msg'")) (HsTyCon un),  (HsTyCon un)]+        [ inst "getVal" [HsPVar (HsIdent "m'"),HsPVar (HsIdent "f'")] (HsApp (lvar "f'" ) (lvar "m'")) ]+  where un = UnQual (HsIdent (baseName protoName))++mkOp :: String -> HsExp -> HsExp -> HsExp+mkOp s a b = HsInfixApp a (HsQVarOp (UnQual (HsSymbol s))) b++{-+        isAllowed x = pvar "or" $$ HsList ranges where+          (<=!) = mkOp "<="; (&&!) = mkOp "&&"; -- (||!) = mkOp "||"+          ranges = map (\(FieldId lo,FieldId hi) -> (litInt lo <=! x) &&! (x <=! litInt hi)) allowedExts+-}+instanceWireDescriptor :: DescriptorInfo -> HsDecl+instanceWireDescriptor (DescriptorInfo { descName = protoName+                                       , fields = fieldInfos+                                       , extRanges = allowedExts+                                       , knownKeys = fieldExts })+  = let me = unqualName protoName+        extensible = not (null allowedExts)+        len = (if extensible then succ else id) $ Seq.length fieldInfos+        mine = HsPApp me . take len . map (\n -> HsPVar (HsIdent ("x'" ++ show n))) $ [1..]+        vars = take len . map (\n -> lvar ("x'" ++ show n)) $ [1..]++        cases g m e = HsCase (lvar "ft'") [ HsAlt src (litIntP 10) (HsUnGuardedAlt g) noWhere+                                          , HsAlt src (litIntP 11) (HsUnGuardedAlt m) noWhere+                                          , HsAlt src HsPWildCard (HsUnGuardedAlt e) noWhere+                                          ]++        sizeCases = HsUnGuardedRhs $ cases (lvar "calc'Size") +                                           (pvar "prependMessageSize" $$ lvar "calc'Size")+                                           (pvar "wireSizeErr" $$ lvar "ft'" $$ lvar "self'")+        whereCalcSize = [HsFunBind [HsMatch src (HsIdent "calc'Size") [] (HsUnGuardedRhs sizes) noWhere]]+        sizes | null sizesListExt = HsLit (HsInt 0)+              | otherwise = HsParen (foldl1' (+!) sizesListExt)+          where (+!) = mkOp "+"+                sizesListExt | extensible = sizesList ++ [ pvar "wireSizeExtField" $$ last vars ]+                             | otherwise = sizesList+                sizesList =  zipWith toSize vars . F.toList $ fieldInfos+        toSize var fi = let f = if isRequired fi then "wireSizeReq"+                                  else if canRepeat fi then "wireSizeRep"+                                      else "wireSizeOpt"+                        in foldl' HsApp (pvar f) [ litInt (wireTagLength fi)+                                                 , litInt (getFieldType (typeCode fi))+                                                 , var]++        putCases = HsUnGuardedRhs $ cases+          (lvar "put'Fields")+          (HsDo [ HsQualifier $ pvar "putSize" $$+                    (HsParen $ foldl' HsApp (pvar "wireSize") [ litInt 10 , lvar "self'" ])+                , HsQualifier $ lvar "put'Fields" ])+          (pvar "wirePutErr" $$ lvar "ft'" $$ lvar "self'")+        wherePutFields = [HsFunBind [HsMatch src (HsIdent "put'Fields") [] (HsUnGuardedRhs (HsDo putStmts)) noWhere]]+        putStmts = putStmtsContent+          where putStmtsContent | null putStmtsListExt = [HsQualifier $ pvar "return" $$ HsCon (Special HsUnitCon)]+                                | otherwise = putStmtsListExt+                putStmtsListExt | extensible = sortedPutStmtsList ++ [ HsQualifier $ pvar "wirePutExtField" $$ last vars ]+                                | otherwise = sortedPutStmtsList+                sortedPutStmtsList = map snd                                          -- remove number+                                     . sortBy (compare `on` fst)                      -- sort by number+                                     . zip (map fieldNumber . F.toList $ fieldInfos)  -- add number as fst+                                     $ putStmtsList+                putStmtsList = zipWith toPut vars . F.toList $ fieldInfos+        toPut var fi = let f = if isRequired fi then "wirePutReq"+                                 else if canRepeat fi then "wirePutRep"+                                     else "wirePutOpt"+                       in HsQualifier $+                          foldl' HsApp (pvar f) [ litInt (getWireTag (wireTag fi))+                                                , litInt (getFieldType (typeCode fi))+                                                , var]++        getCases = HsUnGuardedRhs $ cases+          (pvar (if extensible then "getBareMessageExt" else "getBareMessage") $$ lvar "update'Self")+          (pvar (if extensible then "getMessageExt" else "getMessage") $$ lvar "update'Self")+          (pvar "wireGetErr" $$ lvar "ft'")+        whereUpdateSelf = [HsFunBind [HsMatch src (HsIdent "update'Self")+                            [HsPVar (HsIdent "field'Number") ,HsPVar (HsIdent "old'Self")]+                            (HsUnGuardedRhs (HsCase (lvar "field'Number") updateAlts)) noWhere]]+        updateAlts = map toUpdate (F.toList fieldInfos) +                     ++ (if extensible && (not (Seq.null fieldExts)) then map toUpdateExt (F.toList fieldExts) else [])+                     ++ [HsAlt src HsPWildCard (HsUnGuardedAlt $+                           pvar "unknownField" $$ (lvar "field'Number")) noWhere]+        toUpdateExt fi = HsAlt src (litIntP . getFieldId . fieldNumber $ fi) (HsUnGuardedAlt $+                           pvar "wireGetKey" $$ HsVar (mayQualName protoName (fieldName fi)) $$ lvar "old'Self") noWhere+        -- fieldIds cannot be negative so no parenthesis are required to protect a negative sign+        toUpdate fi = HsAlt src (litIntP . getFieldId . fieldNumber $ fi) (HsUnGuardedAlt $ +                        pvar "fmap" $$ (HsParen $ HsLambda src [HsPVar (HsIdent "new'Field")] $+                                          HsRecUpdate (lvar "old'Self") [HsFieldUpdate (UnQual . HsIdent . baseName . fieldName $ fi)+                                                                                       (labelUpdate fi)])+                                    $$ (HsParen (pvar "wireGet" $$ (litInt . getFieldType . typeCode $ fi)))) noWhere+        labelUpdate fi | canRepeat fi = pvar "append" $$ HsParen ((lvar . baseName . fieldName $ fi) $$ lvar "old'Self")+                                                      $$ lvar "new'Field"+                       | isRequired fi = qMerge (lvar "new'Field")+                       | otherwise = qMerge (HsCon (private "Just") $$ lvar "new'Field")+            where qMerge x | fromIntegral (getFieldType (typeCode fi)) `elem` [10,11] =+                               pvar "mergeAppend" $$ HsParen ((lvar . baseName . fieldName $ fi) $$ lvar "old'Self") $$ (HsParen x)+                           | otherwise = x+         +    in HsInstDecl src [] (private "Wire") [HsTyCon me]+        [ HsFunBind [HsMatch src (HsIdent "wireSize") [HsPVar (HsIdent "ft'"),HsPAsPat (HsIdent "self'") (HsPParen mine)] sizeCases whereCalcSize]+        , HsFunBind [HsMatch src (HsIdent "wirePut")  [HsPVar (HsIdent "ft'"),HsPAsPat (HsIdent "self'") (HsPParen mine)] putCases wherePutFields]+        , HsFunBind [HsMatch src (HsIdent "wireGet") [HsPVar (HsIdent "ft'")] getCases whereUpdateSelf]+        ]++instanceReflectDescriptor :: DescriptorInfo -> HsDecl+instanceReflectDescriptor di+    = HsInstDecl src [] (private "ReflectDescriptor") [HsTyCon (UnQual (HsIdent (baseName (descName di))))]+        [ inst "reflectDescriptorInfo" [ HsPWildCard ] rdi ]+  where -- massive shortcut through show and read+        rdi :: HsExp+        rdi = pvar "read" $$ HsLit (HsString (show di))++------------------------------------------------------------------++derives,derivesEnum :: [HsQName]+derives = map private ["Show","Eq","Ord","Typeable"]+derivesEnum = map private ["Read","Show","Eq","Ord","Typeable"]++useType :: Int -> Maybe String+useType  1 = Just "Double"+useType  2 = Just "Float"+useType  3 = Just "Int64"+useType  4 = Just "Word64"+useType  5 = Just "Int32"+useType  6 = Just "Word64"+useType  7 = Just "Word32"+useType  8 = Just "Bool"+useType  9 = Just "Utf8"+useType 10 = Nothing+useType 11 = Nothing+useType 12 = Just "ByteString"+useType 13 = Just "Word32"+useType 14 = Nothing+useType 15 = Just "Int32"+useType 16 = Just "Int64"+useType 17 = Just "Int32"+useType 18 = Just "Int64"+useType  x = error $ "Text.ProtocolBuffers.Gen: Impossible? useType Unknown type code "++show x++-----------------------+{-+test = putStrLn . prettyPrint . descriptorModule False "Text" $ d'++testDesc =  putStrLn . prettyPrint . descriptorModule False "Text" $ genFieldOptions++testLabel = putStrLn . prettyPrint $ enumModule "Text" labelTest+testType = putStrLn . prettyPrint $ enumModule "Text" t++-- testing+utf8FromString = Utf8 . U.fromString++-- try and generate a small replacement for my manual file+genFieldOptions :: D.DescriptorProto.DescriptorProto+genFieldOptions =+  defaultValue+  { D.DescriptorProto.name = Just (utf8FromString "DescriptorProtos.FieldOptions") +  , D.DescriptorProto.field = Seq.fromList+    [ defaultValue+      { D.FieldDescriptorProto.name = Just (utf8FromString "ctype")+      , D.FieldDescriptorProto.number = Just 1+      , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL+      , D.FieldDescriptorProto.type' = Just TYPE_ENUM+      , D.FieldDescriptorProto.type_name = Just (utf8FromString "DescriptorProtos.FieldOptions.CType")+      , D.FieldDescriptorProto.default_value = Nothing+      }+    , defaultValue+      { D.FieldDescriptorProto.name = Just (utf8FromString "experimental_map_key")+      , D.FieldDescriptorProto.number = Just 9+      , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL+      , D.FieldDescriptorProto.type' = Just TYPE_STRING+      , D.FieldDescriptorProto.default_value = Nothing+      }+    ]+  }++-- test several features+d' :: D.DescriptorProto.DescriptorProto+d' = defaultValue+    { D.DescriptorProto.name = Just (utf8FromString "SomeMod.ServiceOptions") +    , D.DescriptorProto.field = Seq.fromList+       [ defaultValue+         { D.FieldDescriptorProto.name = Just (utf8FromString "fieldString")+         , D.FieldDescriptorProto.number = Just 1+         , D.FieldDescriptorProto.label = Just LABEL_REQUIRED+         , D.FieldDescriptorProto.type' = Just TYPE_STRING+         , D.FieldDescriptorProto.default_value = Just (utf8FromString "Hello World")+         }+       , defaultValue+         { D.FieldDescriptorProto.name = Just (utf8FromString "fieldDouble")+         , D.FieldDescriptorProto.number = Just 4+         , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL+         , D.FieldDescriptorProto.type' = Just TYPE_DOUBLE+         , D.FieldDescriptorProto.default_value = Just (utf8FromString "+5.5e-10")+        }+       , defaultValue+         { D.FieldDescriptorProto.name = Just (utf8FromString "fieldBytes")+         , D.FieldDescriptorProto.number = Just 2+         , D.FieldDescriptorProto.label = Just LABEL_REQUIRED+         , D.FieldDescriptorProto.type' = Just TYPE_STRING+         , D.FieldDescriptorProto.default_value = Just (utf8FromString . map toEnum $ [0,5..255])+        }+       , defaultValue+         { D.FieldDescriptorProto.name = Just (utf8FromString "fieldInt64")+         , D.FieldDescriptorProto.number = Just 3+         , D.FieldDescriptorProto.label = Just LABEL_REQUIRED+         , D.FieldDescriptorProto.type' = Just TYPE_INT64+         , D.FieldDescriptorProto.default_value = Just (utf8FromString "-0x40")+        }+       , defaultValue+         { D.FieldDescriptorProto.name = Just (utf8FromString "fieldBool")+         , D.FieldDescriptorProto.number = Just 5+         , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL+         , D.FieldDescriptorProto.type' = Just TYPE_STRING+         , D.FieldDescriptorProto.default_value = Just (utf8FromString "False")+        }+       , defaultValue+         { D.FieldDescriptorProto.name = Just (utf8FromString "field2TestSelf")+         , D.FieldDescriptorProto.number = Just 6+         , D.FieldDescriptorProto.label = Just LABEL_OPTIONAL+         , D.FieldDescriptorProto.type' = Just TYPE_MESSAGE+         , D.FieldDescriptorProto.type_name = Just (utf8FromString "ServiceOptions")+         }+       , defaultValue+         { D.FieldDescriptorProto.name = Just (utf8FromString "field3TestQualified")+         , D.FieldDescriptorProto.number = Just 7+         , D.FieldDescriptorProto.label = Just LABEL_REPEATED+         , D.FieldDescriptorProto.type' = Just TYPE_MESSAGE+         , D.FieldDescriptorProto.type_name = Just (utf8FromString "A.B.C.Label")+         }+       , defaultValue+         { D.FieldDescriptorProto.name = Just (utf8FromString "field4TestUnqualified")+         , D.FieldDescriptorProto.number = Just 8+         , D.FieldDescriptorProto.label = Just LABEL_REPEATED+         , D.FieldDescriptorProto.type' = Just TYPE_MESSAGE+         , D.FieldDescriptorProto.type_name = Just (utf8FromString "Maybe")+         }+       ]+    }++labelTest :: D.EnumDescriptorProto.EnumDescriptorProto+labelTest = defaultValue+    { D.EnumDescriptorProto.name = Just (utf8FromString "DescriptorProtos.FieldDescriptorProto.Label")+    , D.EnumDescriptorProto.value = Seq.fromList+      [ defaultValue { D.EnumValueDescriptorProto.name = Just (utf8FromString "LABEL_OPTIONAL")+                     , D.EnumValueDescriptorProto.number = Just 1 }+      , defaultValue { D.EnumValueDescriptorProto.name = Just (utf8FromString "LABEL_REQUIRED")+                     , D.EnumValueDescriptorProto.number = Just 2 }+      , defaultValue { D.EnumValueDescriptorProto.name = Just (utf8FromString "LABEL_REPEATED")+                     , D.EnumValueDescriptorProto.number = Just 3 }+      ]+    }++t :: D.EnumDescriptorProto.EnumDescriptorProto+t = defaultValue { D.EnumDescriptorProto.name = Just (utf8FromString "DescriptorProtos.FieldDescriptorProto.Type")+                 , D.EnumDescriptorProto.value = Seq.fromList . zipWith make [1..] $ names }+  where make :: Int32 -> String -> D.EnumValueDescriptorProto+        make i s = defaultValue { D.EnumValueDescriptorProto.name = Just (utf8FromString s)+                                , D.EnumValueDescriptorProto.number = Just i }+        names = ["TYPE_DOUBLE","TYPE_FLOAT","TYPE_INT64","TYPE_UINT64","TYPE_INT32"+                ,"TYPE_FIXED64","TYPE_FIXED32","TYPE_BOOL","TYPE_STRING","TYPE_GROUP"+                ,"TYPE_MESSAGE","TYPE_BYTES","TYPE_UINT32","TYPE_ENUM","TYPE_SFIXED32"+                ,"TYPE_SFIXED64","TYPE_SINT32","TYPE_SINT64"]+-}
+ hprotoc/Text/ProtocolBuffers/ProtoCompile/Instances.hs view
@@ -0,0 +1,79 @@+module Text.ProtocolBuffers.ProtoCompile.Instances(showsType,parseType,showsLabel,parseLabel) where++import Text.ParserCombinators.ReadP+import Text.DescriptorProtos.FieldDescriptorProto.Type(Type(..))+import Text.DescriptorProtos.FieldDescriptorProto.Label(Label(..))++{-+instance Show Type where+  showsPrec _ = showsType++instance Read Type where+  readsPrec _ = readP_to_S readType+-}++showsLabel :: Label -> ShowS+showsLabel LABEL_OPTIONAL s = "optional" ++ s+showsLabel LABEL_REQUIRED s = "required" ++ s+showsLabel LABEL_REPEATED s = "repeated" ++ s++showsType :: Type -> ShowS+showsType TYPE_DOUBLE s = "double" ++ s+showsType TYPE_FLOAT s = "float" ++ s+showsType TYPE_INT64 s = "int64" ++ s+showsType TYPE_UINT64 s = "uint64" ++ s+showsType TYPE_INT32  s = "int32" ++ s+showsType TYPE_FIXED64 s = "fixed64" ++ s+showsType TYPE_FIXED32 s = "fixed32" ++ s+showsType TYPE_BOOL s = "bool" ++ s+showsType TYPE_STRING s = "string" ++ s+showsType TYPE_GROUP s = "group" ++ s+showsType TYPE_MESSAGE s = "message" ++ s+showsType TYPE_BYTES s = "bytes" ++ s+showsType TYPE_UINT32 s = "uint32" ++ s+showsType TYPE_ENUM s = "enum" ++ s+showsType TYPE_SFIXED32 s = "sfixed32" ++ s+showsType TYPE_SFIXED64 s = "sfixed64" ++ s+showsType TYPE_SINT32 s = "sint32" ++ s+showsType TYPE_SINT64 s = "sint64" ++ s++parseType :: String -> Maybe Type+parseType s = case readP_to_S readType s of+                [(val,[])] -> Just val+                _ -> Nothing++parseLabel :: String -> Maybe Label+parseLabel s = case readP_to_S readLabel s of+                [(val,[])] -> Just val+                _ -> Nothing++readLabel :: ReadP Label+readLabel = choice [ return LABEL_OPTIONAL << string "optional"+                   , return LABEL_REQUIRED << string "required"+                   , return LABEL_REPEATED << string "repeated"+                   ]++readType :: ReadP Type+readType = choice [ return TYPE_DOUBLE << string "double"+                  , return TYPE_FLOAT << string "float"+                  , return TYPE_INT64 << string "int64"+                  , return TYPE_UINT64 << string "uint64"+                  , return TYPE_INT32  << string "int32"+                  , return TYPE_FIXED64 << string "fixed64"+                  , return TYPE_FIXED32 << string "fixed32"+                  , return TYPE_BOOL << string "bool"+                  , return TYPE_STRING << string "string"+                  , return TYPE_GROUP << string "group"+                  , return TYPE_MESSAGE << string "message"+                  , return TYPE_BYTES << string "bytes"+                  , return TYPE_UINT32 << string "uint32"+                  , return TYPE_ENUM << string "enum"+                  , return TYPE_SFIXED32 << string "sfixed32"+                  , return TYPE_SFIXED64 << string "sfixed64"+                  , return TYPE_SINT32 << string "sint32"+                  , return TYPE_SINT64 << string "sint64"+                  ]++(<<) :: Monad m => m a -> m b -> m a+(<<) = flip (>>)+
+ hprotoc/Text/ProtocolBuffers/ProtoCompile/Lexer.hs view
@@ -0,0 +1,451 @@+{-# OPTIONS -cpp #-}+{-# LINE 1 "Text/ProtocolBuffers/ProtoCompile/Lexer.x" #-}++{-# OPTIONS_GHC -Wwarn #-}+module Text.ProtocolBuffers.ProtoCompile.Lexer (Lexed(..), alexScanTokens,getLinePos)  where++import Control.Monad.Error()+import Codec.Binary.UTF8.String(encode)+import qualified Data.ByteString.Lazy as L+import Data.Char(ord,isHexDigit,isOctDigit,toLower)+import Data.Word(Word8)+import Numeric(readHex,readOct,readDec,readSigned,readFloat)+++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#elif defined(__GLASGOW_HASKELL__)+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Char (ord)+import Data.Array.Base (unsafeAt)+#else+import Array+import Char (ord)+#endif+{-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++++import qualified Data.ByteString.Lazy.Char8 as ByteString++++-- -----------------------------------------------------------------------------+-- The input type++{-# LINE 29 "templates/wrappers.hs" #-}+++type AlexInput = (AlexPosn, 	-- current position,+		  Char,		-- previous char+		  ByteString.ByteString)	-- current input string++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p,c,s) = c++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p,_,cs) | ByteString.null cs = Nothing+                     | otherwise = let c   = ByteString.head cs+                                       cs' = ByteString.tail cs+                                       p'  = alexMove p c+                                    in p' `seq` cs' `seq` Just (c, (p', c, cs'))+++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+	deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+7) `div` 8)*8+1)+alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad++{-# LINE 150 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++{-# LINE 233 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Basic wrapper++{-# LINE 255 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version++{-# LINE 277 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++{-# LINE 294 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++--alexScanTokens :: ByteString -> [token]+alexScanTokens str = go (alexStartPos,'\n',str)+  where go inp@(pos,_,str) =+          case alexScan inp 0 of+                AlexEOF -> []+                AlexError _ -> error "lexical error"+                AlexSkip  inp' len     -> go inp'+                AlexToken inp' len act -> act pos (ByteString.take (fromIntegral len) str) : go inp'++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++alex_base :: Array Int Int+alex_base = listArray (0,74) [-8,-3,2,109,0,-26,7,8,9,10,-19,106,-21,-20,-17,-12,77,108,133,118,170,0,247,269,323,377,0,452,475,536,0,613,623,143,257,345,355,677,0,0,137,327,329,343,800,823,879,344,903,950,972,996,1018,346,330,331,1029,1090,1101,381,1163,1174,1185,1196,1231,537,1259,1336,1413,1490,1567,1625,1683,0,0]++alex_table :: Array Int Int+alex_table = listArray (0,1938) [0,3,2,3,3,3,2,2,2,2,2,2,2,2,2,2,11,-1,-1,-1,-1,11,11,10,3,11,54,8,5,2,12,42,73,73,2,6,73,19,71,15,23,17,17,17,17,17,17,17,17,17,0,73,0,73,0,0,0,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,73,0,73,0,67,0,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,67,73,-1,73,2,2,2,2,2,34,0,18,18,18,18,18,18,18,18,18,18,0,0,-1,0,0,0,2,0,0,0,0,35,-1,10,0,0,0,0,4,34,0,18,18,18,18,18,18,18,18,18,18,22,16,16,16,16,16,16,16,16,16,39,35,35,34,-1,18,18,18,18,18,18,18,18,18,18,33,33,33,33,33,33,33,33,33,33,0,35,0,0,0,0,0,0,35,0,0,0,0,0,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,45,0,0,0,0,35,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,-1,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,0,24,24,24,24,24,24,24,24,31,31,32,32,32,32,32,32,32,32,32,32,34,35,24,24,24,24,24,24,24,24,31,31,-1,0,-1,-1,-1,0,0,0,28,0,-1,35,-1,-1,-1,0,-1,-1,0,-1,0,35,0,0,0,0,-1,-1,0,-1,28,0,0,0,39,0,0,39,39,0,28,39,34,35,24,24,24,24,24,24,24,24,31,31,-1,39,39,0,39,0,-1,36,28,36,-1,35,33,33,33,33,33,33,33,33,33,33,33,33,33,33,33,33,33,33,33,33,0,0,39,0,0,0,57,0,45,57,57,35,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,45,45,0,45,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,-1,57,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,27,27,27,27,27,27,27,27,27,27,0,0,0,0,0,0,0,27,27,27,27,27,27,27,27,27,27,27,27,27,27,27,27,0,0,0,0,-1,0,0,27,27,27,27,27,27,-1,-1,0,27,27,27,27,27,27,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,39,27,27,27,27,27,27,0,0,0,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,57,0,-1,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,0,31,31,31,31,31,31,31,31,31,31,32,32,32,32,32,32,32,32,32,32,0,35,0,0,0,0,-1,0,0,0,0,35,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,35,0,0,0,0,0,0,0,0,0,35,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,0,0,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,-1,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,39,0,0,0,0,0,0,0,0,46,46,46,46,46,46,46,46,46,46,0,0,0,0,40,0,0,46,46,46,46,46,46,48,49,49,49,49,49,49,49,-1,0,0,0,0,0,0,0,0,0,-1,0,0,45,0,0,0,0,46,46,46,46,46,46,-1,0,0,0,0,0,0,0,44,0,-1,0,45,0,0,39,0,0,0,0,0,0,0,0,47,47,47,47,47,47,47,47,47,47,0,0,0,0,0,39,44,47,47,47,47,47,47,-1,50,50,50,50,50,50,50,50,0,-1,0,0,0,0,0,0,0,0,0,0,45,-1,0,0,0,47,47,47,47,47,47,-1,0,0,0,0,0,0,39,0,0,0,0,0,45,-1,0,51,51,51,51,51,51,51,51,-1,0,0,0,0,39,0,0,0,0,0,0,-1,0,52,52,52,52,52,52,52,52,-1,-1,0,0,0,0,0,39,0,0,0,-1,0,0,45,0,53,53,53,53,53,53,53,53,0,0,0,0,0,39,0,0,0,0,0,39,45,0,53,53,53,53,53,53,53,53,0,0,0,58,58,58,58,58,58,58,58,58,58,0,45,0,-1,0,0,0,58,58,58,58,58,58,-1,-1,0,0,0,0,0,0,0,0,45,-1,0,0,0,0,0,0,0,0,0,57,0,0,41,0,58,58,58,58,58,58,0,0,0,39,0,0,60,61,61,61,61,61,61,61,0,0,0,59,59,59,59,59,59,59,59,59,59,0,0,0,0,-1,0,0,59,59,59,59,59,59,0,-1,-1,0,0,0,56,0,0,0,57,0,-1,-1,0,0,0,0,0,0,0,57,0,-1,-1,39,59,59,59,59,59,59,0,0,-1,0,39,0,56,62,62,62,62,62,62,62,62,39,0,0,63,63,63,63,63,63,63,63,39,-1,0,64,64,64,64,64,64,64,64,-1,0,0,65,65,65,65,65,65,65,65,0,0,0,57,0,0,0,0,0,0,0,0,0,39,57,0,0,0,0,0,0,0,0,0,0,57,0,65,65,65,65,65,65,65,65,0,57,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,72,0,68,68,68,68,68,68,68,68,68,68,0,0,0,0,0,0,57,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,0,0,0,0,68,0,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,72,0,68,68,68,68,68,68,68,68,68,68,0,0,0,0,0,0,0,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,0,0,0,0,68,0,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,72,0,68,68,68,68,68,68,68,68,68,68,0,0,0,0,0,0,0,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,0,0,0,0,68,0,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,68,72,0,70,70,70,70,70,70,70,70,70,70,0,0,0,0,0,0,0,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,0,0,0,0,70,0,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,72,0,70,70,70,70,70,70,70,70,70,70,0,0,0,0,0,0,0,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,0,0,0,0,70,0,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,70,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,0,0,0,0,66,0,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,0,0,0,0,69,0,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,69,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]++alex_check :: Array Int Int+alex_check = listArray (0,1938) [-1,9,10,11,12,13,9,10,11,12,13,9,10,11,12,13,42,10,10,10,10,42,42,42,32,42,34,35,47,32,42,39,40,41,32,47,44,45,46,47,48,49,50,51,52,53,54,55,56,57,-1,59,-1,61,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,-1,93,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,10,125,9,10,11,12,13,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,0,-1,-1,-1,32,-1,-1,-1,-1,69,10,42,-1,-1,-1,-1,47,46,-1,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,39,69,101,46,10,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,-1,69,-1,-1,-1,-1,-1,-1,101,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,92,-1,-1,-1,-1,101,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,46,69,48,49,50,51,52,53,54,55,56,57,0,-1,0,0,0,-1,-1,-1,88,-1,10,69,10,10,10,-1,0,0,-1,0,-1,101,-1,-1,-1,-1,10,10,-1,10,88,-1,-1,-1,34,-1,-1,34,34,-1,120,39,46,101,48,49,50,51,52,53,54,55,56,57,0,39,39,-1,39,-1,10,43,120,45,10,69,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,-1,-1,34,-1,-1,-1,92,-1,92,92,92,101,48,49,50,51,52,53,54,55,56,57,92,92,-1,92,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,92,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,0,-1,-1,65,66,67,68,69,70,10,10,-1,97,98,99,100,101,102,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,97,98,99,100,101,102,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,92,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,-1,69,-1,-1,-1,-1,10,-1,-1,-1,-1,69,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,101,-1,-1,-1,-1,-1,-1,-1,-1,-1,101,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,39,-1,-1,65,66,67,68,69,70,48,49,50,51,52,53,54,55,0,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,92,-1,-1,-1,-1,97,98,99,100,101,102,0,-1,-1,-1,-1,-1,-1,-1,88,-1,10,-1,92,-1,-1,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,39,120,65,66,67,68,69,70,0,48,49,50,51,52,53,54,55,-1,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,92,0,-1,-1,-1,97,98,99,100,101,102,10,-1,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,92,0,-1,48,49,50,51,52,53,54,55,10,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,-1,0,-1,48,49,50,51,52,53,54,55,10,0,-1,-1,-1,-1,-1,39,-1,-1,-1,10,-1,-1,92,-1,48,49,50,51,52,53,54,55,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,34,92,-1,48,49,50,51,52,53,54,55,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,92,-1,0,-1,-1,-1,65,66,67,68,69,70,10,0,-1,-1,-1,-1,-1,-1,-1,-1,92,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,92,-1,-1,34,-1,97,98,99,100,101,102,-1,-1,-1,34,-1,-1,48,49,50,51,52,53,54,55,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,0,-1,-1,65,66,67,68,69,70,-1,10,0,-1,-1,-1,88,-1,-1,-1,92,-1,10,0,-1,-1,-1,-1,-1,-1,-1,92,-1,10,0,34,97,98,99,100,101,102,-1,-1,10,-1,34,-1,120,48,49,50,51,52,53,54,55,34,-1,-1,48,49,50,51,52,53,54,55,34,0,-1,48,49,50,51,52,53,54,55,10,-1,-1,48,49,50,51,52,53,54,55,-1,-1,-1,92,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,92,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,92,-1,48,49,50,51,52,53,54,55,-1,92,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,92,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,46,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]++alex_deflt :: Array Int Int+alex_deflt = listArray (0,74) [74,-1,-1,-1,-1,13,7,7,9,9,13,14,13,13,13,-1,-1,-1,-1,-1,21,-1,-1,-1,-1,26,-1,-1,-1,30,-1,-1,-1,-1,-1,-1,-1,38,-1,-1,43,55,43,43,43,43,43,43,43,43,43,43,43,43,55,55,55,55,55,55,55,55,55,55,55,55,-1,-1,-1,-1,-1,-1,-1,-1,-1]++alex_accept = listArray (0::Int,74) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[],[(AlexAcc (alex_action_13))],[(AlexAccPred  (alex_action_2) (alexRightContext 20)),(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_6))],[(AlexAccPred  (alex_action_2) (alexRightContext 20)),(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_6))],[(AlexAccPred  (alex_action_2) (alexRightContext 20)),(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_13))],[],[(AlexAccSkip)],[(AlexAccPred  (alex_action_3) (alexRightContext 25)),(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_7))],[(AlexAccPred  (alex_action_3) (alexRightContext 25)),(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_7))],[(AlexAccPred  (alex_action_3) (alexRightContext 25)),(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_7))],[],[(AlexAccSkip)],[(AlexAccPred  (alex_action_4) (alexRightContext 29)),(AlexAcc (alex_action_8))],[],[],[(AlexAccSkip)],[(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_9))],[(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_9))],[(AlexAccPred  (alex_action_5) (alexRightContext 37)),(AlexAcc (alex_action_9))],[],[],[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_13))],[],[],[],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_13))],[],[],[],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_13))],[],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_13))]]+{-# LINE 54 "Text/ProtocolBuffers/ProtoCompile/Lexer.x" #-}++line :: AlexPosn -> Int+line (AlexPn _byte lineNum _col) = lineNum+{-# INLINE line #-}++data Lexed = L_Integer !Int !Integer+           | L_Double !Int !Double+           | L_Name !Int !L.ByteString+           | L_String !Int !L.ByteString+           | L !Int !Char+           | L_Error !Int !String+  deriving (Show,Eq)++getLinePos :: Lexed -> Int+getLinePos x = case x of+                 L_Integer i _ -> i+                 L_Double  i _ -> i+                 L_Name    i _ -> i+                 L_String  i _ -> i+                 L         i _ -> i+                 L_Error   i _ -> i++-- 'errAt' is the only access to L_Error, so I can see where it is created with pos+errAt pos msg =  L_Error (line pos) $ "Lexical error (in Text.ProtocolBuffers.Lexer): "++ msg ++ ", at "++see pos where+  see (AlexPn char lineNum col) = "character "++show char++" line "++show lineNum++" column "++show col++"."+dieAt msg pos _s = errAt pos msg+wtfAt pos s = errAt pos $ "unknown character "++show c++" (decimal "++show (ord c)++")"+  where (c:_) = ByteString.unpack s++{-# INLINE mayRead #-}+mayRead :: ReadS a -> String -> Maybe a+mayRead f s = case f s of [(a,"")] -> Just a; _ -> Nothing++-- Given the regexps above, the "parse* failed" messages should be impossible.+parseDec pos s = maybe (errAt pos "Impossible? parseDec failed")+                       (L_Integer (line pos)) $ mayRead (readSigned readDec) (ByteString.unpack s)+parseOct pos s = maybe (errAt pos "Impossible? parseOct failed")+                       (L_Integer (line pos)) $ mayRead (readSigned readOct) (ByteString.unpack s)+parseHex pos s = maybe (errAt pos "Impossible? parseHex failed")+                       (L_Integer (line pos)) $ mayRead (readSigned (readHex . drop 2)) (ByteString.unpack s)+parseDouble pos s = maybe (errAt pos "Impossible? parseDouble failed")+                          (L_Double (line pos)) $ mayRead (readSigned readFloat) (ByteString.unpack s)+-- The sDecode of the string contents may fail+parseStr pos s = either (errAt pos) (L_String (line pos) . L.pack) +               . sDecode . ByteString.unpack+               . ByteString.init . ByteString.tail+               $ s+parseName pos s = L_Name (line pos) s+parseChar pos s = L (line pos) (ByteString.head s)++-- Generalization of concat . unfoldr to monadic-Either form:+op :: ( [Char] -> Either String (Maybe ([Word8],[Char]))) -> [Char] -> Either String [Word8]+op one = go id where+  go f cs = case one cs of+              Left msg -> Left msg+              Right Nothing -> Right (f [])+              Right (Just (ws,cs')) -> go (f . (ws++)) cs'++-- Put this mess in the lexer, so the rest of the code can assume+-- everything is saner.  The input is checked to really be "Char8"+-- values in the range [0..255] and to be c-escaped (in order to+-- render binary information printable).  This decodes the c-escaping+-- and returns the binary data as Word8.+-- +-- A decoding error causes (Left msg) to be returned.+sDecode :: [Char] -> Either String [Word8]+sDecode = op one where+  one :: [Char] -> Either String (Maybe ([Word8],[Char]))+  one ('\\':xs) = unescape xs+  one (x:xs) = do x' <- checkChar8 x+                  return $ Just (x',xs)  -- main case of unescaped value+  one [] = return Nothing+  unescape [] = Left "cannot understand a string that ends with a backslash"+  unescape ys | 1 <= len =+      case mayRead readOct oct of+        Just w -> do w' <- checkByte w+                     return $ Just (w',rest)+        Nothing -> Left $ "failed to decode octal sequence "++ys+    where oct = takeWhile isOctDigit (take 3 ys)+          len = length oct+          rest = drop len ys+  unescape (x:ys) | 'x' == toLower x && 1 <= len =+      case mayRead readHex hex of+        Just w -> do w' <- checkByte w+                     return $ Just (w',rest)+        Nothing -> Left $ "failed to decode hex sequence "++ys+    where hex = takeWhile isHexDigit (take 2 ys)+          len = length hex+          rest = drop len ys          +  unescape ('u':ys) | ok =+      case mayRead readHex hex of+        Just w -> do w' <- checkUnicode w+                     return $ Just (w',rest)+        Nothing -> Left $ "failed to decode 4 char unicode sequence "++ys+    where ok = all isHexDigit hex && 4 == length hex+          (hex,rest) = splitAt 4 ys+  unescape ('U':ys) | ok =+      case mayRead readHex hex of+        Just w -> do w' <- checkUnicode w+                     return $ Just (w',rest)+        Nothing -> Left $ "failed to decode 8 char unicode sequence "++ys+    where ok = all isHexDigit hex && 8 == length hex+          (hex,rest) = splitAt 8 ys+  unescape (x:xs) = do x' <- decode x+                       return $ Just ([x'],xs)+  decode :: Char -> Either String Word8+  decode 'a' = return 7+  decode 'b' = return 8+  decode 't' = return 9+  decode 'n' = return 10+  decode 'v' = return 11+  decode 'f' = return 12+  decode 'r' = return 13+  decode '\"' = return 34+  decode '\'' = return 39+  decode '?' = return 63    -- C99 rule : "\?" is '?'+  decode '\\' = return 92+  decode x | toLower x == 'x' = Left "cannot understand your 'xX' hexadecimal escaped value"+  decode x | toLower x == 'u' = Left "cannot understand your 'uU' unicode UTF-8 hexadecimal escaped value"+  decode _ = Left "cannot understand your backslash-escaped value"+  checkChar8 :: Char -> Either String [Word8]+  checkChar8 c | (0 <= i) && (i <= 255) = Right [toEnum i]+               | otherwise = Left $ "found Char out of range 0..255, value="++show (ord c)+    where i = fromEnum c+  checkByte :: Integer -> Either String [Word8]+  checkByte i | (0 <= i) && (i <= 255) = Right [fromInteger i]+              | otherwise = Left $ "found Oct/Hex Int out of range 0..255, value="++show i+  checkUnicode :: Integer -> Either String [Word8]+  checkUnicode i | (0 <= i) && (i <= 127) = Right [fromInteger i]+                 | i <= maxChar = Right $ encode [ toEnum . fromInteger $ i ]+                 | otherwise = Left $ "found Unicode Char out of range 0..0x10FFFF, value="++show i+    where maxChar = toInteger (fromEnum (maxBound ::Char)) -- 0x10FFFF+++alex_action_2 =  parseDec +alex_action_3 =  parseOct +alex_action_4 =  parseHex +alex_action_5 =  parseDouble +alex_action_6 =  dieAt "decimal followed by invalid character" +alex_action_7 =  dieAt "octal followed by invalid character" +alex_action_8 =  dieAt "hex followed by invalid character" +alex_action_9 =  dieAt "floating followed by invalid character" +alex_action_10 =  parseStr +alex_action_11 =  parseName +alex_action_12 =  parseChar +alex_action_13 =  wtfAt +{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++{-# LINE 35 "templates/GenericTemplate.hs" #-}++{-# LINE 45 "templates/GenericTemplate.hs" #-}++{-# LINE 66 "templates/GenericTemplate.hs" #-}+alexIndexInt16OffAddr arr off = arr ! off+++{-# LINE 87 "templates/GenericTemplate.hs" #-}+alexIndexInt32OffAddr arr off = arr ! off+++{-# LINE 98 "templates/GenericTemplate.hs" #-}+quickIndex arr i = arr ! i+++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input (sc)+  = alexScanUser undefined input (sc)++alexScanUser user input (sc)+  = case alex_scan_tkn user input (0) input sc AlexNone of+	(AlexNone, input') ->+		case alexGetChar input of+			Nothing -> ++++				   AlexEOF+			Just _ ->++++				   AlexError input'++	(AlexLastSkip input len, _) ->++++		AlexSkip input len++	(AlexLastAcc k input len, _) ->++++		AlexToken input len k+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user orig_input len input s last_acc =+  input `seq` -- strict in the input+  let +	new_acc = check_accs (alex_accept `quickIndex` (s))+  in+  new_acc `seq`+  case alexGetChar input of+     Nothing -> (new_acc, input)+     Just (c, new_input) -> ++++	let+		base   = alexIndexInt32OffAddr alex_base s+		(ord_c) = ord c+		offset = (base + ord_c)+		check  = alexIndexInt16OffAddr alex_check offset+		+		new_s = if (offset >= (0)) && (check == ord_c)+			  then alexIndexInt16OffAddr alex_table offset+			  else alexIndexInt16OffAddr alex_deflt s+	in+	case new_s of +	    (-1) -> (new_acc, input)+		-- on an error, we want to keep the input *before* the+		-- character that failed, not after.+    	    _ -> alex_scan_tkn user orig_input (len + (1)) +			new_input new_s new_acc++  where+	check_accs [] = last_acc+	check_accs (AlexAcc a : _) = AlexLastAcc a input (len)+	check_accs (AlexAccSkip : _)  = AlexLastSkip  input (len)+	check_accs (AlexAccPred a pred : rest)+	   | pred user orig_input (len) input+	   = AlexLastAcc a input (len)+	check_accs (AlexAccSkipPred pred : rest)+	   | pred user orig_input (len) input+	   = AlexLastSkip input (len)+	check_accs (_ : rest) = check_accs rest++data AlexLastAcc a+  = AlexNone+  | AlexLastAcc a !AlexInput !Int+  | AlexLastSkip  !AlexInput !Int++data AlexAcc a user+  = AlexAcc a+  | AlexAccSkip+  | AlexAccPred a (AlexAccPred user)+  | AlexAccSkipPred (AlexAccPred user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user in1 len in2+  = p1 user in1 len in2 && p2 user in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (sc) user _ _ input = +     case alex_scan_tkn user input (0) input sc AlexNone of+	  (AlexNone, _) -> False+	  _ -> True+	-- TODO: there's no need to find the longest+	-- match when checking the right context, just+	-- the first match will do.++-- used by wrappers+iUnbox (i) = i
+ hprotoc/Text/ProtocolBuffers/ProtoCompile/Lexer.x view
@@ -0,0 +1,187 @@+{+{-# OPTIONS_GHC -Wwarn #-}+module Text.ProtocolBuffers.ProtoCompile.Lexer (Lexed(..), alexScanTokens,getLinePos)  where++import Control.Monad.Error()+import Codec.Binary.UTF8.String(encode)+import qualified Data.ByteString.Lazy as L+import Data.Char(ord,isHexDigit,isOctDigit,toLower)+import Data.Word(Word8)+import Numeric(readHex,readOct,readDec,readSigned,readFloat)++}++%wrapper "posn-bytestring"++@inComment = ([^\*] | $white)+ | ([\*]+ [^\/])+@comment = [\/] [\*] (@inComment)* [\*]+ [\/] | "//".* | "#".*++$d = [0-9]+@decInt = [\-]?[1-9]$d*+@hexInt = [\-]?0[xX]([A-Fa-f0-9])++@octInt = [\-]?0[0-7]*+@doubleLit = [\-]?$d+(\.$d+)?([Ee][\+\-]?$d+)?++@ident1 = [A-Za-z_][A-Za-z0-9_]*+@ident = [\.]?@ident1([\.]@ident1)*+@notChar = [^A-Za-z0-9_]++@hexEscape = \\[Xx][A-Fa-f0-9]{1,2}+@octEscape = \\0?[0-7]{1,3}+@charEscape = \\[abfnrtv\\\?'\"]+@inStr = @hexEscape | @octEscape | @charEscape | [^'\"\0\n]+@strLit = ['] (@inStr | [\"])* ['] | [\"] (@inStr | ['])* [\"]++$special    = [=\(\)\,\;\[\]\{\}]++:-++  $white+  ;+  @comment ;+  @decInt / @notChar    { parseDec }+  @octInt / @notChar    { parseOct }+  @hexInt / @notChar    { parseHex }+  @doubleLit / @notChar { parseDouble }+  @decInt               { dieAt "decimal followed by invalid character" }+  @octInt               { dieAt "octal followed by invalid character" }+  @hexInt               { dieAt "hex followed by invalid character" }+  @doubleLit            { dieAt "floating followed by invalid character" }+  @strLit               { parseStr }+  @ident                { parseName }+  $special              { parseChar }+  .                     { wtfAt }++{+line :: AlexPosn -> Int+line (AlexPn _byte lineNum _col) = lineNum+{-# INLINE line #-}++data Lexed = L_Integer !Int !Integer+           | L_Double !Int !Double+           | L_Name !Int !L.ByteString+           | L_String !Int !L.ByteString+           | L !Int !Char+           | L_Error !Int !String+  deriving (Show,Eq)++getLinePos :: Lexed -> Int+getLinePos x = case x of+                 L_Integer i _ -> i+                 L_Double  i _ -> i+                 L_Name    i _ -> i+                 L_String  i _ -> i+                 L         i _ -> i+                 L_Error   i _ -> i++-- 'errAt' is the only access to L_Error, so I can see where it is created with pos+errAt pos msg =  L_Error (line pos) $ "Lexical error (in Text.ProtocolBuffers.Lexer): "++ msg ++ ", at "++see pos where+  see (AlexPn char lineNum col) = "character "++show char++" line "++show lineNum++" column "++show col++"."+dieAt msg pos _s = errAt pos msg+wtfAt pos s = errAt pos $ "unknown character "++show c++" (decimal "++show (ord c)++")"+  where (c:_) = ByteString.unpack s++{-# INLINE mayRead #-}+mayRead :: ReadS a -> String -> Maybe a+mayRead f s = case f s of [(a,"")] -> Just a; _ -> Nothing++-- Given the regexps above, the "parse* failed" messages should be impossible.+parseDec pos s = maybe (errAt pos "Impossible? parseDec failed")+                       (L_Integer (line pos)) $ mayRead (readSigned readDec) (ByteString.unpack s)+parseOct pos s = maybe (errAt pos "Impossible? parseOct failed")+                       (L_Integer (line pos)) $ mayRead (readSigned readOct) (ByteString.unpack s)+parseHex pos s = maybe (errAt pos "Impossible? parseHex failed")+                       (L_Integer (line pos)) $ mayRead (readSigned (readHex . drop 2)) (ByteString.unpack s)+parseDouble pos s = maybe (errAt pos "Impossible? parseDouble failed")+                          (L_Double (line pos)) $ mayRead (readSigned readFloat) (ByteString.unpack s)+-- The sDecode of the string contents may fail+parseStr pos s = either (errAt pos) (L_String (line pos) . L.pack) +               . sDecode . ByteString.unpack+               . ByteString.init . ByteString.tail+               $ s+parseName pos s = L_Name (line pos) s+parseChar pos s = L (line pos) (ByteString.head s)++-- Generalization of concat . unfoldr to monadic-Either form:+op :: ( [Char] -> Either String (Maybe ([Word8],[Char]))) -> [Char] -> Either String [Word8]+op one = go id where+  go f cs = case one cs of+              Left msg -> Left msg+              Right Nothing -> Right (f [])+              Right (Just (ws,cs')) -> go (f . (ws++)) cs'++-- Put this mess in the lexer, so the rest of the code can assume+-- everything is saner.  The input is checked to really be "Char8"+-- values in the range [0..255] and to be c-escaped (in order to+-- render binary information printable).  This decodes the c-escaping+-- and returns the binary data as Word8.+-- +-- A decoding error causes (Left msg) to be returned.+sDecode :: [Char] -> Either String [Word8]+sDecode = op one where+  one :: [Char] -> Either String (Maybe ([Word8],[Char]))+  one ('\\':xs) = unescape xs+  one (x:xs) = do x' <- checkChar8 x+                  return $ Just (x',xs)  -- main case of unescaped value+  one [] = return Nothing+  unescape [] = Left "cannot understand a string that ends with a backslash"+  unescape ys | 1 <= len =+      case mayRead readOct oct of+        Just w -> do w' <- checkByte w+                     return $ Just (w',rest)+        Nothing -> Left $ "failed to decode octal sequence "++ys+    where oct = takeWhile isOctDigit (take 3 ys)+          len = length oct+          rest = drop len ys+  unescape (x:ys) | 'x' == toLower x && 1 <= len =+      case mayRead readHex hex of+        Just w -> do w' <- checkByte w+                     return $ Just (w',rest)+        Nothing -> Left $ "failed to decode hex sequence "++ys+    where hex = takeWhile isHexDigit (take 2 ys)+          len = length hex+          rest = drop len ys          +  unescape ('u':ys) | ok =+      case mayRead readHex hex of+        Just w -> do w' <- checkUnicode w+                     return $ Just (w',rest)+        Nothing -> Left $ "failed to decode 4 char unicode sequence "++ys+    where ok = all isHexDigit hex && 4 == length hex+          (hex,rest) = splitAt 4 ys+  unescape ('U':ys) | ok =+      case mayRead readHex hex of+        Just w -> do w' <- checkUnicode w+                     return $ Just (w',rest)+        Nothing -> Left $ "failed to decode 8 char unicode sequence "++ys+    where ok = all isHexDigit hex && 8 == length hex+          (hex,rest) = splitAt 8 ys+  unescape (x:xs) = do x' <- decode x+                       return $ Just ([x'],xs)+  decode :: Char -> Either String Word8+  decode 'a' = return 7+  decode 'b' = return 8+  decode 't' = return 9+  decode 'n' = return 10+  decode 'v' = return 11+  decode 'f' = return 12+  decode 'r' = return 13+  decode '\"' = return 34+  decode '\'' = return 39+  decode '?' = return 63    -- C99 rule : "\?" is '?'+  decode '\\' = return 92+  decode x | toLower x == 'x' = Left "cannot understand your 'xX' hexadecimal escaped value"+  decode x | toLower x == 'u' = Left "cannot understand your 'uU' unicode UTF-8 hexadecimal escaped value"+  decode _ = Left "cannot understand your backslash-escaped value"+  checkChar8 :: Char -> Either String [Word8]+  checkChar8 c | (0 <= i) && (i <= 255) = Right [toEnum i]+               | otherwise = Left $ "found Char out of range 0..255, value="++show (ord c)+    where i = fromEnum c+  checkByte :: Integer -> Either String [Word8]+  checkByte i | (0 <= i) && (i <= 255) = Right [fromInteger i]+              | otherwise = Left $ "found Oct/Hex Int out of range 0..255, value="++show i+  checkUnicode :: Integer -> Either String [Word8]+  checkUnicode i | (0 <= i) && (i <= 127) = Right [fromInteger i]+                 | i <= maxChar = Right $ encode [ toEnum . fromInteger $ i ]+                 | otherwise = Left $ "found Unicode Char out of range 0..0x10FFFF, value="++show i+    where maxChar = toInteger (fromEnum (maxBound ::Char)) -- 0x10FFFF++}
+ hprotoc/Text/ProtocolBuffers/ProtoCompile/MakeReflections.hs view
@@ -0,0 +1,284 @@+-- | The 'MakeReflections' module takes the 'FileDescriptorProto'+-- output from 'Resolve' and produces a 'ProtoInfo' from+-- 'Reflections'.  This also takes a Haskell module prefix and the+-- proto's package namespace as input.  The output is suitable+-- for passing to the 'Gen' module to produce the files.+--+-- This acheives several things: It moves the data from a nested tree+-- to flat lists and maps. It moves the group information from the+-- parent Descriptor to the actual Descriptor.  It moves the data out+-- of Maybe types.  It converts Utf8 to String.  Keys known to extend+-- a Descriptor are listed in that Descriptor.+-- +-- In building the reflection info new things are computed. It changes+-- dotted names to ProtoName with the outer prefix.  It parses the+-- default value from the ByteString to a Haskell type.  The value of+-- the tag on the wire is computed and so is its size on the wire.+module Text.ProtocolBuffers.ProtoCompile.MakeReflections(makeProtoInfo,makeEnumInfo,makeDescriptorInfo,serializeFDP) where++import qualified Text.DescriptorProtos.DescriptorProto                as D(DescriptorProto)+import qualified Text.DescriptorProtos.DescriptorProto                as D.DescriptorProto(DescriptorProto(..))+import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.DescriptorProto(ExtensionRange(ExtensionRange))+import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.DescriptorProto.ExtensionRange(ExtensionRange(..))+import qualified Text.DescriptorProtos.EnumDescriptorProto            as D(EnumDescriptorProto) +import qualified Text.DescriptorProtos.EnumDescriptorProto            as D.EnumDescriptorProto(EnumDescriptorProto(..)) +import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D(EnumValueDescriptorProto)+import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D.EnumValueDescriptorProto(EnumValueDescriptorProto(..))+import qualified Text.DescriptorProtos.FieldDescriptorProto           as D(FieldDescriptorProto) +import qualified Text.DescriptorProtos.FieldDescriptorProto           as D.FieldDescriptorProto(FieldDescriptorProto(..)) +import qualified Text.DescriptorProtos.FieldDescriptorProto.Label     as D.FieldDescriptorProto(Label)+import           Text.DescriptorProtos.FieldDescriptorProto.Label     as D.FieldDescriptorProto.Label(Label(..))+import qualified Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto(Type)+import           Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto.Type(Type(..))+import qualified Text.DescriptorProtos.FileDescriptorProto            as D(FileDescriptorProto(FileDescriptorProto)) +import qualified Text.DescriptorProtos.FileDescriptorProto            as D.FileDescriptorProto(FileDescriptorProto(..)) ++import Text.ProtocolBuffers.Basic+import Text.ProtocolBuffers.Reflections+import Text.ProtocolBuffers.WireMessage(size'Varint,toWireTag,runPut)++import qualified Data.Foldable as F(foldr,toList)+import qualified Data.ByteString as S(concat)+import qualified Data.ByteString.Char8 as SC(spanEnd)+import qualified Data.ByteString.Lazy.Char8 as LC(toChunks,fromChunks,length,init)+import qualified Data.ByteString.Lazy.UTF8 as U(fromString,toString)+import Data.List(partition,unfoldr)+import qualified Data.Sequence as Seq(fromList,empty,singleton)+import Numeric(readHex,readOct,readDec)+import Data.Monoid(mconcat,mappend)+import qualified Data.Map as M(fromListWith,lookup)+import Data.Maybe(fromMaybe,catMaybes)+import System.FilePath++--import Debug.Trace (trace)++imp :: String -> a+imp msg = error $ "Text.ProtocolBuffers.ProtoCompile.MakeReflections: Impossible? "++msg++spanEndL :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)+spanEndL f bs = let (a,b) = SC.spanEnd f (S.concat . LC.toChunks $ bs)+                in (LC.fromChunks [a],LC.fromChunks [b])++-- Take a bytestring of "A" into "Right A" and "A.B.C" into "Left (A.B,C)"+splitMod :: Utf8 -> Either (Utf8,Utf8) Utf8+splitMod (Utf8 bs) = case spanEndL ('.'/=) bs of+                       (pre,post) | LC.length pre <= 1 -> Right (Utf8 bs)+                                  | otherwise -> Left (Utf8 (LC.init pre),Utf8 post)++toString :: Utf8 -> String+toString = U.toString . utf8++toProtoName :: String -> Utf8 -> ProtoName+toProtoName prefix rawName =+  case splitMod rawName of+    Left (m,b) -> ProtoName prefix (toString m) (toString b)+    Right b    -> ProtoName prefix ""           (toString b)++toPath :: String -> Utf8 -> [FilePath]+toPath prefix name = splitDirectories (combine a b)+  where a = joinPath . splitDot $ prefix+        b = flip addExtension "hs" . joinPath . splitDot . U.toString . utf8 $ name++splitDot :: String -> [FilePath]+splitDot = unfoldr s where+    s ('.':xs) = s xs+    s [] = Nothing+    s xs = Just (span ('.'/=) xs)++pnPath :: ProtoName -> [FilePath]+pnPath (ProtoName a b c) = splitDirectories .flip addExtension "hs" . joinPath . splitDot $ dotPre a (dotPre b c)++dotPre :: String -> String -> String+dotPre "" x = x+dotPre x "" = x+dotPre s x@('.':xs)  | '.' == last s = s ++ xs+                     | otherwise = s ++ x+dotPre s x | '.' == last s = s++x+           | otherwise = s++('.':x)++serializeFDP :: D.FileDescriptorProto -> ByteString+serializeFDP fdp = runPut (wirePut 11 fdp)++makeProtoInfo :: String -> [String] -> D.FileDescriptorProto -> ProtoInfo+makeProtoInfo prefix names+              fdp@(D.FileDescriptorProto+                    { D.FileDescriptorProto.name = Just rawName })+     = ProtoInfo protoName (pnPath protoName) (toString rawName) keyInfos allMessages allEnums allKeys where+  protoName = case names of+                [] -> ProtoName prefix "" ""+                [name] -> ProtoName prefix "" name+                _ -> ProtoName prefix (foldr1 (\a bs -> a  ++ ('.' : bs)) (init names)) (last names)+  keyInfos = Seq.fromList . map (\f -> (keyExtendee prefix f,toFieldInfo protoName f))+             . F.toList . D.FileDescriptorProto.extension $ fdp+  allMessages = concatMap (processMSG False) (F.toList $ D.FileDescriptorProto.message_type fdp)+  allEnums = map (makeEnumInfo prefix) (F.toList $ D.FileDescriptorProto.enum_type fdp) +             ++ concatMap processENM (F.toList $ D.FileDescriptorProto.message_type fdp)+  allKeys = M.fromListWith mappend . map (\(k,a) -> (k,Seq.singleton a))+            . F.toList . mconcat $ keyInfos : map keys allMessages++  processMSG msgIsGroup msg = +    let getKnownKeys protoName' = fromMaybe Seq.empty (M.lookup protoName' allKeys)+        groups = collectedGroups msg+        checkGroup x = elem (fromMaybe (imp $ "no message name in makeProtoInfo.processMSG.checkGroup:\n"++show msg)+                                       (D.DescriptorProto.name x))+                            groups+    in makeDescriptorInfo getKnownKeys prefix msgIsGroup msg+       : concatMap (\x -> processMSG (checkGroup x) x)+                   (F.toList (D.DescriptorProto.nested_type msg))+  processENM msg = foldr ((:) . makeEnumInfo prefix) nested+                         (F.toList (D.DescriptorProto.enum_type msg))+    where nested = concatMap processENM (F.toList (D.DescriptorProto.nested_type msg))+makeProtoInfo prefix names fdp = imp $ "no name in fdp passed to makeProtoInfo: " ++ show (prefix,names,fdp)++collectedGroups :: D.DescriptorProto -> [Utf8] +collectedGroups = catMaybes+                . map D.FieldDescriptorProto.type_name+                . filter (\f -> D.FieldDescriptorProto.type' f == Just TYPE_GROUP) +                . F.toList+                . D.DescriptorProto.field++makeEnumInfo :: String -> D.EnumDescriptorProto -> EnumInfo+makeEnumInfo prefix e@(D.EnumDescriptorProto.EnumDescriptorProto+                        { D.EnumDescriptorProto.name = Just rawName })+    = let protoName = toProtoName prefix rawName+      in EnumInfo protoName (toPath prefix rawName) (enumVals e)+  where enumVals :: D.EnumDescriptorProto -> [(EnumCode,String)]+        enumVals (D.EnumDescriptorProto.EnumDescriptorProto+                    { D.EnumDescriptorProto.value = value}) +            = F.foldr ((:) . oneValue) [] value+          where oneValue  :: D.EnumValueDescriptorProto -> (EnumCode,String)+                oneValue (D.EnumValueDescriptorProto.EnumValueDescriptorProto+                          { D.EnumValueDescriptorProto.name = Just name+                          , D.EnumValueDescriptorProto.number = Just number })+                    = (EnumCode number,toString name)+                oneValue evdp = imp $ "no name or number for evdp passed to makeEnumInfo.oneValue: "++show evdp+makeEnumInfo prefix e = imp $ "no name for enum passed to makeEnumInfo: " ++ show (prefix,e)++makeDescriptorInfo :: (ProtoName -> Seq FieldInfo)+                   -> String -> Bool -> D.DescriptorProto -> DescriptorInfo+makeDescriptorInfo getKnownKeys prefix msgIsGroup+                   (D.DescriptorProto.DescriptorProto+                     { D.DescriptorProto.name = Just rawName+                     , D.DescriptorProto.field = rawFields+                     , D.DescriptorProto.extension_range = extension_range })+    = let di = DescriptorInfo protoName (toPath prefix rawName) msgIsGroup+                              fieldInfos keyInfos extRangeList (getKnownKeys protoName)+      in di -- trace (toString rawName ++ "\n" ++ show di ++ "\n\n") $ di+  where protoName = toProtoName prefix rawName+        (msgFields,keysHere) = partition (\ f -> Nothing == (D.FieldDescriptorProto.extendee f)) . F.toList $ rawFields+        fieldInfos = Seq.fromList . map (toFieldInfo protoName) $ msgFields+        keyInfos = Seq.fromList . map (\f -> (keyExtendee prefix f,toFieldInfo protoName f)) $ keysHere+        extRangeList = concatMap check unchecked+          where check x@(lo,hi) | hi < lo = []+                                | hi<19000 || 19999<lo  = [x]+                                | otherwise = concatMap check [(lo,18999),(20000,hi)]+                unchecked = F.foldr ((:) . extToPair) [] extension_range+                extToPair (D.DescriptorProto.ExtensionRange+                            { D.DescriptorProto.ExtensionRange.start = start+                            , D.DescriptorProto.ExtensionRange.end = end }) =+                  (maybe minBound FieldId start, maybe maxBound FieldId end)+makeDescriptorInfo _ prefix msgIsGroup d =+  imp $ "No name passed in dp passed to makeDescriptorInfo: "++show (prefix,msgIsGroup,d)++  +keyExtendee :: String -> D.FieldDescriptorProto.FieldDescriptorProto -> ProtoName+keyExtendee prefix f+    = case D.FieldDescriptorProto.extendee f of+        Nothing -> error "Impossible? keyExtendee expected Just but found Nothing"+        Just extName -> toProtoName prefix extName++toFieldInfo :: ProtoName ->  D.FieldDescriptorProto -> FieldInfo+toFieldInfo (ProtoName prefix modName parent)+            f@(D.FieldDescriptorProto.FieldDescriptorProto+                { D.FieldDescriptorProto.name = Just name+                , D.FieldDescriptorProto.number = Just number+                , D.FieldDescriptorProto.label = Just label+                , D.FieldDescriptorProto.type' = Just type'+                , D.FieldDescriptorProto.type_name = mayTypeName+--                , D.FieldDescriptorProto.extendee = Nothing  -- sanity check+                , D.FieldDescriptorProto.default_value = mayRawDef })+    = fieldInfo+  where mayDef = parseDefaultValue f+        fieldInfo = let fullName = ProtoName prefix (dotPre modName parent) (toString name)+                        fieldId = (FieldId (fromIntegral number))+                        fieldType = (FieldType (fromEnum type'))+                        wt = toWireTag fieldId fieldType+                        wtLength = size'Varint (getWireTag wt)+                    in FieldInfo fullName+                                 fieldId+                                 wt+                                 wtLength+                                 (label == LABEL_REQUIRED)+                                 (label == LABEL_REPEATED)+                                 fieldType+                                 (fmap (toProtoName prefix) mayTypeName)+                                 (fmap utf8 mayRawDef)+                                 mayDef+toFieldInfo pn f = imp $ "Not enough information defined in field passed to toFieldInfo: "++show(pn,f)++-- "Nothing" means no value specified+-- A failure to parse a provided value will result in an error at the moment+parseDefaultValue :: D.FieldDescriptorProto -> Maybe HsDefault+parseDefaultValue f@(D.FieldDescriptorProto.FieldDescriptorProto+                     { D.FieldDescriptorProto.type' = type'+                     , D.FieldDescriptorProto.default_value = mayRawDef })+    = do bs <- mayRawDef+         t <- type'+         todo <- case t of+                   TYPE_MESSAGE -> Nothing+                   TYPE_GROUP   -> Nothing+                   TYPE_ENUM    -> Just parseDefEnum+                   TYPE_BOOL    -> Just parseDefBool+                   TYPE_BYTES   -> Just parseDefBytes+                   TYPE_DOUBLE  -> Just parseDefDouble+                   TYPE_FLOAT   -> Just parseDefFloat+                   TYPE_STRING  -> Just parseDefString+                   _            -> Just parseDefInteger+         case todo (utf8 bs) of+           Nothing -> error $ "Could not parse as type "++ show t ++"the default value "++ show mayRawDef ++" for field "++show f+           Just value -> return value++--- From here down is code used to parse the format of the default values in the .proto files++parseDefEnum :: ByteString -> Maybe HsDefault+parseDefEnum = Just . HsDef'Enum . U.toString++{-# INLINE mayRead #-}+mayRead :: ReadS a -> String -> Maybe a+mayRead f s = case f s of [(a,"")] -> Just a; _ -> Nothing++parseDefDouble :: ByteString -> Maybe HsDefault+parseDefDouble bs = fmap (HsDef'Rational . toRational) +                    . mayRead reads' . U.toString $ bs+  where reads' :: ReadS Double+        reads' = readSigned' reads++parseDefFloat :: ByteString -> Maybe HsDefault+parseDefFloat bs = fmap  (HsDef'Rational . toRational) +                   . mayRead reads' . U.toString $ bs+  where reads' :: ReadS Float+        reads' = readSigned' reads++parseDefString :: ByteString -> Maybe HsDefault+parseDefString bs = Just (HsDef'ByteString bs)++parseDefBytes :: ByteString -> Maybe HsDefault+parseDefBytes bs = Just (HsDef'ByteString bs)++parseDefInteger :: ByteString -> Maybe HsDefault+parseDefInteger bs = fmap HsDef'Integer . mayRead checkSign . U.toString $ bs+    where checkSign = readSigned' checkBase+          checkBase ('0':'x':xs) = readHex xs+          checkBase ('0':xs) = readOct xs+          checkBase xs = readDec xs++parseDefBool :: ByteString -> Maybe HsDefault+parseDefBool bs | bs == U.fromString "true" = Just (HsDef'Bool True)+                | bs == U.fromString "false" = Just (HsDef'Bool False)+                | otherwise = Nothing++-- The Numeric.readSigned does not handle '+' for some odd reason+readSigned' :: (Num a) => ([Char] -> [(a, t)]) -> [Char] -> [(a, t)]+readSigned' f ('-':xs) = map (\(v,s) -> (-v,s)) . f $ xs+readSigned' f ('+':xs) = f xs+readSigned' f xs = f xs
+ hprotoc/Text/ProtocolBuffers/ProtoCompile/Parser.hs view
@@ -0,0 +1,459 @@+module Text.ProtocolBuffers.ProtoCompile.Parser(pbParse,parseProto,filename1,filename2) where++import qualified Text.DescriptorProtos.DescriptorProto                as D(DescriptorProto)+import qualified Text.DescriptorProtos.DescriptorProto                as D.DescriptorProto(DescriptorProto(..))+import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D(ExtensionRange(ExtensionRange))+import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.ExtensionRange(ExtensionRange(..))+import qualified Text.DescriptorProtos.EnumDescriptorProto            as D(EnumDescriptorProto)+import qualified Text.DescriptorProtos.EnumDescriptorProto            as D.EnumDescriptorProto(EnumDescriptorProto(..))+import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D(EnumValueDescriptorProto(EnumValueDescriptorProto))+import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D.EnumValueDescriptorProto(EnumValueDescriptorProto(..))+import qualified Text.DescriptorProtos.FieldDescriptorProto           as D(FieldDescriptorProto(FieldDescriptorProto))+import qualified Text.DescriptorProtos.FieldDescriptorProto           as D.FieldDescriptorProto(FieldDescriptorProto(..))+import qualified Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto(Type)+import           Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto.Type(Type(..))+import qualified Text.DescriptorProtos.FieldOptions                   as D(FieldOptions)+import qualified Text.DescriptorProtos.FieldOptions                   as D.FieldOptions(FieldOptions(..))+import qualified Text.DescriptorProtos.FileDescriptorProto            as D(FileDescriptorProto)+import qualified Text.DescriptorProtos.FileDescriptorProto            as D.FileDescriptorProto(FileDescriptorProto(..))+import qualified Text.DescriptorProtos.FileOptions                    as D.FileOptions(FileOptions(..))+import qualified Text.DescriptorProtos.MessageOptions                 as D.MessageOptions(MessageOptions(..))+import qualified Text.DescriptorProtos.MethodDescriptorProto          as D(MethodDescriptorProto(MethodDescriptorProto))+import qualified Text.DescriptorProtos.MethodDescriptorProto          as D.MethodDescriptorProto(MethodDescriptorProto(..))+import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D.ServiceDescriptorProto(ServiceDescriptorProto(..))++import Text.ProtocolBuffers.Basic+import Text.ProtocolBuffers.Header(ByteString,Int32,Int64,Word32,Word64+                                  ,mergeEmpty,ReflectEnum(reflectEnumInfo),enumName)++import Text.ProtocolBuffers.ProtoCompile.Lexer(Lexed(..),alexScanTokens,getLinePos)+import Text.ProtocolBuffers.ProtoCompile.Instances(parseLabel,parseType)++import Control.Monad(when,liftM3)+import qualified Data.ByteString.Lazy as L(unpack)+import qualified Data.ByteString.Lazy.Char8 as LC(notElem,head,readFile)+import qualified Data.ByteString.Lazy.UTF8 as U(fromString,toString,uncons)+import Data.Char(isUpper)+import Data.Ix(inRange)+import Data.Maybe(fromMaybe)+import Data.Sequence((|>))+import Text.ParserCombinators.Parsec(GenParser,ParseError,runParser,sourceName+                                    ,getInput,setInput,getPosition,setPosition,getState,setState+                                    ,(<?>),(<|>),option,token,choice,between,eof,unexpected,skipMany)+import Text.ParserCombinators.Parsec.Pos(newPos)+import Data.Word(Word8)++default ()++type P = GenParser Lexed++pbParse :: String -> IO (Either ParseError D.FileDescriptorProto)+pbParse filename = fmap (parseProto filename) (LC.readFile filename)++parseProto :: String -> ByteString -> Either ParseError D.FileDescriptorProto+parseProto filename file = do+  let lexed = alexScanTokens file+      ipos = case lexed of+               [] -> setPosition (newPos filename 0 0)+               (l:_) -> setPosition (newPos filename (getLinePos l) 0)+  runParser (ipos >> parser) (initState filename) filename lexed++filename1,filename2 :: String+filename1 = "/tmp/unittest.proto"+filename2 = "/tmp/descriptor.proto"++utf8FromString :: String -> Maybe Utf8+utf8FromString = Just . Utf8 . U.fromString+utf8ToString :: Utf8 -> String+utf8ToString = U.toString . utf8++initState :: String -> D.FileDescriptorProto+initState filename = mergeEmpty {D.FileDescriptorProto.name=utf8FromString filename}++{-# INLINE mayRead #-}+mayRead :: ReadS a -> String -> Maybe a+mayRead f s = case f s of [(a,"")] -> Just a; _ -> Nothing++true,false :: ByteString+true = U.fromString "true"+false = U.fromString "false"++-- Use 'token' via 'tok' to make all the parsers for the Lexed values+tok :: (Lexed -> Maybe a) -> P s a+tok f = token show (\lexed -> newPos "" (getLinePos lexed) 0) f++pChar :: Char -> P s ()+pChar c = tok (\l-> case l of L _ x -> if (x==c) then return () else Nothing+                              _ -> Nothing) <?> ("character "++show c)++eol :: P s ()+eol = pChar ';'++eols :: P s ()+eols = skipMany eol++pName :: ByteString -> P s Utf8+pName name = tok (\l-> case l of L_Name _ x -> if (x==name) then return (Utf8 x) else Nothing+                                 _ -> Nothing) <?> ("name "++show (U.toString name))++bsLit :: P s ByteString+bsLit = tok (\l-> case l of L_String _ x -> return x+                            _ -> Nothing) <?> "quoted bytes literal"++strLit :: P s Utf8+strLit = tok (\l-> case l of L_String _ x -> case isValidUTF8 x of+                                               Nothing -> return (Utf8 x)+                                               Just n -> fail $ "bad utf-8 byte in string literal position # "++show n+                             _ -> fail "quoted string literal (UTF-8)")++intLit :: (Num a) => P s a+intLit = tok (\l-> case l of L_Integer _ x -> return (fromInteger x)+                             _ -> Nothing) <?> "integer literal"++fieldInt :: (Num a) => P s a+fieldInt = tok (\l-> case l of L_Integer _ x | inRange validRange x && not (inRange reservedRange x) -> return (fromInteger x)+                               _ -> Nothing) <?> "field number (from 0 to 2^29-1 and not in 19000 to 19999)"+  where validRange = (0,(2^(29::Int))-1)+        reservedRange = (19000,19999)++enumInt :: (Num a) => P s a+enumInt = tok (\l-> case l of L_Integer _ x | inRange validRange x -> return (fromInteger x)+                              _ -> Nothing) <?> "enum value (from 0 to 2^31-1)"+  where validRange = (0,(2^(31::Int))-1)++doubleLit :: P s Double+doubleLit = tok (\l-> case l of L_Double _ x -> return x+                                L_Integer _ x -> return (fromInteger x)+                                _ -> Nothing) <?> "double (or integer) literal"++ident,ident1,ident_package :: P s Utf8+ident = tok (\l-> case l of L_Name _ x -> return (Utf8 x)+                            _ -> Nothing) <?> "identifier (perhaps dotted)"++ident1 = tok (\l-> case l of L_Name _ x | LC.notElem '.' x -> return (Utf8 x)+                             _ -> Nothing) <?> "identifier (not dotted)"++ident_package = tok (\l-> case l of L_Name _ x | LC.head x /= '.' -> return (Utf8 x)+                                    _ -> Nothing) <?> "package name (no leading dot)"++boolLit :: P s Bool+boolLit = tok (\l-> case l of L_Name _ x | x == true -> return True+                                         | x == false -> return False+                              _ -> Nothing) <?> "boolean literal ('true' or 'false')"++enumLit :: forall s a. (Read a,ReflectEnum a) => P s a -- This is very polymorphic, and with a good error message+enumLit = do+  s <- fmap' utf8ToString ident1+  case mayRead reads s of+    Just x -> return x+    Nothing -> let self = enumName (reflectEnumInfo (undefined :: a))+               in unexpected $ "Enum value not recognized: "++show s++", wanted enum value of type "++show self++-- subParser changes the user state. It is a bit of a hack and is used+-- to define an interesting style of parsing below.+subParser :: GenParser t sSub a -> sSub -> GenParser t s sSub+subParser doSub inSub = do+  in1 <- getInput+  pos1 <- getPosition+  let out = runParser (setPosition pos1 >> doSub >> getStatus) inSub (sourceName pos1) in1+  case out of Left pe -> fail ("the error message from the nested subParser was:\n"++indent (show pe))+              Right (outSub,in2,pos2) -> setInput in2 >> setPosition pos2 >> return outSub+ where getStatus = liftM3 (,,) getState getInput getPosition+       indent = unlines . map (\s -> ' ':' ':s) . lines++{-# INLINE return' #-}+return' :: (Monad m) => a -> m a+return' a = return $! a++{-# INLINE fmap' #-}+fmap' :: (Monad m) => (a->b) -> m a -> m b+fmap' f m = m >>= \a -> seq a (return $! (f a))++type Update s = (s -> s) -> P s ()+update' :: Update s+update' f = getState >>= \s -> setState $! (f s)++parser :: P D.FileDescriptorProto D.FileDescriptorProto +parser = proto >> getState+  where proto = eof <|> (choice [ eol+                                , importFile+                                , package+                                , fileOption+                                , message upTopMsg+                                , enum upTopEnum+                                , extend upTopMsg upTopField+                                , service] >> proto)+        upTopMsg msg = update' (\s -> s {D.FileDescriptorProto.message_type=D.FileDescriptorProto.message_type s |> msg})+        upTopEnum e  = update' (\s -> s {D.FileDescriptorProto.enum_type=D.FileDescriptorProto.enum_type s |> e})+        upTopField f = update' (\s -> s {D.FileDescriptorProto.extension=D.FileDescriptorProto.extension s |> f})++importFile,package,fileOption,service :: P D.FileDescriptorProto.FileDescriptorProto ()+importFile = pName (U.fromString "import") >> strLit >>= \p -> eol >> update' (\s -> s {D.FileDescriptorProto.dependency=(D.FileDescriptorProto.dependency s) |> p})++package = pName (U.fromString "package") >> ident_package >>= \p -> eol >> update' (\s -> s {D.FileDescriptorProto.package=Just p})++pOption :: P s String+pOption = pName (U.fromString "option") >> fmap utf8ToString ident1 >>= \optName -> pChar '=' >> return optName++fileOption = pOption >>= setOption >>= \p -> eol >> update' (\s -> s {D.FileDescriptorProto.options=Just p})+  where+    setOption optName = do+      old <- fmap (maybe mergeEmpty id . D.FileDescriptorProto.options) getState+      case optName of+        "java_package"         -> strLit >>= \p -> return' (old {D.FileOptions.java_package=Just p})+        "java_outer_classname" -> strLit >>= \p -> return' (old {D.FileOptions.java_outer_classname=Just p})+        "java_multiple_files"  -> boolLit >>= \p -> return' (old {D.FileOptions.java_multiple_files=Just p})+        "optimize_for"         -> enumLit >>= \p -> return' (old {D.FileOptions.optimize_for=Just p})+        s -> unexpected $ "option name "++s++message :: (D.DescriptorProto -> P s ()) -> P s ()+message up = pName (U.fromString "message") >> do+  self <- ident1+  up =<< subParser (pChar '{' >> subMessage) (mergeEmpty {D.DescriptorProto.name=Just self})++-- subMessage is also used to parse group declarations+subMessage,messageOption,extensions :: P D.DescriptorProto.DescriptorProto ()+subMessage = (pChar '}') <|> (choice [ eol+                                     , field upNestedMsg Nothing >>= upMsgField+                                     , message upNestedMsg+                                     , enum upNestedEnum+                                     , extensions+                                     , extend upNestedMsg upMsgField+                                     , messageOption] >> subMessage)+  where upNestedMsg msg = update' (\s -> s {D.DescriptorProto.nested_type=D.DescriptorProto.nested_type s |> msg})+        upNestedEnum e  = update' (\s -> s {D.DescriptorProto.enum_type=D.DescriptorProto.enum_type s |> e})+        upMsgField f    = update' (\s -> s {D.DescriptorProto.field=D.DescriptorProto.field s |> f})++messageOption = pOption >>= setOption >>= \p -> eol >> update' (\s -> s {D.DescriptorProto.options=Just p}) +  where+    setOption optName = do+      old <- fmap (maybe mergeEmpty id . D.DescriptorProto.options) getState+      case optName of+        "message_set_wire_format" -> boolLit >>= \p -> return' (old {D.MessageOptions.message_set_wire_format=Just p})+        s -> unexpected $ "option name "++s++extend :: (D.DescriptorProto -> P s ()) -> (D.FieldDescriptorProto -> P s ())+       -> P s ()+extend upGroup upField = pName (U.fromString "extend") >> do+  typeExtendee <- ident+  pChar '{'+  let rest = (field upGroup (Just typeExtendee) >>= upField) >> eols >> (pChar '}' <|> rest)+  eols >> rest++{-+  let first = (eol >> first) <|> ((field upGroup (Just typeExtendee) >>= upField)  >> rest)+      rest = pChar '}' <|> ((eol <|> (field upGroup (Just typeExtendee) >>= upField)) >> rest)+  pChar '{' >> first+-}+  +field :: (D.DescriptorProto -> P s ()) -> Maybe Utf8+      -> P s D.FieldDescriptorProto+field upGroup maybeExtendee = do +  let allowedLabels = case maybeExtendee of+                        Nothing -> ["optional","repeated","required"]+                        Just {} -> ["optional","repeated"] -- cannot declare a required extension+  sLabel <- choice . map (pName . U.fromString) $ allowedLabels+  theLabel <- maybe (fail ("not a valid Label :"++show sLabel)) return (parseLabel (utf8ToString sLabel))+  sType <- ident+  let (maybeTypeCode,maybeTypeName) = case parseType (utf8ToString sType) of+                                        Just t -> (Just t,Nothing)+                                        Nothing -> (Nothing, Just sType)+  name <- ident1+  let first = fromMaybe (error "Impossible: ident1 for field name was empty") . fmap fst $ U.uncons (utf8 name)+  number <- pChar '=' >> fieldInt+  (maybeOptions,maybeDefault) <-+    if maybeTypeCode == Just TYPE_GROUP+      then do when (not (isUpper first))+                   (fail $ "Group names must start with an upper case letter: "++show name)+              upGroup =<< subParser (pChar '{' >> subMessage) (mergeEmpty {D.DescriptorProto.name=Just name})+              return (Nothing,Nothing)+      else do hasBracket <- option False (pChar '[' >> return True)+              pair <- if not hasBracket then return (Nothing,Nothing)+                        else subParser (subBracketOptions maybeTypeCode) (Nothing,Nothing)+              eol+              return pair+  return $ D.FieldDescriptorProto+               { D.FieldDescriptorProto.name = Just name+               , D.FieldDescriptorProto.number = Just number+               , D.FieldDescriptorProto.label = Just theLabel+               , D.FieldDescriptorProto.type' = maybeTypeCode+               , D.FieldDescriptorProto.type_name = maybeTypeName+               , D.FieldDescriptorProto.extendee = maybeExtendee+               , D.FieldDescriptorProto.default_value = fmap Utf8 maybeDefault -- XXX Hack: we lie about Utf8 for the default value+               , D.FieldDescriptorProto.options = maybeOptions+               }++subBracketOptions :: Maybe Type+                  -> P (Maybe D.FieldOptions, Maybe ByteString) ()+subBracketOptions mt = (defaultConstant <|> fieldOptions) >> (pChar ']' <|> (pChar ',' >> subBracketOptions mt))+  where defaultConstant = do+          pName (U.fromString "default")+          x <- pChar '=' >> constant mt+          (a,_) <- getState+          setState $! (a,Just x)+        fieldOptions = do+          optName <- fmap utf8ToString ident1+          pChar '='+          (mOld,def) <- getState+          let old = maybe mergeEmpty id mOld+          case optName of+            "ctype" | (Just TYPE_STRING) == mt -> do+              enumLit >>= \p -> let new = old {D.FieldOptions.ctype=Just p}+                                in seq new $ setState $! (Just new,def)+            "experimental_map_key" | Nothing == mt -> do+              strLit >>= \p -> let new = old {D.FieldOptions.experimental_map_key=Just p}+                               in seq new $ setState $! (Just new,def)+            s -> unexpected $ "option name: "++s++-- This does a type and range safe parsing of the default value,+-- except for enum constants which cannot be checked (the definition+-- may not have been parsed yet).+--+-- Double and Float are checked to be not-Nan and not-Inf.  The+-- int-like types are checked to be within the corresponding range.+constant :: Maybe Type -> P s ByteString+constant Nothing = fmap utf8 ident1 -- hopefully a matching enum; forget about Utf8+constant (Just t) =+  case t of+    TYPE_DOUBLE  -> do d <- doubleLit+                       when (isNaN d || isInfinite d)+                            (fail $ "default floating point literal "++show d++" is out of range for type "++show t)+                       return' (U.fromString . show $ d)+    TYPE_FLOAT   -> do d <- doubleLit+                       let fl :: Float+                           fl = read (show d)+                       when (isNaN fl || isInfinite fl || (d==0) /= (fl==0))+                            (fail $ "default floating point literal "++show d++" is out of range for type "++show t)+                       return' (U.fromString . show $ d)+    TYPE_BOOL    -> boolLit >>= \b -> return' $ if b then true else false+    TYPE_STRING  -> bsLit >>= \s -> maybe (return s) +                                          (\n -> fail $ "default string literal is invalid UTF-8 at byte # "++show n)+                                          (isValidUTF8 s)+    TYPE_BYTES   -> bsLit+    TYPE_GROUP   -> unexpected $ "cannot have a default literal for type "++show t+    TYPE_MESSAGE -> unexpected $ "cannot have a default literal for type "++show t+    TYPE_ENUM    -> fmap utf8 ident1 -- IMPOSSIBLE : SHOULD HAVE HAD Maybe Type PARAMETER match Nothing+    TYPE_SFIXED32 -> f (undefined :: Int32)+    TYPE_SINT32   -> f (undefined :: Int32)+    TYPE_INT32    -> f (undefined :: Int32)+    TYPE_SFIXED64 -> f (undefined :: Int64)+    TYPE_SINT64   -> f (undefined :: Int64)+    TYPE_INT64    -> f (undefined :: Int64)+    TYPE_FIXED32  -> f (undefined :: Word32)+    TYPE_UINT32   -> f (undefined :: Word32)+    TYPE_FIXED64  -> f (undefined :: Word64)+    TYPE_UINT64   -> f (undefined :: Word64)+  where f :: (Bounded a,Integral a) => a -> P s ByteString+        f u = do let range = (toInteger (minBound `asTypeOf` u),toInteger (maxBound `asTypeOf` u))+                 i <- intLit+                 when (not (inRange range i))+                      (fail $ "default integer value "++show i++" is out of range for type "++show t)+                 return' (U.fromString . show $ i)++-- 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++enum :: (D.EnumDescriptorProto -> P s ()) -> P s ()+enum up = pName (U.fromString "enum") >> do+  self <- ident1+  up =<< subParser (pChar '{' >> subEnum) (mergeEmpty {D.EnumDescriptorProto.name=Just self})++enumOption,subEnum :: P D.EnumDescriptorProto.EnumDescriptorProto ()+enumOption = pOption >>= setOption >>= \p -> eol >> update' (\s -> s {D.EnumDescriptorProto.options=Just p})+  where+    setOption optName = do+      -- old <- fmap (maybe mergeEmpty id . D.EnumDescriptorProto.options) getState+      case optName of+        s -> unexpected $ "There are no options for enumerations (when this parser was written): "++s++subEnum = eols >> rest +  where rest = (enumVal <|> enumOption) >> eols >> (pChar '}' <|> rest)+{-+        first = (eol >> first) <|> ((enumVal <|> (pOption >>= setOption)) >> rest)+        rest = pChar '}' <|> ((eol <|> enumVal <|> (pOption >>= setOption)) >> rest)+        setOption = fail "There are no options for enumerations (when this parser was written)"+-}+        enumVal :: P D.EnumDescriptorProto ()+        enumVal = do+          name <- ident1+          number <- pChar '=' >> enumInt+          eol+          let v = D.EnumValueDescriptorProto+                       { D.EnumValueDescriptorProto.name = Just name+                       , D.EnumValueDescriptorProto.number = Just number+                       , D.EnumValueDescriptorProto.options = Nothing+                       }+          update' (\s -> s {D.EnumDescriptorProto.value=D.EnumDescriptorProto.value s |> v})++extensions = pName (U.fromString "extensions") >> do+  start <- fmap Just fieldInt+  pName (U.fromString "to")+  end <- (fmap Just fieldInt <|> fmap (const Nothing) (pName (U.fromString "max")))+  let e = D.ExtensionRange+            { D.ExtensionRange.start = start+            , D.ExtensionRange.end = end+            }+  update' (\s -> s {D.DescriptorProto.extension_range=D.DescriptorProto.extension_range s |> e})++service = pName (U.fromString "service") >> do+  name <- ident1+  f <- subParser (pChar '{' >> subRpc) (mergeEmpty {D.ServiceDescriptorProto.name=Just name})+  update' (\s -> s {D.FileDescriptorProto.service=D.FileDescriptorProto.service s |> f})+       + where subRpc = pChar '}' <|> (choice [ eol+                                      , rpc+                                      , pOption >>= setOption+                                      ] >> subRpc)+       rpc = pName (U.fromString "rpc") >> do+               name <- ident1+               input <- between (pChar '(') (pChar ')') ident1+               pName (U.fromString "returns")+               output <- between (pChar '(') (pChar ')') ident1+               eol+               let m = D.MethodDescriptorProto+                         { D.MethodDescriptorProto.name=Just name+                         , D.MethodDescriptorProto.input_type=Just input+                         , D.MethodDescriptorProto.output_type=Just output+                         , D.MethodDescriptorProto.options=Nothing+                         }+               update' (\s -> s {D.ServiceDescriptorProto.method=D.ServiceDescriptorProto.method s |> m})+       setOption optName = do+         -- old <- fmap (maybe mergeEmpty id . D.ServiceDescriptorProto.options) getState+         case optName of+           s -> unexpected $ "There are no options for services (when this parser was written): "++s++{-+-- see google's stubs/strutil.cc lines 398-449/1121 and C99 specification+-- This mainly targets three digit octal codes+cEncode :: [Word8] -> [Char]+cEncode = concatMap one where+  one :: Word8 -> [Char]+  one x | (32 <= x) && (x < 127) = [toEnum .  fromEnum $  x]  -- main case of unescaped value+  one 9 = sl  't'+  one 10 = sl 'n'+  one 13 = sl 'r'+  one 34 = sl '"'+  one 39 = sl '\''+  one 92 = sl '\\'+  one 0 = '\\':"000"+  one x | x < 8 = '\\':'0':'0':(showOct x "")+        | x < 64 = '\\':'0':(showOct x "")+        | otherwise = '\\':(showOct x "")+  sl c = ['\\',c]+-}
+ hprotoc/Text/ProtocolBuffers/ProtoCompile/Resolve.hs view
@@ -0,0 +1,354 @@+-- | Text.ProtocolBuffers.Resolve takes the output of Text.ProtocolBuffers.Parse and runs all+-- the preprocessing and sanity checks that precede Text.ProtocolBuffers.Gen creating modules.+--+-- Currently this involves mangling the names, building a NameSpace (or [NameSpace]), and making+-- all the names fully qualified (and setting TYPE_MESSAGE or TYPE_ENUM) as appropriate.+-- Field names are also checked against a list of reserved words, appending a single quote+-- to disambiguate.+-- All names from Parser should start with a letter, but _ is also handled by replacing with U' or u'.+-- Anything else will trigger a "subborn ..." error.+-- Name resolution failure are not handled elegantly: it will kill the system with a long error message.+--+-- TODO: treat names with leading "." as already "fully-qualified"+--       make sure the optional fields that will be needed are not Nothing (or punt to Reflections.hs)+--       look for repeated use of the same name (before and after mangling)+module Text.ProtocolBuffers.ProtoCompile.Resolve(loadProto,resolveFDP) where++import qualified Text.DescriptorProtos.DescriptorProto                as D(DescriptorProto)+import qualified Text.DescriptorProtos.DescriptorProto                as D.DescriptorProto(DescriptorProto(..))+import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D(ExtensionRange(ExtensionRange))+import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.ExtensionRange(ExtensionRange(..))+import qualified Text.DescriptorProtos.EnumDescriptorProto            as D(EnumDescriptorProto)+import qualified Text.DescriptorProtos.EnumDescriptorProto            as D.EnumDescriptorProto(EnumDescriptorProto(..))+import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D(EnumValueDescriptorProto)+import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D.EnumValueDescriptorProto(EnumValueDescriptorProto(..))+import qualified Text.DescriptorProtos.FieldDescriptorProto           as D.FieldDescriptorProto(FieldDescriptorProto(..))+import qualified Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto(Type)+import           Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto.Type(Type(..))+import qualified Text.DescriptorProtos.FileDescriptorProto            as D(FileDescriptorProto(FileDescriptorProto))+import qualified Text.DescriptorProtos.FileDescriptorProto            as D.FileDescriptorProto(FileDescriptorProto(..))+import qualified Text.DescriptorProtos.FileOptions                    as D.FileOptions(FileOptions(..))+import qualified Text.DescriptorProtos.MethodDescriptorProto          as D(MethodDescriptorProto)+import qualified Text.DescriptorProtos.MethodDescriptorProto          as D.MethodDescriptorProto(MethodDescriptorProto(..))+import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D.ServiceDescriptorProto(ServiceDescriptorProto(..))++import Text.ProtocolBuffers.Header+import Text.ProtocolBuffers.ProtoCompile.Parser++import Control.Monad.State+import Data.Char+import Data.Ix(inRange)+import qualified Data.Foldable as F+import qualified Data.Set as Set+import Data.Maybe(fromMaybe,catMaybes)+import Data.Monoid(Monoid(..))+import Data.Map(Map)+import qualified Data.Map as M+import Data.List(unfoldr,span,inits,foldl')+import qualified Data.ByteString.Lazy.UTF8 as U+import qualified Data.ByteString.Lazy.Char8 as LC+import System.Directory+import System.FilePath++err :: forall b. String -> b+err s = error $ "Text.ProtocolBuffers.Resolve fatal error encountered, message:\n"++indent s+  where indent = unlines . map (\str -> ' ':' ':str) . lines++encodeModuleNames :: [String] -> Utf8+encodeModuleNames [] = Utf8 mempty+encodeModuleNames xs = Utf8 . U.fromString . foldr1 (\a b -> a ++ '.':b) $ xs++mangleCap :: Maybe Utf8 -> [String]+mangleCap = mangleModuleNames . fromMaybe (Utf8 mempty)+  where mangleModuleNames :: Utf8 -> [String]+        mangleModuleNames bs = map mangleModuleName . splitDot . toString $ bs+        splitDot :: String -> [String]+        splitDot = unfoldr s where+          s ('.':xs) = s xs+          s [] = Nothing+          s xs = Just (span ('.'/=) xs)++mangleCap1 :: Maybe Utf8 -> String+mangleCap1 Nothing = ""+mangleCap1 (Just u) = mangleModuleName . toString $ u++mangleEnums :: Seq D.EnumValueDescriptorProto -> Seq D.EnumValueDescriptorProto+mangleEnums s =  fmap fixEnum s+  where fixEnum v = v { D.EnumValueDescriptorProto.name = mangleEnum (D.EnumValueDescriptorProto.name v)}++mangleEnum :: Maybe Utf8 -> Maybe Utf8+mangleEnum = fmap (Utf8 . U.fromString . mangleModuleName . toString)++mangleModuleName :: String -> String+mangleModuleName [] = "Empty'Name" -- XXX+mangleModuleName ('_':xs) = "U'"++xs+mangleModuleName (x:xs) | isLower x = let x' = toUpper x+                                      in if isLower x' then err ("subborn lower case"++show (x:xs))+                                           else x': xs+mangleModuleName xs = xs++mangleFieldName :: Maybe Utf8 -> Maybe Utf8+mangleFieldName = fmap (Utf8 . U.fromString . fixname . toString)+  where fixname [] = "empty'name" -- XXX+        fixname ('_':xs) = "u'"++xs+        fixname (x:xs) | isUpper x = let x' = toLower x+                                     in if isUpper x' then err ("stubborn upper case: "++show (x:xs))+                                          else fixname (x':xs)+        fixname xs | xs `elem` reserved = xs ++ "'"+        fixname xs = xs+        reserved :: [String]+        reserved = ["case","class","data","default","deriving","do","else","foreign"+                   ,"if","import","in","infix","infixl","infixr","instance"+                   ,"let","module","newtype","of","then","type","where"] -- also reserved is "_"++checkER :: [(Int32,Int32)] -> Int32 -> Bool+checkER ers fid = any (`inRange` fid) ers++extRangeList :: D.DescriptorProto -> [(Int32,Int32)]+extRangeList d = concatMap check unchecked+  where check x@(lo,hi) | hi < lo = []+                        | hi<19000 || 19999<lo  = [x]+                        | otherwise = concatMap check [(lo,18999),(20000,hi)]+        unchecked = F.foldr ((:) . extToPair) [] (D.DescriptorProto.extension_range d)+        extToPair (D.ExtensionRange+                    { D.ExtensionRange.start = start+                    , D.ExtensionRange.end = end }) =+          (getFieldId $ maybe minBound FieldId start, getFieldId $ maybe maxBound FieldId end)++newtype NameSpace = NameSpace {unNameSpace::(Map String ([String],NameType,Maybe NameSpace))}+  deriving (Show,Read)+data NameType = Message [(Int32,Int32)] | Enumeration [Utf8] | Service | Void +  deriving (Show,Read)++type Context = [NameSpace]++seeContext :: Context -> [String] +seeContext cx = map ((++"[]") . concatMap (\k -> show k ++ ", ") . M.keys . unNameSpace) cx++toString :: Utf8 -> String+toString = U.toString . utf8++findFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)+findFile paths target = do+  let test [] = return Nothing+      test (path:rest) = do+        let fullname = combine path target+        found <- doesFileExist fullname+        if found then return (Just fullname)+          else test rest+  test paths++-- loadProto is a slight kludge.  It takes a single search directory+-- and an initial .proto file path relative to this directory.  It+-- loads this file and then chases the imports.  If an import loop is+-- detected then it aborts.  A state monad is used to memorize+-- previous invocations of 'load'.  A progress message of the filepath+-- is printed before reading a new .proto file.+--+-- The "contexts" collected and used to "resolveWithContext" can+-- contain duplicates: File A imports B and C, and File B imports C+-- will cause the context for C to be included twice in contexts.+--+-- The result type of loadProto is enough for now, but may be changed+-- in the future.  It returns a map from the files (relative to the+-- search directory) to a pair of the resolved descriptor and a set of+-- directly imported files.  The dependency tree is thus implicit.+loadProto :: [FilePath] -> FilePath -> IO (Map FilePath (D.FileDescriptorProto,Set.Set FilePath,[String]))+loadProto protoDirs protoFile = fmap answer $ execStateT (load Set.empty protoFile) mempty where+  answer built = fmap snd built -- drop the fst Context from the pair in the memorized map+  loadFailed f msg = fail . unlines $ ["Parsing proto:",f,"has failed with message",msg]+  load :: Set.Set FilePath  -- set of "parents" that is used by load to detect an import loop. Not memorized.+       -> FilePath          -- the FilePath to load and resolve (may used memorized result of load)+       -> StateT (Map FilePath (Context,(D.FileDescriptorProto,Set.Set FilePath,[String]))) -- memorized results of load+                 IO (Context  -- Only used during load. This is the view of the file as an imported namespace.+                    ,(D.FileDescriptorProto  -- This is the resolved version of the FileDescriptorProto+                     ,Set.Set FilePath+                     ,[String]))  -- This is the list of file directly imported by the FilePath argument+  load parentsIn file = do+    built <- get -- to check memorized results+    when (Set.member file parentsIn)+         (loadFailed file (unlines ["imports failed: recursive loop detected"+                                   ,unlines . map show . M.assocs $ built,show parentsIn]))+    let parents = Set.insert file parentsIn+    case M.lookup file built of+      Just result -> return result+      Nothing -> do+        mayToRead <- liftIO $ findFile protoDirs file+        when (Nothing == mayToRead) $+           loadFailed file (unlines (["loading failed, could not find file: "++show file+                                     ,"Searched paths were:"] ++ map ("  "++) protoDirs))+        let (Just toRead) = mayToRead+        proto <- liftIO $ do print ("Loading filepath: "++toRead)+                             LC.readFile toRead+        parsed <- either (loadFailed toRead . show) return (parseProto toRead proto)+        let (context,imports,names) = toContext parsed+        contexts <- fmap (concatMap fst)    -- keep only the fst Context's+                    . mapM (load parents)   -- recursively chase imports+                    . Set.toList $ imports+        let result = ( withPackage context parsed ++ contexts+                     , ( resolveWithContext (context++contexts) parsed+                       , imports+                       , names ) )+        -- add to memorized results, the "load" above may have updated/invalidated the "built <- get" state above+        modify (\built' -> M.insert file result built')+        return result++-- Imported names must be fully qualified in the .proto file by the+-- target's package name, but the resolved name might be fully+-- quilified by something else (e.g. one of the java options).+withPackage :: Context -> D.FileDescriptorProto -> Context+withPackage (cx:_) (D.FileDescriptorProto {D.FileDescriptorProto.package=Just package}) =+  let prepend = mangleCap1 . Just $ package+  in [NameSpace (M.singleton prepend ([prepend],Void,Just cx))]+withPackage (_:_) (D.FileDescriptorProto {D.FileDescriptorProto.name=n}) =  err $+  "withPackage given an imported FDP without a package declaration: "++show n+withPackage [] (D.FileDescriptorProto {D.FileDescriptorProto.name=n}) =  err $+  "withPackage given an empty context: "++show n++resolveFDP :: D.FileDescriptorProto.FileDescriptorProto+           -> (D.FileDescriptorProto.FileDescriptorProto, [String])+resolveFDP fdpIn =+  let (context,_,names) = toContext fdpIn+  in (resolveWithContext context fdpIn,names)+  +-- process to get top level context for FDP and list of its imports+toContext :: D.FileDescriptorProto -> (Context,Set.Set FilePath,[String])+toContext protoIn =+  let prefix :: [String]+      prefix = mangleCap . msum $+                 [ D.FileOptions.java_outer_classname =<< (D.FileDescriptorProto.options protoIn)+                 , D.FileOptions.java_package =<< (D.FileDescriptorProto.options protoIn)+                 , D.FileDescriptorProto.package protoIn]+      -- Make top-most root NameSpace+      nameSpace = fromMaybe (NameSpace mempty) $ foldr addPrefix protoNames $ zip prefix (tail (inits prefix))+        where addPrefix (s1,ss) ns = Just . NameSpace $ M.singleton s1 (ss,Void,ns)+              protoNames | null protoMsgs = Nothing+                         | otherwise = Just . NameSpace . M.fromList $ protoMsgs+                where protoMsgs = F.foldr ((:) . msgNames prefix) protoEnums (D.FileDescriptorProto.message_type protoIn)+                      protoEnums = F.foldr ((:) . enumNames prefix) protoServices (D.FileDescriptorProto.enum_type protoIn)+                      protoServices = F.foldr ((:) . serviceNames prefix) [] (D.FileDescriptorProto.service protoIn)+                      msgNames context dIn =+                        let s1 = mangleCap1 (D.DescriptorProto.name dIn)+                            ss' = context ++ [s1]+                            dNames | null dMsgs = Nothing+                                   | otherwise = Just . NameSpace . M.fromList $ dMsgs+                            dMsgs = F.foldr ((:) . msgNames ss') dEnums (D.DescriptorProto.nested_type dIn)+                            dEnums = F.foldr ((:) . enumNames ss') [] (D.DescriptorProto.enum_type dIn)+                        in ( s1 , (ss',Message (extRangeList dIn),dNames) )+                      enumNames context eIn = -- XXX todo mangle enum names ? No+                        let s1 = mangleCap1 (D.EnumDescriptorProto.name eIn)+                            values :: [Utf8]+                            values = catMaybes $ map D.EnumValueDescriptorProto.name (F.toList (D.EnumDescriptorProto.value eIn))+                        in ( s1 , (context ++ [s1],Enumeration values,Nothing) )+                      serviceNames context sIn =+                        let s1 = mangleCap1 (D.ServiceDescriptorProto.name sIn)+                        in ( s1 , (context ++ [s1],Service,Nothing) )+      -- Context stack for resolving the top level declarations+      protoContext :: Context+      protoContext = foldl' (\nss@(NameSpace ns:_) pre -> case M.lookup pre ns of+                                                            Just (_,Void,Just ns1) -> (ns1:nss)+                                                            _ -> nss) [nameSpace] prefix+  in ( protoContext+     , Set.fromList (map toString (F.toList (D.FileDescriptorProto.dependency protoIn)))+     , prefix+     )++resolveWithContext :: Context -> D.FileDescriptorProto -> D.FileDescriptorProto+resolveWithContext protoContext protoIn =+  let rerr msg = err $ "Failure while resolving file descriptor proto whose name is "+                       ++ maybe "<empty name>" toString (D.FileDescriptorProto.name protoIn)++"\n"+                       ++ msg+      descend :: Context -> Maybe Utf8 -> Context -- XXX todo take away the maybe +      descend cx@(NameSpace n:_) name =+        case M.lookup mangled n of+          Just (_,_,Nothing) -> cx+          Just (_,_,Just ns1) -> ns1:cx+          x -> rerr $ "*** Name resolution failed when descending:\n"++unlines (mangled : show x : "KNOWN NAMES" : seeContext cx)+       where mangled = mangleCap1 name -- XXX empty on nothing?+      descend [] _ = []+      resolve :: Context -> Maybe Utf8 -> Maybe Utf8+      resolve _context Nothing = Nothing+      resolve context (Just bs) = fmap fst (resolveWithNameType context bs)+      resolveWithNameType :: Context -> Utf8 -> Maybe (Utf8,NameType)+      resolveWithNameType context bsIn =+        let nameIn = mangleCap (Just bsIn)+            errMsg = "*** Name resolution failed:\n"+                     ++unlines ["Unmangled name: "++show bsIn+                               ,"Mangled name: "++show nameIn+                               ,"List of known names:"]+                     ++ unlines (seeContext context)+            resolver [] (NameSpace _cx) = rerr $ "Impossible? case in Text.ProtocolBuffers.Resolve.resolveWithNameType.resolver []\n" ++ errMsg+            resolver [name] (NameSpace cx) = case M.lookup name cx of+                                               Nothing -> Nothing+                                               Just (fqName,nameType,_) -> Just (encodeModuleNames fqName,nameType)+            resolver (name:rest) (NameSpace cx) = case M.lookup name cx of+                                                    Nothing -> Nothing+                                                    Just (_,_,Nothing) -> Nothing+                                                    Just (_,_,Just cx') -> resolver rest cx'+        in case msum . map (resolver nameIn) $ context of+             Nothing -> rerr errMsg+             Just x -> Just x+      processFDP fdp = fdp+        { D.FileDescriptorProto.message_type = fmap (processMSG protoContext) (D.FileDescriptorProto.message_type fdp)+        , D.FileDescriptorProto.enum_type    = fmap (processENM protoContext) (D.FileDescriptorProto.enum_type fdp)+        , D.FileDescriptorProto.service      = fmap (processSRV protoContext) (D.FileDescriptorProto.service fdp)+        , D.FileDescriptorProto.extension    = fmap (processFLD protoContext Nothing) (D.FileDescriptorProto.extension fdp) }+      processMSG cx msg = msg+        { D.DescriptorProto.name        = self+        , D.DescriptorProto.field       = fmap (processFLD cx' self) (D.DescriptorProto.field msg)+        , D.DescriptorProto.extension   = fmap (processFLD cx' self) (D.DescriptorProto.extension msg)+        , D.DescriptorProto.nested_type = fmap (processMSG cx') (D.DescriptorProto.nested_type msg)+        , D.DescriptorProto.enum_type   = fmap (processENM cx') (D.DescriptorProto.enum_type msg) }+       where cx' = descend cx (D.DescriptorProto.name msg)+             self = resolve cx (D.DescriptorProto.name msg)+      processFLD cx mp f = f { D.FieldDescriptorProto.name          = mangleFieldName (D.FieldDescriptorProto.name f)+                             , D.FieldDescriptorProto.type'         = new_type'+                             , D.FieldDescriptorProto.type_name     = if new_type' == Just TYPE_GROUP+                                                                        then groupName+                                                                        else fmap fst r2+                             , D.FieldDescriptorProto.default_value = checkEnumDefault+                             , D.FieldDescriptorProto.extendee      = fmap newExt (D.FieldDescriptorProto.extendee f)}+       where newExt :: Utf8 -> Utf8+             newExt orig = let e2 = resolveWithNameType cx orig+                           in case (e2,D.FieldDescriptorProto.number f) of+                                (Just (newName,Message ers),Just fid) ->+                                  if checkER ers fid then newName+                                    else rerr $ "*** Name resolution found an extension field that is out of the allowed extension ranges: "++show f ++ "\n has a number "++ show fid ++" not in one of the valid ranges: " ++ show ers+                                (Just _,_) -> rerr $ "*** Name resolution found wrong type for "++show orig++" : "++show e2+                                (Nothing,Just {}) -> rerr $ "*** Name resolution failed for the extendee: "++show f+                                (_,Nothing) -> rerr $ "*** No field id number for the extension field: "++show f+             r2 = fmap (fromMaybe (rerr $ "*** Name resolution failed for the type_name of extension field: "++show f)+                         . (resolveWithNameType cx))+                       (D.FieldDescriptorProto.type_name f)+             t (Message {}) = TYPE_MESSAGE+             t (Enumeration {}) = TYPE_ENUM+             t _ = rerr $ unlines [ "Problem found: processFLD cannot resolve type_name to Void or Service"+                                  , "  The parent message is "++maybe "<no message>" toString mp+                                  , "  The field name is "++maybe "<no field name>" toString (D.FieldDescriptorProto.name f)]+             new_type' = (D.FieldDescriptorProto.type' f) `mplus` (fmap (t.snd) r2)+             checkEnumDefault = case (D.FieldDescriptorProto.default_value f,fmap snd r2) of+                                  (Just name,Just (Enumeration values)) | name  `elem` values -> mangleEnum (Just name)+                                                                        | otherwise ->+                                      rerr $ unlines ["Problem found: default enumeration value not recognized:"+                                                     ,"  The parent message is "++maybe "<no message>" toString mp+                                                     ,"  field name is "++maybe "" toString (D.FieldDescriptorProto.name f)+                                                     ,"  bad enum name is "++show (toString name)+                                                     ,"  possible enum values are "++show (map toString values)]+                                  (Just def,_) | new_type' == Just TYPE_MESSAGE+                                                 || new_type' == Just TYPE_GROUP ->+                                    rerr $ "Problem found: You set a default value for a MESSAGE or GROUP: "++unlines [show def,show f]+                                  (maybeDef,_) -> maybeDef+  +             groupName = case mp of+                           Nothing -> resolve cx (D.FieldDescriptorProto.name f)+                           Just p -> do n <- D.FieldDescriptorProto.name f+                                        return (Utf8 . U.fromString . (toString p++) . ('.':) . mangleModuleName . toString $ n)++      processENM cx e = e { D.EnumDescriptorProto.name = resolve cx (D.EnumDescriptorProto.name e)+                          , D.EnumDescriptorProto.value = mangleEnums (D.EnumDescriptorProto.value e) }+      processSRV cx s = s { D.ServiceDescriptorProto.name   = resolve cx (D.ServiceDescriptorProto.name s)+                          , D.ServiceDescriptorProto.method = fmap (processMTD cx) (D.ServiceDescriptorProto.method s) }+      processMTD cx m = m { D.MethodDescriptorProto.name        = mangleFieldName (D.MethodDescriptorProto.name m)+                          , D.MethodDescriptorProto.input_type  = resolve cx (D.MethodDescriptorProto.input_type m)+                          , D.MethodDescriptorProto.output_type = resolve cx (D.MethodDescriptorProto.output_type m) }+  in processFDP protoIn
+ hprotoc/hprotoc.cabal view
@@ -0,0 +1,60 @@+name:           hprotoc+-- Synchronize this version number with Text.ProtocolBuffers.ProtocolCompile.version+version:        0.2.8+cabal-version:  >= 1.2+build-type:     Simple+license:        BSD3+license-file:   LICENSE+copyright:      (c) 2008 Christopher Edward Kuklewicz+author:         Christopher Edward Kuklewicz+maintainer:     Chris Kuklewicz <protobuf@personal.mightyreason.com>+stability:      Experimental+homepage:       http://hackage.haskell.org/cgi-bin/hackage-scripts/package/protocol-buffers+package-url:    http://darcs.haskell.org/packages/protocol-buffers2/+synopsis:       Parse Google Protocol Buffer specifications+description:    Parse http://code.google.com/apis/protocolbuffers/docs/proto.html+  and perhaps general haskell code to use them+category:       Text+Tested-With:    GHC ==6.8.3+extra-source-files:++flag small_base+    description: Choose the new smaller, split-up base package.++Executable hprotoc+  Main-Is:         Text/ProtocolBuffers/ProtoCompile.hs+  build-tools:     alex+  ghc-options:     -O2 -Wall+  build-depends:   protocol-buffers == 0.2.8, protocol-buffers-descriptor == 0.2.8+  build-depends:   binary, utf8-string+  build-depends:   parsec, haskell-src+  if flag(small_base)+        build-depends: base >= 3,+                       containers,+                       bytestring,+                       array,+                       filepath,+                       directory,+                       mtl,+                       QuickCheck+  else+        build-depends: base < 3+  other-modules:   Text.ProtocolBuffers.ProtoCompile.Gen+                   Text.ProtocolBuffers.ProtoCompile.Instances+                   Text.ProtocolBuffers.ProtoCompile.Lexer+                   Text.ProtocolBuffers.ProtoCompile.MakeReflections+                   Text.ProtocolBuffers.ProtoCompile.Parser+                   Text.ProtocolBuffers.ProtoCompile.Resolve+  extensions:      DeriveDataTypeable,+                   EmptyDataDecls,+                   FlexibleInstances,+                   GADTs,+                   GeneralizedNewtypeDeriving,+                   MagicHash,+                   PatternGuards,+                   RankNTypes,+                   ScopedTypeVariables,+                   TypeSynonymInstances,+                   MultiParamTypeClasses,+                   FunctionalDependencies+
protocol-buffers.cabal view
@@ -1,5 +1,5 @@ name:           protocol-buffers-version:        0.1.0+version:        0.2.8 cabal-version:  >= 1.2 build-type:     Simple license:        BSD3@@ -9,73 +9,61 @@ maintainer:     Chris Kuklewicz <protobuf@personal.mightyreason.com> stability:      Experimental homepage:       http://hackage.haskell.org/cgi-bin/hackage-scripts/package/protocol-buffers-package-url:    http://darcs.haskell.org/packages/protocol-buffers/+package-url:    http://darcs.haskell.org/packages/protocol-buffers2/ synopsis:       Parse Google Protocol Buffer specifications-description:    Parse http://code.google.com/apis/protocolbuffers/docs/proto.html-  and perhaps general haskell code to use them+description:    Parse proto files and generate Haskell code. category:       Text-Tested-With: GHC ==6.8.3--- data-files:+Tested-With:    GHC ==6.8.3+--data-files:      extra-source-files: Setup.hs                     doc.txt-                    test+                    TODO+                    README+                    Skeleton.hs-boot+                    descriptor.proto+                    google/protobuf/unittest.proto+                    google/protobuf/unittest_import.proto -- extra-tmp-files:  flag small_base     description: Choose the new smaller, split-up base package.  Library-  exposed-modules: Text.DescriptorProtos-                   Text.DescriptorProtos.DescriptorProto.ExtensionRange-                   Text.DescriptorProtos.DescriptorProto-                   Text.DescriptorProtos.EnumDescriptorProto-                   Text.DescriptorProtos.EnumOptions-                   Text.DescriptorProtos.EnumValueDescriptorProto-                   Text.DescriptorProtos.EnumValueOptions-                   Text.DescriptorProtos.FieldDescriptorProto.Label-                   Text.DescriptorProtos.FieldDescriptorProto.Type-                   Text.DescriptorProtos.FieldDescriptorProto-                   Text.DescriptorProtos.FieldOptions.CType-                   Text.DescriptorProtos.FieldOptions-                   Text.DescriptorProtos.FileDescriptorProto-                   Text.DescriptorProtos.FileOptions.OptimizeMode-                   Text.DescriptorProtos.FileOptions-                   Text.DescriptorProtos.MessageOptions-                   Text.DescriptorProtos.MethodDescriptorProto-                   Text.DescriptorProtos.MethodOptions-                   Text.DescriptorProtos.ServiceDescriptorProto-                   Text.DescriptorProtos.ServiceOptions+-- fvia-C is needed on OS X powerPC (G4) with WireMessage.hs to prevent a GHC crash+  ghc-options:  -Wall -O2+  exposed-modules: Text.ProtocolBuffers                    Text.ProtocolBuffers.Basic-                   Text.ProtocolBuffers.BootStrap                    Text.ProtocolBuffers.Default-                   Text.ProtocolBuffers.DeriveMergeable-                   Text.ProtocolBuffers.Gen+                   Text.ProtocolBuffers.Extensions                    Text.ProtocolBuffers.Get                    Text.ProtocolBuffers.Header-                   Text.ProtocolBuffers.Instances-                   Text.ProtocolBuffers.Lexer                    Text.ProtocolBuffers.Mergeable-                   Text.ProtocolBuffers.Parser                    Text.ProtocolBuffers.Reflections-                   Text.ProtocolBuffers.Resolve                    Text.ProtocolBuffers.WireMessage    if flag(small_base)         build-depends: base >= 3,                        containers,                        bytestring,-                       array+                       array,+                       filepath,+                       directory,+                       mtl,+                       QuickCheck   else         build-depends: base < 3 -  build-depends:   binary, binary-strict, derive, parsec, utf8-string, haskell-src-exts-  extensions:      GADTs,+  build-depends:   binary, parsec, utf8-string, haskell-src+-- Most of these are needed for protocol-buffers (Get and WireMessage.hs)+  extensions:      DeriveDataTypeable,                    EmptyDataDecls,-                   TemplateHaskell,-                   DeriveDataTypeable,                    FlexibleInstances,-                   PatternGuards,-                   MagicHash,+                   GADTs,                    GeneralizedNewtypeDeriving,+                   MagicHash,+                   PatternGuards,+                   RankNTypes,                    ScopedTypeVariables,-                   RankNTypes+                   TypeSynonymInstances,+                   MultiParamTypeClasses,+                   FunctionalDependencies
− test 
@@ -1,16 +0,0 @@-//I START WITH A COMMENT--// Currently keeps the LAST package statement-package i.will.be.ignored;-package i.will.be.kept;--// Not quite ready yet-// option java_outer_classname = "Super.Proto.First";-// option java_outer_classname = 'Super.Proto.Middle';-// option java_outer_classname = "Super.Proto.Last";-- ; // Extra semicolon--message Whee-- ;  ; message Whoops;
+ tests/Arb.hs view
@@ -0,0 +1,110 @@+-- | The "Arb" module defined Arbitrary instances for all the basic types+module Arb where++import Test.QuickCheck+import System.Random+import qualified Data.Sequence as Seq+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.UTF8 as U+import Text.ProtocolBuffers.Basic+import Data.Word(Word8)++arb :: Gen a -> IO a+arb g = do+   s <- getStdGen+   let (s1,s2) = split s+   setStdGen s1+   let (i,s2') = random s2+   return $ generate i s2' g++integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)+integralRandomR  (a,b) g =+  case randomR (fromIntegral a :: Integer,fromIntegral b :: Integer) g of+    (x,g) -> (fromIntegral x, g)++minmax :: Bounded a => (a,a)+minmax = (minBound,maxBound)++barb :: (Enum a,Bounded a) => Gen a+barb = elements [minBound..maxBound]++bcoarb :: Enum a => a -> Gen b -> Gen b+bcoarb a = variant ((fromEnum a) `rem` 4)++class ArbCon a x where+  futz :: a -> Gen x++instance ArbCon a a where futz = return++instance (Arbitrary a,ArbCon b x) => ArbCon (a -> b) x where+  futz f = arbitrary >>= futz . f++instance Arbitrary Int32 where+  arbitrary = choose minmax+  coarbitrary n = variant (fromIntegral ((fromIntegral n) `rem` 4))++instance Random Int32 where+  randomR = integralRandomR+  random = randomR minmax++instance Arbitrary Int64 where+  arbitrary = choose minmax+  coarbitrary n = variant (fromIntegral ((fromIntegral n) `rem` 4))++instance Random Int64 where+  randomR = integralRandomR+  random = randomR minmax++instance Arbitrary Word32 where+  arbitrary = choose minmax+  coarbitrary n = variant (fromIntegral ((fromIntegral n) `rem` 4))++instance Random Word32 where+  randomR = integralRandomR+  random = randomR minmax++instance Arbitrary Word64 where+  arbitrary = choose minmax+  coarbitrary n = variant (fromIntegral ((fromIntegral n) `rem` 4))++instance Random Word64 where+  randomR = integralRandomR+  random = randomR minmax++instance Arbitrary Word8 where+  arbitrary = choose minmax+  coarbitrary n = variant (fromIntegral ((fromIntegral n) `rem` 4))++instance Random Word8 where+  randomR = integralRandomR+  random = randomR minmax++instance Arbitrary Char where+  arbitrary = choose minmax+  coarbitrary n = variant (fromIntegral ((fromEnum n) `rem` 4))++instance Arbitrary Utf8 where+  arbitrary = do +    len <- frequency+             [ (3, choose (1,3))+             , (1, return 0) ]+    fmap (Utf8 . U.fromString) (vector len)+  coarbitrary (Utf8 s) = variant (fromIntegral ((L.length s) `rem` 4))++instance Arbitrary L.ByteString where+  arbitrary = do+    len <- frequency+             [ (3, choose (1,3))+             , (1, return 0) ]+    fmap L.pack (vector len)+  coarbitrary s = variant (fromIntegral ((L.length s) `rem` 4))++instance Arbitrary a => Arbitrary (Seq a) where+  arbitrary = do+    len <- frequency+             [ (3, choose (1,3))+             , (1, return 0) ]+    fmap Seq.fromList (vector len)+  coarbitrary s = variant ((Seq.length s) `rem` 4)++
+ tests/Arb/UnittestProto.hs view
@@ -0,0 +1,224 @@+-- everything passes version 0.2.7+module Arb.UnittestProto where++import Arb++import qualified Data.ByteString.Lazy as L+import qualified Data.Foldable as F+import qualified Data.Sequence as Seq+import Numeric+import Test.QuickCheck+import Text.ProtocolBuffers+import Text.ProtocolBuffers.Header(prependMessageSize,putSize)++import Text.ProtocolBuffers.Basic+import Text.ProtocolBuffers.WireMessage+import Text.ProtocolBuffers.Extensions++import Com.Google.Protobuf.Test.ImportEnum(ImportEnum(..))+import Com.Google.Protobuf.Test.ImportMessage(ImportMessage(..))+import UnittestProto.ForeignEnum(ForeignEnum(..))+import UnittestProto.ForeignMessage(ForeignMessage(..))+import UnittestProto.TestAllTypes.NestedEnum(NestedEnum(..))+import UnittestProto.TestAllTypes.NestedMessage(NestedMessage(..))+import UnittestProto.TestAllTypes.OptionalGroup(OptionalGroup(..))+import UnittestProto.TestAllTypes.RepeatedGroup(RepeatedGroup(..))++import UnittestProto.TestAllTypes(TestAllTypes(..))++import UnittestProto+import UnittestProto.TestRequired+import UnittestProto.OptionalGroup_extension (OptionalGroup_extension(..))+import UnittestProto.RepeatedGroup_extension (RepeatedGroup_extension(..))+import UnittestProto.TestAllExtensions (TestAllExtensions(..))++import Debug.Trace(trace)++instance Arbitrary ImportEnum where arbitrary = barb+instance Arbitrary ForeignEnum where arbitrary = barb+instance Arbitrary NestedEnum where arbitrary = barb++instance Arbitrary ImportMessage where arbitrary = futz ImportMessage+instance Arbitrary ForeignMessage where arbitrary = futz ForeignMessage+instance Arbitrary NestedMessage where arbitrary = futz NestedMessage+instance Arbitrary OptionalGroup where arbitrary = futz OptionalGroup+instance Arbitrary RepeatedGroup where arbitrary = futz RepeatedGroup+instance Arbitrary TestAllTypes where arbitrary = futz TestAllTypes++instance Arbitrary TestRequired where arbitrary = futz TestRequired+instance Arbitrary OptionalGroup_extension where arbitrary = futz OptionalGroup_extension+instance Arbitrary RepeatedGroup_extension where arbitrary = futz RepeatedGroup_extension++instance Arbitrary TestAllExtensions where+  arbitrary = F.foldlM (\msg alter -> alter msg) defaultValue (map snd allKeys)++-- Test passes up to 100000+prop_SizeCalcTo limit = all prop_SizeCalc [0..limit] where+  prop_SizeCalc i = prependMessageSize i == i + (L.length . runPut . putSize $ i)++-- quickCheck : TestAllTypes passes 100+prop_Size1 :: forall msg. (ReflectDescriptor msg, Wire msg) => msg -> Bool+prop_Size1 a =+  let predicted = messageSize a+      written = L.length (messagePut a)+  in if predicted == written then True+       else trace ("Wrong size: "++show(predicted,written)) False++-- quickCheck : TestAllTypes passes 100+prop_Size2 :: forall msg. (ReflectDescriptor msg, Wire msg) => msg -> Bool+prop_Size2 a =+  let predicted = messageWithLengthSize a+      written = L.length (messageWithLengthPut a)+  in if predicted == written then True+       else trace ("Wrong size: "++show(predicted,written)) False++-- convert with no header+prop_WireArb1 :: (Show a,Eq a,Arbitrary a,ReflectDescriptor a,Wire a) => a -> Bool+prop_WireArb1 a =+   case messageGet (messagePut a) of+     Right (a',b) | L.null b -> if a==a' then True+                                  else trace ("Unequal\n" ++ show a ++ "\n\n" ++show a') False+                  | otherwise -> trace ("Not all input consumed: "++show (L.length b)++"\n"++ show a ++ "\n\n" ++show (L.unpack (messagePut a))) False+     Left msg -> trace msg False++type G x = Either String (x,ByteString)++-- main method of serialing messages+prop_WireArb3 :: (Show a,Eq a,Arbitrary a,ReflectDescriptor a,Wire a) => a -> Bool+prop_WireArb3 aIn =+   let unused = aIn==a+       Right (a,_) = messageGet (messagePut aIn) in+   case messageGet (messagePut a) of+     Right (a',b) | L.null b -> if a==a' then True+                                  else trace ("Unequal\n" ++ show a ++ "\n\n" ++show a') False+                  | otherwise -> trace ("Not all input consumed: "++show (L.length b)) False+     Left msg -> trace msg False++-- convert with with header+prop_WireArb2 :: (Eq a,Arbitrary a,ReflectDescriptor a,Wire a) => a -> Bool+prop_WireArb2 a =+   case messageWithLengthGet (messageWithLengthPut a) of+     Right (a',b) | L.null b -> if a==a' then True+                                  else trace ("Unequal") False+                  | otherwise -> trace ("Not all input consumed: "++show (L.length b)) False+     Left msg -> trace msg False++-- used in allKeys+maybeKey :: Arbitrary v => Key Maybe msg v -> msg -> Gen msg+maybeKey k = \msg -> do+  b <- choose (False,True)+  if b then return msg+    else do+  v <- arbitrary+  return (putExt k (Just v) msg)++-- used in allKeys+seqKey :: Arbitrary v => Key Seq msg v -> msg -> Gen msg+seqKey k = \msg -> do+  n <- choose (0,3)+  v <- vector n+  return (putExt k (Seq.fromList v) msg)++-- Really push the extension system by creating two new keys here, one+-- for Maybe code and one for Seq code testing.+newOptKey :: Key Maybe TestAllExtensions Int32+newOptKey = Key 1000000 15 Nothing++newRepKey :: Key Seq TestAllExtensions Utf8+newRepKey = Key 1000001 9 Nothing++-- This is all 70 known for TestAllExtensions plus the two above.+-- The String names are currently discarded.+allKeys :: [ ( String , TestAllExtensions -> Gen TestAllExtensions ) ]+allKeys = +  [ ( "newOptKey" , maybeKey newOptKey )+  , ( "newRepKey" , seqKey newRepKey )+  , ( "single" , maybeKey single )+  , ( "multi" , seqKey multi )+  , ( "optional_int32_extension" , maybeKey optional_int32_extension )+  , ( "optional_int64_extension" , maybeKey optional_int64_extension )+  , ( "optional_uint32_extension" , maybeKey optional_uint32_extension )+  , ( "optional_uint64_extension" , maybeKey optional_uint64_extension )+  , ( "optional_sint32_extension" , maybeKey optional_sint32_extension )+  , ( "optional_sint64_extension" , maybeKey optional_sint64_extension )+  , ( "optional_fixed32_extension" , maybeKey optional_fixed32_extension )+  , ( "optional_fixed64_extension" , maybeKey optional_fixed64_extension )+  , ( "optional_sfixed32_extension" , maybeKey optional_sfixed32_extension )+  , ( "optional_sfixed64_extension" , maybeKey optional_sfixed64_extension )+  , ( "optional_float_extension" , maybeKey optional_float_extension )+  , ( "optional_double_extension" , maybeKey optional_double_extension )+  , ( "optional_bool_extension" , maybeKey optional_bool_extension )+  , ( "optional_string_extension" , maybeKey optional_string_extension )+  , ( "optional_bytes_extension" , maybeKey optional_bytes_extension )+  , ( "optionalGroup_extension" , maybeKey optionalGroup_extension )+  , ( "optional_nested_message_extension" , maybeKey optional_nested_message_extension )+  , ( "optional_foreign_message_extension" , maybeKey optional_foreign_message_extension )+  , ( "optional_import_message_extension" , maybeKey optional_import_message_extension )+  , ( "optional_nested_enum_extension" , maybeKey optional_nested_enum_extension )+  , ( "optional_foreign_enum_extension" , maybeKey optional_foreign_enum_extension )+  , ( "optional_import_enum_extension" , maybeKey optional_import_enum_extension )+  , ( "optional_string_piece_extension" , maybeKey optional_string_piece_extension )+  , ( "optional_cord_extension" , maybeKey optional_cord_extension )+  , ( "repeated_int32_extension" , seqKey repeated_int32_extension )+  , ( "repeated_int64_extension" , seqKey repeated_int64_extension )+  , ( "repeated_uint32_extension" , seqKey repeated_uint32_extension )+  , ( "repeated_uint64_extension" , seqKey repeated_uint64_extension )+  , ( "repeated_sint32_extension" , seqKey repeated_sint32_extension )+  , ( "repeated_sint64_extension" , seqKey repeated_sint64_extension )+  , ( "repeated_fixed32_extension" , seqKey repeated_fixed32_extension )+  , ( "repeated_fixed64_extension" , seqKey repeated_fixed64_extension )+  , ( "repeated_sfixed32_extension" , seqKey repeated_sfixed32_extension )+  , ( "repeated_sfixed64_extension" , seqKey repeated_sfixed64_extension )+  , ( "repeated_float_extension" , seqKey repeated_float_extension )+  , ( "repeated_double_extension" , seqKey repeated_double_extension )+  , ( "repeated_bool_extension" , seqKey repeated_bool_extension )+  , ( "repeated_string_extension" , seqKey repeated_string_extension )+  , ( "repeated_bytes_extension" , seqKey repeated_bytes_extension )+  , ( "repeatedGroup_extension" , seqKey repeatedGroup_extension )+  , ( "repeated_nested_message_extension" , seqKey repeated_nested_message_extension )+  , ( "repeated_foreign_message_extension" , seqKey repeated_foreign_message_extension )+  , ( "repeated_import_message_extension" , seqKey repeated_import_message_extension )+  , ( "repeated_nested_enum_extension" , seqKey repeated_nested_enum_extension )+  , ( "repeated_foreign_enum_extension" , seqKey repeated_foreign_enum_extension )+  , ( "repeated_import_enum_extension" , seqKey repeated_import_enum_extension )+  , ( "repeated_string_piece_extension" , seqKey repeated_string_piece_extension )+  , ( "repeated_cord_extension" , seqKey repeated_cord_extension )+  , ( "default_int32_extension" , maybeKey default_int32_extension )+  , ( "default_int64_extension" , maybeKey default_int64_extension )+  , ( "default_uint32_extension" , maybeKey default_uint32_extension )+  , ( "default_uint64_extension" , maybeKey default_uint64_extension )+  , ( "default_sint32_extension" , maybeKey default_sint32_extension )+  , ( "default_sint64_extension" , maybeKey default_sint64_extension )+  , ( "default_fixed32_extension" , maybeKey default_fixed32_extension )+  , ( "default_fixed64_extension" , maybeKey default_fixed64_extension )+  , ( "default_sfixed32_extension" , maybeKey default_sfixed32_extension )+  , ( "default_sfixed64_extension" , maybeKey default_sfixed64_extension )+  , ( "default_float_extension" , maybeKey default_float_extension )+  , ( "default_double_extension" , maybeKey default_double_extension )+  , ( "default_bool_extension" , maybeKey default_bool_extension )+  , ( "default_string_extension" , maybeKey default_string_extension )+  , ( "default_bytes_extension" , maybeKey default_bytes_extension )+  , ( "default_nested_enum_extension" , maybeKey default_nested_enum_extension )+  , ( "default_foreign_enum_extension" , maybeKey default_foreign_enum_extension )+  , ( "default_import_enum_extension" , maybeKey default_import_enum_extension )+  , ( "default_string_piece_extension" , maybeKey default_string_piece_extension )+  , ( "default_cord_extension" , maybeKey default_cord_extension )+  ]++tests_TestAllTypes :: [(String,TestAllTypes -> Bool)]+tests_TestAllTypes =+ [ ( "Size1" , prop_Size1 )+ , ( "Size2", prop_Size2 )+ , ( "WireArb1", prop_WireArb1 )+ , ( "WireArb2", prop_WireArb2 )+ ]+++tests_TestAllExtensions :: [(String,TestAllExtensions -> Bool)]+tests_TestAllExtensions =+  [ ( "Size1" , prop_Size1 )+  , ( "Size2", prop_Size2 )+  , ( "WireArb1", prop_WireArb1 )+  , ( "WireArb2", prop_WireArb2 )+  , ( "WireArb3", prop_WireArb3 ) +  ]
+ tests/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import Test.QuickCheck+import Arb.UnittestProto++main =  do+  mapM_ (\(name,test) -> putStrLn name >> quickCheck test) tests_TestAllTypes+  mapM_ (\(name,test) -> putStrLn name >> quickCheck test) tests_TestAllExtensions
+ tests/UnittestProto/BarRequest.hs view
@@ -0,0 +1,54 @@+module UnittestProto.BarRequest (BarRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data BarRequest = BarRequest{}+                deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable BarRequest where+  mergeEmpty = BarRequest+  mergeAppend (BarRequest) (BarRequest) = BarRequest+ +instance P'.Default BarRequest where+  defaultValue = BarRequest+ +instance P'.Wire BarRequest where+  wireSize ft' self'@(BarRequest)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(BarRequest)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> BarRequest) BarRequest where+  getVal m' f' = f' m'+ +instance P'.GPB BarRequest+ +instance P'.ReflectDescriptor BarRequest where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"BarRequest\"}, descFilePath = [\"UnittestProto\",\"BarRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/BarResponse.hs view
@@ -0,0 +1,54 @@+module UnittestProto.BarResponse (BarResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data BarResponse = BarResponse{}+                 deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable BarResponse where+  mergeEmpty = BarResponse+  mergeAppend (BarResponse) (BarResponse) = BarResponse+ +instance P'.Default BarResponse where+  defaultValue = BarResponse+ +instance P'.Wire BarResponse where+  wireSize ft' self'@(BarResponse)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(BarResponse)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> BarResponse) BarResponse where+  getVal m' f' = f' m'+ +instance P'.GPB BarResponse+ +instance P'.ReflectDescriptor BarResponse where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"BarResponse\"}, descFilePath = [\"UnittestProto\",\"BarResponse.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/FooRequest.hs view
@@ -0,0 +1,54 @@+module UnittestProto.FooRequest (FooRequest(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data FooRequest = FooRequest{}+                deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable FooRequest where+  mergeEmpty = FooRequest+  mergeAppend (FooRequest) (FooRequest) = FooRequest+ +instance P'.Default FooRequest where+  defaultValue = FooRequest+ +instance P'.Wire FooRequest where+  wireSize ft' self'@(FooRequest)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(FooRequest)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> FooRequest) FooRequest where+  getVal m' f' = f' m'+ +instance P'.GPB FooRequest+ +instance P'.ReflectDescriptor FooRequest where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"FooRequest\"}, descFilePath = [\"UnittestProto\",\"FooRequest.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/FooResponse.hs view
@@ -0,0 +1,54 @@+module UnittestProto.FooResponse (FooResponse(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data FooResponse = FooResponse{}+                 deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable FooResponse where+  mergeEmpty = FooResponse+  mergeAppend (FooResponse) (FooResponse) = FooResponse+ +instance P'.Default FooResponse where+  defaultValue = FooResponse+ +instance P'.Wire FooResponse where+  wireSize ft' self'@(FooResponse)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(FooResponse)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> FooResponse) FooResponse where+  getVal m' f' = f' m'+ +instance P'.GPB FooResponse+ +instance P'.ReflectDescriptor FooResponse where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"FooResponse\"}, descFilePath = [\"UnittestProto\",\"FooResponse.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/ForeignEnum.hs view
@@ -0,0 +1,47 @@+module UnittestProto.ForeignEnum (ForeignEnum(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ForeignEnum = FOREIGN_FOO+                 | FOREIGN_BAR+                 | FOREIGN_BAZ+                 deriving (P'.Read, P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ForeignEnum+ +instance P'.Bounded ForeignEnum where+  minBound = FOREIGN_FOO+  maxBound = FOREIGN_BAZ+ +instance P'.Default ForeignEnum where+  defaultValue = FOREIGN_FOO+ +instance P'.Enum ForeignEnum where+  fromEnum (FOREIGN_FOO) = 4+  fromEnum (FOREIGN_BAR) = 5+  fromEnum (FOREIGN_BAZ) = 6+  toEnum 4 = FOREIGN_FOO+  toEnum 5 = FOREIGN_BAR+  toEnum 6 = FOREIGN_BAZ+  succ (FOREIGN_FOO) = FOREIGN_BAR+  succ (FOREIGN_BAR) = FOREIGN_BAZ+  pred (FOREIGN_BAR) = FOREIGN_FOO+  pred (FOREIGN_BAZ) = FOREIGN_BAR+ +instance P'.Wire ForeignEnum where+  wireSize ft' enum = P'.wireSize ft' (P'.fromEnum enum)+  wirePut ft' enum = P'.wirePut ft' (P'.fromEnum enum)+  wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)+  wireGet ft' = P'.wireGetErr ft'+ +instance P'.GPB ForeignEnum+ +instance P'.MessageAPI msg' (msg' -> ForeignEnum) ForeignEnum where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum ForeignEnum where+  reflectEnum = [(4, "FOREIGN_FOO", FOREIGN_FOO), (5, "FOREIGN_BAR", FOREIGN_BAR), (6, "FOREIGN_BAZ", FOREIGN_BAZ)]+  reflectEnumInfo _+    = P'.EnumInfo (P'.ProtoName "" "UnittestProto" "ForeignEnum") ["UnittestProto", "ForeignEnum.hs"]+        [(4, "FOREIGN_FOO"), (5, "FOREIGN_BAR"), (6, "FOREIGN_BAZ")]
+ tests/UnittestProto/ForeignMessage.hs view
@@ -0,0 +1,55 @@+module UnittestProto.ForeignMessage (ForeignMessage(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data ForeignMessage = ForeignMessage{c :: P'.Maybe P'.Int32}+                    deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable ForeignMessage where+  mergeEmpty = ForeignMessage P'.mergeEmpty+  mergeAppend (ForeignMessage x'1) (ForeignMessage y'1) = ForeignMessage (P'.mergeAppend x'1 y'1)+ +instance P'.Default ForeignMessage where+  defaultValue = ForeignMessage P'.defaultValue+ +instance P'.Wire ForeignMessage where+  wireSize ft' self'@(ForeignMessage x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 5 x'1)+  wirePut ft' self'@(ForeignMessage x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{c = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> ForeignMessage) ForeignMessage where+  getVal m' f' = f' m'+ +instance P'.GPB ForeignMessage+ +instance P'.ReflectDescriptor ForeignMessage where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignMessage\"}, descFilePath = [\"UnittestProto\",\"ForeignMessage.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.ForeignMessage\", baseName = \"c\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/OptionalGroup_extension.hs view
@@ -0,0 +1,55 @@+module UnittestProto.OptionalGroup_extension (OptionalGroup_extension(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'++data OptionalGroup_extension = OptionalGroup_extension{a :: P'.Maybe P'.Int32}+                             deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable OptionalGroup_extension where+  mergeEmpty = OptionalGroup_extension P'.mergeEmpty+  mergeAppend (OptionalGroup_extension x'1) (OptionalGroup_extension y'1) = OptionalGroup_extension (P'.mergeAppend x'1 y'1)+ +instance P'.Default OptionalGroup_extension where+  defaultValue = OptionalGroup_extension P'.defaultValue+ +instance P'.Wire OptionalGroup_extension where+  wireSize ft' self'@(OptionalGroup_extension x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 2 5 x'1)+  wirePut ft' self'@(OptionalGroup_extension x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 136 5 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              17 -> P'.fmap (\ new'Field -> old'Self{a = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> OptionalGroup_extension) OptionalGroup_extension where+  getVal m' f' = f' m'+ +instance P'.GPB OptionalGroup_extension+ +instance P'.ReflectDescriptor OptionalGroup_extension where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"OptionalGroup_extension\"}, descFilePath = [\"UnittestProto\",\"OptionalGroup_extension.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.OptionalGroup_extension\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 17}, wireTag = WireTag {getWireTag = 136}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/RepeatedGroup_extension.hs view
@@ -0,0 +1,55 @@+module UnittestProto.RepeatedGroup_extension (RepeatedGroup_extension(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data RepeatedGroup_extension = RepeatedGroup_extension{a :: P'.Maybe P'.Int32}+                             deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable RepeatedGroup_extension where+  mergeEmpty = RepeatedGroup_extension P'.mergeEmpty+  mergeAppend (RepeatedGroup_extension x'1) (RepeatedGroup_extension y'1) = RepeatedGroup_extension (P'.mergeAppend x'1 y'1)+ +instance P'.Default RepeatedGroup_extension where+  defaultValue = RepeatedGroup_extension P'.defaultValue+ +instance P'.Wire RepeatedGroup_extension where+  wireSize ft' self'@(RepeatedGroup_extension x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 2 5 x'1)+  wirePut ft' self'@(RepeatedGroup_extension x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 376 5 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              47 -> P'.fmap (\ new'Field -> old'Self{a = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> RepeatedGroup_extension) RepeatedGroup_extension where+  getVal m' f' = f' m'+ +instance P'.GPB RepeatedGroup_extension+ +instance P'.ReflectDescriptor RepeatedGroup_extension where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"RepeatedGroup_extension\"}, descFilePath = [\"UnittestProto\",\"RepeatedGroup_extension.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.RepeatedGroup_extension\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 47}, wireTag = WireTag {getWireTag = 376}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestAllExtensions.hs view
@@ -0,0 +1,149 @@+module UnittestProto.TestAllExtensions (TestAllExtensions(..)) where+import Prelude ((+), (<=), (&&), ( || ))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto as UnittestProto+       (default_bool_extension, default_bytes_extension, default_cord_extension, default_double_extension,+        default_fixed32_extension, default_fixed64_extension, default_float_extension, default_foreign_enum_extension,+        default_import_enum_extension, default_int32_extension, default_int64_extension, default_nested_enum_extension,+        default_sfixed32_extension, default_sfixed64_extension, default_sint32_extension, default_sint64_extension,+        default_string_extension, default_string_piece_extension, default_uint32_extension, default_uint64_extension,+        optionalGroup_extension, optional_bool_extension, optional_bytes_extension, optional_cord_extension,+        optional_double_extension, optional_fixed32_extension, optional_fixed64_extension, optional_float_extension,+        optional_foreign_enum_extension, optional_foreign_message_extension, optional_import_enum_extension,+        optional_import_message_extension, optional_int32_extension, optional_int64_extension, optional_nested_enum_extension,+        optional_nested_message_extension, optional_sfixed32_extension, optional_sfixed64_extension, optional_sint32_extension,+        optional_sint64_extension, optional_string_extension, optional_string_piece_extension, optional_uint32_extension,+        optional_uint64_extension, repeatedGroup_extension, repeated_bool_extension, repeated_bytes_extension,+        repeated_cord_extension, repeated_double_extension, repeated_fixed32_extension, repeated_fixed64_extension,+        repeated_float_extension, repeated_foreign_enum_extension, repeated_foreign_message_extension,+        repeated_import_enum_extension, repeated_import_message_extension, repeated_int32_extension, repeated_int64_extension,+        repeated_nested_enum_extension, repeated_nested_message_extension, repeated_sfixed32_extension, repeated_sfixed64_extension,+        repeated_sint32_extension, repeated_sint64_extension, repeated_string_extension, repeated_string_piece_extension,+        repeated_uint32_extension, repeated_uint64_extension)+import qualified UnittestProto.TestRequired as UnittestProto.TestRequired (multi, single)+ +data TestAllExtensions = TestAllExtensions{ext'field :: P'.ExtField}+                       deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.ExtendMessage TestAllExtensions where+  getExtField = ext'field+  putExtField e'f msg = msg{ext'field = e'f}+  validExtRanges msg = P'.extRanges (P'.reflectDescriptorInfo msg)+ +instance P'.Mergeable TestAllExtensions where+  mergeEmpty = TestAllExtensions P'.mergeEmpty+  mergeAppend (TestAllExtensions x'1) (TestAllExtensions y'1) = TestAllExtensions (P'.mergeAppend x'1 y'1)+ +instance P'.Default TestAllExtensions where+  defaultValue = TestAllExtensions P'.defaultValue+ +instance P'.Wire TestAllExtensions where+  wireSize ft' self'@(TestAllExtensions x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeExtField x'1)+  wirePut ft' self'@(TestAllExtensions x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutExtField x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessageExt update'Self+        11 -> P'.getMessageExt update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1001 -> P'.wireGetKey UnittestProto.TestRequired.multi old'Self+              1000 -> P'.wireGetKey UnittestProto.TestRequired.single old'Self+              85 -> P'.wireGetKey UnittestProto.default_cord_extension old'Self+              84 -> P'.wireGetKey UnittestProto.default_string_piece_extension old'Self+              83 -> P'.wireGetKey UnittestProto.default_import_enum_extension old'Self+              82 -> P'.wireGetKey UnittestProto.default_foreign_enum_extension old'Self+              81 -> P'.wireGetKey UnittestProto.default_nested_enum_extension old'Self+              75 -> P'.wireGetKey UnittestProto.default_bytes_extension old'Self+              74 -> P'.wireGetKey UnittestProto.default_string_extension old'Self+              73 -> P'.wireGetKey UnittestProto.default_bool_extension old'Self+              72 -> P'.wireGetKey UnittestProto.default_double_extension old'Self+              71 -> P'.wireGetKey UnittestProto.default_float_extension old'Self+              70 -> P'.wireGetKey UnittestProto.default_sfixed64_extension old'Self+              69 -> P'.wireGetKey UnittestProto.default_sfixed32_extension old'Self+              68 -> P'.wireGetKey UnittestProto.default_fixed64_extension old'Self+              67 -> P'.wireGetKey UnittestProto.default_fixed32_extension old'Self+              66 -> P'.wireGetKey UnittestProto.default_sint64_extension old'Self+              65 -> P'.wireGetKey UnittestProto.default_sint32_extension old'Self+              64 -> P'.wireGetKey UnittestProto.default_uint64_extension old'Self+              63 -> P'.wireGetKey UnittestProto.default_uint32_extension old'Self+              62 -> P'.wireGetKey UnittestProto.default_int64_extension old'Self+              61 -> P'.wireGetKey UnittestProto.default_int32_extension old'Self+              55 -> P'.wireGetKey UnittestProto.repeated_cord_extension old'Self+              54 -> P'.wireGetKey UnittestProto.repeated_string_piece_extension old'Self+              53 -> P'.wireGetKey UnittestProto.repeated_import_enum_extension old'Self+              52 -> P'.wireGetKey UnittestProto.repeated_foreign_enum_extension old'Self+              51 -> P'.wireGetKey UnittestProto.repeated_nested_enum_extension old'Self+              50 -> P'.wireGetKey UnittestProto.repeated_import_message_extension old'Self+              49 -> P'.wireGetKey UnittestProto.repeated_foreign_message_extension old'Self+              48 -> P'.wireGetKey UnittestProto.repeated_nested_message_extension old'Self+              46 -> P'.wireGetKey UnittestProto.repeatedGroup_extension old'Self+              45 -> P'.wireGetKey UnittestProto.repeated_bytes_extension old'Self+              44 -> P'.wireGetKey UnittestProto.repeated_string_extension old'Self+              43 -> P'.wireGetKey UnittestProto.repeated_bool_extension old'Self+              42 -> P'.wireGetKey UnittestProto.repeated_double_extension old'Self+              41 -> P'.wireGetKey UnittestProto.repeated_float_extension old'Self+              40 -> P'.wireGetKey UnittestProto.repeated_sfixed64_extension old'Self+              39 -> P'.wireGetKey UnittestProto.repeated_sfixed32_extension old'Self+              38 -> P'.wireGetKey UnittestProto.repeated_fixed64_extension old'Self+              37 -> P'.wireGetKey UnittestProto.repeated_fixed32_extension old'Self+              36 -> P'.wireGetKey UnittestProto.repeated_sint64_extension old'Self+              35 -> P'.wireGetKey UnittestProto.repeated_sint32_extension old'Self+              34 -> P'.wireGetKey UnittestProto.repeated_uint64_extension old'Self+              33 -> P'.wireGetKey UnittestProto.repeated_uint32_extension old'Self+              32 -> P'.wireGetKey UnittestProto.repeated_int64_extension old'Self+              31 -> P'.wireGetKey UnittestProto.repeated_int32_extension old'Self+              25 -> P'.wireGetKey UnittestProto.optional_cord_extension old'Self+              24 -> P'.wireGetKey UnittestProto.optional_string_piece_extension old'Self+              23 -> P'.wireGetKey UnittestProto.optional_import_enum_extension old'Self+              22 -> P'.wireGetKey UnittestProto.optional_foreign_enum_extension old'Self+              21 -> P'.wireGetKey UnittestProto.optional_nested_enum_extension old'Self+              20 -> P'.wireGetKey UnittestProto.optional_import_message_extension old'Self+              19 -> P'.wireGetKey UnittestProto.optional_foreign_message_extension old'Self+              18 -> P'.wireGetKey UnittestProto.optional_nested_message_extension old'Self+              16 -> P'.wireGetKey UnittestProto.optionalGroup_extension old'Self+              15 -> P'.wireGetKey UnittestProto.optional_bytes_extension old'Self+              14 -> P'.wireGetKey UnittestProto.optional_string_extension old'Self+              13 -> P'.wireGetKey UnittestProto.optional_bool_extension old'Self+              12 -> P'.wireGetKey UnittestProto.optional_double_extension old'Self+              11 -> P'.wireGetKey UnittestProto.optional_float_extension old'Self+              10 -> P'.wireGetKey UnittestProto.optional_sfixed64_extension old'Self+              9 -> P'.wireGetKey UnittestProto.optional_sfixed32_extension old'Self+              8 -> P'.wireGetKey UnittestProto.optional_fixed64_extension old'Self+              7 -> P'.wireGetKey UnittestProto.optional_fixed32_extension old'Self+              6 -> P'.wireGetKey UnittestProto.optional_sint64_extension old'Self+              5 -> P'.wireGetKey UnittestProto.optional_sint32_extension old'Self+              4 -> P'.wireGetKey UnittestProto.optional_uint64_extension old'Self+              3 -> P'.wireGetKey UnittestProto.optional_uint32_extension old'Self+              2 -> P'.wireGetKey UnittestProto.optional_int64_extension old'Self+              1 -> P'.wireGetKey UnittestProto.optional_int32_extension old'Self+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestAllExtensions) TestAllExtensions where+  getVal m' f' = f' m'+ +instance P'.GPB TestAllExtensions+ +instance P'.ReflectDescriptor TestAllExtensions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestAllExtensions\"}, descFilePath = [\"UnittestProto\",\"TestAllExtensions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 1},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 536870911})], knownKeys = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"multi\"}, fieldNumber = FieldId {getFieldId = 1001}, wireTag = WireTag {getWireTag = 8010}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRequired\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"single\"}, fieldNumber = FieldId {getFieldId = 1000}, wireTag = WireTag {getWireTag = 8002}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRequired\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_cord_extension\"}, fieldNumber = FieldId {getFieldId = 85}, wireTag = WireTag {getWireTag = 682}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Just (Chunk \"123\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"123\" Empty))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_string_piece_extension\"}, fieldNumber = FieldId {getFieldId = 84}, wireTag = WireTag {getWireTag = 674}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Just (Chunk \"abc\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"abc\" Empty))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_import_enum_extension\"}, fieldNumber = FieldId {getFieldId = 83}, wireTag = WireTag {getWireTag = 664}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportEnum\"}), hsRawDefault = Just (Chunk \"IMPORT_BAR\" Empty), hsDefault = Just (HsDef'Enum \"IMPORT_BAR\")},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_foreign_enum_extension\"}, fieldNumber = FieldId {getFieldId = 82}, wireTag = WireTag {getWireTag = 656}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignEnum\"}), hsRawDefault = Just (Chunk \"FOREIGN_BAR\" Empty), hsDefault = Just (HsDef'Enum \"FOREIGN_BAR\")},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_nested_enum_extension\"}, fieldNumber = FieldId {getFieldId = 81}, wireTag = WireTag {getWireTag = 648}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedEnum\"}), hsRawDefault = Just (Chunk \"BAR\" Empty), hsDefault = Just (HsDef'Enum \"BAR\")},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_bytes_extension\"}, fieldNumber = FieldId {getFieldId = 75}, wireTag = WireTag {getWireTag = 602}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Just (Chunk \"world\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"world\" Empty))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_string_extension\"}, fieldNumber = FieldId {getFieldId = 74}, wireTag = WireTag {getWireTag = 594}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Just (Chunk \"hello\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"hello\" Empty))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_bool_extension\"}, fieldNumber = FieldId {getFieldId = 73}, wireTag = WireTag {getWireTag = 584}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just (Chunk \"true\" Empty), hsDefault = Just (HsDef'Bool True)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_double_extension\"}, fieldNumber = FieldId {getFieldId = 72}, wireTag = WireTag {getWireTag = 577}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Just (Chunk \"52000.0\" Empty), hsDefault = Just (HsDef'Rational (52000%1))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_float_extension\"}, fieldNumber = FieldId {getFieldId = 71}, wireTag = WireTag {getWireTag = 573}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Just (Chunk \"51.5\" Empty), hsDefault = Just (HsDef'Rational (103%2))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_sfixed64_extension\"}, fieldNumber = FieldId {getFieldId = 70}, wireTag = WireTag {getWireTag = 561}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 16}, typeName = Nothing, hsRawDefault = Just (Chunk \"-50\" Empty), hsDefault = Just (HsDef'Integer (-50))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_sfixed32_extension\"}, fieldNumber = FieldId {getFieldId = 69}, wireTag = WireTag {getWireTag = 557}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 15}, typeName = Nothing, hsRawDefault = Just (Chunk \"49\" Empty), hsDefault = Just (HsDef'Integer 49)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_fixed64_extension\"}, fieldNumber = FieldId {getFieldId = 68}, wireTag = WireTag {getWireTag = 545}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 6}, typeName = Nothing, hsRawDefault = Just (Chunk \"48\" Empty), hsDefault = Just (HsDef'Integer 48)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_fixed32_extension\"}, fieldNumber = FieldId {getFieldId = 67}, wireTag = WireTag {getWireTag = 541}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 7}, typeName = Nothing, hsRawDefault = Just (Chunk \"47\" Empty), hsDefault = Just (HsDef'Integer 47)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_sint64_extension\"}, fieldNumber = FieldId {getFieldId = 66}, wireTag = WireTag {getWireTag = 529}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Just (Chunk \"46\" Empty), hsDefault = Just (HsDef'Integer 46)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_sint32_extension\"}, fieldNumber = FieldId {getFieldId = 65}, wireTag = WireTag {getWireTag = 525}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 17}, typeName = Nothing, hsRawDefault = Just (Chunk \"-45\" Empty), hsDefault = Just (HsDef'Integer (-45))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_uint64_extension\"}, fieldNumber = FieldId {getFieldId = 64}, wireTag = WireTag {getWireTag = 512}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Just (Chunk \"44\" Empty), hsDefault = Just (HsDef'Integer 44)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_uint32_extension\"}, fieldNumber = FieldId {getFieldId = 63}, wireTag = WireTag {getWireTag = 504}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Just (Chunk \"43\" Empty), hsDefault = Just (HsDef'Integer 43)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_int64_extension\"}, fieldNumber = FieldId {getFieldId = 62}, wireTag = WireTag {getWireTag = 496}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Just (Chunk \"42\" Empty), hsDefault = Just (HsDef'Integer 42)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"default_int32_extension\"}, fieldNumber = FieldId {getFieldId = 61}, wireTag = WireTag {getWireTag = 488}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Just (Chunk \"41\" Empty), hsDefault = Just (HsDef'Integer 41)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_cord_extension\"}, fieldNumber = FieldId {getFieldId = 55}, wireTag = WireTag {getWireTag = 442}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_string_piece_extension\"}, fieldNumber = FieldId {getFieldId = 54}, wireTag = WireTag {getWireTag = 434}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_import_enum_extension\"}, fieldNumber = FieldId {getFieldId = 53}, wireTag = WireTag {getWireTag = 424}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_foreign_enum_extension\"}, fieldNumber = FieldId {getFieldId = 52}, wireTag = WireTag {getWireTag = 416}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_nested_enum_extension\"}, fieldNumber = FieldId {getFieldId = 51}, wireTag = WireTag {getWireTag = 408}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_import_message_extension\"}, fieldNumber = FieldId {getFieldId = 50}, wireTag = WireTag {getWireTag = 402}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_foreign_message_extension\"}, fieldNumber = FieldId {getFieldId = 49}, wireTag = WireTag {getWireTag = 394}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_nested_message_extension\"}, fieldNumber = FieldId {getFieldId = 48}, wireTag = WireTag {getWireTag = 386}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeatedGroup_extension\"}, fieldNumber = FieldId {getFieldId = 46}, wireTag = WireTag {getWireTag = 371}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 10}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"RepeatedGroup_extension\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_bytes_extension\"}, fieldNumber = FieldId {getFieldId = 45}, wireTag = WireTag {getWireTag = 362}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_string_extension\"}, fieldNumber = FieldId {getFieldId = 44}, wireTag = WireTag {getWireTag = 354}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_bool_extension\"}, fieldNumber = FieldId {getFieldId = 43}, wireTag = WireTag {getWireTag = 344}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_double_extension\"}, fieldNumber = FieldId {getFieldId = 42}, wireTag = WireTag {getWireTag = 337}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_float_extension\"}, fieldNumber = FieldId {getFieldId = 41}, wireTag = WireTag {getWireTag = 333}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_sfixed64_extension\"}, fieldNumber = FieldId {getFieldId = 40}, wireTag = WireTag {getWireTag = 321}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 16}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_sfixed32_extension\"}, fieldNumber = FieldId {getFieldId = 39}, wireTag = WireTag {getWireTag = 317}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 15}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_fixed64_extension\"}, fieldNumber = FieldId {getFieldId = 38}, wireTag = WireTag {getWireTag = 305}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 6}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_fixed32_extension\"}, fieldNumber = FieldId {getFieldId = 37}, wireTag = WireTag {getWireTag = 301}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 7}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_sint64_extension\"}, fieldNumber = FieldId {getFieldId = 36}, wireTag = WireTag {getWireTag = 289}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_sint32_extension\"}, fieldNumber = FieldId {getFieldId = 35}, wireTag = WireTag {getWireTag = 285}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 17}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_uint64_extension\"}, fieldNumber = FieldId {getFieldId = 34}, wireTag = WireTag {getWireTag = 272}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_uint32_extension\"}, fieldNumber = FieldId {getFieldId = 33}, wireTag = WireTag {getWireTag = 264}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_int64_extension\"}, fieldNumber = FieldId {getFieldId = 32}, wireTag = WireTag {getWireTag = 256}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"repeated_int32_extension\"}, fieldNumber = FieldId {getFieldId = 31}, wireTag = WireTag {getWireTag = 248}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_cord_extension\"}, fieldNumber = FieldId {getFieldId = 25}, wireTag = WireTag {getWireTag = 202}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_string_piece_extension\"}, fieldNumber = FieldId {getFieldId = 24}, wireTag = WireTag {getWireTag = 194}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_import_enum_extension\"}, fieldNumber = FieldId {getFieldId = 23}, wireTag = WireTag {getWireTag = 184}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_foreign_enum_extension\"}, fieldNumber = FieldId {getFieldId = 22}, wireTag = WireTag {getWireTag = 176}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_nested_enum_extension\"}, fieldNumber = FieldId {getFieldId = 21}, wireTag = WireTag {getWireTag = 168}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_import_message_extension\"}, fieldNumber = FieldId {getFieldId = 20}, wireTag = WireTag {getWireTag = 162}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_foreign_message_extension\"}, fieldNumber = FieldId {getFieldId = 19}, wireTag = WireTag {getWireTag = 154}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_nested_message_extension\"}, fieldNumber = FieldId {getFieldId = 18}, wireTag = WireTag {getWireTag = 146}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optionalGroup_extension\"}, fieldNumber = FieldId {getFieldId = 16}, wireTag = WireTag {getWireTag = 131}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 10}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"OptionalGroup_extension\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_bytes_extension\"}, fieldNumber = FieldId {getFieldId = 15}, wireTag = WireTag {getWireTag = 122}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_string_extension\"}, fieldNumber = FieldId {getFieldId = 14}, wireTag = WireTag {getWireTag = 114}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_bool_extension\"}, fieldNumber = FieldId {getFieldId = 13}, wireTag = WireTag {getWireTag = 104}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_double_extension\"}, fieldNumber = FieldId {getFieldId = 12}, wireTag = WireTag {getWireTag = 97}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_float_extension\"}, fieldNumber = FieldId {getFieldId = 11}, wireTag = WireTag {getWireTag = 93}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_sfixed64_extension\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 81}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 16}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_sfixed32_extension\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 77}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 15}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_fixed64_extension\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 65}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 6}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_fixed32_extension\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 61}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 7}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_sint64_extension\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 49}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_sint32_extension\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 45}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 17}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_uint64_extension\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_uint32_extension\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_int64_extension\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"optional_int32_extension\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}]}"
+ tests/UnittestProto/TestAllTypes.hs view
@@ -0,0 +1,557 @@+module UnittestProto.TestAllTypes (TestAllTypes(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Com.Google.Protobuf.Test.ImportEnum as Com.Google.Protobuf.Test (ImportEnum)+import qualified Com.Google.Protobuf.Test.ImportMessage as Com.Google.Protobuf.Test (ImportMessage)+import qualified UnittestProto.ForeignEnum as UnittestProto (ForeignEnum)+import qualified UnittestProto.ForeignMessage as UnittestProto (ForeignMessage)+import qualified UnittestProto.TestAllTypes.NestedEnum as UnittestProto.TestAllTypes (NestedEnum)+import qualified UnittestProto.TestAllTypes.NestedMessage as UnittestProto.TestAllTypes (NestedMessage)+import qualified UnittestProto.TestAllTypes.OptionalGroup as UnittestProto.TestAllTypes (OptionalGroup)+import qualified UnittestProto.TestAllTypes.RepeatedGroup as UnittestProto.TestAllTypes (RepeatedGroup)+ +data TestAllTypes = TestAllTypes{optional_int32 :: P'.Maybe P'.Int32, optional_int64 :: P'.Maybe P'.Int64,+                                 optional_uint32 :: P'.Maybe P'.Word32, optional_uint64 :: P'.Maybe P'.Word64,+                                 optional_sint32 :: P'.Maybe P'.Int32, optional_sint64 :: P'.Maybe P'.Int64,+                                 optional_fixed32 :: P'.Maybe P'.Word32, optional_fixed64 :: P'.Maybe P'.Word64,+                                 optional_sfixed32 :: P'.Maybe P'.Int32, optional_sfixed64 :: P'.Maybe P'.Int64,+                                 optional_float :: P'.Maybe P'.Float, optional_double :: P'.Maybe P'.Double,+                                 optional_bool :: P'.Maybe P'.Bool, optional_string :: P'.Maybe P'.Utf8,+                                 optional_bytes :: P'.Maybe P'.ByteString,+                                 optionalGroup :: P'.Maybe UnittestProto.TestAllTypes.OptionalGroup,+                                 optional_nested_message :: P'.Maybe UnittestProto.TestAllTypes.NestedMessage,+                                 optional_foreign_message :: P'.Maybe UnittestProto.ForeignMessage,+                                 optional_import_message :: P'.Maybe Com.Google.Protobuf.Test.ImportMessage,+                                 optional_nested_enum :: P'.Maybe UnittestProto.TestAllTypes.NestedEnum,+                                 optional_foreign_enum :: P'.Maybe UnittestProto.ForeignEnum,+                                 optional_import_enum :: P'.Maybe Com.Google.Protobuf.Test.ImportEnum,+                                 optional_string_piece :: P'.Maybe P'.Utf8, optional_cord :: P'.Maybe P'.Utf8,+                                 repeated_int32 :: P'.Seq P'.Int32, repeated_int64 :: P'.Seq P'.Int64,+                                 repeated_uint32 :: P'.Seq P'.Word32, repeated_uint64 :: P'.Seq P'.Word64,+                                 repeated_sint32 :: P'.Seq P'.Int32, repeated_sint64 :: P'.Seq P'.Int64,+                                 repeated_fixed32 :: P'.Seq P'.Word32, repeated_fixed64 :: P'.Seq P'.Word64,+                                 repeated_sfixed32 :: P'.Seq P'.Int32, repeated_sfixed64 :: P'.Seq P'.Int64,+                                 repeated_float :: P'.Seq P'.Float, repeated_double :: P'.Seq P'.Double,+                                 repeated_bool :: P'.Seq P'.Bool, repeated_string :: P'.Seq P'.Utf8,+                                 repeated_bytes :: P'.Seq P'.ByteString,+                                 repeatedGroup :: P'.Seq UnittestProto.TestAllTypes.RepeatedGroup,+                                 repeated_nested_message :: P'.Seq UnittestProto.TestAllTypes.NestedMessage,+                                 repeated_foreign_message :: P'.Seq UnittestProto.ForeignMessage,+                                 repeated_import_message :: P'.Seq Com.Google.Protobuf.Test.ImportMessage,+                                 repeated_nested_enum :: P'.Seq UnittestProto.TestAllTypes.NestedEnum,+                                 repeated_foreign_enum :: P'.Seq UnittestProto.ForeignEnum,+                                 repeated_import_enum :: P'.Seq Com.Google.Protobuf.Test.ImportEnum,+                                 repeated_string_piece :: P'.Seq P'.Utf8, repeated_cord :: P'.Seq P'.Utf8,+                                 default_int32 :: P'.Maybe P'.Int32, default_int64 :: P'.Maybe P'.Int64,+                                 default_uint32 :: P'.Maybe P'.Word32, default_uint64 :: P'.Maybe P'.Word64,+                                 default_sint32 :: P'.Maybe P'.Int32, default_sint64 :: P'.Maybe P'.Int64,+                                 default_fixed32 :: P'.Maybe P'.Word32, default_fixed64 :: P'.Maybe P'.Word64,+                                 default_sfixed32 :: P'.Maybe P'.Int32, default_sfixed64 :: P'.Maybe P'.Int64,+                                 default_float :: P'.Maybe P'.Float, default_double :: P'.Maybe P'.Double,+                                 default_bool :: P'.Maybe P'.Bool, default_string :: P'.Maybe P'.Utf8,+                                 default_bytes :: P'.Maybe P'.ByteString,+                                 default_nested_enum :: P'.Maybe UnittestProto.TestAllTypes.NestedEnum,+                                 default_foreign_enum :: P'.Maybe UnittestProto.ForeignEnum,+                                 default_import_enum :: P'.Maybe Com.Google.Protobuf.Test.ImportEnum,+                                 default_string_piece :: P'.Maybe P'.Utf8, default_cord :: P'.Maybe P'.Utf8}+                  deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestAllTypes where+  mergeEmpty+    = TestAllTypes P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+  mergeAppend+    (TestAllTypes x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18 x'19 x'20 x'21 x'22 x'23 x'24+       x'25 x'26 x'27 x'28 x'29 x'30 x'31 x'32 x'33 x'34 x'35 x'36 x'37 x'38 x'39 x'40 x'41 x'42 x'43 x'44 x'45 x'46 x'47 x'48 x'49+       x'50 x'51 x'52 x'53 x'54 x'55 x'56 x'57 x'58 x'59 x'60 x'61 x'62 x'63 x'64 x'65 x'66 x'67 x'68)+    (TestAllTypes y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8 y'9 y'10 y'11 y'12 y'13 y'14 y'15 y'16 y'17 y'18 y'19 y'20 y'21 y'22 y'23 y'24+       y'25 y'26 y'27 y'28 y'29 y'30 y'31 y'32 y'33 y'34 y'35 y'36 y'37 y'38 y'39 y'40 y'41 y'42 y'43 y'44 y'45 y'46 y'47 y'48 y'49+       y'50 y'51 y'52 y'53 y'54 y'55 y'56 y'57 y'58 y'59 y'60 y'61 y'62 y'63 y'64 y'65 y'66 y'67 y'68)+    = TestAllTypes (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+        (P'.mergeAppend x'5 y'5)+        (P'.mergeAppend x'6 y'6)+        (P'.mergeAppend x'7 y'7)+        (P'.mergeAppend x'8 y'8)+        (P'.mergeAppend x'9 y'9)+        (P'.mergeAppend x'10 y'10)+        (P'.mergeAppend x'11 y'11)+        (P'.mergeAppend x'12 y'12)+        (P'.mergeAppend x'13 y'13)+        (P'.mergeAppend x'14 y'14)+        (P'.mergeAppend x'15 y'15)+        (P'.mergeAppend x'16 y'16)+        (P'.mergeAppend x'17 y'17)+        (P'.mergeAppend x'18 y'18)+        (P'.mergeAppend x'19 y'19)+        (P'.mergeAppend x'20 y'20)+        (P'.mergeAppend x'21 y'21)+        (P'.mergeAppend x'22 y'22)+        (P'.mergeAppend x'23 y'23)+        (P'.mergeAppend x'24 y'24)+        (P'.mergeAppend x'25 y'25)+        (P'.mergeAppend x'26 y'26)+        (P'.mergeAppend x'27 y'27)+        (P'.mergeAppend x'28 y'28)+        (P'.mergeAppend x'29 y'29)+        (P'.mergeAppend x'30 y'30)+        (P'.mergeAppend x'31 y'31)+        (P'.mergeAppend x'32 y'32)+        (P'.mergeAppend x'33 y'33)+        (P'.mergeAppend x'34 y'34)+        (P'.mergeAppend x'35 y'35)+        (P'.mergeAppend x'36 y'36)+        (P'.mergeAppend x'37 y'37)+        (P'.mergeAppend x'38 y'38)+        (P'.mergeAppend x'39 y'39)+        (P'.mergeAppend x'40 y'40)+        (P'.mergeAppend x'41 y'41)+        (P'.mergeAppend x'42 y'42)+        (P'.mergeAppend x'43 y'43)+        (P'.mergeAppend x'44 y'44)+        (P'.mergeAppend x'45 y'45)+        (P'.mergeAppend x'46 y'46)+        (P'.mergeAppend x'47 y'47)+        (P'.mergeAppend x'48 y'48)+        (P'.mergeAppend x'49 y'49)+        (P'.mergeAppend x'50 y'50)+        (P'.mergeAppend x'51 y'51)+        (P'.mergeAppend x'52 y'52)+        (P'.mergeAppend x'53 y'53)+        (P'.mergeAppend x'54 y'54)+        (P'.mergeAppend x'55 y'55)+        (P'.mergeAppend x'56 y'56)+        (P'.mergeAppend x'57 y'57)+        (P'.mergeAppend x'58 y'58)+        (P'.mergeAppend x'59 y'59)+        (P'.mergeAppend x'60 y'60)+        (P'.mergeAppend x'61 y'61)+        (P'.mergeAppend x'62 y'62)+        (P'.mergeAppend x'63 y'63)+        (P'.mergeAppend x'64 y'64)+        (P'.mergeAppend x'65 y'65)+        (P'.mergeAppend x'66 y'66)+        (P'.mergeAppend x'67 y'67)+        (P'.mergeAppend x'68 y'68)+ +instance P'.Default TestAllTypes where+  defaultValue+    = TestAllTypes P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        (P'.Just 41)+        (P'.Just 42)+        (P'.Just 43)+        (P'.Just 44)+        (P'.Just (-45))+        (P'.Just 46)+        (P'.Just 47)+        (P'.Just 48)+        (P'.Just 49)+        (P'.Just (-50))+        (P'.Just 51.5)+        (P'.Just 52000.0)+        (P'.Just P'.True)+        (P'.Just (P'.Utf8 (P'.pack "hello")))+        (P'.Just (P'.pack "world"))+        (P'.Just (P'.read "BAR"))+        (P'.Just (P'.read "FOREIGN_BAR"))+        (P'.Just (P'.read "IMPORT_BAR"))+        (P'.Just (P'.Utf8 (P'.pack "abc")))+        (P'.Just (P'.Utf8 (P'.pack "123")))+ +instance P'.Wire TestAllTypes where+  wireSize ft'+    self'@(TestAllTypes x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18 x'19 x'20 x'21 x'22 x'23+             x'24 x'25 x'26 x'27 x'28 x'29 x'30 x'31 x'32 x'33 x'34 x'35 x'36 x'37 x'38 x'39 x'40 x'41 x'42 x'43 x'44 x'45 x'46 x'47+             x'48 x'49 x'50 x'51 x'52 x'53 x'54 x'55 x'56 x'57 x'58 x'59 x'60 x'61 x'62 x'63 x'64 x'65 x'66 x'67 x'68)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+          = (P'.wireSizeOpt 1 5 x'1 + P'.wireSizeOpt 1 3 x'2 + P'.wireSizeOpt 1 13 x'3 + P'.wireSizeOpt 1 4 x'4 ++               P'.wireSizeOpt 1 17 x'5+               + P'.wireSizeOpt 1 18 x'6+               + P'.wireSizeOpt 1 7 x'7+               + P'.wireSizeOpt 1 6 x'8+               + P'.wireSizeOpt 1 15 x'9+               + P'.wireSizeOpt 1 16 x'10+               + P'.wireSizeOpt 1 2 x'11+               + P'.wireSizeOpt 1 1 x'12+               + P'.wireSizeOpt 1 8 x'13+               + P'.wireSizeOpt 1 9 x'14+               + P'.wireSizeOpt 1 12 x'15+               + P'.wireSizeOpt 2 10 x'16+               + P'.wireSizeOpt 2 11 x'17+               + P'.wireSizeOpt 2 11 x'18+               + P'.wireSizeOpt 2 11 x'19+               + P'.wireSizeOpt 2 14 x'20+               + P'.wireSizeOpt 2 14 x'21+               + P'.wireSizeOpt 2 14 x'22+               + P'.wireSizeOpt 2 9 x'23+               + P'.wireSizeOpt 2 9 x'24+               + P'.wireSizeRep 2 5 x'25+               + P'.wireSizeRep 2 3 x'26+               + P'.wireSizeRep 2 13 x'27+               + P'.wireSizeRep 2 4 x'28+               + P'.wireSizeRep 2 17 x'29+               + P'.wireSizeRep 2 18 x'30+               + P'.wireSizeRep 2 7 x'31+               + P'.wireSizeRep 2 6 x'32+               + P'.wireSizeRep 2 15 x'33+               + P'.wireSizeRep 2 16 x'34+               + P'.wireSizeRep 2 2 x'35+               + P'.wireSizeRep 2 1 x'36+               + P'.wireSizeRep 2 8 x'37+               + P'.wireSizeRep 2 9 x'38+               + P'.wireSizeRep 2 12 x'39+               + P'.wireSizeRep 2 10 x'40+               + P'.wireSizeRep 2 11 x'41+               + P'.wireSizeRep 2 11 x'42+               + P'.wireSizeRep 2 11 x'43+               + P'.wireSizeRep 2 14 x'44+               + P'.wireSizeRep 2 14 x'45+               + P'.wireSizeRep 2 14 x'46+               + P'.wireSizeRep 2 9 x'47+               + P'.wireSizeRep 2 9 x'48+               + P'.wireSizeOpt 2 5 x'49+               + P'.wireSizeOpt 2 3 x'50+               + P'.wireSizeOpt 2 13 x'51+               + P'.wireSizeOpt 2 4 x'52+               + P'.wireSizeOpt 2 17 x'53+               + P'.wireSizeOpt 2 18 x'54+               + P'.wireSizeOpt 2 7 x'55+               + P'.wireSizeOpt 2 6 x'56+               + P'.wireSizeOpt 2 15 x'57+               + P'.wireSizeOpt 2 16 x'58+               + P'.wireSizeOpt 2 2 x'59+               + P'.wireSizeOpt 2 1 x'60+               + P'.wireSizeOpt 2 8 x'61+               + P'.wireSizeOpt 2 9 x'62+               + P'.wireSizeOpt 2 12 x'63+               + P'.wireSizeOpt 2 14 x'64+               + P'.wireSizeOpt 2 14 x'65+               + P'.wireSizeOpt 2 14 x'66+               + P'.wireSizeOpt 2 9 x'67+               + P'.wireSizeOpt 2 9 x'68)+  wirePut ft'+    self'@(TestAllTypes x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18 x'19 x'20 x'21 x'22 x'23+             x'24 x'25 x'26 x'27 x'28 x'29 x'30 x'31 x'32 x'33 x'34 x'35 x'36 x'37 x'38 x'39 x'40 x'41 x'42 x'43 x'44 x'45 x'46 x'47+             x'48 x'49 x'50 x'51 x'52 x'53 x'54 x'55 x'56 x'57 x'58 x'59 x'60 x'61 x'62 x'63 x'64 x'65 x'66 x'67 x'68)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+              P'.wirePutOpt 16 3 x'2+              P'.wirePutOpt 24 13 x'3+              P'.wirePutOpt 32 4 x'4+              P'.wirePutOpt 45 17 x'5+              P'.wirePutOpt 49 18 x'6+              P'.wirePutOpt 61 7 x'7+              P'.wirePutOpt 65 6 x'8+              P'.wirePutOpt 77 15 x'9+              P'.wirePutOpt 81 16 x'10+              P'.wirePutOpt 93 2 x'11+              P'.wirePutOpt 97 1 x'12+              P'.wirePutOpt 104 8 x'13+              P'.wirePutOpt 114 9 x'14+              P'.wirePutOpt 122 12 x'15+              P'.wirePutOpt 131 10 x'16+              P'.wirePutOpt 146 11 x'17+              P'.wirePutOpt 154 11 x'18+              P'.wirePutOpt 162 11 x'19+              P'.wirePutOpt 168 14 x'20+              P'.wirePutOpt 176 14 x'21+              P'.wirePutOpt 184 14 x'22+              P'.wirePutOpt 194 9 x'23+              P'.wirePutOpt 202 9 x'24+              P'.wirePutRep 248 5 x'25+              P'.wirePutRep 256 3 x'26+              P'.wirePutRep 264 13 x'27+              P'.wirePutRep 272 4 x'28+              P'.wirePutRep 285 17 x'29+              P'.wirePutRep 289 18 x'30+              P'.wirePutRep 301 7 x'31+              P'.wirePutRep 305 6 x'32+              P'.wirePutRep 317 15 x'33+              P'.wirePutRep 321 16 x'34+              P'.wirePutRep 333 2 x'35+              P'.wirePutRep 337 1 x'36+              P'.wirePutRep 344 8 x'37+              P'.wirePutRep 354 9 x'38+              P'.wirePutRep 362 12 x'39+              P'.wirePutRep 371 10 x'40+              P'.wirePutRep 386 11 x'41+              P'.wirePutRep 394 11 x'42+              P'.wirePutRep 402 11 x'43+              P'.wirePutRep 408 14 x'44+              P'.wirePutRep 416 14 x'45+              P'.wirePutRep 424 14 x'46+              P'.wirePutRep 434 9 x'47+              P'.wirePutRep 442 9 x'48+              P'.wirePutOpt 488 5 x'49+              P'.wirePutOpt 496 3 x'50+              P'.wirePutOpt 504 13 x'51+              P'.wirePutOpt 512 4 x'52+              P'.wirePutOpt 525 17 x'53+              P'.wirePutOpt 529 18 x'54+              P'.wirePutOpt 541 7 x'55+              P'.wirePutOpt 545 6 x'56+              P'.wirePutOpt 557 15 x'57+              P'.wirePutOpt 561 16 x'58+              P'.wirePutOpt 573 2 x'59+              P'.wirePutOpt 577 1 x'60+              P'.wirePutOpt 584 8 x'61+              P'.wirePutOpt 594 9 x'62+              P'.wirePutOpt 602 12 x'63+              P'.wirePutOpt 648 14 x'64+              P'.wirePutOpt 656 14 x'65+              P'.wirePutOpt 664 14 x'66+              P'.wirePutOpt 674 9 x'67+              P'.wirePutOpt 682 9 x'68+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{optional_int32 = P'.Just new'Field}) (P'.wireGet 5)+              2 -> P'.fmap (\ new'Field -> old'Self{optional_int64 = P'.Just new'Field}) (P'.wireGet 3)+              3 -> P'.fmap (\ new'Field -> old'Self{optional_uint32 = P'.Just new'Field}) (P'.wireGet 13)+              4 -> P'.fmap (\ new'Field -> old'Self{optional_uint64 = P'.Just new'Field}) (P'.wireGet 4)+              5 -> P'.fmap (\ new'Field -> old'Self{optional_sint32 = P'.Just new'Field}) (P'.wireGet 17)+              6 -> P'.fmap (\ new'Field -> old'Self{optional_sint64 = P'.Just new'Field}) (P'.wireGet 18)+              7 -> P'.fmap (\ new'Field -> old'Self{optional_fixed32 = P'.Just new'Field}) (P'.wireGet 7)+              8 -> P'.fmap (\ new'Field -> old'Self{optional_fixed64 = P'.Just new'Field}) (P'.wireGet 6)+              9 -> P'.fmap (\ new'Field -> old'Self{optional_sfixed32 = P'.Just new'Field}) (P'.wireGet 15)+              10 -> P'.fmap (\ new'Field -> old'Self{optional_sfixed64 = P'.Just new'Field}) (P'.wireGet 16)+              11 -> P'.fmap (\ new'Field -> old'Self{optional_float = P'.Just new'Field}) (P'.wireGet 2)+              12 -> P'.fmap (\ new'Field -> old'Self{optional_double = P'.Just new'Field}) (P'.wireGet 1)+              13 -> P'.fmap (\ new'Field -> old'Self{optional_bool = P'.Just new'Field}) (P'.wireGet 8)+              14 -> P'.fmap (\ new'Field -> old'Self{optional_string = P'.Just new'Field}) (P'.wireGet 9)+              15 -> P'.fmap (\ new'Field -> old'Self{optional_bytes = P'.Just new'Field}) (P'.wireGet 12)+              16+                -> P'.fmap (\ new'Field -> old'Self{optionalGroup = P'.mergeAppend (optionalGroup old'Self) (P'.Just new'Field)})+                     (P'.wireGet 10)+              18+                -> P'.fmap+                     (\ new'Field ->+                        old'Self{optional_nested_message = P'.mergeAppend (optional_nested_message old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              19+                -> P'.fmap+                     (\ new'Field ->+                        old'Self{optional_foreign_message = P'.mergeAppend (optional_foreign_message old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              20+                -> P'.fmap+                     (\ new'Field ->+                        old'Self{optional_import_message = P'.mergeAppend (optional_import_message old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              21 -> P'.fmap (\ new'Field -> old'Self{optional_nested_enum = P'.Just new'Field}) (P'.wireGet 14)+              22 -> P'.fmap (\ new'Field -> old'Self{optional_foreign_enum = P'.Just new'Field}) (P'.wireGet 14)+              23 -> P'.fmap (\ new'Field -> old'Self{optional_import_enum = P'.Just new'Field}) (P'.wireGet 14)+              24 -> P'.fmap (\ new'Field -> old'Self{optional_string_piece = P'.Just new'Field}) (P'.wireGet 9)+              25 -> P'.fmap (\ new'Field -> old'Self{optional_cord = P'.Just new'Field}) (P'.wireGet 9)+              31 -> P'.fmap (\ new'Field -> old'Self{repeated_int32 = P'.append (repeated_int32 old'Self) new'Field}) (P'.wireGet 5)+              32 -> P'.fmap (\ new'Field -> old'Self{repeated_int64 = P'.append (repeated_int64 old'Self) new'Field}) (P'.wireGet 3)+              33+                -> P'.fmap (\ new'Field -> old'Self{repeated_uint32 = P'.append (repeated_uint32 old'Self) new'Field})+                     (P'.wireGet 13)+              34+                -> P'.fmap (\ new'Field -> old'Self{repeated_uint64 = P'.append (repeated_uint64 old'Self) new'Field})+                     (P'.wireGet 4)+              35+                -> P'.fmap (\ new'Field -> old'Self{repeated_sint32 = P'.append (repeated_sint32 old'Self) new'Field})+                     (P'.wireGet 17)+              36+                -> P'.fmap (\ new'Field -> old'Self{repeated_sint64 = P'.append (repeated_sint64 old'Self) new'Field})+                     (P'.wireGet 18)+              37+                -> P'.fmap (\ new'Field -> old'Self{repeated_fixed32 = P'.append (repeated_fixed32 old'Self) new'Field})+                     (P'.wireGet 7)+              38+                -> P'.fmap (\ new'Field -> old'Self{repeated_fixed64 = P'.append (repeated_fixed64 old'Self) new'Field})+                     (P'.wireGet 6)+              39+                -> P'.fmap (\ new'Field -> old'Self{repeated_sfixed32 = P'.append (repeated_sfixed32 old'Self) new'Field})+                     (P'.wireGet 15)+              40+                -> P'.fmap (\ new'Field -> old'Self{repeated_sfixed64 = P'.append (repeated_sfixed64 old'Self) new'Field})+                     (P'.wireGet 16)+              41 -> P'.fmap (\ new'Field -> old'Self{repeated_float = P'.append (repeated_float old'Self) new'Field}) (P'.wireGet 2)+              42+                -> P'.fmap (\ new'Field -> old'Self{repeated_double = P'.append (repeated_double old'Self) new'Field})+                     (P'.wireGet 1)+              43 -> P'.fmap (\ new'Field -> old'Self{repeated_bool = P'.append (repeated_bool old'Self) new'Field}) (P'.wireGet 8)+              44+                -> P'.fmap (\ new'Field -> old'Self{repeated_string = P'.append (repeated_string old'Self) new'Field})+                     (P'.wireGet 9)+              45+                -> P'.fmap (\ new'Field -> old'Self{repeated_bytes = P'.append (repeated_bytes old'Self) new'Field}) (P'.wireGet 12)+              46 -> P'.fmap (\ new'Field -> old'Self{repeatedGroup = P'.append (repeatedGroup old'Self) new'Field}) (P'.wireGet 10)+              48+                -> P'.fmap+                     (\ new'Field -> old'Self{repeated_nested_message = P'.append (repeated_nested_message old'Self) new'Field})+                     (P'.wireGet 11)+              49+                -> P'.fmap+                     (\ new'Field -> old'Self{repeated_foreign_message = P'.append (repeated_foreign_message old'Self) new'Field})+                     (P'.wireGet 11)+              50+                -> P'.fmap+                     (\ new'Field -> old'Self{repeated_import_message = P'.append (repeated_import_message old'Self) new'Field})+                     (P'.wireGet 11)+              51+                -> P'.fmap (\ new'Field -> old'Self{repeated_nested_enum = P'.append (repeated_nested_enum old'Self) new'Field})+                     (P'.wireGet 14)+              52+                -> P'.fmap (\ new'Field -> old'Self{repeated_foreign_enum = P'.append (repeated_foreign_enum old'Self) new'Field})+                     (P'.wireGet 14)+              53+                -> P'.fmap (\ new'Field -> old'Self{repeated_import_enum = P'.append (repeated_import_enum old'Self) new'Field})+                     (P'.wireGet 14)+              54+                -> P'.fmap (\ new'Field -> old'Self{repeated_string_piece = P'.append (repeated_string_piece old'Self) new'Field})+                     (P'.wireGet 9)+              55 -> P'.fmap (\ new'Field -> old'Self{repeated_cord = P'.append (repeated_cord old'Self) new'Field}) (P'.wireGet 9)+              61 -> P'.fmap (\ new'Field -> old'Self{default_int32 = P'.Just new'Field}) (P'.wireGet 5)+              62 -> P'.fmap (\ new'Field -> old'Self{default_int64 = P'.Just new'Field}) (P'.wireGet 3)+              63 -> P'.fmap (\ new'Field -> old'Self{default_uint32 = P'.Just new'Field}) (P'.wireGet 13)+              64 -> P'.fmap (\ new'Field -> old'Self{default_uint64 = P'.Just new'Field}) (P'.wireGet 4)+              65 -> P'.fmap (\ new'Field -> old'Self{default_sint32 = P'.Just new'Field}) (P'.wireGet 17)+              66 -> P'.fmap (\ new'Field -> old'Self{default_sint64 = P'.Just new'Field}) (P'.wireGet 18)+              67 -> P'.fmap (\ new'Field -> old'Self{default_fixed32 = P'.Just new'Field}) (P'.wireGet 7)+              68 -> P'.fmap (\ new'Field -> old'Self{default_fixed64 = P'.Just new'Field}) (P'.wireGet 6)+              69 -> P'.fmap (\ new'Field -> old'Self{default_sfixed32 = P'.Just new'Field}) (P'.wireGet 15)+              70 -> P'.fmap (\ new'Field -> old'Self{default_sfixed64 = P'.Just new'Field}) (P'.wireGet 16)+              71 -> P'.fmap (\ new'Field -> old'Self{default_float = P'.Just new'Field}) (P'.wireGet 2)+              72 -> P'.fmap (\ new'Field -> old'Self{default_double = P'.Just new'Field}) (P'.wireGet 1)+              73 -> P'.fmap (\ new'Field -> old'Self{default_bool = P'.Just new'Field}) (P'.wireGet 8)+              74 -> P'.fmap (\ new'Field -> old'Self{default_string = P'.Just new'Field}) (P'.wireGet 9)+              75 -> P'.fmap (\ new'Field -> old'Self{default_bytes = P'.Just new'Field}) (P'.wireGet 12)+              81 -> P'.fmap (\ new'Field -> old'Self{default_nested_enum = P'.Just new'Field}) (P'.wireGet 14)+              82 -> P'.fmap (\ new'Field -> old'Self{default_foreign_enum = P'.Just new'Field}) (P'.wireGet 14)+              83 -> P'.fmap (\ new'Field -> old'Self{default_import_enum = P'.Just new'Field}) (P'.wireGet 14)+              84 -> P'.fmap (\ new'Field -> old'Self{default_string_piece = P'.Just new'Field}) (P'.wireGet 9)+              85 -> P'.fmap (\ new'Field -> old'Self{default_cord = P'.Just new'Field}) (P'.wireGet 9)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestAllTypes) TestAllTypes where+  getVal m' f' = f' m'+ +instance P'.GPB TestAllTypes+ +instance P'.ReflectDescriptor TestAllTypes where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestAllTypes\"}, descFilePath = [\"UnittestProto\",\"TestAllTypes.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_int32\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_int64\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_uint32\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_uint64\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_sint32\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 45}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 17}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_sint64\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 49}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_fixed32\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 61}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 7}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_fixed64\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 65}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 6}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_sfixed32\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 77}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 15}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_sfixed64\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 81}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 16}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_float\"}, fieldNumber = FieldId {getFieldId = 11}, wireTag = WireTag {getWireTag = 93}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_double\"}, fieldNumber = FieldId {getFieldId = 12}, wireTag = WireTag {getWireTag = 97}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_bool\"}, fieldNumber = FieldId {getFieldId = 13}, wireTag = WireTag {getWireTag = 104}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_string\"}, fieldNumber = FieldId {getFieldId = 14}, wireTag = WireTag {getWireTag = 114}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_bytes\"}, fieldNumber = FieldId {getFieldId = 15}, wireTag = WireTag {getWireTag = 122}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optionalGroup\"}, fieldNumber = FieldId {getFieldId = 16}, wireTag = WireTag {getWireTag = 131}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 10}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"OptionalGroup\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_nested_message\"}, fieldNumber = FieldId {getFieldId = 18}, wireTag = WireTag {getWireTag = 146}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_foreign_message\"}, fieldNumber = FieldId {getFieldId = 19}, wireTag = WireTag {getWireTag = 154}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_import_message\"}, fieldNumber = FieldId {getFieldId = 20}, wireTag = WireTag {getWireTag = 162}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_nested_enum\"}, fieldNumber = FieldId {getFieldId = 21}, wireTag = WireTag {getWireTag = 168}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_foreign_enum\"}, fieldNumber = FieldId {getFieldId = 22}, wireTag = WireTag {getWireTag = 176}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_import_enum\"}, fieldNumber = FieldId {getFieldId = 23}, wireTag = WireTag {getWireTag = 184}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_string_piece\"}, fieldNumber = FieldId {getFieldId = 24}, wireTag = WireTag {getWireTag = 194}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"optional_cord\"}, fieldNumber = FieldId {getFieldId = 25}, wireTag = WireTag {getWireTag = 202}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_int32\"}, fieldNumber = FieldId {getFieldId = 31}, wireTag = WireTag {getWireTag = 248}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_int64\"}, fieldNumber = FieldId {getFieldId = 32}, wireTag = WireTag {getWireTag = 256}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_uint32\"}, fieldNumber = FieldId {getFieldId = 33}, wireTag = WireTag {getWireTag = 264}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_uint64\"}, fieldNumber = FieldId {getFieldId = 34}, wireTag = WireTag {getWireTag = 272}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_sint32\"}, fieldNumber = FieldId {getFieldId = 35}, wireTag = WireTag {getWireTag = 285}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 17}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_sint64\"}, fieldNumber = FieldId {getFieldId = 36}, wireTag = WireTag {getWireTag = 289}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_fixed32\"}, fieldNumber = FieldId {getFieldId = 37}, wireTag = WireTag {getWireTag = 301}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 7}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_fixed64\"}, fieldNumber = FieldId {getFieldId = 38}, wireTag = WireTag {getWireTag = 305}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 6}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_sfixed32\"}, fieldNumber = FieldId {getFieldId = 39}, wireTag = WireTag {getWireTag = 317}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 15}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_sfixed64\"}, fieldNumber = FieldId {getFieldId = 40}, wireTag = WireTag {getWireTag = 321}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 16}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_float\"}, fieldNumber = FieldId {getFieldId = 41}, wireTag = WireTag {getWireTag = 333}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_double\"}, fieldNumber = FieldId {getFieldId = 42}, wireTag = WireTag {getWireTag = 337}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_bool\"}, fieldNumber = FieldId {getFieldId = 43}, wireTag = WireTag {getWireTag = 344}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_string\"}, fieldNumber = FieldId {getFieldId = 44}, wireTag = WireTag {getWireTag = 354}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_bytes\"}, fieldNumber = FieldId {getFieldId = 45}, wireTag = WireTag {getWireTag = 362}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeatedGroup\"}, fieldNumber = FieldId {getFieldId = 46}, wireTag = WireTag {getWireTag = 371}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 10}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"RepeatedGroup\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_nested_message\"}, fieldNumber = FieldId {getFieldId = 48}, wireTag = WireTag {getWireTag = 386}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_foreign_message\"}, fieldNumber = FieldId {getFieldId = 49}, wireTag = WireTag {getWireTag = 394}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_import_message\"}, fieldNumber = FieldId {getFieldId = 50}, wireTag = WireTag {getWireTag = 402}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_nested_enum\"}, fieldNumber = FieldId {getFieldId = 51}, wireTag = WireTag {getWireTag = 408}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_foreign_enum\"}, fieldNumber = FieldId {getFieldId = 52}, wireTag = WireTag {getWireTag = 416}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_import_enum\"}, fieldNumber = FieldId {getFieldId = 53}, wireTag = WireTag {getWireTag = 424}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_string_piece\"}, fieldNumber = FieldId {getFieldId = 54}, wireTag = WireTag {getWireTag = 434}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"repeated_cord\"}, fieldNumber = FieldId {getFieldId = 55}, wireTag = WireTag {getWireTag = 442}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_int32\"}, fieldNumber = FieldId {getFieldId = 61}, wireTag = WireTag {getWireTag = 488}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Just (Chunk \"41\" Empty), hsDefault = Just (HsDef'Integer 41)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_int64\"}, fieldNumber = FieldId {getFieldId = 62}, wireTag = WireTag {getWireTag = 496}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Just (Chunk \"42\" Empty), hsDefault = Just (HsDef'Integer 42)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_uint32\"}, fieldNumber = FieldId {getFieldId = 63}, wireTag = WireTag {getWireTag = 504}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Just (Chunk \"43\" Empty), hsDefault = Just (HsDef'Integer 43)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_uint64\"}, fieldNumber = FieldId {getFieldId = 64}, wireTag = WireTag {getWireTag = 512}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Just (Chunk \"44\" Empty), hsDefault = Just (HsDef'Integer 44)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_sint32\"}, fieldNumber = FieldId {getFieldId = 65}, wireTag = WireTag {getWireTag = 525}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 17}, typeName = Nothing, hsRawDefault = Just (Chunk \"-45\" Empty), hsDefault = Just (HsDef'Integer (-45))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_sint64\"}, fieldNumber = FieldId {getFieldId = 66}, wireTag = WireTag {getWireTag = 529}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Just (Chunk \"46\" Empty), hsDefault = Just (HsDef'Integer 46)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_fixed32\"}, fieldNumber = FieldId {getFieldId = 67}, wireTag = WireTag {getWireTag = 541}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 7}, typeName = Nothing, hsRawDefault = Just (Chunk \"47\" Empty), hsDefault = Just (HsDef'Integer 47)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_fixed64\"}, fieldNumber = FieldId {getFieldId = 68}, wireTag = WireTag {getWireTag = 545}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 6}, typeName = Nothing, hsRawDefault = Just (Chunk \"48\" Empty), hsDefault = Just (HsDef'Integer 48)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_sfixed32\"}, fieldNumber = FieldId {getFieldId = 69}, wireTag = WireTag {getWireTag = 557}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 15}, typeName = Nothing, hsRawDefault = Just (Chunk \"49\" Empty), hsDefault = Just (HsDef'Integer 49)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_sfixed64\"}, fieldNumber = FieldId {getFieldId = 70}, wireTag = WireTag {getWireTag = 561}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 16}, typeName = Nothing, hsRawDefault = Just (Chunk \"-50\" Empty), hsDefault = Just (HsDef'Integer (-50))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_float\"}, fieldNumber = FieldId {getFieldId = 71}, wireTag = WireTag {getWireTag = 573}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Just (Chunk \"51.5\" Empty), hsDefault = Just (HsDef'Rational (103%2))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_double\"}, fieldNumber = FieldId {getFieldId = 72}, wireTag = WireTag {getWireTag = 577}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Just (Chunk \"52000.0\" Empty), hsDefault = Just (HsDef'Rational (52000%1))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_bool\"}, fieldNumber = FieldId {getFieldId = 73}, wireTag = WireTag {getWireTag = 584}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just (Chunk \"true\" Empty), hsDefault = Just (HsDef'Bool True)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_string\"}, fieldNumber = FieldId {getFieldId = 74}, wireTag = WireTag {getWireTag = 594}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Just (Chunk \"hello\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"hello\" Empty))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_bytes\"}, fieldNumber = FieldId {getFieldId = 75}, wireTag = WireTag {getWireTag = 602}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Just (Chunk \"world\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"world\" Empty))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_nested_enum\"}, fieldNumber = FieldId {getFieldId = 81}, wireTag = WireTag {getWireTag = 648}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedEnum\"}), hsRawDefault = Just (Chunk \"BAR\" Empty), hsDefault = Just (HsDef'Enum \"BAR\")},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_foreign_enum\"}, fieldNumber = FieldId {getFieldId = 82}, wireTag = WireTag {getWireTag = 656}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignEnum\"}), hsRawDefault = Just (Chunk \"FOREIGN_BAR\" Empty), hsDefault = Just (HsDef'Enum \"FOREIGN_BAR\")},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_import_enum\"}, fieldNumber = FieldId {getFieldId = 83}, wireTag = WireTag {getWireTag = 664}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"Com.Google.Protobuf.Test\", baseName = \"ImportEnum\"}), hsRawDefault = Just (Chunk \"IMPORT_BAR\" Empty), hsDefault = Just (HsDef'Enum \"IMPORT_BAR\")},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_string_piece\"}, fieldNumber = FieldId {getFieldId = 84}, wireTag = WireTag {getWireTag = 674}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Just (Chunk \"abc\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"abc\" Empty))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"default_cord\"}, fieldNumber = FieldId {getFieldId = 85}, wireTag = WireTag {getWireTag = 682}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Just (Chunk \"123\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"123\" Empty))}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestAllTypes/NestedEnum.hs view
@@ -0,0 +1,47 @@+module UnittestProto.TestAllTypes.NestedEnum (NestedEnum(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data NestedEnum = FOO+                | BAR+                | BAZ+                deriving (P'.Read, P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable NestedEnum+ +instance P'.Bounded NestedEnum where+  minBound = FOO+  maxBound = BAZ+ +instance P'.Default NestedEnum where+  defaultValue = FOO+ +instance P'.Enum NestedEnum where+  fromEnum (FOO) = 1+  fromEnum (BAR) = 2+  fromEnum (BAZ) = 3+  toEnum 1 = FOO+  toEnum 2 = BAR+  toEnum 3 = BAZ+  succ (FOO) = BAR+  succ (BAR) = BAZ+  pred (BAR) = FOO+  pred (BAZ) = BAR+ +instance P'.Wire NestedEnum where+  wireSize ft' enum = P'.wireSize ft' (P'.fromEnum enum)+  wirePut ft' enum = P'.wirePut ft' (P'.fromEnum enum)+  wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)+  wireGet ft' = P'.wireGetErr ft'+ +instance P'.GPB NestedEnum+ +instance P'.MessageAPI msg' (msg' -> NestedEnum) NestedEnum where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum NestedEnum where+  reflectEnum = [(1, "FOO", FOO), (2, "BAR", BAR), (3, "BAZ", BAZ)]+  reflectEnumInfo _+    = P'.EnumInfo (P'.ProtoName "" "UnittestProto.TestAllTypes" "NestedEnum") ["UnittestProto", "TestAllTypes", "NestedEnum.hs"]+        [(1, "FOO"), (2, "BAR"), (3, "BAZ")]
+ tests/UnittestProto/TestAllTypes/NestedMessage.hs view
@@ -0,0 +1,55 @@+module UnittestProto.TestAllTypes.NestedMessage (NestedMessage(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data NestedMessage = NestedMessage{bb :: P'.Maybe P'.Int32}+                   deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable NestedMessage where+  mergeEmpty = NestedMessage P'.mergeEmpty+  mergeAppend (NestedMessage x'1) (NestedMessage y'1) = NestedMessage (P'.mergeAppend x'1 y'1)+ +instance P'.Default NestedMessage where+  defaultValue = NestedMessage P'.defaultValue+ +instance P'.Wire NestedMessage where+  wireSize ft' self'@(NestedMessage x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 5 x'1)+  wirePut ft' self'@(NestedMessage x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{bb = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> NestedMessage) NestedMessage where+  getVal m' f' = f' m'+ +instance P'.GPB NestedMessage+ +instance P'.ReflectDescriptor NestedMessage where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedMessage\"}, descFilePath = [\"UnittestProto\",\"TestAllTypes\",\"NestedMessage.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes.NestedMessage\", baseName = \"bb\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestAllTypes/OptionalGroup.hs view
@@ -0,0 +1,55 @@+module UnittestProto.TestAllTypes.OptionalGroup (OptionalGroup(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data OptionalGroup = OptionalGroup{a :: P'.Maybe P'.Int32}+                   deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable OptionalGroup where+  mergeEmpty = OptionalGroup P'.mergeEmpty+  mergeAppend (OptionalGroup x'1) (OptionalGroup y'1) = OptionalGroup (P'.mergeAppend x'1 y'1)+ +instance P'.Default OptionalGroup where+  defaultValue = OptionalGroup P'.defaultValue+ +instance P'.Wire OptionalGroup where+  wireSize ft' self'@(OptionalGroup x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 2 5 x'1)+  wirePut ft' self'@(OptionalGroup x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 136 5 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              17 -> P'.fmap (\ new'Field -> old'Self{a = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> OptionalGroup) OptionalGroup where+  getVal m' f' = f' m'+ +instance P'.GPB OptionalGroup+ +instance P'.ReflectDescriptor OptionalGroup where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"OptionalGroup\"}, descFilePath = [\"UnittestProto\",\"TestAllTypes\",\"OptionalGroup.hs\"], isGroup = True, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes.OptionalGroup\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 17}, wireTag = WireTag {getWireTag = 136}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestAllTypes/RepeatedGroup.hs view
@@ -0,0 +1,55 @@+module UnittestProto.TestAllTypes.RepeatedGroup (RepeatedGroup(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data RepeatedGroup = RepeatedGroup{a :: P'.Maybe P'.Int32}+                   deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable RepeatedGroup where+  mergeEmpty = RepeatedGroup P'.mergeEmpty+  mergeAppend (RepeatedGroup x'1) (RepeatedGroup y'1) = RepeatedGroup (P'.mergeAppend x'1 y'1)+ +instance P'.Default RepeatedGroup where+  defaultValue = RepeatedGroup P'.defaultValue+ +instance P'.Wire RepeatedGroup where+  wireSize ft' self'@(RepeatedGroup x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 2 5 x'1)+  wirePut ft' self'@(RepeatedGroup x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 376 5 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              47 -> P'.fmap (\ new'Field -> old'Self{a = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> RepeatedGroup) RepeatedGroup where+  getVal m' f' = f' m'+ +instance P'.GPB RepeatedGroup+ +instance P'.ReflectDescriptor RepeatedGroup where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"RepeatedGroup\"}, descFilePath = [\"UnittestProto\",\"TestAllTypes\",\"RepeatedGroup.hs\"], isGroup = True, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes.RepeatedGroup\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 47}, wireTag = WireTag {getWireTag = 376}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestCamelCaseFieldNames.hs view
@@ -0,0 +1,131 @@+module UnittestProto.TestCamelCaseFieldNames (TestCamelCaseFieldNames(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto.ForeignEnum as UnittestProto (ForeignEnum)+import qualified UnittestProto.ForeignMessage as UnittestProto (ForeignMessage)+ +data TestCamelCaseFieldNames = TestCamelCaseFieldNames{primitiveField :: P'.Maybe P'.Int32, stringField :: P'.Maybe P'.Utf8,+                                                       enumField :: P'.Maybe UnittestProto.ForeignEnum,+                                                       messageField :: P'.Maybe UnittestProto.ForeignMessage,+                                                       stringPieceField :: P'.Maybe P'.Utf8, cordField :: P'.Maybe P'.Utf8,+                                                       repeatedPrimitiveField :: P'.Seq P'.Int32,+                                                       repeatedStringField :: P'.Seq P'.Utf8,+                                                       repeatedEnumField :: P'.Seq UnittestProto.ForeignEnum,+                                                       repeatedMessageField :: P'.Seq UnittestProto.ForeignMessage,+                                                       repeatedStringPieceField :: P'.Seq P'.Utf8,+                                                       repeatedCordField :: P'.Seq P'.Utf8}+                             deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestCamelCaseFieldNames where+  mergeEmpty+    = TestCamelCaseFieldNames P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+  mergeAppend (TestCamelCaseFieldNames x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12)+    (TestCamelCaseFieldNames y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8 y'9 y'10 y'11 y'12)+    = TestCamelCaseFieldNames (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+        (P'.mergeAppend x'5 y'5)+        (P'.mergeAppend x'6 y'6)+        (P'.mergeAppend x'7 y'7)+        (P'.mergeAppend x'8 y'8)+        (P'.mergeAppend x'9 y'9)+        (P'.mergeAppend x'10 y'10)+        (P'.mergeAppend x'11 y'11)+        (P'.mergeAppend x'12 y'12)+ +instance P'.Default TestCamelCaseFieldNames where+  defaultValue+    = TestCamelCaseFieldNames P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+ +instance P'.Wire TestCamelCaseFieldNames where+  wireSize ft' self'@(TestCamelCaseFieldNames x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+          = (P'.wireSizeOpt 1 5 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeOpt 1 14 x'3 + P'.wireSizeOpt 1 11 x'4 ++               P'.wireSizeOpt 1 9 x'5+               + P'.wireSizeOpt 1 9 x'6+               + P'.wireSizeRep 1 5 x'7+               + P'.wireSizeRep 1 9 x'8+               + P'.wireSizeRep 1 14 x'9+               + P'.wireSizeRep 1 11 x'10+               + P'.wireSizeRep 1 9 x'11+               + P'.wireSizeRep 1 9 x'12)+  wirePut ft' self'@(TestCamelCaseFieldNames x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+              P'.wirePutOpt 18 9 x'2+              P'.wirePutOpt 24 14 x'3+              P'.wirePutOpt 34 11 x'4+              P'.wirePutOpt 42 9 x'5+              P'.wirePutOpt 50 9 x'6+              P'.wirePutRep 56 5 x'7+              P'.wirePutRep 66 9 x'8+              P'.wirePutRep 72 14 x'9+              P'.wirePutRep 82 11 x'10+              P'.wirePutRep 90 9 x'11+              P'.wirePutRep 98 9 x'12+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{primitiveField = P'.Just new'Field}) (P'.wireGet 5)+              2 -> P'.fmap (\ new'Field -> old'Self{stringField = P'.Just new'Field}) (P'.wireGet 9)+              3 -> P'.fmap (\ new'Field -> old'Self{enumField = P'.Just new'Field}) (P'.wireGet 14)+              4 -> P'.fmap (\ new'Field -> old'Self{messageField = P'.mergeAppend (messageField old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              5 -> P'.fmap (\ new'Field -> old'Self{stringPieceField = P'.Just new'Field}) (P'.wireGet 9)+              6 -> P'.fmap (\ new'Field -> old'Self{cordField = P'.Just new'Field}) (P'.wireGet 9)+              7 -> P'.fmap (\ new'Field -> old'Self{repeatedPrimitiveField = P'.append (repeatedPrimitiveField old'Self) new'Field})+                     (P'.wireGet 5)+              8 -> P'.fmap (\ new'Field -> old'Self{repeatedStringField = P'.append (repeatedStringField old'Self) new'Field})+                     (P'.wireGet 9)+              9 -> P'.fmap (\ new'Field -> old'Self{repeatedEnumField = P'.append (repeatedEnumField old'Self) new'Field})+                     (P'.wireGet 14)+              10+                -> P'.fmap (\ new'Field -> old'Self{repeatedMessageField = P'.append (repeatedMessageField old'Self) new'Field})+                     (P'.wireGet 11)+              11+                -> P'.fmap+                     (\ new'Field -> old'Self{repeatedStringPieceField = P'.append (repeatedStringPieceField old'Self) new'Field})+                     (P'.wireGet 9)+              12+                -> P'.fmap (\ new'Field -> old'Self{repeatedCordField = P'.append (repeatedCordField old'Self) new'Field})+                     (P'.wireGet 9)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestCamelCaseFieldNames) TestCamelCaseFieldNames where+  getVal m' f' = f' m'+ +instance P'.GPB TestCamelCaseFieldNames+ +instance P'.ReflectDescriptor TestCamelCaseFieldNames where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestCamelCaseFieldNames\"}, descFilePath = [\"UnittestProto\",\"TestCamelCaseFieldNames.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"primitiveField\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"stringField\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"enumField\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"messageField\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"stringPieceField\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"cordField\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"repeatedPrimitiveField\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"repeatedStringField\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 66}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"repeatedEnumField\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 72}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignEnum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"repeatedMessageField\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 82}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"repeatedStringPieceField\"}, fieldNumber = FieldId {getFieldId = 11}, wireTag = WireTag {getWireTag = 90}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestCamelCaseFieldNames\", baseName = \"repeatedCordField\"}, fieldNumber = FieldId {getFieldId = 12}, wireTag = WireTag {getWireTag = 98}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestDupFieldNumber.hs view
@@ -0,0 +1,63 @@+module UnittestProto.TestDupFieldNumber (TestDupFieldNumber(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto.TestDupFieldNumber.Bar as UnittestProto.TestDupFieldNumber (Bar)+import qualified UnittestProto.TestDupFieldNumber.Foo as UnittestProto.TestDupFieldNumber (Foo)+ +data TestDupFieldNumber = TestDupFieldNumber{a :: P'.Maybe P'.Int32, foo :: P'.Maybe UnittestProto.TestDupFieldNumber.Foo,+                                             bar :: P'.Maybe UnittestProto.TestDupFieldNumber.Bar}+                        deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestDupFieldNumber where+  mergeEmpty = TestDupFieldNumber P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (TestDupFieldNumber x'1 x'2 x'3) (TestDupFieldNumber y'1 y'2 y'3)+    = TestDupFieldNumber (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default TestDupFieldNumber where+  defaultValue = TestDupFieldNumber P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire TestDupFieldNumber where+  wireSize ft' self'@(TestDupFieldNumber x'1 x'2 x'3)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 5 x'1 + P'.wireSizeOpt 1 10 x'2 + P'.wireSizeOpt 1 10 x'3)+  wirePut ft' self'@(TestDupFieldNumber x'1 x'2 x'3)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+              P'.wirePutOpt 19 10 x'2+              P'.wirePutOpt 27 10 x'3+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{a = P'.Just new'Field}) (P'.wireGet 5)+              2 -> P'.fmap (\ new'Field -> old'Self{foo = P'.mergeAppend (foo old'Self) (P'.Just new'Field)}) (P'.wireGet 10)+              3 -> P'.fmap (\ new'Field -> old'Self{bar = P'.mergeAppend (bar old'Self) (P'.Just new'Field)}) (P'.wireGet 10)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestDupFieldNumber) TestDupFieldNumber where+  getVal m' f' = f' m'+ +instance P'.GPB TestDupFieldNumber+ +instance P'.ReflectDescriptor TestDupFieldNumber where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestDupFieldNumber\"}, descFilePath = [\"UnittestProto\",\"TestDupFieldNumber.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber\", baseName = \"foo\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 19}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 10}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber\", baseName = \"Foo\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber\", baseName = \"bar\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 27}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 10}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber\", baseName = \"Bar\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestDupFieldNumber/Bar.hs view
@@ -0,0 +1,55 @@+module UnittestProto.TestDupFieldNumber.Bar (Bar(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data Bar = Bar{a :: P'.Maybe P'.Int32}+         deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable Bar where+  mergeEmpty = Bar P'.mergeEmpty+  mergeAppend (Bar x'1) (Bar y'1) = Bar (P'.mergeAppend x'1 y'1)+ +instance P'.Default Bar where+  defaultValue = Bar P'.defaultValue+ +instance P'.Wire Bar where+  wireSize ft' self'@(Bar x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 5 x'1)+  wirePut ft' self'@(Bar x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{a = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> Bar) Bar where+  getVal m' f' = f' m'+ +instance P'.GPB Bar+ +instance P'.ReflectDescriptor Bar where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber\", baseName = \"Bar\"}, descFilePath = [\"UnittestProto\",\"TestDupFieldNumber\",\"Bar.hs\"], isGroup = True, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber.Bar\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestDupFieldNumber/Foo.hs view
@@ -0,0 +1,55 @@+module UnittestProto.TestDupFieldNumber.Foo (Foo(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data Foo = Foo{a :: P'.Maybe P'.Int32}+         deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable Foo where+  mergeEmpty = Foo P'.mergeEmpty+  mergeAppend (Foo x'1) (Foo y'1) = Foo (P'.mergeAppend x'1 y'1)+ +instance P'.Default Foo where+  defaultValue = Foo P'.defaultValue+ +instance P'.Wire Foo where+  wireSize ft' self'@(Foo x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 5 x'1)+  wirePut ft' self'@(Foo x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{a = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> Foo) Foo where+  getVal m' f' = f' m'+ +instance P'.GPB Foo+ +instance P'.ReflectDescriptor Foo where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber\", baseName = \"Foo\"}, descFilePath = [\"UnittestProto\",\"TestDupFieldNumber\",\"Foo.hs\"], isGroup = True, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestDupFieldNumber.Foo\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestEmptyMessage.hs view
@@ -0,0 +1,54 @@+module UnittestProto.TestEmptyMessage (TestEmptyMessage(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data TestEmptyMessage = TestEmptyMessage{}+                      deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestEmptyMessage where+  mergeEmpty = TestEmptyMessage+  mergeAppend (TestEmptyMessage) (TestEmptyMessage) = TestEmptyMessage+ +instance P'.Default TestEmptyMessage where+  defaultValue = TestEmptyMessage+ +instance P'.Wire TestEmptyMessage where+  wireSize ft' self'@(TestEmptyMessage)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(TestEmptyMessage)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.return ()+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestEmptyMessage) TestEmptyMessage where+  getVal m' f' = f' m'+ +instance P'.GPB TestEmptyMessage+ +instance P'.ReflectDescriptor TestEmptyMessage where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestEmptyMessage\"}, descFilePath = [\"UnittestProto\",\"TestEmptyMessage.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestEmptyMessageWithExtensions.hs view
@@ -0,0 +1,60 @@+module UnittestProto.TestEmptyMessageWithExtensions (TestEmptyMessageWithExtensions(..)) where+import Prelude ((+), (<=), (&&), ( || ))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data TestEmptyMessageWithExtensions = TestEmptyMessageWithExtensions{ext'field :: P'.ExtField}+                                    deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.ExtendMessage TestEmptyMessageWithExtensions where+  getExtField = ext'field+  putExtField e'f msg = msg{ext'field = e'f}+  validExtRanges msg = P'.extRanges (P'.reflectDescriptorInfo msg)+ +instance P'.Mergeable TestEmptyMessageWithExtensions where+  mergeEmpty = TestEmptyMessageWithExtensions P'.mergeEmpty+  mergeAppend (TestEmptyMessageWithExtensions x'1) (TestEmptyMessageWithExtensions y'1)+    = TestEmptyMessageWithExtensions (P'.mergeAppend x'1 y'1)+ +instance P'.Default TestEmptyMessageWithExtensions where+  defaultValue = TestEmptyMessageWithExtensions P'.defaultValue+ +instance P'.Wire TestEmptyMessageWithExtensions where+  wireSize ft' self'@(TestEmptyMessageWithExtensions x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeExtField x'1)+  wirePut ft' self'@(TestEmptyMessageWithExtensions x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutExtField x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessageExt update'Self+        11 -> P'.getMessageExt update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestEmptyMessageWithExtensions) TestEmptyMessageWithExtensions where+  getVal m' f' = f' m'+ +instance P'.GPB TestEmptyMessageWithExtensions+ +instance P'.ReflectDescriptor TestEmptyMessageWithExtensions where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestEmptyMessageWithExtensions\"}, descFilePath = [\"UnittestProto\",\"TestEmptyMessageWithExtensions.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 1},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 536870911})], knownKeys = fromList []}"
+ tests/UnittestProto/TestEnumWithDupValue.hs view
@@ -0,0 +1,57 @@+module UnittestProto.TestEnumWithDupValue (TestEnumWithDupValue(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data TestEnumWithDupValue = FOO1+                          | BAR1+                          | BAZ+                          | FOO2+                          | BAR2+                          deriving (P'.Read, P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestEnumWithDupValue+ +instance P'.Bounded TestEnumWithDupValue where+  minBound = FOO1+  maxBound = BAR2+ +instance P'.Default TestEnumWithDupValue where+  defaultValue = FOO1+ +instance P'.Enum TestEnumWithDupValue where+  fromEnum (FOO1) = 1+  fromEnum (BAR1) = 2+  fromEnum (BAZ) = 3+  fromEnum (FOO2) = 1+  fromEnum (BAR2) = 2+  toEnum 1 = FOO1+  toEnum 2 = BAR1+  toEnum 3 = BAZ+  toEnum 1 = FOO2+  toEnum 2 = BAR2+  succ (FOO1) = BAR1+  succ (BAR1) = BAZ+  succ (BAZ) = FOO2+  succ (FOO2) = BAR2+  pred (BAR1) = FOO1+  pred (BAZ) = BAR1+  pred (FOO2) = BAZ+  pred (BAR2) = FOO2+ +instance P'.Wire TestEnumWithDupValue where+  wireSize ft' enum = P'.wireSize ft' (P'.fromEnum enum)+  wirePut ft' enum = P'.wirePut ft' (P'.fromEnum enum)+  wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)+  wireGet ft' = P'.wireGetErr ft'+ +instance P'.GPB TestEnumWithDupValue+ +instance P'.MessageAPI msg' (msg' -> TestEnumWithDupValue) TestEnumWithDupValue where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum TestEnumWithDupValue where+  reflectEnum = [(1, "FOO1", FOO1), (2, "BAR1", BAR1), (3, "BAZ", BAZ), (1, "FOO2", FOO2), (2, "BAR2", BAR2)]+  reflectEnumInfo _+    = P'.EnumInfo (P'.ProtoName "" "UnittestProto" "TestEnumWithDupValue") ["UnittestProto", "TestEnumWithDupValue.hs"]+        [(1, "FOO1"), (2, "BAR1"), (3, "BAZ"), (1, "FOO2"), (2, "BAR2")]
+ tests/UnittestProto/TestExtremeDefaultValues.hs view
@@ -0,0 +1,79 @@+module UnittestProto.TestExtremeDefaultValues (TestExtremeDefaultValues(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data TestExtremeDefaultValues = TestExtremeDefaultValues{escaped_bytes :: P'.Maybe P'.ByteString,+                                                         large_uint32 :: P'.Maybe P'.Word32, large_uint64 :: P'.Maybe P'.Word64,+                                                         small_int32 :: P'.Maybe P'.Int32, small_int64 :: P'.Maybe P'.Int64,+                                                         utf8_string :: P'.Maybe P'.Utf8}+                              deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestExtremeDefaultValues where+  mergeEmpty = TestExtremeDefaultValues P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (TestExtremeDefaultValues x'1 x'2 x'3 x'4 x'5 x'6) (TestExtremeDefaultValues y'1 y'2 y'3 y'4 y'5 y'6)+    = TestExtremeDefaultValues (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+        (P'.mergeAppend x'5 y'5)+        (P'.mergeAppend x'6 y'6)+ +instance P'.Default TestExtremeDefaultValues where+  defaultValue+    = TestExtremeDefaultValues (P'.Just (P'.pack "\NUL\SOH\a\b\f\n\r\t\v\\'\"\254")) (P'.Just 4294967295)+        (P'.Just 18446744073709551615)+        (P'.Just (-2147483647))+        (P'.Just (-9223372036854775807))+        (P'.Just (P'.Utf8 (P'.pack "\225\136\180")))+ +instance P'.Wire TestExtremeDefaultValues where+  wireSize ft' self'@(TestExtremeDefaultValues x'1 x'2 x'3 x'4 x'5 x'6)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+          = (P'.wireSizeOpt 1 12 x'1 + P'.wireSizeOpt 1 13 x'2 + P'.wireSizeOpt 1 4 x'3 + P'.wireSizeOpt 1 5 x'4 ++               P'.wireSizeOpt 1 3 x'5+               + P'.wireSizeOpt 1 9 x'6)+  wirePut ft' self'@(TestExtremeDefaultValues x'1 x'2 x'3 x'4 x'5 x'6)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 12 x'1+              P'.wirePutOpt 16 13 x'2+              P'.wirePutOpt 24 4 x'3+              P'.wirePutOpt 32 5 x'4+              P'.wirePutOpt 40 3 x'5+              P'.wirePutOpt 50 9 x'6+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{escaped_bytes = P'.Just new'Field}) (P'.wireGet 12)+              2 -> P'.fmap (\ new'Field -> old'Self{large_uint32 = P'.Just new'Field}) (P'.wireGet 13)+              3 -> P'.fmap (\ new'Field -> old'Self{large_uint64 = P'.Just new'Field}) (P'.wireGet 4)+              4 -> P'.fmap (\ new'Field -> old'Self{small_int32 = P'.Just new'Field}) (P'.wireGet 5)+              5 -> P'.fmap (\ new'Field -> old'Self{small_int64 = P'.Just new'Field}) (P'.wireGet 3)+              6 -> P'.fmap (\ new'Field -> old'Self{utf8_string = P'.Just new'Field}) (P'.wireGet 9)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestExtremeDefaultValues) TestExtremeDefaultValues where+  getVal m' f' = f' m'+ +instance P'.GPB TestExtremeDefaultValues+ +instance P'.ReflectDescriptor TestExtremeDefaultValues where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestExtremeDefaultValues\"}, descFilePath = [\"UnittestProto\",\"TestExtremeDefaultValues.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestExtremeDefaultValues\", baseName = \"escaped_bytes\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Just (Chunk \"\\NUL\\SOH\\a\\b\\f\\n\\r\\t\\v\\\\'\\\"\\254\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"\\NUL\\SOH\\a\\b\\f\\n\\r\\t\\v\\\\'\\\"\\254\" Empty))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestExtremeDefaultValues\", baseName = \"large_uint32\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Just (Chunk \"4294967295\" Empty), hsDefault = Just (HsDef'Integer 4294967295)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestExtremeDefaultValues\", baseName = \"large_uint64\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Just (Chunk \"18446744073709551615\" Empty), hsDefault = Just (HsDef'Integer 18446744073709551615)},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestExtremeDefaultValues\", baseName = \"small_int32\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Just (Chunk \"-2147483647\" Empty), hsDefault = Just (HsDef'Integer (-2147483647))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestExtremeDefaultValues\", baseName = \"small_int64\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Just (Chunk \"-9223372036854775807\" Empty), hsDefault = Just (HsDef'Integer (-9223372036854775807))},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestExtremeDefaultValues\", baseName = \"utf8_string\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Just (Chunk \"\\225\\136\\180\" Empty), hsDefault = Just (HsDef'ByteString (Chunk \"\\225\\136\\180\" Empty))}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestFieldOrderings.hs view
@@ -0,0 +1,70 @@+module UnittestProto.TestFieldOrderings (TestFieldOrderings(..)) where+import Prelude ((+), (<=), (&&), ( || ))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto as UnittestProto (my_extension_int, my_extension_string)+ +data TestFieldOrderings = TestFieldOrderings{my_string :: P'.Maybe P'.Utf8, my_int :: P'.Maybe P'.Int64,+                                             my_float :: P'.Maybe P'.Float, ext'field :: P'.ExtField}+                        deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.ExtendMessage TestFieldOrderings where+  getExtField = ext'field+  putExtField e'f msg = msg{ext'field = e'f}+  validExtRanges msg = P'.extRanges (P'.reflectDescriptorInfo msg)+ +instance P'.Mergeable TestFieldOrderings where+  mergeEmpty = TestFieldOrderings P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (TestFieldOrderings x'1 x'2 x'3 x'4) (TestFieldOrderings y'1 y'2 y'3 y'4)+    = TestFieldOrderings (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+ +instance P'.Default TestFieldOrderings where+  defaultValue = TestFieldOrderings P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire TestFieldOrderings where+  wireSize ft' self'@(TestFieldOrderings x'1 x'2 x'3 x'4)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 3 x'2 + P'.wireSizeOpt 2 2 x'3 + P'.wireSizeExtField x'4)+  wirePut ft' self'@(TestFieldOrderings x'1 x'2 x'3 x'4)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 3 x'2+              P'.wirePutOpt 90 9 x'1+              P'.wirePutOpt 813 2 x'3+              P'.wirePutExtField x'4+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessageExt update'Self+        11 -> P'.getMessageExt update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              11 -> P'.fmap (\ new'Field -> old'Self{my_string = P'.Just new'Field}) (P'.wireGet 9)+              1 -> P'.fmap (\ new'Field -> old'Self{my_int = P'.Just new'Field}) (P'.wireGet 3)+              101 -> P'.fmap (\ new'Field -> old'Self{my_float = P'.Just new'Field}) (P'.wireGet 2)+              5 -> P'.wireGetKey UnittestProto.my_extension_int old'Self+              50 -> P'.wireGetKey UnittestProto.my_extension_string old'Self+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestFieldOrderings) TestFieldOrderings where+  getVal m' f' = f' m'+ +instance P'.GPB TestFieldOrderings+ +instance P'.ReflectDescriptor TestFieldOrderings where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestFieldOrderings\"}, descFilePath = [\"UnittestProto\",\"TestFieldOrderings.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestFieldOrderings\", baseName = \"my_string\"}, fieldNumber = FieldId {getFieldId = 11}, wireTag = WireTag {getWireTag = 90}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestFieldOrderings\", baseName = \"my_int\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestFieldOrderings\", baseName = \"my_float\"}, fieldNumber = FieldId {getFieldId = 101}, wireTag = WireTag {getWireTag = 813}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [(FieldId {getFieldId = 2},FieldId {getFieldId = 10}),(FieldId {getFieldId = 12},FieldId {getFieldId = 100})], knownKeys = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"my_extension_int\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"my_extension_string\"}, fieldNumber = FieldId {getFieldId = 50}, wireTag = WireTag {getWireTag = 402}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}]}"
+ tests/UnittestProto/TestForeignNested.hs view
@@ -0,0 +1,57 @@+module UnittestProto.TestForeignNested (TestForeignNested(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto.TestAllTypes.NestedMessage as UnittestProto.TestAllTypes (NestedMessage)+ +data TestForeignNested = TestForeignNested{foreign_nested :: P'.Maybe UnittestProto.TestAllTypes.NestedMessage}+                       deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestForeignNested where+  mergeEmpty = TestForeignNested P'.mergeEmpty+  mergeAppend (TestForeignNested x'1) (TestForeignNested y'1) = TestForeignNested (P'.mergeAppend x'1 y'1)+ +instance P'.Default TestForeignNested where+  defaultValue = TestForeignNested P'.defaultValue+ +instance P'.Wire TestForeignNested where+  wireSize ft' self'@(TestForeignNested x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 11 x'1)+  wirePut ft' self'@(TestForeignNested x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 11 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{foreign_nested = P'.mergeAppend (foreign_nested old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestForeignNested) TestForeignNested where+  getVal m' f' = f' m'+ +instance P'.GPB TestForeignNested+ +instance P'.ReflectDescriptor TestForeignNested where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestForeignNested\"}, descFilePath = [\"UnittestProto\",\"TestForeignNested.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestForeignNested\", baseName = \"foreign_nested\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestAllTypes\", baseName = \"NestedMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestMutualRecursionA.hs view
@@ -0,0 +1,56 @@+module UnittestProto.TestMutualRecursionA (TestMutualRecursionA(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto.TestMutualRecursionB as UnittestProto (TestMutualRecursionB)+ +data TestMutualRecursionA = TestMutualRecursionA{bb :: P'.Maybe UnittestProto.TestMutualRecursionB}+                          deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestMutualRecursionA where+  mergeEmpty = TestMutualRecursionA P'.mergeEmpty+  mergeAppend (TestMutualRecursionA x'1) (TestMutualRecursionA y'1) = TestMutualRecursionA (P'.mergeAppend x'1 y'1)+ +instance P'.Default TestMutualRecursionA where+  defaultValue = TestMutualRecursionA P'.defaultValue+ +instance P'.Wire TestMutualRecursionA where+  wireSize ft' self'@(TestMutualRecursionA x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 11 x'1)+  wirePut ft' self'@(TestMutualRecursionA x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 11 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{bb = P'.mergeAppend (bb old'Self) (P'.Just new'Field)}) (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestMutualRecursionA) TestMutualRecursionA where+  getVal m' f' = f' m'+ +instance P'.GPB TestMutualRecursionA+ +instance P'.ReflectDescriptor TestMutualRecursionA where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestMutualRecursionA\"}, descFilePath = [\"UnittestProto\",\"TestMutualRecursionA.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestMutualRecursionA\", baseName = \"bb\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestMutualRecursionB\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestMutualRecursionB.hs view
@@ -0,0 +1,60 @@+module UnittestProto.TestMutualRecursionB (TestMutualRecursionB(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import {-# SOURCE #-} qualified UnittestProto.TestMutualRecursionA as UnittestProto (TestMutualRecursionA)+ +data TestMutualRecursionB = TestMutualRecursionB{a :: P'.Maybe UnittestProto.TestMutualRecursionA,+                                                 optional_int32 :: P'.Maybe P'.Int32}+                          deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestMutualRecursionB where+  mergeEmpty = TestMutualRecursionB P'.mergeEmpty P'.mergeEmpty+  mergeAppend (TestMutualRecursionB x'1 x'2) (TestMutualRecursionB y'1 y'2)+    = TestMutualRecursionB (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default TestMutualRecursionB where+  defaultValue = TestMutualRecursionB P'.defaultValue P'.defaultValue+ +instance P'.Wire TestMutualRecursionB where+  wireSize ft' self'@(TestMutualRecursionB x'1 x'2)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 11 x'1 + P'.wireSizeOpt 1 5 x'2)+  wirePut ft' self'@(TestMutualRecursionB x'1 x'2)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 11 x'1+              P'.wirePutOpt 16 5 x'2+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{a = P'.mergeAppend (a old'Self) (P'.Just new'Field)}) (P'.wireGet 11)+              2 -> P'.fmap (\ new'Field -> old'Self{optional_int32 = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestMutualRecursionB) TestMutualRecursionB where+  getVal m' f' = f' m'+ +instance P'.GPB TestMutualRecursionB+ +instance P'.ReflectDescriptor TestMutualRecursionB where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestMutualRecursionB\"}, descFilePath = [\"UnittestProto\",\"TestMutualRecursionB.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestMutualRecursionB\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestMutualRecursionA\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestMutualRecursionB\", baseName = \"optional_int32\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestNestedMessageHasBits.hs view
@@ -0,0 +1,60 @@+module UnittestProto.TestNestedMessageHasBits (TestNestedMessageHasBits(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto.TestNestedMessageHasBits.NestedMessage as UnittestProto.TestNestedMessageHasBits (NestedMessage)+ +data TestNestedMessageHasBits = TestNestedMessageHasBits{optional_nested_message ::+                                                         P'.Maybe UnittestProto.TestNestedMessageHasBits.NestedMessage}+                              deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestNestedMessageHasBits where+  mergeEmpty = TestNestedMessageHasBits P'.mergeEmpty+  mergeAppend (TestNestedMessageHasBits x'1) (TestNestedMessageHasBits y'1) = TestNestedMessageHasBits (P'.mergeAppend x'1 y'1)+ +instance P'.Default TestNestedMessageHasBits where+  defaultValue = TestNestedMessageHasBits P'.defaultValue+ +instance P'.Wire TestNestedMessageHasBits where+  wireSize ft' self'@(TestNestedMessageHasBits x'1)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 11 x'1)+  wirePut ft' self'@(TestNestedMessageHasBits x'1)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 11 x'1+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap+                     (\ new'Field ->+                        old'Self{optional_nested_message = P'.mergeAppend (optional_nested_message old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestNestedMessageHasBits) TestNestedMessageHasBits where+  getVal m' f' = f' m'+ +instance P'.GPB TestNestedMessageHasBits+ +instance P'.ReflectDescriptor TestNestedMessageHasBits where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestNestedMessageHasBits\"}, descFilePath = [\"UnittestProto\",\"TestNestedMessageHasBits.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestNestedMessageHasBits\", baseName = \"optional_nested_message\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestNestedMessageHasBits\", baseName = \"NestedMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestNestedMessageHasBits/NestedMessage.hs view
@@ -0,0 +1,66 @@+module UnittestProto.TestNestedMessageHasBits.NestedMessage (NestedMessage(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto.ForeignMessage as UnittestProto (ForeignMessage)+ +data NestedMessage = NestedMessage{nestedmessage_repeated_int32 :: P'.Seq P'.Int32,+                                   nestedmessage_repeated_foreignmessage :: P'.Seq UnittestProto.ForeignMessage}+                   deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable NestedMessage where+  mergeEmpty = NestedMessage P'.mergeEmpty P'.mergeEmpty+  mergeAppend (NestedMessage x'1 x'2) (NestedMessage y'1 y'2) = NestedMessage (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default NestedMessage where+  defaultValue = NestedMessage P'.defaultValue P'.defaultValue+ +instance P'.Wire NestedMessage where+  wireSize ft' self'@(NestedMessage x'1 x'2)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 5 x'1 + P'.wireSizeRep 1 11 x'2)+  wirePut ft' self'@(NestedMessage x'1 x'2)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutRep 8 5 x'1+              P'.wirePutRep 18 11 x'2+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap+                     (\ new'Field ->+                        old'Self{nestedmessage_repeated_int32 = P'.append (nestedmessage_repeated_int32 old'Self) new'Field})+                     (P'.wireGet 5)+              2 -> P'.fmap+                     (\ new'Field ->+                        old'Self{nestedmessage_repeated_foreignmessage =+                                   P'.append (nestedmessage_repeated_foreignmessage old'Self) new'Field})+                     (P'.wireGet 11)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> NestedMessage) NestedMessage where+  getVal m' f' = f' m'+ +instance P'.GPB NestedMessage+ +instance P'.ReflectDescriptor NestedMessage where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestNestedMessageHasBits\", baseName = \"NestedMessage\"}, descFilePath = [\"UnittestProto\",\"TestNestedMessageHasBits\",\"NestedMessage.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestNestedMessageHasBits.NestedMessage\", baseName = \"nestedmessage_repeated_int32\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestNestedMessageHasBits.NestedMessage\", baseName = \"nestedmessage_repeated_foreignmessage\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"ForeignMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestReallyLargeTagNumber.hs view
@@ -0,0 +1,58 @@+module UnittestProto.TestReallyLargeTagNumber (TestReallyLargeTagNumber(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data TestReallyLargeTagNumber = TestReallyLargeTagNumber{a :: P'.Maybe P'.Int32, bb :: P'.Maybe P'.Int32}+                              deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestReallyLargeTagNumber where+  mergeEmpty = TestReallyLargeTagNumber P'.mergeEmpty P'.mergeEmpty+  mergeAppend (TestReallyLargeTagNumber x'1 x'2) (TestReallyLargeTagNumber y'1 y'2)+    = TestReallyLargeTagNumber (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default TestReallyLargeTagNumber where+  defaultValue = TestReallyLargeTagNumber P'.defaultValue P'.defaultValue+ +instance P'.Wire TestReallyLargeTagNumber where+  wireSize ft' self'@(TestReallyLargeTagNumber x'1 x'2)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 5 x'1 + P'.wireSizeOpt 5 5 x'2)+  wirePut ft' self'@(TestReallyLargeTagNumber x'1 x'2)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 8 5 x'1+              P'.wirePutOpt 2147483640 5 x'2+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{a = P'.Just new'Field}) (P'.wireGet 5)+              268435455 -> P'.fmap (\ new'Field -> old'Self{bb = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestReallyLargeTagNumber) TestReallyLargeTagNumber where+  getVal m' f' = f' m'+ +instance P'.GPB TestReallyLargeTagNumber+ +instance P'.ReflectDescriptor TestReallyLargeTagNumber where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestReallyLargeTagNumber\"}, descFilePath = [\"UnittestProto\",\"TestReallyLargeTagNumber.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestReallyLargeTagNumber\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestReallyLargeTagNumber\", baseName = \"bb\"}, fieldNumber = FieldId {getFieldId = 268435455}, wireTag = WireTag {getWireTag = 2147483640}, wireTagLength = 5, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestRecursiveMessage.hs view
@@ -0,0 +1,58 @@+module UnittestProto.TestRecursiveMessage (TestRecursiveMessage(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data TestRecursiveMessage = TestRecursiveMessage{a :: P'.Maybe TestRecursiveMessage, i :: P'.Maybe P'.Int32}+                          deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestRecursiveMessage where+  mergeEmpty = TestRecursiveMessage P'.mergeEmpty P'.mergeEmpty+  mergeAppend (TestRecursiveMessage x'1 x'2) (TestRecursiveMessage y'1 y'2)+    = TestRecursiveMessage (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default TestRecursiveMessage where+  defaultValue = TestRecursiveMessage P'.defaultValue P'.defaultValue+ +instance P'.Wire TestRecursiveMessage where+  wireSize ft' self'@(TestRecursiveMessage x'1 x'2)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 11 x'1 + P'.wireSizeOpt 1 5 x'2)+  wirePut ft' self'@(TestRecursiveMessage x'1 x'2)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 11 x'1+              P'.wirePutOpt 16 5 x'2+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{a = P'.mergeAppend (a old'Self) (P'.Just new'Field)}) (P'.wireGet 11)+              2 -> P'.fmap (\ new'Field -> old'Self{i = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestRecursiveMessage) TestRecursiveMessage where+  getVal m' f' = f' m'+ +instance P'.GPB TestRecursiveMessage+ +instance P'.ReflectDescriptor TestRecursiveMessage where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRecursiveMessage\"}, descFilePath = [\"UnittestProto\",\"TestRecursiveMessage.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRecursiveMessage\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRecursiveMessage\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRecursiveMessage\", baseName = \"i\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestRequired.hs view
@@ -0,0 +1,257 @@+module UnittestProto.TestRequired (TestRequired(..), single, multi) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import {-# SOURCE #-} qualified UnittestProto.TestAllExtensions as UnittestProto (TestAllExtensions)+ +data TestRequired = TestRequired{a :: P'.Int32, dummy2 :: P'.Maybe P'.Int32, b :: P'.Int32, dummy4 :: P'.Maybe P'.Int32,+                                 dummy5 :: P'.Maybe P'.Int32, dummy6 :: P'.Maybe P'.Int32, dummy7 :: P'.Maybe P'.Int32,+                                 dummy8 :: P'.Maybe P'.Int32, dummy9 :: P'.Maybe P'.Int32, dummy10 :: P'.Maybe P'.Int32,+                                 dummy11 :: P'.Maybe P'.Int32, dummy12 :: P'.Maybe P'.Int32, dummy13 :: P'.Maybe P'.Int32,+                                 dummy14 :: P'.Maybe P'.Int32, dummy15 :: P'.Maybe P'.Int32, dummy16 :: P'.Maybe P'.Int32,+                                 dummy17 :: P'.Maybe P'.Int32, dummy18 :: P'.Maybe P'.Int32, dummy19 :: P'.Maybe P'.Int32,+                                 dummy20 :: P'.Maybe P'.Int32, dummy21 :: P'.Maybe P'.Int32, dummy22 :: P'.Maybe P'.Int32,+                                 dummy23 :: P'.Maybe P'.Int32, dummy24 :: P'.Maybe P'.Int32, dummy25 :: P'.Maybe P'.Int32,+                                 dummy26 :: P'.Maybe P'.Int32, dummy27 :: P'.Maybe P'.Int32, dummy28 :: P'.Maybe P'.Int32,+                                 dummy29 :: P'.Maybe P'.Int32, dummy30 :: P'.Maybe P'.Int32, dummy31 :: P'.Maybe P'.Int32,+                                 dummy32 :: P'.Maybe P'.Int32, c :: P'.Int32}+                  deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +single :: P'.Key P'.Maybe UnittestProto.TestAllExtensions TestRequired+single = P'.Key 1000 11 P'.Nothing+ +multi :: P'.Key P'.Seq UnittestProto.TestAllExtensions TestRequired+multi = P'.Key 1001 11 P'.Nothing+ +instance P'.Mergeable TestRequired where+  mergeEmpty+    = TestRequired P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+        P'.mergeEmpty+  mergeAppend+    (TestRequired x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18 x'19 x'20 x'21 x'22 x'23 x'24+       x'25 x'26 x'27 x'28 x'29 x'30 x'31 x'32 x'33)+    (TestRequired y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8 y'9 y'10 y'11 y'12 y'13 y'14 y'15 y'16 y'17 y'18 y'19 y'20 y'21 y'22 y'23 y'24+       y'25 y'26 y'27 y'28 y'29 y'30 y'31 y'32 y'33)+    = TestRequired (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+        (P'.mergeAppend x'5 y'5)+        (P'.mergeAppend x'6 y'6)+        (P'.mergeAppend x'7 y'7)+        (P'.mergeAppend x'8 y'8)+        (P'.mergeAppend x'9 y'9)+        (P'.mergeAppend x'10 y'10)+        (P'.mergeAppend x'11 y'11)+        (P'.mergeAppend x'12 y'12)+        (P'.mergeAppend x'13 y'13)+        (P'.mergeAppend x'14 y'14)+        (P'.mergeAppend x'15 y'15)+        (P'.mergeAppend x'16 y'16)+        (P'.mergeAppend x'17 y'17)+        (P'.mergeAppend x'18 y'18)+        (P'.mergeAppend x'19 y'19)+        (P'.mergeAppend x'20 y'20)+        (P'.mergeAppend x'21 y'21)+        (P'.mergeAppend x'22 y'22)+        (P'.mergeAppend x'23 y'23)+        (P'.mergeAppend x'24 y'24)+        (P'.mergeAppend x'25 y'25)+        (P'.mergeAppend x'26 y'26)+        (P'.mergeAppend x'27 y'27)+        (P'.mergeAppend x'28 y'28)+        (P'.mergeAppend x'29 y'29)+        (P'.mergeAppend x'30 y'30)+        (P'.mergeAppend x'31 y'31)+        (P'.mergeAppend x'32 y'32)+        (P'.mergeAppend x'33 y'33)+ +instance P'.Default TestRequired where+  defaultValue+    = TestRequired P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+        P'.defaultValue+ +instance P'.Wire TestRequired where+  wireSize ft'+    self'@(TestRequired x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18 x'19 x'20 x'21 x'22 x'23+             x'24 x'25 x'26 x'27 x'28 x'29 x'30 x'31 x'32 x'33)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+          = (P'.wireSizeReq 1 5 x'1 + P'.wireSizeOpt 1 5 x'2 + P'.wireSizeReq 1 5 x'3 + P'.wireSizeOpt 1 5 x'4 ++               P'.wireSizeOpt 1 5 x'5+               + P'.wireSizeOpt 1 5 x'6+               + P'.wireSizeOpt 1 5 x'7+               + P'.wireSizeOpt 1 5 x'8+               + P'.wireSizeOpt 1 5 x'9+               + P'.wireSizeOpt 1 5 x'10+               + P'.wireSizeOpt 1 5 x'11+               + P'.wireSizeOpt 1 5 x'12+               + P'.wireSizeOpt 1 5 x'13+               + P'.wireSizeOpt 1 5 x'14+               + P'.wireSizeOpt 1 5 x'15+               + P'.wireSizeOpt 2 5 x'16+               + P'.wireSizeOpt 2 5 x'17+               + P'.wireSizeOpt 2 5 x'18+               + P'.wireSizeOpt 2 5 x'19+               + P'.wireSizeOpt 2 5 x'20+               + P'.wireSizeOpt 2 5 x'21+               + P'.wireSizeOpt 2 5 x'22+               + P'.wireSizeOpt 2 5 x'23+               + P'.wireSizeOpt 2 5 x'24+               + P'.wireSizeOpt 2 5 x'25+               + P'.wireSizeOpt 2 5 x'26+               + P'.wireSizeOpt 2 5 x'27+               + P'.wireSizeOpt 2 5 x'28+               + P'.wireSizeOpt 2 5 x'29+               + P'.wireSizeOpt 2 5 x'30+               + P'.wireSizeOpt 2 5 x'31+               + P'.wireSizeOpt 2 5 x'32+               + P'.wireSizeReq 2 5 x'33)+  wirePut ft'+    self'@(TestRequired x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18 x'19 x'20 x'21 x'22 x'23+             x'24 x'25 x'26 x'27 x'28 x'29 x'30 x'31 x'32 x'33)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutReq 8 5 x'1+              P'.wirePutOpt 16 5 x'2+              P'.wirePutReq 24 5 x'3+              P'.wirePutOpt 32 5 x'4+              P'.wirePutOpt 40 5 x'5+              P'.wirePutOpt 48 5 x'6+              P'.wirePutOpt 56 5 x'7+              P'.wirePutOpt 64 5 x'8+              P'.wirePutOpt 72 5 x'9+              P'.wirePutOpt 80 5 x'10+              P'.wirePutOpt 88 5 x'11+              P'.wirePutOpt 96 5 x'12+              P'.wirePutOpt 104 5 x'13+              P'.wirePutOpt 112 5 x'14+              P'.wirePutOpt 120 5 x'15+              P'.wirePutOpt 128 5 x'16+              P'.wirePutOpt 136 5 x'17+              P'.wirePutOpt 144 5 x'18+              P'.wirePutOpt 152 5 x'19+              P'.wirePutOpt 160 5 x'20+              P'.wirePutOpt 168 5 x'21+              P'.wirePutOpt 176 5 x'22+              P'.wirePutOpt 184 5 x'23+              P'.wirePutOpt 192 5 x'24+              P'.wirePutOpt 200 5 x'25+              P'.wirePutOpt 208 5 x'26+              P'.wirePutOpt 216 5 x'27+              P'.wirePutOpt 224 5 x'28+              P'.wirePutOpt 232 5 x'29+              P'.wirePutOpt 240 5 x'30+              P'.wirePutOpt 248 5 x'31+              P'.wirePutOpt 256 5 x'32+              P'.wirePutReq 264 5 x'33+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap (\ new'Field -> old'Self{a = new'Field}) (P'.wireGet 5)+              2 -> P'.fmap (\ new'Field -> old'Self{dummy2 = P'.Just new'Field}) (P'.wireGet 5)+              3 -> P'.fmap (\ new'Field -> old'Self{b = new'Field}) (P'.wireGet 5)+              4 -> P'.fmap (\ new'Field -> old'Self{dummy4 = P'.Just new'Field}) (P'.wireGet 5)+              5 -> P'.fmap (\ new'Field -> old'Self{dummy5 = P'.Just new'Field}) (P'.wireGet 5)+              6 -> P'.fmap (\ new'Field -> old'Self{dummy6 = P'.Just new'Field}) (P'.wireGet 5)+              7 -> P'.fmap (\ new'Field -> old'Self{dummy7 = P'.Just new'Field}) (P'.wireGet 5)+              8 -> P'.fmap (\ new'Field -> old'Self{dummy8 = P'.Just new'Field}) (P'.wireGet 5)+              9 -> P'.fmap (\ new'Field -> old'Self{dummy9 = P'.Just new'Field}) (P'.wireGet 5)+              10 -> P'.fmap (\ new'Field -> old'Self{dummy10 = P'.Just new'Field}) (P'.wireGet 5)+              11 -> P'.fmap (\ new'Field -> old'Self{dummy11 = P'.Just new'Field}) (P'.wireGet 5)+              12 -> P'.fmap (\ new'Field -> old'Self{dummy12 = P'.Just new'Field}) (P'.wireGet 5)+              13 -> P'.fmap (\ new'Field -> old'Self{dummy13 = P'.Just new'Field}) (P'.wireGet 5)+              14 -> P'.fmap (\ new'Field -> old'Self{dummy14 = P'.Just new'Field}) (P'.wireGet 5)+              15 -> P'.fmap (\ new'Field -> old'Self{dummy15 = P'.Just new'Field}) (P'.wireGet 5)+              16 -> P'.fmap (\ new'Field -> old'Self{dummy16 = P'.Just new'Field}) (P'.wireGet 5)+              17 -> P'.fmap (\ new'Field -> old'Self{dummy17 = P'.Just new'Field}) (P'.wireGet 5)+              18 -> P'.fmap (\ new'Field -> old'Self{dummy18 = P'.Just new'Field}) (P'.wireGet 5)+              19 -> P'.fmap (\ new'Field -> old'Self{dummy19 = P'.Just new'Field}) (P'.wireGet 5)+              20 -> P'.fmap (\ new'Field -> old'Self{dummy20 = P'.Just new'Field}) (P'.wireGet 5)+              21 -> P'.fmap (\ new'Field -> old'Self{dummy21 = P'.Just new'Field}) (P'.wireGet 5)+              22 -> P'.fmap (\ new'Field -> old'Self{dummy22 = P'.Just new'Field}) (P'.wireGet 5)+              23 -> P'.fmap (\ new'Field -> old'Self{dummy23 = P'.Just new'Field}) (P'.wireGet 5)+              24 -> P'.fmap (\ new'Field -> old'Self{dummy24 = P'.Just new'Field}) (P'.wireGet 5)+              25 -> P'.fmap (\ new'Field -> old'Self{dummy25 = P'.Just new'Field}) (P'.wireGet 5)+              26 -> P'.fmap (\ new'Field -> old'Self{dummy26 = P'.Just new'Field}) (P'.wireGet 5)+              27 -> P'.fmap (\ new'Field -> old'Self{dummy27 = P'.Just new'Field}) (P'.wireGet 5)+              28 -> P'.fmap (\ new'Field -> old'Self{dummy28 = P'.Just new'Field}) (P'.wireGet 5)+              29 -> P'.fmap (\ new'Field -> old'Self{dummy29 = P'.Just new'Field}) (P'.wireGet 5)+              30 -> P'.fmap (\ new'Field -> old'Self{dummy30 = P'.Just new'Field}) (P'.wireGet 5)+              31 -> P'.fmap (\ new'Field -> old'Self{dummy31 = P'.Just new'Field}) (P'.wireGet 5)+              32 -> P'.fmap (\ new'Field -> old'Self{dummy32 = P'.Just new'Field}) (P'.wireGet 5)+              33 -> P'.fmap (\ new'Field -> old'Self{c = new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestRequired) TestRequired where+  getVal m' f' = f' m'+ +instance P'.GPB TestRequired+ +instance P'.ReflectDescriptor TestRequired where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRequired\"}, descFilePath = [\"UnittestProto\",\"TestRequired.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"a\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, wireTagLength = 1, isRequired = True, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy2\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"b\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = True, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy4\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy5\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy6\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 48}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy7\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy8\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 64}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy9\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 72}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy10\"}, fieldNumber = FieldId {getFieldId = 10}, wireTag = WireTag {getWireTag = 80}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy11\"}, fieldNumber = FieldId {getFieldId = 11}, wireTag = WireTag {getWireTag = 88}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy12\"}, fieldNumber = FieldId {getFieldId = 12}, wireTag = WireTag {getWireTag = 96}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy13\"}, fieldNumber = FieldId {getFieldId = 13}, wireTag = WireTag {getWireTag = 104}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy14\"}, fieldNumber = FieldId {getFieldId = 14}, wireTag = WireTag {getWireTag = 112}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy15\"}, fieldNumber = FieldId {getFieldId = 15}, wireTag = WireTag {getWireTag = 120}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy16\"}, fieldNumber = FieldId {getFieldId = 16}, wireTag = WireTag {getWireTag = 128}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy17\"}, fieldNumber = FieldId {getFieldId = 17}, wireTag = WireTag {getWireTag = 136}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy18\"}, fieldNumber = FieldId {getFieldId = 18}, wireTag = WireTag {getWireTag = 144}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy19\"}, fieldNumber = FieldId {getFieldId = 19}, wireTag = WireTag {getWireTag = 152}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy20\"}, fieldNumber = FieldId {getFieldId = 20}, wireTag = WireTag {getWireTag = 160}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy21\"}, fieldNumber = FieldId {getFieldId = 21}, wireTag = WireTag {getWireTag = 168}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy22\"}, fieldNumber = FieldId {getFieldId = 22}, wireTag = WireTag {getWireTag = 176}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy23\"}, fieldNumber = FieldId {getFieldId = 23}, wireTag = WireTag {getWireTag = 184}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy24\"}, fieldNumber = FieldId {getFieldId = 24}, wireTag = WireTag {getWireTag = 192}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy25\"}, fieldNumber = FieldId {getFieldId = 25}, wireTag = WireTag {getWireTag = 200}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy26\"}, fieldNumber = FieldId {getFieldId = 26}, wireTag = WireTag {getWireTag = 208}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy27\"}, fieldNumber = FieldId {getFieldId = 27}, wireTag = WireTag {getWireTag = 216}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy28\"}, fieldNumber = FieldId {getFieldId = 28}, wireTag = WireTag {getWireTag = 224}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy29\"}, fieldNumber = FieldId {getFieldId = 29}, wireTag = WireTag {getWireTag = 232}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy30\"}, fieldNumber = FieldId {getFieldId = 30}, wireTag = WireTag {getWireTag = 240}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy31\"}, fieldNumber = FieldId {getFieldId = 31}, wireTag = WireTag {getWireTag = 248}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"dummy32\"}, fieldNumber = FieldId {getFieldId = 32}, wireTag = WireTag {getWireTag = 256}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"c\"}, fieldNumber = FieldId {getFieldId = 33}, wireTag = WireTag {getWireTag = 264}, wireTagLength = 2, isRequired = True, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [(ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestAllExtensions\"},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"single\"}, fieldNumber = FieldId {getFieldId = 1000}, wireTag = WireTag {getWireTag = 8002}, wireTagLength = 2, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRequired\"}), hsRawDefault = Nothing, hsDefault = Nothing}),(ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestAllExtensions\"},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequired\", baseName = \"multi\"}, fieldNumber = FieldId {getFieldId = 1001}, wireTag = WireTag {getWireTag = 8010}, wireTagLength = 2, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRequired\"}), hsRawDefault = Nothing, hsDefault = Nothing})], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestRequiredForeign.hs view
@@ -0,0 +1,65 @@+module UnittestProto.TestRequiredForeign (TestRequiredForeign(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+import qualified UnittestProto.TestRequired as UnittestProto (TestRequired)+ +data TestRequiredForeign = TestRequiredForeign{optional_message :: P'.Maybe UnittestProto.TestRequired,+                                               repeated_message :: P'.Seq UnittestProto.TestRequired, dummy :: P'.Maybe P'.Int32}+                         deriving (P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestRequiredForeign where+  mergeEmpty = TestRequiredForeign P'.mergeEmpty P'.mergeEmpty P'.mergeEmpty+  mergeAppend (TestRequiredForeign x'1 x'2 x'3) (TestRequiredForeign y'1 y'2 y'3)+    = TestRequiredForeign (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default TestRequiredForeign where+  defaultValue = TestRequiredForeign P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire TestRequiredForeign where+  wireSize ft' self'@(TestRequiredForeign x'1 x'2 x'3)+    = case ft' of+        10 -> calc'Size+        11 -> P'.prependMessageSize calc'Size+        _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 11 x'1 + P'.wireSizeRep 1 11 x'2 + P'.wireSizeOpt 1 5 x'3)+  wirePut ft' self'@(TestRequiredForeign x'1 x'2 x'3)+    = case ft' of+        10 -> put'Fields+        11+          -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+        _ -> P'.wirePutErr ft' self'+    where+        put'Fields+          = do+              P'.wirePutOpt 10 11 x'1+              P'.wirePutRep 18 11 x'2+              P'.wirePutOpt 24 5 x'3+  wireGet ft'+    = case ft' of+        10 -> P'.getBareMessage update'Self+        11 -> P'.getMessage update'Self+        _ -> P'.wireGetErr ft'+    where+        update'Self field'Number old'Self+          = case field'Number of+              1 -> P'.fmap+                     (\ new'Field -> old'Self{optional_message = P'.mergeAppend (optional_message old'Self) (P'.Just new'Field)})+                     (P'.wireGet 11)+              2 -> P'.fmap (\ new'Field -> old'Self{repeated_message = P'.append (repeated_message old'Self) new'Field})+                     (P'.wireGet 11)+              3 -> P'.fmap (\ new'Field -> old'Self{dummy = P'.Just new'Field}) (P'.wireGet 5)+              _ -> P'.unknownField field'Number+ +instance P'.MessageAPI msg' (msg' -> TestRequiredForeign) TestRequiredForeign where+  getVal m' f' = f' m'+ +instance P'.GPB TestRequiredForeign+ +instance P'.ReflectDescriptor TestRequiredForeign where+  reflectDescriptorInfo _+    = P'.read+        "DescriptorInfo {descName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRequiredForeign\"}, descFilePath = [\"UnittestProto\",\"TestRequiredForeign.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequiredForeign\", baseName = \"optional_message\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRequired\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequiredForeign\", baseName = \"repeated_message\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, wireTagLength = 1, isRequired = False, canRepeat = True, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto\", baseName = \"TestRequired\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoName {haskellPrefix = \"\", parentModule = \"UnittestProto.TestRequiredForeign\", baseName = \"dummy\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, wireTagLength = 1, isRequired = False, canRepeat = False, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList []}"
+ tests/UnittestProto/TestSparseEnum.hs view
@@ -0,0 +1,70 @@+module UnittestProto.TestSparseEnum (TestSparseEnum(..)) where+import Prelude ((+))+import qualified Prelude as P'+import qualified Text.ProtocolBuffers.Header as P'+ +data TestSparseEnum = SPARSE_A+                    | SPARSE_B+                    | SPARSE_C+                    | SPARSE_D+                    | SPARSE_E+                    | SPARSE_F+                    | SPARSE_G+                    deriving (P'.Read, P'.Show, P'.Eq, P'.Ord, P'.Typeable)+ +instance P'.Mergeable TestSparseEnum+ +instance P'.Bounded TestSparseEnum where+  minBound = SPARSE_A+  maxBound = SPARSE_G+ +instance P'.Default TestSparseEnum where+  defaultValue = SPARSE_A+ +instance P'.Enum TestSparseEnum where+  fromEnum (SPARSE_A) = 123+  fromEnum (SPARSE_B) = 62374+  fromEnum (SPARSE_C) = 12589234+  fromEnum (SPARSE_D) = 15+  fromEnum (SPARSE_E) = 53452+  fromEnum (SPARSE_F) = 0+  fromEnum (SPARSE_G) = 2+  toEnum 123 = SPARSE_A+  toEnum 62374 = SPARSE_B+  toEnum 12589234 = SPARSE_C+  toEnum 15 = SPARSE_D+  toEnum 53452 = SPARSE_E+  toEnum 0 = SPARSE_F+  toEnum 2 = SPARSE_G+  succ (SPARSE_A) = SPARSE_B+  succ (SPARSE_B) = SPARSE_C+  succ (SPARSE_C) = SPARSE_D+  succ (SPARSE_D) = SPARSE_E+  succ (SPARSE_E) = SPARSE_F+  succ (SPARSE_F) = SPARSE_G+  pred (SPARSE_B) = SPARSE_A+  pred (SPARSE_C) = SPARSE_B+  pred (SPARSE_D) = SPARSE_C+  pred (SPARSE_E) = SPARSE_D+  pred (SPARSE_F) = SPARSE_E+  pred (SPARSE_G) = SPARSE_F+ +instance P'.Wire TestSparseEnum where+  wireSize ft' enum = P'.wireSize ft' (P'.fromEnum enum)+  wirePut ft' enum = P'.wirePut ft' (P'.fromEnum enum)+  wireGet 14 = P'.fmap P'.toEnum (P'.wireGet 14)+  wireGet ft' = P'.wireGetErr ft'+ +instance P'.GPB TestSparseEnum+ +instance P'.MessageAPI msg' (msg' -> TestSparseEnum) TestSparseEnum where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum TestSparseEnum where+  reflectEnum+    = [(123, "SPARSE_A", SPARSE_A), (62374, "SPARSE_B", SPARSE_B), (12589234, "SPARSE_C", SPARSE_C), (15, "SPARSE_D", SPARSE_D),+       (53452, "SPARSE_E", SPARSE_E), (0, "SPARSE_F", SPARSE_F), (2, "SPARSE_G", SPARSE_G)]+  reflectEnumInfo _+    = P'.EnumInfo (P'.ProtoName "" "UnittestProto" "TestSparseEnum") ["UnittestProto", "TestSparseEnum.hs"]+        [(123, "SPARSE_A"), (62374, "SPARSE_B"), (12589234, "SPARSE_C"), (15, "SPARSE_D"), (53452, "SPARSE_E"), (0, "SPARSE_F"),+         (2, "SPARSE_G")]
+ tests/google-proto-files/examples/addressbook.proto view
@@ -0,0 +1,30 @@+// See README.txt for information and build instructions.++package tutorial;++option java_package = "com.example.tutorial";+option java_outer_classname = "AddressBookProtos";++message Person {+  required string name = 1;+  required int32 id = 2;        // Unique ID number for this person.+  optional string email = 3;++  enum PhoneType {+    MOBILE = 0;+    HOME = 1;+    WORK = 2;+  }++  message PhoneNumber {+    required string number = 1;+    optional PhoneType type = 2 [default = HOME];+  }++  repeated PhoneNumber phone = 4;+}++// Our address book file is just one of these.+message AddressBook {+  repeated Person person = 1;+}
+ tests/google-proto-files/java/src/test/java/com/google/protobuf/multiple_file view
@@ -0,0 +1,53 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//+// A proto file which tests the java_multiple_files option.+++import "google/protobuf/unittest.proto";++package protobuf_unittest;++option java_multiple_files = true;+option java_outer_classname = "MultipleFilesTestProto";++message MessageWithNoOuter {+  message NestedMessage {+    optional int32 i = 1;+  }+  enum NestedEnum {+    BAZ = 3;+  }+  optional NestedMessage nested = 1;+  repeated TestAllTypes foreign = 2;+  optional NestedEnum nested_enum = 3;+  optional EnumWithNoOuter foreign_enum = 4;+}++enum EnumWithNoOuter {+  FOO = 1;+  BAR = 2;+}++service ServiceWithNoOuter {+  rpc Foo(MessageWithNoOuter) returns(TestAllTypes);+}++extend TestAllExtensions {+  optional int32 extension_with_outer = 1234567;+}
+ tests/google-proto-files/python/google/protobuf/internal/more_extensions.prot view
@@ -0,0 +1,44 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: robinson@google.com (Will Robinson)+++package google.protobuf.internal;+++message TopLevelMessage {+  optional ExtendedMessage submessage = 1;+}+++message ExtendedMessage {+  extensions 1 to max;+}+++message ForeignMessage {+  optional int32 foreign_message_int = 1;+}+++extend ExtendedMessage {+  optional int32 optional_int_extension = 1;+  optional ForeignMessage optional_message_extension = 2;++  repeated int32 repeated_int_extension = 3;+  repeated ForeignMessage repeated_message_extension = 4;+}
+ tests/google-proto-files/python/google/protobuf/internal/more_messages.proto view
@@ -0,0 +1,37 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: robinson@google.com (Will Robinson)+++package google.protobuf.internal;++// A message where tag numbers are listed out of order, to allow us to test our+// canonicalization of serialized output, which should always be in tag order.+// We also mix in some extensions for extra fun.+message OutOfOrderFields {+  optional   sint32 optional_sint32   =  5;+  extensions 4 to 4;+  optional   uint32 optional_uint32   =  3;+  extensions 2 to 2;+  optional    int32 optional_int32    =  1;+};+++extend OutOfOrderFields {+  optional   uint64 optional_uint64   =  4;+  optional    int64 optional_int64    =  2;+}
+ tests/google-proto-files/src/google/protobuf/compiler/cpp/cpp_test_bad_identi view
@@ -0,0 +1,87 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// This file tests that various identifiers work as field and type names even+// though the same identifiers are used internally by the C++ code generator.+++// We don't put this in a package within proto2 because we need to make sure+// that the generated code doesn't depend on being in the proto2 namespace.+package protobuf_unittest;++// Test that fields can have names like "input" and "i" which are also used+// internally by the code generator for local variables.+message TestConflictingSymbolNames {+  message BuildDescriptors {}+  message TypeTraits {}++  optional int32 input = 1;+  optional int32 output = 2;+  optional string length = 3;+  repeated int32 i = 4;+  repeated string new_element = 5 [ctype=STRING_PIECE];+  optional int32 total_size = 6;+  optional int32 tag = 7;++  optional int32 source = 8;+  optional int32 value = 9;+  optional int32 file = 10;+  optional int32 from = 11;+  optional int32 handle_uninterpreted = 12;+  repeated int32 index = 13;+  optional int32 controller = 14;+  optional int32 already_here = 15;++  optional uint32 uint32 = 16;+  optional uint64 uint64 = 17;+  optional string string = 18;+  optional int32 memset = 19;+  optional int32 int32 = 20;+  optional int64 int64 = 21;++  optional uint32 cached_size = 22;+  optional uint32 extensions = 23;+  optional uint32 bit = 24;+  optional uint32 bits = 25;+  optional uint32 offsets = 26;+  optional uint32 reflection = 27;++  message Cord {}+  optional string some_cord = 28 [ctype=CORD];++  message StringPiece {}+  optional string some_string_piece = 29 [ctype=STRING_PIECE];++  // Some keywords.+  optional uint32 int = 30;+  optional uint32 friend = 31;++  // The generator used to #define a macro called "DO" inside the .cc file.+  message DO {}+  optional DO do = 32;++  extensions 1000 to max;+}++message DummyMessage {}++service TestConflictingMethodNames {+  rpc Closure(DummyMessage) returns (DummyMessage);+}
+ tests/google-proto-files/src/google/protobuf/descriptor.proto view
@@ -0,0 +1,286 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// The messages in this file describe the definitions found in .proto files.+// A valid .proto file can be translated directly to a FileDescriptorProto+// without any other information (e.g. without reading its imports).++++package google.protobuf;+option java_package = "com.google.protobuf";+option java_outer_classname = "DescriptorProtos";++// descriptor.proto must be optimized for speed because reflection-based+// algorithms don't work during bootstrapping.+option optimize_for = SPEED;++// Describes a complete .proto file.+message FileDescriptorProto {+  optional string name = 1;       // file name, relative to root of source tree+  optional string package = 2;    // e.g. "foo", "foo.bar", etc.++  // Names of files imported by this file.+  repeated string dependency = 3;++  // All top-level definitions in this file.+  repeated DescriptorProto message_type = 4;+  repeated EnumDescriptorProto enum_type = 5;+  repeated ServiceDescriptorProto service = 6;+  repeated FieldDescriptorProto extension = 7;++  optional FileOptions options = 8;+}++// Describes a message type.+message DescriptorProto {+  optional string name = 1;++  repeated FieldDescriptorProto field = 2;+  repeated FieldDescriptorProto extension = 6;++  repeated DescriptorProto nested_type = 3;+  repeated EnumDescriptorProto enum_type = 4;++  message ExtensionRange {+    optional int32 start = 1;+    optional int32 end = 2;+  }+  repeated ExtensionRange extension_range = 5;++  optional MessageOptions options = 7;+}++// Describes a field within a message.+message FieldDescriptorProto {+  enum Type {+    // 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.+  };++  enum Label {+    // 0 is reserved for errors+    LABEL_OPTIONAL      = 1;+    LABEL_REQUIRED      = 2;+    LABEL_REPEATED      = 3;+    // TODO(sanjay): Should we add LABEL_MAP?+  };++  optional string name = 1;+  optional int32 number = 3;+  optional Label label = 4;++  // If type_name is set, this need not be set.  If both this and type_name+  // are set, this must be either TYPE_ENUM or TYPE_MESSAGE.+  optional Type type = 5;++  // For message and enum types, this is the name of the type.  If the name+  // starts with a '.', it is fully-qualified.  Otherwise, C++-like scoping+  // rules are used to find the type (i.e. first the nested types within this+  // message are searched, then within the parent, on up to the root+  // namespace).+  optional string type_name = 6;++  // For extensions, this is the name of the type being extended.  It is+  // resolved in the same manner as type_name.+  optional string extendee = 2;++  // For numeric types, contains the original text representation of the value.+  // For booleans, "true" or "false".+  // For strings, contains the default text contents (not escaped in any way).+  // For bytes, contains the C escaped value.  All bytes >= 128 are escaped.+  // TODO(kenton):  Base-64 encode?+  optional string default_value = 7;++  optional FieldOptions options = 8;+}++// Describes an enum type.+message EnumDescriptorProto {+  optional string name = 1;++  repeated EnumValueDescriptorProto value = 2;++  optional EnumOptions options = 3;+}++// Describes a value within an enum.+message EnumValueDescriptorProto {+  optional string name = 1;+  optional int32 number = 2;++  optional EnumValueOptions options = 3;+}++// Describes a service.+message ServiceDescriptorProto {+  optional string name = 1;+  repeated MethodDescriptorProto method = 2;++  optional ServiceOptions options = 3;+}++// Describes a method of a service.+message MethodDescriptorProto {+  optional string name = 1;++  // Input and output type names.  These are resolved in the same way as+  // FieldDescriptorProto.type_name, but must refer to a message type.+  optional string input_type = 2;+  optional string output_type = 3;++  optional MethodOptions options = 4;+}++// ===================================================================+// Options++// Each of the definitions above may have "options" attached.  These are+// just annotations which may cause code to be generated slightly differently+// or may contain hints for code that manipulates protocol messages.++// TODO(kenton):  Allow extensions to options.++message FileOptions {++  // Sets the Java package where classes generated from this .proto will be+  // placed.  By default, the proto package is used, but this is often+  // inappropriate because proto packages do not normally start with backwards+  // domain names.+  optional string java_package = 1;+++  // If set, all the classes from the .proto file are wrapped in a single+  // outer class with the given name.  This applies to both Proto1+  // (equivalent to the old "--one_java_file" option) and Proto2 (where+  // a .proto always translates to a single class, but you may want to+  // explicitly choose the class name).+  optional string java_outer_classname = 8;++  // If set true, then the Java code generator will generate a separate .java+  // file for each top-level message, enum, and service defined in the .proto+  // file.  Thus, these types will *not* be nested inside the outer class+  // named by java_outer_classname.  However, the outer class will still be+  // generated to contain the file's getDescriptor() method as well as any+  // top-level extensions defined in the file.+  optional bool java_multiple_files = 10 [default=false];++  // Generated classes can be optimized for speed or code size.+  enum OptimizeMode {+    SPEED = 1;      // Generate complete code for parsing, serialization, etc.+    CODE_SIZE = 2;  // Use ReflectionOps to implement these methods.+  }+  optional OptimizeMode optimize_for = 9 [default=CODE_SIZE];+}++message MessageOptions {+  // Set true to use the old proto1 MessageSet wire format for extensions.+  // This is provided for backwards-compatibility with the MessageSet wire+  // format.  You should not use this for any other reason:  It's less+  // efficient, has fewer features, and is more complicated.+  //+  // The message must be defined exactly as follows:+  //   message Foo {+  //     option message_set_wire_format = true;+  //     extensions 4 to max;+  //   }+  // Note that the message cannot have any defined fields; MessageSets only+  // have extensions.+  //+  // All extensions of your type must be singular messages; e.g. they cannot+  // be int32s, enums, or repeated messages.+  //+  // Because this is an option, the above two restrictions are not enforced by+  // the protocol compiler.+  optional bool message_set_wire_format = 1 [default=false];+}++message FieldOptions {+  // The ctype option instructs the C++ code generator to use a different+  // representation of the field than it normally would.  See the specific+  // options below.  This option is not yet implemented in the open source+  // release -- sorry, we'll try to include it in a future version!+  optional CType ctype = 1;+  enum CType {+    CORD = 1;++    STRING_PIECE = 2;+  }++  // EXPERIMENTAL.  DO NOT USE.+  // For "map" fields, the name of the field in the enclosed type that+  // is the key for this map.  For example, suppose we have:+  //   message Item {+  //     required string name = 1;+  //     required string value = 2;+  //   }+  //   message Config {+  //     repeated Item items = 1 [experimental_map_key="name"];+  //   }+  // In this situation, the map key for Item will be set to "name".+  // TODO: Fully-implement this, then remove the "experimental_" prefix.+  optional string experimental_map_key = 9;+}++message EnumOptions {+}++message EnumValueOptions {+}++message ServiceOptions {++  // Note:  Field numbers 1 through 32 are reserved for Google's internal RPC+  //   framework.  We apologize for hoarding these numbers to ourselves, but+  //   we were already using them long before we decided to release Protocol+  //   Buffers.+}++message MethodOptions {++  // Note:  Field numbers 1 through 32 are reserved for Google's internal RPC+  //   framework.  We apologize for hoarding these numbers to ourselves, but+  //   we were already using them long before we decided to release Protocol+  //   Buffers.+}
+ tests/google-proto-files/src/google/protobuf/unittest.proto view
@@ -0,0 +1,452 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// A proto file we will use for unit testing.+++import "google/protobuf/unittest_import.proto";++// We don't put this in a package within proto2 because we need to make sure+// that the generated code doesn't depend on being in the proto2 namespace.+// In test_util.h we do "using namespace unittest = protobuf_unittest".+package protobuf_unittest;++// Protos optimized for SPEED use a strict superset of the generated code+// of equivalent ones optimized for CODE_SIZE, so we should optimize all our+// tests for speed unless explicitly testing code size optimization.+option optimize_for = SPEED;++option java_outer_classname = "UnittestProto";++// This proto includes every type of field in both singular and repeated+// forms.+message TestAllTypes {+  message NestedMessage {+    // The field name "b" fails to compile in proto1 because it conflicts with+    // a local variable named "b" in one of the generated methods.  Doh.+    // This file needs to compile in proto1 to test backwards-compatibility.+    optional int32 bb = 1;+  }++  enum NestedEnum {+    FOO = 1;+    BAR = 2;+    BAZ = 3;+  }++  // Singular+  optional    int32 optional_int32    =  1;+  optional    int64 optional_int64    =  2;+  optional   uint32 optional_uint32   =  3;+  optional   uint64 optional_uint64   =  4;+  optional   sint32 optional_sint32   =  5;+  optional   sint64 optional_sint64   =  6;+  optional  fixed32 optional_fixed32  =  7;+  optional  fixed64 optional_fixed64  =  8;+  optional sfixed32 optional_sfixed32 =  9;+  optional sfixed64 optional_sfixed64 = 10;+  optional    float optional_float    = 11;+  optional   double optional_double   = 12;+  optional     bool optional_bool     = 13;+  optional   string optional_string   = 14;+  optional    bytes optional_bytes    = 15;++  optional group OptionalGroup = 16 {+    optional int32 a = 17;+  }++  optional NestedMessage                        optional_nested_message  = 18;+  optional ForeignMessage                       optional_foreign_message = 19;+  optional protobuf_unittest_import.ImportMessage optional_import_message  = 20;++  optional NestedEnum                           optional_nested_enum     = 21;+  optional ForeignEnum                          optional_foreign_enum    = 22;+  optional protobuf_unittest_import.ImportEnum    optional_import_enum     = 23;++  optional string optional_string_piece = 24 [ctype=STRING_PIECE];+  optional string optional_cord = 25 [ctype=CORD];++  // Repeated+  repeated    int32 repeated_int32    = 31;+  repeated    int64 repeated_int64    = 32;+  repeated   uint32 repeated_uint32   = 33;+  repeated   uint64 repeated_uint64   = 34;+  repeated   sint32 repeated_sint32   = 35;+  repeated   sint64 repeated_sint64   = 36;+  repeated  fixed32 repeated_fixed32  = 37;+  repeated  fixed64 repeated_fixed64  = 38;+  repeated sfixed32 repeated_sfixed32 = 39;+  repeated sfixed64 repeated_sfixed64 = 40;+  repeated    float repeated_float    = 41;+  repeated   double repeated_double   = 42;+  repeated     bool repeated_bool     = 43;+  repeated   string repeated_string   = 44;+  repeated    bytes repeated_bytes    = 45;++  repeated group RepeatedGroup = 46 {+    optional int32 a = 47;+  }++  repeated NestedMessage                        repeated_nested_message  = 48;+  repeated ForeignMessage                       repeated_foreign_message = 49;+  repeated protobuf_unittest_import.ImportMessage repeated_import_message  = 50;++  repeated NestedEnum                           repeated_nested_enum     = 51;+  repeated ForeignEnum                          repeated_foreign_enum    = 52;+  repeated protobuf_unittest_import.ImportEnum    repeated_import_enum     = 53;++  repeated string repeated_string_piece = 54 [ctype=STRING_PIECE];+  repeated string repeated_cord = 55 [ctype=CORD];++  // Singular with defaults+  optional    int32 default_int32    = 61 [default =  41    ];+  optional    int64 default_int64    = 62 [default =  42    ];+  optional   uint32 default_uint32   = 63 [default =  43    ];+  optional   uint64 default_uint64   = 64 [default =  44    ];+  optional   sint32 default_sint32   = 65 [default = -45    ];+  optional   sint64 default_sint64   = 66 [default =  46    ];+  optional  fixed32 default_fixed32  = 67 [default =  47    ];+  optional  fixed64 default_fixed64  = 68 [default =  48    ];+  optional sfixed32 default_sfixed32 = 69 [default =  49    ];+  optional sfixed64 default_sfixed64 = 70 [default = -50    ];+  optional    float default_float    = 71 [default =  51.5  ];+  optional   double default_double   = 72 [default =  52e3  ];+  optional     bool default_bool     = 73 [default = true   ];+  optional   string default_string   = 74 [default = "hello"];+  optional    bytes default_bytes    = 75 [default = "world"];++  optional NestedEnum  default_nested_enum  = 81 [default = BAR        ];+  optional ForeignEnum default_foreign_enum = 82 [default = FOREIGN_BAR];+  optional protobuf_unittest_import.ImportEnum+      default_import_enum = 83 [default = IMPORT_BAR];++  optional string default_string_piece = 84 [ctype=STRING_PIECE,default="abc"];+  optional string default_cord = 85 [ctype=CORD,default="123"];+}++// Define these after TestAllTypes to make sure the compiler can handle+// that.+message ForeignMessage {+  optional int32 c = 1;+}++enum ForeignEnum {+  FOREIGN_FOO = 4;+  FOREIGN_BAR = 5;+  FOREIGN_BAZ = 6;+}++message TestAllExtensions {+  extensions 1 to max;+}++extend TestAllExtensions {+  // Singular+  optional    int32 optional_int32_extension    =  1;+  optional    int64 optional_int64_extension    =  2;+  optional   uint32 optional_uint32_extension   =  3;+  optional   uint64 optional_uint64_extension   =  4;+  optional   sint32 optional_sint32_extension   =  5;+  optional   sint64 optional_sint64_extension   =  6;+  optional  fixed32 optional_fixed32_extension  =  7;+  optional  fixed64 optional_fixed64_extension  =  8;+  optional sfixed32 optional_sfixed32_extension =  9;+  optional sfixed64 optional_sfixed64_extension = 10;+  optional    float optional_float_extension    = 11;+  optional   double optional_double_extension   = 12;+  optional     bool optional_bool_extension     = 13;+  optional   string optional_string_extension   = 14;+  optional    bytes optional_bytes_extension    = 15;++  optional group OptionalGroup_extension = 16 {+    optional int32 a = 17;+  }++  optional TestAllTypes.NestedMessage optional_nested_message_extension = 18;+  optional ForeignMessage optional_foreign_message_extension = 19;+  optional protobuf_unittest_import.ImportMessage+    optional_import_message_extension = 20;++  optional TestAllTypes.NestedEnum optional_nested_enum_extension = 21;+  optional ForeignEnum optional_foreign_enum_extension = 22;+  optional protobuf_unittest_import.ImportEnum+    optional_import_enum_extension = 23;++  optional string optional_string_piece_extension = 24 [ctype=STRING_PIECE];+  optional string optional_cord_extension = 25 [ctype=CORD];++  // Repeated+  repeated    int32 repeated_int32_extension    = 31;+  repeated    int64 repeated_int64_extension    = 32;+  repeated   uint32 repeated_uint32_extension   = 33;+  repeated   uint64 repeated_uint64_extension   = 34;+  repeated   sint32 repeated_sint32_extension   = 35;+  repeated   sint64 repeated_sint64_extension   = 36;+  repeated  fixed32 repeated_fixed32_extension  = 37;+  repeated  fixed64 repeated_fixed64_extension  = 38;+  repeated sfixed32 repeated_sfixed32_extension = 39;+  repeated sfixed64 repeated_sfixed64_extension = 40;+  repeated    float repeated_float_extension    = 41;+  repeated   double repeated_double_extension   = 42;+  repeated     bool repeated_bool_extension     = 43;+  repeated   string repeated_string_extension   = 44;+  repeated    bytes repeated_bytes_extension    = 45;++  repeated group RepeatedGroup_extension = 46 {+    optional int32 a = 47;+  }++  repeated TestAllTypes.NestedMessage repeated_nested_message_extension = 48;+  repeated ForeignMessage repeated_foreign_message_extension = 49;+  repeated protobuf_unittest_import.ImportMessage+    repeated_import_message_extension = 50;++  repeated TestAllTypes.NestedEnum repeated_nested_enum_extension = 51;+  repeated ForeignEnum repeated_foreign_enum_extension = 52;+  repeated protobuf_unittest_import.ImportEnum+    repeated_import_enum_extension = 53;++  repeated string repeated_string_piece_extension = 54 [ctype=STRING_PIECE];+  repeated string repeated_cord_extension = 55 [ctype=CORD];++  // Singular with defaults+  optional    int32 default_int32_extension    = 61 [default =  41    ];+  optional    int64 default_int64_extension    = 62 [default =  42    ];+  optional   uint32 default_uint32_extension   = 63 [default =  43    ];+  optional   uint64 default_uint64_extension   = 64 [default =  44    ];+  optional   sint32 default_sint32_extension   = 65 [default = -45    ];+  optional   sint64 default_sint64_extension   = 66 [default =  46    ];+  optional  fixed32 default_fixed32_extension  = 67 [default =  47    ];+  optional  fixed64 default_fixed64_extension  = 68 [default =  48    ];+  optional sfixed32 default_sfixed32_extension = 69 [default =  49    ];+  optional sfixed64 default_sfixed64_extension = 70 [default = -50    ];+  optional    float default_float_extension    = 71 [default =  51.5  ];+  optional   double default_double_extension   = 72 [default =  52e3  ];+  optional     bool default_bool_extension     = 73 [default = true   ];+  optional   string default_string_extension   = 74 [default = "hello"];+  optional    bytes default_bytes_extension    = 75 [default = "world"];++  optional TestAllTypes.NestedEnum+    default_nested_enum_extension = 81 [default = BAR];+  optional ForeignEnum+    default_foreign_enum_extension = 82 [default = FOREIGN_BAR];+  optional protobuf_unittest_import.ImportEnum+    default_import_enum_extension = 83 [default = IMPORT_BAR];++  optional string default_string_piece_extension = 84 [ctype=STRING_PIECE,+                                                       default="abc"];+  optional string default_cord_extension = 85 [ctype=CORD, default="123"];+}++// We have separate messages for testing required fields because it's+// annoying to have to fill in required fields in TestProto in order to+// do anything with it.  Note that we don't need to test every type of+// required filed because the code output is basically identical to+// optional fields for all types.+message TestRequired {+  required int32 a = 1;+  optional int32 dummy2 = 2;+  required int32 b = 3;++  extend TestAllExtensions {+    optional TestRequired single = 1000;+    repeated TestRequired multi  = 1001;+  }++  // Pad the field count to 32 so that we can test that IsInitialized()+  // properly checks multiple elements of has_bits_.+  optional int32 dummy4  =  4;+  optional int32 dummy5  =  5;+  optional int32 dummy6  =  6;+  optional int32 dummy7  =  7;+  optional int32 dummy8  =  8;+  optional int32 dummy9  =  9;+  optional int32 dummy10 = 10;+  optional int32 dummy11 = 11;+  optional int32 dummy12 = 12;+  optional int32 dummy13 = 13;+  optional int32 dummy14 = 14;+  optional int32 dummy15 = 15;+  optional int32 dummy16 = 16;+  optional int32 dummy17 = 17;+  optional int32 dummy18 = 18;+  optional int32 dummy19 = 19;+  optional int32 dummy20 = 20;+  optional int32 dummy21 = 21;+  optional int32 dummy22 = 22;+  optional int32 dummy23 = 23;+  optional int32 dummy24 = 24;+  optional int32 dummy25 = 25;+  optional int32 dummy26 = 26;+  optional int32 dummy27 = 27;+  optional int32 dummy28 = 28;+  optional int32 dummy29 = 29;+  optional int32 dummy30 = 30;+  optional int32 dummy31 = 31;+  optional int32 dummy32 = 32;++  required int32 c = 33;+}++message TestRequiredForeign {+  optional TestRequired optional_message = 1;+  repeated TestRequired repeated_message = 2;+  optional int32 dummy = 3;+}++// Test that we can use NestedMessage from outside TestAllTypes.+message TestForeignNested {+  optional TestAllTypes.NestedMessage foreign_nested = 1;+}++// TestEmptyMessage is used to test unknown field support.+message TestEmptyMessage {+}++// Like above, but declare all field numbers as potential extensions.  No+// actual extensions should ever be defined for this type.+message TestEmptyMessageWithExtensions {+  extensions 1 to max;+}++// Test that really large tag numbers don't break anything.+message TestReallyLargeTagNumber {+  // The largest possible tag number is 2^28 - 1, since the wire format uses+  // three bits to communicate wire type.+  optional int32 a = 1;+  optional int32 bb = 268435455;+}++message TestRecursiveMessage {+  optional TestRecursiveMessage a = 1;+  optional int32 i = 2;+}++// Test that mutual recursion works.+message TestMutualRecursionA {+  optional TestMutualRecursionB bb = 1;+}++message TestMutualRecursionB {+  optional TestMutualRecursionA a = 1;+  optional int32 optional_int32 = 2;+}++// Test that groups have disjoint field numbers from their siblings and+// parents.  This is NOT possible in proto1; only proto2.  When outputting+// proto1, the dup fields should be dropped.+message TestDupFieldNumber {+  optional int32 a = 1;+  optional group Foo = 2 { optional int32 a = 1; }+  optional group Bar = 3 { optional int32 a = 1; }+}+++// Needed for a Python test.+message TestNestedMessageHasBits {+  message NestedMessage {+    repeated int32 nestedmessage_repeated_int32 = 1;+    repeated ForeignMessage nestedmessage_repeated_foreignmessage = 2;+  }+  optional NestedMessage optional_nested_message = 1;+}+++// Test an enum that has multiple values with the same number.+enum TestEnumWithDupValue {+  FOO1 = 1;+  BAR1 = 2;+  BAZ = 3;+  FOO2 = 1;+  BAR2 = 2;+}++// Test an enum with large, unordered values.+enum TestSparseEnum {+  SPARSE_A = 123;+  SPARSE_B = 62374;+  SPARSE_C = 12589234;+  SPARSE_D = 15; // XXX was -15+  SPARSE_E = 53452; // XXX was -53452+  SPARSE_F = 0;+  SPARSE_G = 2;+}++// Test message with CamelCase field names.  This violates Protocol Buffer+// standard style.+message TestCamelCaseFieldNames {+  optional int32 PrimitiveField = 1;+  optional string StringField = 2;+  optional ForeignEnum EnumField = 3;+  optional ForeignMessage MessageField = 4;+  optional string StringPieceField = 5 [ctype=STRING_PIECE];+  optional string CordField = 6 [ctype=CORD];++  repeated int32 RepeatedPrimitiveField = 7;+  repeated string RepeatedStringField = 8;+  repeated ForeignEnum RepeatedEnumField = 9;+  repeated ForeignMessage RepeatedMessageField = 10;+  repeated string RepeatedStringPieceField = 11 [ctype=STRING_PIECE];+  repeated string RepeatedCordField = 12 [ctype=CORD];+}+++// We list fields out of order, to ensure that we're using field number and not+// field index to determine serialization order.+message TestFieldOrderings {+  optional string my_string = 11;+  extensions 2 to 10;+  optional int64 my_int = 1;+  extensions 12 to 100;+  optional float my_float = 101;+}+++extend TestFieldOrderings {+  optional string my_extension_string = 50;+  optional int32 my_extension_int = 5;+}+++message TestExtremeDefaultValues {+  optional bytes escaped_bytes = 1 [default = "\0\001\a\b\f\n\r\t\v\\\'\"\xfe"];+  optional uint32 large_uint32 = 2 [default = 0xFFFFFFFF];+  optional uint64 large_uint64 = 3 [default = 0xFFFFFFFFFFFFFFFF];+  optional  int32 small_int32  = 4 [default = -0x7FFFFFFF];+  optional  int64 small_int64  = 5 [default = -0x7FFFFFFFFFFFFFFF];++  // The default value here is UTF-8 for "\u1234".  (We could also just type+  // the UTF-8 text directly into this text file rather than escape it, but+  // lots of people use editors that would be confused by this.)+  optional string utf8_string = 6 [default = "\341\210\264"];+}++// Test that RPC services work.+message FooRequest  {}+message FooResponse {}++service TestService {+  rpc Foo(FooRequest) returns (FooResponse);+  rpc Bar(BarRequest) returns (BarResponse);+}+++message BarRequest  {}+message BarResponse {}
+ tests/google-proto-files/src/google/protobuf/unittest_embed_optimize_for.prot view
@@ -0,0 +1,36 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// A proto file which imports a proto file that uses optimize_for = CODE_SIZE.++import "google/protobuf/unittest_optimize_for.proto";++package protobuf_unittest;++// We optimize for speed here, but we are importing a proto that is optimized+// for code size.+option optimize_for = SPEED;++message TestEmbedOptimizedForSize {+  // Test that embedding a message which has optimize_for = CODE_SIZE into+  // one optimized for speed works.+  optional TestOptimizedForSize optional_message = 1;+  repeated TestOptimizedForSize repeated_message = 2;+}
+ tests/google-proto-files/src/google/protobuf/unittest_import.proto view
@@ -0,0 +1,47 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// A proto file which is imported by unittest.proto to test importing.+++// We don't put this in a package within proto2 because we need to make sure+// that the generated code doesn't depend on being in the proto2 namespace.+// In test_util.h we do+// "using namespace unittest_import = protobuf_unittest_import".+package protobuf_unittest_import;++option optimize_for = SPEED;++// Excercise the java_package option.+option java_package = "com.google.protobuf.test";++// Do not set a java_outer_classname here to verify that Proto2 works without+// one.++message ImportMessage {+  optional int32 d = 1;+}++enum ImportEnum {+  IMPORT_FOO = 7;+  IMPORT_BAR = 8;+  IMPORT_BAZ = 9;+}+
+ tests/google-proto-files/src/google/protobuf/unittest_mset.proto view
@@ -0,0 +1,58 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// This file contains messages for testing message_set_wire_format.++package protobuf_unittest;++option optimize_for = SPEED;++// A message with message_set_wire_format.+message TestMessageSet {+  option message_set_wire_format = true;+  extensions 4 to max;+}++message TestMessageSetContainer {+  optional TestMessageSet message_set = 1;+}++message TestMessageSetExtension1 {+  extend TestMessageSet {+    optional TestMessageSetExtension1 message_set_extension = 1545008;+  }+  optional int32 i = 15;+}++message TestMessageSetExtension2 {+  extend TestMessageSet {+    optional TestMessageSetExtension2 message_set_extension = 1547769;+  }+  optional string str = 25;+}++// MessageSet wire format is equivalent to this.+message RawMessageSet {+  repeated group Item = 1 {+    required int32 type_id = 2;+    required bytes message = 3;+  }+}+
+ tests/google-proto-files/src/google/protobuf/unittest_optimize_for.proto view
@@ -0,0 +1,38 @@+// Protocol Buffers - Google's data interchange format+// Copyright 2008 Google Inc.+// http://code.google.com/p/protobuf/+//+// Licensed under the Apache License, Version 2.0 (the "License");+// you may not use this file except in compliance with the License.+// You may obtain a copy of the License at+//+//      http://www.apache.org/licenses/LICENSE-2.0+//+// Unless required by applicable law or agreed to in writing, software+// distributed under the License is distributed on an "AS IS" BASIS,+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+// See the License for the specific language governing permissions and+// limitations under the License.++// Author: kenton@google.com (Kenton Varda)+//  Based on original Protocol Buffers design by+//  Sanjay Ghemawat, Jeff Dean, and others.+//+// A proto file which uses optimize_for = CODE_SIZE.++import "google/protobuf/unittest.proto";++package protobuf_unittest;++option optimize_for = CODE_SIZE;++message TestOptimizedForSize {+  optional int32 i = 1;+  optional ForeignMessage msg = 19;++  extensions 1000 to max;++  extend TestOptimizedForSize {+    optional int32 test_extension = 1234;+  }+}
+ tests/patchBoot view
@@ -0,0 +1,92 @@+diff -Nru UnittestProto/TestAllExtensions.hs-boot Unew/TestAllExtensions.hs-boot+--- UnittestProto/TestAllExtensions.hs-boot	1970-01-01 01:00:00.000000000 +0100++++ Unew/TestAllExtensions.hs-boot	2008-09-18 19:13:19.000000000 +0100+@@ -0,0 +1,19 @@++module UnittestProto.TestAllExtensions (TestAllExtensions) where++++import qualified Prelude as P'(Show,Eq,Ord,Maybe,Double,Float)++import qualified Text.ProtocolBuffers.Header as P'(Typeable,Mergeable,Default,Wire,MessageAPI,GPB,ReflectDescriptor++                                                  ,Seq,Utf8,ByteString,Int32,Int64,Word32,Word64,ExtendMessage)++++data TestAllExtensions++++instance P'.Show TestAllExtensions++instance P'.Eq TestAllExtensions++instance P'.Ord TestAllExtensions++instance P'.Typeable TestAllExtensions++instance P'.Mergeable TestAllExtensions++instance P'.Default TestAllExtensions++instance P'.Wire TestAllExtensions++instance P'.MessageAPI msg' (msg' -> TestAllExtensions) TestAllExtensions++instance P'.GPB TestAllExtensions++instance P'.ExtendMessage TestAllExtensions++instance P'.ReflectDescriptor TestAllExtensions+diff -Nru UnittestProto/TestFieldOrderings.hs-boot Unew/TestFieldOrderings.hs-boot+--- UnittestProto/TestFieldOrderings.hs-boot	1970-01-01 01:00:00.000000000 +0100++++ Unew/TestFieldOrderings.hs-boot	2008-09-18 19:12:51.000000000 +0100+@@ -0,0 +1,19 @@++module UnittestProto.TestFieldOrderings (TestFieldOrderings) where++++import qualified Prelude as P'(Show,Eq,Ord,Maybe,Double,Float)++import qualified Text.ProtocolBuffers.Header as P'(Typeable,Mergeable,Default,Wire,MessageAPI,GPB,ReflectDescriptor++                                                  ,Seq,Utf8,ByteString,Int32,Int64,Word32,Word64,ExtendMessage)++++data TestFieldOrderings++++instance P'.Show TestFieldOrderings++instance P'.Eq TestFieldOrderings++instance P'.Ord TestFieldOrderings++instance P'.Typeable TestFieldOrderings++instance P'.Mergeable TestFieldOrderings++instance P'.Default TestFieldOrderings++instance P'.Wire TestFieldOrderings++instance P'.MessageAPI msg' (msg' -> TestFieldOrderings) TestFieldOrderings++instance P'.GPB TestFieldOrderings++instance P'.ExtendMessage TestFieldOrderings++instance P'.ReflectDescriptor TestFieldOrderings+diff -Nru UnittestProto/TestMutualRecursionA.hs-boot Unew/TestMutualRecursionA.hs-boot+--- UnittestProto/TestMutualRecursionA.hs-boot	1970-01-01 01:00:00.000000000 +0100++++ Unew/TestMutualRecursionA.hs-boot	2008-09-18 19:12:13.000000000 +0100+@@ -0,0 +1,18 @@++module UnittestProto.TestMutualRecursionA (TestMutualRecursionA) where++++import qualified Prelude as P'(Show,Eq,Ord,Maybe,Double,Float)++import qualified Text.ProtocolBuffers.Header as P'(Typeable,Mergeable,Default,Wire,MessageAPI,GPB,ReflectDescriptor++                                                  ,Seq,Utf8,ByteString,Int32,Int64,Word32,Word64,ExtendMessage)++++data TestMutualRecursionA++++instance P'.Show TestMutualRecursionA++instance P'.Eq TestMutualRecursionA++instance P'.Ord TestMutualRecursionA++instance P'.Typeable TestMutualRecursionA++instance P'.Mergeable TestMutualRecursionA++instance P'.Default TestMutualRecursionA++instance P'.Wire TestMutualRecursionA++instance P'.MessageAPI msg' (msg' -> TestMutualRecursionA) TestMutualRecursionA++instance P'.GPB TestMutualRecursionA++instance P'.ReflectDescriptor TestMutualRecursionA+diff -Nru UnittestProto/TestMutualRecursionB.hs Unew/TestMutualRecursionB.hs+--- UnittestProto/TestMutualRecursionB.hs	2008-09-19 06:31:10.000000000 +0100++++ Unew/TestMutualRecursionB.hs	2008-09-18 19:15:29.000000000 +0100+@@ -2,7 +2,7 @@+ import Prelude ((+))+ import qualified Prelude as P'+ import qualified Text.ProtocolBuffers.Header as P'+-import qualified UnittestProto.TestMutualRecursionA as UnittestProto (TestMutualRecursionA)++import {-# SOURCE #-} qualified UnittestProto.TestMutualRecursionA as UnittestProto (TestMutualRecursionA)+  + data TestMutualRecursionB = TestMutualRecursionB{a :: P'.Maybe UnittestProto.TestMutualRecursionA,+                                                  optional_int32 :: P'.Maybe P'.Int32}+diff -Nru UnittestProto/TestRequired.hs Unew/TestRequired.hs+--- UnittestProto/TestRequired.hs	2008-09-19 06:31:09.000000000 +0100++++ Unew/TestRequired.hs	2008-09-18 19:14:48.000000000 +0100+@@ -2,7 +2,7 @@+ import Prelude ((+))+ import qualified Prelude as P'+ import qualified Text.ProtocolBuffers.Header as P'+-import qualified UnittestProto.TestAllExtensions as UnittestProto (TestAllExtensions)++import {-# SOURCE #-} qualified UnittestProto.TestAllExtensions as UnittestProto (TestAllExtensions)+  + data TestRequired = TestRequired{a :: P'.Int32, dummy2 :: P'.Maybe P'.Int32, b :: P'.Int32, dummy4 :: P'.Maybe P'.Int32,+                                  dummy5 :: P'.Maybe P'.Int32, dummy6 :: P'.Maybe P'.Int32, dummy7 :: P'.Maybe P'.Int32,
− unittest.proto 
@@ -1,452 +0,0 @@-// Protocol Buffers - Google's data interchange format-// Copyright 2008 Google Inc.-// http://code.google.com/p/protobuf/-//-// Licensed under the Apache License, Version 2.0 (the "License");-// you may not use this file except in compliance with the License.-// You may obtain a copy of the License at-//-//      http://www.apache.org/licenses/LICENSE-2.0-//-// Unless required by applicable law or agreed to in writing, software-// distributed under the License is distributed on an "AS IS" BASIS,-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-// See the License for the specific language governing permissions and-// limitations under the License.--// Author: kenton@google.com (Kenton Varda)-//  Based on original Protocol Buffers design by-//  Sanjay Ghemawat, Jeff Dean, and others.-//-// A proto file we will use for unit testing.---import "google/protobuf/unittest_import.proto";--// We don't put this in a package within proto2 because we need to make sure-// that the generated code doesn't depend on being in the proto2 namespace.-// In test_util.h we do "using namespace unittest = protobuf_unittest".-package protobuf_unittest;--// Protos optimized for SPEED use a strict superset of the generated code-// of equivalent ones optimized for CODE_SIZE, so we should optimize all our-// tests for speed unless explicitly testing code size optimization.-option optimize_for = SPEED;--option java_outer_classname = "UnittestProto";--// This proto includes every type of field in both singular and repeated-// forms.-message TestAllTypes {-  message NestedMessage {-    // The field name "b" fails to compile in proto1 because it conflicts with-    // a local variable named "b" in one of the generated methods.  Doh.-    // This file needs to compile in proto1 to test backwards-compatibility.-    optional int32 bb = 1;-  }--  enum NestedEnum {-    FOO = 1;-    BAR = 2;-    BAZ = 3;-  }--  // Singular-  optional    int32 optional_int32    =  1;-  optional    int64 optional_int64    =  2;-  optional   uint32 optional_uint32   =  3;-  optional   uint64 optional_uint64   =  4;-  optional   sint32 optional_sint32   =  5;-  optional   sint64 optional_sint64   =  6;-  optional  fixed32 optional_fixed32  =  7;-  optional  fixed64 optional_fixed64  =  8;-  optional sfixed32 optional_sfixed32 =  9;-  optional sfixed64 optional_sfixed64 = 10;-  optional    float optional_float    = 11;-  optional   double optional_double   = 12;-  optional     bool optional_bool     = 13;-  optional   string optional_string   = 14;-  optional    bytes optional_bytes    = 15;--  optional group OptionalGroup = 16 {-    optional int32 a = 17;-  }--  optional NestedMessage                        optional_nested_message  = 18;-  optional ForeignMessage                       optional_foreign_message = 19;-  optional protobuf_unittest_import.ImportMessage optional_import_message  = 20;--  optional NestedEnum                           optional_nested_enum     = 21;-  optional ForeignEnum                          optional_foreign_enum    = 22;-  optional protobuf_unittest_import.ImportEnum    optional_import_enum     = 23;--  optional string optional_string_piece = 24 [ctype=STRING_PIECE];-  optional string optional_cord = 25 [ctype=CORD];--  // Repeated-  repeated    int32 repeated_int32    = 31;-  repeated    int64 repeated_int64    = 32;-  repeated   uint32 repeated_uint32   = 33;-  repeated   uint64 repeated_uint64   = 34;-  repeated   sint32 repeated_sint32   = 35;-  repeated   sint64 repeated_sint64   = 36;-  repeated  fixed32 repeated_fixed32  = 37;-  repeated  fixed64 repeated_fixed64  = 38;-  repeated sfixed32 repeated_sfixed32 = 39;-  repeated sfixed64 repeated_sfixed64 = 40;-  repeated    float repeated_float    = 41;-  repeated   double repeated_double   = 42;-  repeated     bool repeated_bool     = 43;-  repeated   string repeated_string   = 44;-  repeated    bytes repeated_bytes    = 45;--  repeated group RepeatedGroup = 46 {-    optional int32 a = 47;-  }--  repeated NestedMessage                        repeated_nested_message  = 48;-  repeated ForeignMessage                       repeated_foreign_message = 49;-  repeated protobuf_unittest_import.ImportMessage repeated_import_message  = 50;--  repeated NestedEnum                           repeated_nested_enum     = 51;-  repeated ForeignEnum                          repeated_foreign_enum    = 52;-  repeated protobuf_unittest_import.ImportEnum    repeated_import_enum     = 53;--  repeated string repeated_string_piece = 54 [ctype=STRING_PIECE];-  repeated string repeated_cord = 55 [ctype=CORD];--  // Singular with defaults-  optional    int32 default_int32    = 61 [default =  41    ];-  optional    int64 default_int64    = 62 [default =  42    ];-  optional   uint32 default_uint32   = 63 [default =  43    ];-  optional   uint64 default_uint64   = 64 [default =  44    ];-  optional   sint32 default_sint32   = 65 [default = -45    ];-  optional   sint64 default_sint64   = 66 [default =  46    ];-  optional  fixed32 default_fixed32  = 67 [default =  47    ];-  optional  fixed64 default_fixed64  = 68 [default =  48    ];-  optional sfixed32 default_sfixed32 = 69 [default =  49    ];-  optional sfixed64 default_sfixed64 = 70 [default = -50    ];-  optional    float default_float    = 71 [default =  51.5  ];-  optional   double default_double   = 72 [default =  52e3  ];-  optional     bool default_bool     = 73 [default = true   ];-  optional   string default_string   = 74 [default = "hello"];-  optional    bytes default_bytes    = 75 [default = "world"];--  optional NestedEnum  default_nested_enum  = 81 [default = BAR        ];-  optional ForeignEnum default_foreign_enum = 82 [default = FOREIGN_BAR];-  optional protobuf_unittest_import.ImportEnum-      default_import_enum = 83 [default = IMPORT_BAR];--  optional string default_string_piece = 84 [ctype=STRING_PIECE,default="abc"];-  optional string default_cord = 85 [ctype=CORD,default="123"];-}--// Define these after TestAllTypes to make sure the compiler can handle-// that.-message ForeignMessage {-  optional int32 c = 1;-}--enum ForeignEnum {-  FOREIGN_FOO = 4;-  FOREIGN_BAR = 5;-  FOREIGN_BAZ = 6;-}--message TestAllExtensions {-  extensions 1 to max;-}--extend TestAllExtensions {-  // Singular-  optional    int32 optional_int32_extension    =  1;-  optional    int64 optional_int64_extension    =  2;-  optional   uint32 optional_uint32_extension   =  3;-  optional   uint64 optional_uint64_extension   =  4;-  optional   sint32 optional_sint32_extension   =  5;-  optional   sint64 optional_sint64_extension   =  6;-  optional  fixed32 optional_fixed32_extension  =  7;-  optional  fixed64 optional_fixed64_extension  =  8;-  optional sfixed32 optional_sfixed32_extension =  9;-  optional sfixed64 optional_sfixed64_extension = 10;-  optional    float optional_float_extension    = 11;-  optional   double optional_double_extension   = 12;-  optional     bool optional_bool_extension     = 13;-  optional   string optional_string_extension   = 14;-  optional    bytes optional_bytes_extension    = 15;--  optional group OptionalGroup_extension = 16 {-    optional int32 a = 17;-  }--  optional TestAllTypes.NestedMessage optional_nested_message_extension = 18;-  optional ForeignMessage optional_foreign_message_extension = 19;-  optional protobuf_unittest_import.ImportMessage-    optional_import_message_extension = 20;--  optional TestAllTypes.NestedEnum optional_nested_enum_extension = 21;-  optional ForeignEnum optional_foreign_enum_extension = 22;-  optional protobuf_unittest_import.ImportEnum-    optional_import_enum_extension = 23;--  optional string optional_string_piece_extension = 24 [ctype=STRING_PIECE];-  optional string optional_cord_extension = 25 [ctype=CORD];--  // Repeated-  repeated    int32 repeated_int32_extension    = 31;-  repeated    int64 repeated_int64_extension    = 32;-  repeated   uint32 repeated_uint32_extension   = 33;-  repeated   uint64 repeated_uint64_extension   = 34;-  repeated   sint32 repeated_sint32_extension   = 35;-  repeated   sint64 repeated_sint64_extension   = 36;-  repeated  fixed32 repeated_fixed32_extension  = 37;-  repeated  fixed64 repeated_fixed64_extension  = 38;-  repeated sfixed32 repeated_sfixed32_extension = 39;-  repeated sfixed64 repeated_sfixed64_extension = 40;-  repeated    float repeated_float_extension    = 41;-  repeated   double repeated_double_extension   = 42;-  repeated     bool repeated_bool_extension     = 43;-  repeated   string repeated_string_extension   = 44;-  repeated    bytes repeated_bytes_extension    = 45;--  repeated group RepeatedGroup_extension = 46 {-    optional int32 a = 47;-  }--  repeated TestAllTypes.NestedMessage repeated_nested_message_extension = 48;-  repeated ForeignMessage repeated_foreign_message_extension = 49;-  repeated protobuf_unittest_import.ImportMessage-    repeated_import_message_extension = 50;--  repeated TestAllTypes.NestedEnum repeated_nested_enum_extension = 51;-  repeated ForeignEnum repeated_foreign_enum_extension = 52;-  repeated protobuf_unittest_import.ImportEnum-    repeated_import_enum_extension = 53;--  repeated string repeated_string_piece_extension = 54 [ctype=STRING_PIECE];-  repeated string repeated_cord_extension = 55 [ctype=CORD];--  // Singular with defaults-  optional    int32 default_int32_extension    = 61 [default =  41    ];-  optional    int64 default_int64_extension    = 62 [default =  42    ];-  optional   uint32 default_uint32_extension   = 63 [default =  43    ];-  optional   uint64 default_uint64_extension   = 64 [default =  44    ];-  optional   sint32 default_sint32_extension   = 65 [default = -45    ];-  optional   sint64 default_sint64_extension   = 66 [default =  46    ];-  optional  fixed32 default_fixed32_extension  = 67 [default =  47    ];-  optional  fixed64 default_fixed64_extension  = 68 [default =  48    ];-  optional sfixed32 default_sfixed32_extension = 69 [default =  49    ];-  optional sfixed64 default_sfixed64_extension = 70 [default = -50    ];-  optional    float default_float_extension    = 71 [default =  51.5  ];-  optional   double default_double_extension   = 72 [default =  52e3  ];-  optional     bool default_bool_extension     = 73 [default = true   ];-  optional   string default_string_extension   = 74 [default = "hello"];-  optional    bytes default_bytes_extension    = 75 [default = "world"];--  optional TestAllTypes.NestedEnum-    default_nested_enum_extension = 81 [default = BAR];-  optional ForeignEnum-    default_foreign_enum_extension = 82 [default = FOREIGN_BAR];-  optional protobuf_unittest_import.ImportEnum-    default_import_enum_extension = 83 [default = IMPORT_BAR];--  optional string default_string_piece_extension = 84 [ctype=STRING_PIECE,-                                                       default="abc"];-  optional string default_cord_extension = 85 [ctype=CORD, default="123"];-}--// We have separate messages for testing required fields because it's-// annoying to have to fill in required fields in TestProto in order to-// do anything with it.  Note that we don't need to test every type of-// required filed because the code output is basically identical to-// optional fields for all types.-message TestRequired {-  required int32 a = 1;-  optional int32 dummy2 = 2;-  required int32 b = 3;--  extend TestAllExtensions {-    optional TestRequired single = 1000;-    repeated TestRequired multi  = 1001;-  }--  // Pad the field count to 32 so that we can test that IsInitialized()-  // properly checks multiple elements of has_bits_.-  optional int32 dummy4  =  4;-  optional int32 dummy5  =  5;-  optional int32 dummy6  =  6;-  optional int32 dummy7  =  7;-  optional int32 dummy8  =  8;-  optional int32 dummy9  =  9;-  optional int32 dummy10 = 10;-  optional int32 dummy11 = 11;-  optional int32 dummy12 = 12;-  optional int32 dummy13 = 13;-  optional int32 dummy14 = 14;-  optional int32 dummy15 = 15;-  optional int32 dummy16 = 16;-  optional int32 dummy17 = 17;-  optional int32 dummy18 = 18;-  optional int32 dummy19 = 19;-  optional int32 dummy20 = 20;-  optional int32 dummy21 = 21;-  optional int32 dummy22 = 22;-  optional int32 dummy23 = 23;-  optional int32 dummy24 = 24;-  optional int32 dummy25 = 25;-  optional int32 dummy26 = 26;-  optional int32 dummy27 = 27;-  optional int32 dummy28 = 28;-  optional int32 dummy29 = 29;-  optional int32 dummy30 = 30;-  optional int32 dummy31 = 31;-  optional int32 dummy32 = 32;--  required int32 c = 33;-}--message TestRequiredForeign {-  optional TestRequired optional_message = 1;-  repeated TestRequired repeated_message = 2;-  optional int32 dummy = 3;-}--// Test that we can use NestedMessage from outside TestAllTypes.-message TestForeignNested {-  optional TestAllTypes.NestedMessage foreign_nested = 1;-}--// TestEmptyMessage is used to test unknown field support.-message TestEmptyMessage {-}--// Like above, but declare all field numbers as potential extensions.  No-// actual extensions should ever be defined for this type.-message TestEmptyMessageWithExtensions {-  extensions 1 to max;-}--// Test that really large tag numbers don't break anything.-message TestReallyLargeTagNumber {-  // The largest possible tag number is 2^28 - 1, since the wire format uses-  // three bits to communicate wire type.-  optional int32 a = 1;-  optional int32 bb = 268435455;-}--message TestRecursiveMessage {-  optional TestRecursiveMessage a = 1;-  optional int32 i = 2;-}--// Test that mutual recursion works.-message TestMutualRecursionA {-  optional TestMutualRecursionB bb = 1;-}--message TestMutualRecursionB {-  optional TestMutualRecursionA a = 1;-  optional int32 optional_int32 = 2;-}--// Test that groups have disjoint field numbers from their siblings and-// parents.  This is NOT possible in proto1; only proto2.  When outputting-// proto1, the dup fields should be dropped.-message TestDupFieldNumber {-  optional int32 a = 1;-  optional group Foo = 2 { optional int32 a = 1; }-  optional group Bar = 3 { optional int32 a = 1; }-}---// Needed for a Python test.-message TestNestedMessageHasBits {-  message NestedMessage {-    repeated int32 nestedmessage_repeated_int32 = 1;-    repeated ForeignMessage nestedmessage_repeated_foreignmessage = 2;-  }-  optional NestedMessage optional_nested_message = 1;-}---// Test an enum that has multiple values with the same number.-enum TestEnumWithDupValue {-  FOO1 = 1;-  BAR1 = 2;-  BAZ = 3;-  FOO2 = 1;-  BAR2 = 2;-}--// Test an enum with large, unordered values.-enum TestSparseEnum {-  SPARSE_A = 123;-  SPARSE_B = 62374;-  SPARSE_C = 12589234;-//  SPARSE_D = -15;-//  SPARSE_E = -53452;-  SPARSE_F = 0;-  SPARSE_G = 2;-}--// Test message with CamelCase field names.  This violates Protocol Buffer-// standard style.-message TestCamelCaseFieldNames {-  optional int32 PrimitiveField = 1;-  optional string StringField = 2;-  optional ForeignEnum EnumField = 3;-  optional ForeignMessage MessageField = 4;-  optional string StringPieceField = 5 [ctype=STRING_PIECE];-  optional string CordField = 6 [ctype=CORD];--  repeated int32 RepeatedPrimitiveField = 7;-  repeated string RepeatedStringField = 8;-  repeated ForeignEnum RepeatedEnumField = 9;-  repeated ForeignMessage RepeatedMessageField = 10;-  repeated string RepeatedStringPieceField = 11 [ctype=STRING_PIECE];-  repeated string RepeatedCordField = 12 [ctype=CORD];-}---// We list fields out of order, to ensure that we're using field number and not-// field index to determine serialization order.-message TestFieldOrderings {-  optional string my_string = 11;-  extensions 2 to 10;-  optional int64 my_int = 1;-  extensions 12 to 100;-  optional float my_float = 101;-}---extend TestFieldOrderings {-  optional string my_extension_string = 50;-  optional int32 my_extension_int = 5;-}---message TestExtremeDefaultValues {-  optional bytes escaped_bytes = 1 [default = "\0\001\a\b\f\n\r\t\v\\\'\"\xfe"];-  optional uint32 large_uint32 = 2 [default = 0xFFFFFFFF];-  optional uint64 large_uint64 = 3 [default = 0xFFFFFFFFFFFFFFFF];-  optional  int32 small_int32  = 4 [default = -0x7FFFFFFF];-  optional  int64 small_int64  = 5 [default = -0x7FFFFFFFFFFFFFFF];--  // The default value here is UTF-8 for "\u1234".  (We could also just type-  // the UTF-8 text directly into this text file rather than escape it, but-  // lots of people use editors that would be confused by this.)-  optional string utf8_string = 6 [default = "\341\210\264"];-}--// Test that RPC services work.-message FooRequest  {}-message FooResponse {}--service TestService {-  rpc Foo(FooRequest) returns (FooResponse);-  rpc Bar(BarRequest) returns (BarResponse);-}---message BarRequest  {}-message BarResponse {}