diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +The MIT license. + +Copyright (c) 2015-2016 Martijn Rijkeboer + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Parser.hs b/app/Parser.hs new file mode 100644 --- /dev/null +++ b/app/Parser.hs @@ -0,0 +1,109 @@ +-- | +-- Module: Main +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Main module for the protoc executable. + +module Main where + + +import Data.Either (lefts, rights) +import Parser.FileDesc (FileDesc) +import Parser.FileWriter (write) +import Parser.Generator (generate) +import Parser.ProtoParser (parseProto) +import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt, usageInfo) +import System.Environment (getArgs) + + +data Options = Options + { optHelp :: Bool + , optVersion :: Bool + } deriving Show + + +data ProtoInfo = ProtoInfo + { filePath :: FilePath + , content :: String + } deriving Show + + +defaultOptions :: Options +defaultOptions = Options + { optHelp = False + , optVersion = False + } + + +options :: [OptDescr (Options -> Options)] +options = + [ Option ['h'] ["help"] + (NoArg (\opts -> opts{optHelp = True})) + "show usage" + , Option ['v'] ["version"] + (NoArg (\opts -> opts{optVersion = True})) + "show version number" + ] + + +parserOpts :: [String] -> Either String (Options, [String]) +parserOpts argv = + case getOpt Permute options argv of + (o,n,[] ) -> Right (foldl (flip id) defaultOptions o, n) + (_,_,errs) -> Left (concat errs ++ usage) + + + +main :: IO () +main = do + args <- getArgs + case parserOpts args of + Right opts -> handleOpts opts + Left errs -> putStrLn errs + + +handleOpts :: (Options, [String]) -> IO () +handleOpts (Options {optHelp=True}, _) = putStrLn usage +handleOpts (Options {optVersion=True}, _) = putStrLn version +handleOpts (Options {}, []) = putStrLn noFiles +handleOpts (Options {}, fs) = printFiles $ getProtoInfos fs + + +getProtoInfos :: [FilePath] -> IO [ProtoInfo] +getProtoInfos = mapM getProtoInfo + + +getProtoInfo :: FilePath -> IO ProtoInfo +getProtoInfo fPath = do + fData <- readFile fPath + return $ ProtoInfo fPath fData + + +printFiles :: IO [ProtoInfo] -> IO () +printFiles infos = do + is <- infos + let parsed = parseFiles is + putStr $ unlines $ lefts parsed + write $ generate $ rights parsed + + +parseFiles :: [ProtoInfo] -> [Either String FileDesc] +parseFiles = map parseFile + + +parseFile :: ProtoInfo -> Either String FileDesc +parseFile info = parseProto (filePath info) (content info) + + +noFiles :: String +noFiles = "protoc: no file given\n" ++ usage + + +usage :: String +usage = usageInfo "Usage: protoc [OPTION]... FILES" options + + +version :: String +version = "protoc 0.0.1" diff --git a/data/BoolList.bin b/data/BoolList.bin new file mode 100644 Binary files /dev/null and b/data/BoolList.bin differ diff --git a/data/BoolListPacked.bin b/data/BoolListPacked.bin new file mode 100644 Binary files /dev/null and b/data/BoolListPacked.bin differ diff --git a/data/BoolMsg.bin b/data/BoolMsg.bin new file mode 100644 --- /dev/null +++ b/data/BoolMsg.bin @@ -0,0 +1,1 @@ + diff --git a/data/BoolOptMsg.bin b/data/BoolOptMsg.bin new file mode 100644 --- /dev/null +++ b/data/BoolOptMsg.bin diff --git a/data/BytesList.bin b/data/BytesList.bin new file mode 100644 Binary files /dev/null and b/data/BytesList.bin differ diff --git a/data/BytesMsg.bin b/data/BytesMsg.bin new file mode 100644 Binary files /dev/null and b/data/BytesMsg.bin differ diff --git a/data/BytesOptMsg.bin b/data/BytesOptMsg.bin new file mode 100644 --- /dev/null +++ b/data/BytesOptMsg.bin diff --git a/data/DoubleList.bin b/data/DoubleList.bin new file mode 100644 Binary files /dev/null and b/data/DoubleList.bin differ diff --git a/data/DoubleListPacked.bin b/data/DoubleListPacked.bin new file mode 100644 Binary files /dev/null and b/data/DoubleListPacked.bin differ diff --git a/data/DoubleMsg.bin b/data/DoubleMsg.bin new file mode 100644 --- /dev/null +++ b/data/DoubleMsg.bin @@ -0,0 +1,1 @@ + š™™™™™ñ? diff --git a/data/DoubleOptMsg.bin b/data/DoubleOptMsg.bin new file mode 100644 --- /dev/null +++ b/data/DoubleOptMsg.bin diff --git a/data/EnumList.bin b/data/EnumList.bin new file mode 100644 Binary files /dev/null and b/data/EnumList.bin differ diff --git a/data/EnumListPacked.bin b/data/EnumListPacked.bin new file mode 100644 Binary files /dev/null and b/data/EnumListPacked.bin differ diff --git a/data/EnumMsg.bin b/data/EnumMsg.bin new file mode 100644 --- /dev/null +++ b/data/EnumMsg.bin @@ -0,0 +1,1 @@ + diff --git a/data/EnumOptMsg.bin b/data/EnumOptMsg.bin new file mode 100644 --- /dev/null +++ b/data/EnumOptMsg.bin diff --git a/data/Fixed32List.bin b/data/Fixed32List.bin new file mode 100644 Binary files /dev/null and b/data/Fixed32List.bin differ diff --git a/data/Fixed32ListPacked.bin b/data/Fixed32ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/Fixed32ListPacked.bin differ diff --git a/data/Fixed32Msg.bin b/data/Fixed32Msg.bin new file mode 100644 Binary files /dev/null and b/data/Fixed32Msg.bin differ diff --git a/data/Fixed32OptMsg.bin b/data/Fixed32OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/Fixed32OptMsg.bin diff --git a/data/Fixed64List.bin b/data/Fixed64List.bin new file mode 100644 Binary files /dev/null and b/data/Fixed64List.bin differ diff --git a/data/Fixed64ListPacked.bin b/data/Fixed64ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/Fixed64ListPacked.bin differ diff --git a/data/Fixed64Msg.bin b/data/Fixed64Msg.bin new file mode 100644 Binary files /dev/null and b/data/Fixed64Msg.bin differ diff --git a/data/Fixed64OptMsg.bin b/data/Fixed64OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/Fixed64OptMsg.bin diff --git a/data/FloatList.bin b/data/FloatList.bin new file mode 100644 Binary files /dev/null and b/data/FloatList.bin differ diff --git a/data/FloatListPacked.bin b/data/FloatListPacked.bin new file mode 100644 Binary files /dev/null and b/data/FloatListPacked.bin differ diff --git a/data/FloatMsg.bin b/data/FloatMsg.bin new file mode 100644 --- /dev/null +++ b/data/FloatMsg.bin @@ -0,0 +1,1 @@ + Í̌? diff --git a/data/FloatOptMsg.bin b/data/FloatOptMsg.bin new file mode 100644 --- /dev/null +++ b/data/FloatOptMsg.bin diff --git a/data/Int32List.bin b/data/Int32List.bin new file mode 100644 Binary files /dev/null and b/data/Int32List.bin differ diff --git a/data/Int32ListPacked.bin b/data/Int32ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/Int32ListPacked.bin differ diff --git a/data/Int32Msg.bin b/data/Int32Msg.bin new file mode 100644 --- /dev/null +++ b/data/Int32Msg.bin @@ -0,0 +1,1 @@ + diff --git a/data/Int32OptMsg.bin b/data/Int32OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/Int32OptMsg.bin diff --git a/data/Int64List.bin b/data/Int64List.bin new file mode 100644 Binary files /dev/null and b/data/Int64List.bin differ diff --git a/data/Int64ListPacked.bin b/data/Int64ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/Int64ListPacked.bin differ diff --git a/data/Int64Msg.bin b/data/Int64Msg.bin new file mode 100644 --- /dev/null +++ b/data/Int64Msg.bin @@ -0,0 +1,1 @@ + diff --git a/data/Int64OptMsg.bin b/data/Int64OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/Int64OptMsg.bin diff --git a/data/MessageList.bin b/data/MessageList.bin new file mode 100644 Binary files /dev/null and b/data/MessageList.bin differ diff --git a/data/MessageMsg.bin b/data/MessageMsg.bin new file mode 100644 Binary files /dev/null and b/data/MessageMsg.bin differ diff --git a/data/MessageOptMsg.bin b/data/MessageOptMsg.bin new file mode 100644 --- /dev/null +++ b/data/MessageOptMsg.bin diff --git a/data/SFixed32List.bin b/data/SFixed32List.bin new file mode 100644 Binary files /dev/null and b/data/SFixed32List.bin differ diff --git a/data/SFixed32ListPacked.bin b/data/SFixed32ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/SFixed32ListPacked.bin differ diff --git a/data/SFixed32Msg.bin b/data/SFixed32Msg.bin new file mode 100644 Binary files /dev/null and b/data/SFixed32Msg.bin differ diff --git a/data/SFixed32OptMsg.bin b/data/SFixed32OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/SFixed32OptMsg.bin diff --git a/data/SFixed64List.bin b/data/SFixed64List.bin new file mode 100644 Binary files /dev/null and b/data/SFixed64List.bin differ diff --git a/data/SFixed64ListPacked.bin b/data/SFixed64ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/SFixed64ListPacked.bin differ diff --git a/data/SFixed64Msg.bin b/data/SFixed64Msg.bin new file mode 100644 Binary files /dev/null and b/data/SFixed64Msg.bin differ diff --git a/data/SFixed64OptMsg.bin b/data/SFixed64OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/SFixed64OptMsg.bin diff --git a/data/SInt32List.bin b/data/SInt32List.bin new file mode 100644 Binary files /dev/null and b/data/SInt32List.bin differ diff --git a/data/SInt32ListPacked.bin b/data/SInt32ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/SInt32ListPacked.bin differ diff --git a/data/SInt32Msg.bin b/data/SInt32Msg.bin new file mode 100644 --- /dev/null +++ b/data/SInt32Msg.bin @@ -0,0 +1,1 @@ + diff --git a/data/SInt32OptMsg.bin b/data/SInt32OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/SInt32OptMsg.bin diff --git a/data/SInt64List.bin b/data/SInt64List.bin new file mode 100644 Binary files /dev/null and b/data/SInt64List.bin differ diff --git a/data/SInt64ListPacked.bin b/data/SInt64ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/SInt64ListPacked.bin differ diff --git a/data/SInt64Msg.bin b/data/SInt64Msg.bin new file mode 100644 --- /dev/null +++ b/data/SInt64Msg.bin @@ -0,0 +1,1 @@ + diff --git a/data/SInt64OptMsg.bin b/data/SInt64OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/SInt64OptMsg.bin diff --git a/data/StringList.bin b/data/StringList.bin new file mode 100644 --- /dev/null +++ b/data/StringList.bin @@ -0,0 +1,4 @@ + +Foo +Bar +Baz diff --git a/data/StringMsg.bin b/data/StringMsg.bin new file mode 100644 --- /dev/null +++ b/data/StringMsg.bin @@ -0,0 +1,2 @@ + +Foo diff --git a/data/StringOptMsg.bin b/data/StringOptMsg.bin new file mode 100644 --- /dev/null +++ b/data/StringOptMsg.bin diff --git a/data/Types.proto b/data/Types.proto new file mode 100644 --- /dev/null +++ b/data/Types.proto @@ -0,0 +1,230 @@ +package Types; + +message BoolList { + repeated bool value = 1; +} +message BoolListPacked { + repeated bool value = 1 [packed = true]; +} +message BoolMsg { + required bool value = 1; +} +message BoolOptMsg { + optional bool value = 1; +} + +message BytesList { + repeated bytes value = 1; +} +message BytesMsg { + required bytes value = 1; +} +message BytesOptMsg { + optional bytes value = 1; +} + +message DoubleList { + repeated double value = 1; +} +message DoubleListPacked { + repeated double value = 1 [packed = true]; +} +message DoubleMsg { + required double value = 1; +} +message DoubleOptMsg { + optional double value = 1; +} + +enum Enum { + ZERO = 0; + ONE = 1; + TWO = 2; + THREE = 3; + FOUR = 4; + FIVE = 5; + SIX = 6; + SEVEN = 7; + EIGHT = 8; + NINE = 9; +} +message EnumList { + repeated Enum value = 1; +} +message EnumListPacked { + repeated Enum value = 1 [packed = true]; +} +message EnumMsg { + required Enum value = 1; +} +message EnumOptMsg { + optional Enum value = 1; +} + +message Fixed32List { + repeated fixed32 value = 1; +} +message Fixed32ListPacked { + repeated fixed32 value = 1 [packed = true]; +} +message Fixed32Msg { + required fixed32 value = 1; +} +message Fixed32OptMsg { + optional fixed32 value = 1; +} + +message Fixed64List { + repeated fixed64 value = 1; +} +message Fixed64ListPacked { + repeated fixed64 value = 1 [packed = true]; +} +message Fixed64Msg { + required fixed64 value = 1; +} +message Fixed64OptMsg { + optional fixed64 value = 1; +} + +message FloatList { + repeated float value = 1; +} +message FloatListPacked { + repeated float value = 1 [packed = true]; +} +message FloatMsg { + required float value = 1; +} +message FloatOptMsg { + optional float value = 1; +} + +message Int32List { + repeated int32 value = 1; +} +message Int32ListPacked { + repeated int32 value = 1 [packed = true]; +} +message Int32Msg { + required int32 value = 1; +} +message Int32OptMsg { + optional int32 value = 1; +} + +message Int64List { + repeated int64 value = 1; +} +message Int64ListPacked { + repeated int64 value = 1 [packed = true]; +} +message Int64Msg { + required int64 value = 1; +} +message Int64OptMsg { + optional int64 value = 1; +} + +message Message { + required bool bool = 1; + optional bytes bytes = 2; + repeated Int32Msg int32Msgs = 3; +} +message MessageList { + repeated Message value = 1; +} +message MessageMsg { + required Message value = 1; +} +message MessageOptMsg { + optional Message value = 1; +} + +message SFixed32List { + repeated sfixed32 value = 1; +} +message SFixed32ListPacked { + repeated sfixed32 value = 1 [packed = true]; +} +message SFixed32Msg { + required sfixed32 value = 1; +} +message SFixed32OptMsg { + optional sfixed32 value = 1; +} + +message SFixed64List { + repeated sfixed64 value = 1; +} +message SFixed64ListPacked { + repeated sfixed64 value = 1 [packed = true]; +} +message SFixed64Msg { + required sfixed64 value = 1; +} +message SFixed64OptMsg { + optional sfixed64 value = 1; +} + +message SInt32List { + repeated sint32 value = 1; +} +message SInt32ListPacked { + repeated sint32 value = 1 [packed = true]; +} +message SInt32Msg { + required sint32 value = 1; +} +message SInt32OptMsg { + optional sint32 value = 1; +} + +message SInt64List { + repeated sint64 value = 1; +} +message SInt64ListPacked { + repeated sint64 value = 1 [packed = true]; +} +message SInt64Msg { + required sint64 value = 1; +} +message SInt64OptMsg { + optional sint64 value = 1; +} + +message StringList { + repeated string value = 1; +} +message StringMsg { + required string value = 1; +} +message StringOptMsg { + optional string value = 1; +} + +message UInt32List { + repeated uint32 value = 1; +} +message UInt32ListPacked { + repeated uint32 value = 1 [packed = true]; +} +message UInt32Msg { + required uint32 value = 1; +} +message UInt32OptMsg { + optional uint32 value = 1; +} + +message UInt64List { + repeated uint64 value = 1; +} +message UInt64ListPacked { + repeated uint64 value = 1 [packed = true]; +} +message UInt64Msg { + required uint64 value = 1; +} +message UInt64OptMsg { + optional uint64 value = 1; +} diff --git a/data/UInt32List.bin b/data/UInt32List.bin new file mode 100644 Binary files /dev/null and b/data/UInt32List.bin differ diff --git a/data/UInt32ListPacked.bin b/data/UInt32ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/UInt32ListPacked.bin differ diff --git a/data/UInt32Msg.bin b/data/UInt32Msg.bin new file mode 100644 Binary files /dev/null and b/data/UInt32Msg.bin differ diff --git a/data/UInt32OptMsg.bin b/data/UInt32OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/UInt32OptMsg.bin diff --git a/data/UInt64List.bin b/data/UInt64List.bin new file mode 100644 Binary files /dev/null and b/data/UInt64List.bin differ diff --git a/data/UInt64ListPacked.bin b/data/UInt64ListPacked.bin new file mode 100644 Binary files /dev/null and b/data/UInt64ListPacked.bin differ diff --git a/data/UInt64Msg.bin b/data/UInt64Msg.bin new file mode 100644 Binary files /dev/null and b/data/UInt64Msg.bin differ diff --git a/data/UInt64OptMsg.bin b/data/UInt64OptMsg.bin new file mode 100644 --- /dev/null +++ b/data/UInt64OptMsg.bin diff --git a/protobuf-simple.cabal b/protobuf-simple.cabal new file mode 100644 --- /dev/null +++ b/protobuf-simple.cabal @@ -0,0 +1,298 @@ +-- Initial protobuf-simple.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: protobuf-simple +synopsis: Simple Protocol Buffers library (proto2) +version: 0.1.0.0 +homepage: https://github.com/sru-systems/protobuf-simple +license: MIT +license-file: LICENSE +copyright: (c) 2015-2016 Martijn Rijkeboer +author: Martijn Rijkeboer +maintainer: Martijn Rijkeboer +category: Data +stability: experimental +tested-with: GHC == 7.10.3 +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: data/*.bin + , data/Types.proto +description: + . + = Protobuf-simple + . + An Haskell implementation of Google's Protocol Buffers version 2 with an + emphasis on simplicity. The implementation consists of a library for + encoding and decoding of data and the `protoc` executable for generating + Haskell types from proto files. In fact, the types that are used in the + tests are generated with the following command: + . + > $ protoc data/Types.proto + . + In the example below, the `CustomType` is a Haskell type that was generated + with the `protoc` executable. The `encCustomType` function encodes a + CustomType into a ByteString. The `decCustomType` function decodes a + ByteString into either a CustomType or an error. + . + > module Codec where + > + > import Data.ByteString.Lazy (ByteString) + > import Data.ProtoBuf (decode, encode) + > import Types.CustomType (CustomType(..)) + > + > encCustomType :: CustomType -> ByteString + > encCustomType = encode + > + > decCustomType :: ByteString -> Either String CustomType + > decCustomType = decode + . + The library exposes two modules, "Data.ProtoBuf", which is used for + encoding and decoding and "Data.ProtoBufInt", which is an internal module + that is used by the generated types. + . + == Supported Data Types + . + The following Protocol Buffer types, with their Haskell counterparts, are + supported: + . + * bool: Bool + * bytes: ByteString (lazy) + * double: Double + * enum: Sum-type + * fixed32: Word32 + * fixed64: Word64 + * float: Float + * int32: Int32 + * int64: Int64 + * message: Product-type or newtype + * sfixed32: Int32 + * sfixed64: Int64 + * sint32: Int32 + * sint64: Int64 + * string: Text (lazy) + * uint32: Word32 + * uint64: Word64 + . + == Compatibility + . + Besides testing that decoding inverses encoding, the compatibility with + other implementations is tested by decoding binary files that were created + with protobuf-net (C#). + . + == Other implementations + . + There are currently multiple Protocol Buffers implementations available. + This library was created for the following reasons. Firstly, I wanted to + use Data.Text for the string type instead of Data.ByteString as the + protocol-buffers library does. Secondly, I wanted to use newtypes for + messages with only one field. Finally, I wanted to use simpler data types + than the protobuf library does. + . + For example, the protobuf library uses the following (example from the + manual): + . + @ + data Foo = Foo + \ \ { field1 :: Required 1 (Value Int64) + \ \ , field2 :: Optional 2 (Value Text) + \ \ , field3 :: Repeated 3 (Value Bool) + \ \ } deriving (Generic, Show) + @ + . + Whereas protobuf-simple would use the following: + . + @ + data Foo = Foo + \ \ { field1 :: Int64 + \ \ , field2 :: Maybe Text + \ \ , field3 :: Seq Bool + \ \ } deriving (Show, Eq, Ord) + @ + . + == Not Implemented + . + The following Protocol Buffers features are currently not implemented: + . + * Importing definitions + * Groups + * Declaring extensions in messages + * Declaring nested extensions in messages + * Oneof feature + * Associative maps + * Defining services + * Custom options + + +library + hs-source-dirs: src + exposed-modules: Data.ProtoBuf + , Data.ProtoBufInt + other-modules: Data.ProtoBuf.Default + , Data.ProtoBuf.FieldNumber + , Data.ProtoBuf.Mergeable + , Data.ProtoBuf.Required + , Data.ProtoBuf.WireEnum + , Data.ProtoBuf.WireFormat + , Data.ProtoBuf.WireMessage + , Data.ProtoBuf.WireTag + , Data.ProtoBuf.WireType + , Data.ProtoBuf.ZigZag + build-depends: base >= 4 && < 5 + , binary >= 0.7 + , bytestring >= 0.9 + , containers >= 0.4 + , data-binary-ieee754 >= 0.4 + , mtl >= 2.0 + , text >= 0.11 + default-language: Haskell2010 + ghc-options: -Wall + + +executable protoc + hs-source-dirs: app, src + main-is: Parser.hs + other-modules: Parser.CaseUtils + , Parser.CodeInfo + , Parser.EnumDesc + , Parser.EnumGenerator + , Parser.EnumValueDesc + , Parser.FieldDesc + , Parser.FileDesc + , Parser.FileWriter + , Parser.Generator + , Parser.GeneratorUtils + , Parser.Label + , Parser.MessageDesc + , Parser.MessageGenerator + , Parser.OptimizeMode + , Parser.ProtoParser + , Parser.Type + build-depends: base + , containers + , directory + , filepath + , mtl + , parsec + , split + , text + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + + +test-suite protobuf-simple-test + type: exitcode-stdio-1.0 + hs-source-dirs: test, src + main-is: Spec.hs + other-modules: Data.ProtoBuf + , Data.ProtoBuf.Default + , Data.ProtoBuf.FieldNumber + , Data.ProtoBuf.Mergeable + , Data.ProtoBuf.Required + , Data.ProtoBuf.WireEnum + , Data.ProtoBuf.WireFormat + , Data.ProtoBuf.WireMessage + , Data.ProtoBuf.WireTag + , Data.ProtoBuf.WireType + , Data.ProtoBuf.ZigZag + , Data.ProtoBuf.ZigZagSpec + , Data.ProtoBufInt + , Data.ProtoBufSpec + , Parser.CaseUtils + , Parser.EnumDesc + , Parser.EnumValueDesc + , Parser.FieldDesc + , Parser.FileDesc + , Parser.Label + , Parser.MessageDesc + , Parser.OptimizeMode + , Parser.ProtoParser + , Parser.ProtoParserSpec + , Parser.Type + , Types.BoolList + , Types.BoolListPacked + , Types.BoolMsg + , Types.BoolOptMsg + , Types.BytesList + , Types.BytesMsg + , Types.BytesOptMsg + , Types.DoubleList + , Types.DoubleListPacked + , Types.DoubleMsg + , Types.DoubleOptMsg + , Types.Enum + , Types.EnumList + , Types.EnumListPacked + , Types.EnumMsg + , Types.EnumOptMsg + , Types.Fixed32List + , Types.Fixed32ListPacked + , Types.Fixed32Msg + , Types.Fixed32OptMsg + , Types.Fixed64List + , Types.Fixed64ListPacked + , Types.Fixed64Msg + , Types.Fixed64OptMsg + , Types.FloatList + , Types.FloatListPacked + , Types.FloatMsg + , Types.FloatOptMsg + , Types.Int32List + , Types.Int32ListPacked + , Types.Int32Msg + , Types.Int32OptMsg + , Types.Int64List + , Types.Int64ListPacked + , Types.Int64Msg + , Types.Int64OptMsg + , Types.Message + , Types.MessageList + , Types.MessageMsg + , Types.MessageOptMsg + , Types.SFixed32List + , Types.SFixed32ListPacked + , Types.SFixed32Msg + , Types.SFixed32OptMsg + , Types.SFixed64List + , Types.SFixed64ListPacked + , Types.SFixed64Msg + , Types.SFixed64OptMsg + , Types.SInt32List + , Types.SInt32ListPacked + , Types.SInt32Msg + , Types.SInt32OptMsg + , Types.SInt64List + , Types.SInt64ListPacked + , Types.SInt64Msg + , Types.SInt64OptMsg + , Types.StringList + , Types.StringMsg + , Types.StringOptMsg + , Types.UInt32List + , Types.UInt32ListPacked + , Types.UInt32Msg + , Types.UInt32OptMsg + , Types.UInt64List + , Types.UInt64ListPacked + , Types.UInt64Msg + , Types.UInt64OptMsg + build-depends: QuickCheck + , base + , binary + , bytestring + , containers + , data-binary-ieee754 + , filepath + , hspec + , parsec + , protobuf-simple + , quickcheck-instances + , split + , text + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + + +source-repository head + type: git + location: https://github.com/sru-systems/protobuf-simple + diff --git a/src/Data/ProtoBuf.hs b/src/Data/ProtoBuf.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf.hs @@ -0,0 +1,14 @@ +-- | +-- Module: Data.ProtoBuf +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Functions for encoding and decoding Protocol Buffers data. + +module Data.ProtoBuf + ( decode + , encode + ) where + +import Data.ProtoBuf.WireFormat (decode, encode) diff --git a/src/Data/ProtoBuf/Default.hs b/src/Data/ProtoBuf/Default.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/Default.hs @@ -0,0 +1,42 @@ +-- | +-- Module: Data.ProtoBuf.Default +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Default typeclass. + +module Data.ProtoBuf.Default + ( Default(..) + ) where + + +import Data.ByteString.Lazy (ByteString) +import Data.Int (Int32, Int64) +import Data.Sequence (Seq) +import Data.Text.Lazy (Text) +import Data.Word (Word32, Word64) + +import qualified Data.ByteString.Lazy as B +import qualified Data.Sequence as S +import qualified Data.Text.Lazy as T + + +-- | Typeclass to handle default values. +class Default a where + + -- | The default value for the field. + defaultVal :: a + + +instance Default Bool where defaultVal = False +instance Default ByteString where defaultVal = B.empty +instance Default Double where defaultVal = 0 +instance Default Float where defaultVal = 0 +instance Default Int32 where defaultVal = 0 +instance Default Int64 where defaultVal = 0 +instance Default Text where defaultVal = T.empty +instance Default Word32 where defaultVal = 0 +instance Default Word64 where defaultVal = 0 +instance Default (Maybe a) where defaultVal = Nothing +instance Default (Seq a) where defaultVal = S.empty diff --git a/src/Data/ProtoBuf/FieldNumber.hs b/src/Data/ProtoBuf/FieldNumber.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/FieldNumber.hs @@ -0,0 +1,45 @@ +-- | +-- Module: Data.ProtoBuf.FieldNumber +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- FieldNumber type and functions. + +module Data.ProtoBuf.FieldNumber + ( FieldNumber(..) + , fromFieldNumber + , toFieldNumber + ) where + + +import Data.Bits (shiftL, shiftR) +import Data.Word (Word32) + + +-- | Type to represent a field number (unique numbered tag). +newtype FieldNumber = FieldNumber Word32 + deriving (Show, Eq, Ord) + + +instance Num FieldNumber where + (FieldNumber x) + (FieldNumber y) = FieldNumber (x + y) + (FieldNumber x) * (FieldNumber y) = FieldNumber (x * y) + abs (FieldNumber x) = FieldNumber (abs x) + negate (FieldNumber x) = FieldNumber (negate x) + signum (FieldNumber x) = FieldNumber (signum x) + fromInteger i = FieldNumber (fromInteger i) + + +-- | Convert a FieldNumber into a Word32. +fromFieldNumber :: FieldNumber -> Word32 +fromFieldNumber (FieldNumber n) = shiftL n 3 + + +-- | Convert a Word32 into a FieldNumber or an error. +toFieldNumber :: Word32 -> Either String FieldNumber +toFieldNumber i + | fn == 0 = Left "Invalid FieldNumber 0" + | fn >= 19000 && fn <= 19999 = Left "Reserved FieldNumber" + | otherwise = Right $ FieldNumber fn + where fn = shiftR i 3 diff --git a/src/Data/ProtoBuf/Mergeable.hs b/src/Data/ProtoBuf/Mergeable.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/Mergeable.hs @@ -0,0 +1,47 @@ +-- | +-- Module: Data.ProtoBuf.Mergeable +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Mergeable typeclass + +module Data.ProtoBuf.Mergeable + ( Mergeable(..) + ) where + + +import Data.ByteString.Lazy (ByteString) +import Data.Int (Int32, Int64) +import Data.Sequence (Seq, (><)) +import Data.Text.Lazy (Text) +import Data.Word (Word32, Word64) + + +-- | Typeclass to handle merging of values. +class Mergeable a where + + -- | Merge two values. + merge :: a -> a -> a + merge _ b = b + + +instance Mergeable Bool +instance Mergeable ByteString +instance Mergeable Double +instance Mergeable Float +instance Mergeable Int32 +instance Mergeable Int64 +instance Mergeable Text +instance Mergeable Word32 +instance Mergeable Word64 + + +instance Mergeable a => Mergeable (Maybe a) where + merge Nothing b = b + merge a Nothing = a + merge (Just a) (Just b) = Just (merge a b) + + +instance Mergeable (Seq a) where + merge = (><) diff --git a/src/Data/ProtoBuf/Required.hs b/src/Data/ProtoBuf/Required.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/Required.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.ProtoBuf.Required +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Required typeclass. + +module Data.ProtoBuf.Required + ( Required(..) + ) where + + +import Data.ProtoBuf.WireTag (WireTag) +import Data.Set (Set) + + +-- | Typeclass to retrieve required WireTags. +class Required a where + + -- | The required WireTags for the data type. + reqTags :: a -> Set WireTag diff --git a/src/Data/ProtoBuf/WireEnum.hs b/src/Data/ProtoBuf/WireEnum.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/WireEnum.hs @@ -0,0 +1,25 @@ +-- | +-- Module: Data.ProtoBuf.WireEnum +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- WireEnum typeclass. + +module Data.ProtoBuf.WireEnum + ( WireEnum(..) + ) where + + +import Data.Int (Int32) + + +-- | Typeclass to handle encoding en decoding of enums. +class WireEnum a where + + -- | Convert an Int32 to an enum value. + intToEnum :: Int32 -> a + + + -- | Convert a enum value to an Int32. + enumToInt :: a -> Int32 diff --git a/src/Data/ProtoBuf/WireFormat.hs b/src/Data/ProtoBuf/WireFormat.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/WireFormat.hs @@ -0,0 +1,954 @@ +-- | +-- Module: Data.ProtoBuf.WireFormat +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Functions for converting Haskell to wire format and back. + +module Data.ProtoBuf.WireFormat + ( module Data.ProtoBuf.Default + , module Data.ProtoBuf.FieldNumber + , module Data.ProtoBuf.Mergeable + , module Data.ProtoBuf.Required + , module Data.ProtoBuf.WireEnum + , module Data.ProtoBuf.WireMessage + , module Data.ProtoBuf.WireTag + , module Data.ProtoBuf.WireType + , decode + , encode + + , getBool + , getBoolOpt + , getBoolPacked + , getBytes + , getBytesOpt + , getDouble + , getDoubleOpt + , getDoublePacked + , getEnum + , getEnumOpt + , getEnumPacked + , getFixed32 + , getFixed32Opt + , getFixed32Packed + , getFixed64 + , getFixed64Opt + , getFixed64Packed + , getFloat + , getFloatOpt + , getFloatPacked + , getGroup + , getGroupOpt + , getInt32 + , getInt32Opt + , getInt32Packed + , getInt64 + , getInt64Opt + , getInt64Packed + , getMessage + , getMessageOpt + , getSFixed32 + , getSFixed32Opt + , getSFixed32Packed + , getSFixed64 + , getSFixed64Opt + , getSFixed64Packed + , getSInt32 + , getSInt32Opt + , getSInt32Packed + , getSInt64 + , getSInt64Opt + , getSInt64Packed + , getString + , getStringOpt + , getUInt32 + , getUInt32Opt + , getUInt32Packed + , getUInt64 + , getUInt64Opt + , getUInt64Packed + , getUnknown + , getWireTag + + , putBool + , putBoolList + , putBoolOpt + , putBoolPacked + , putBytes + , putBytesList + , putBytesOpt + , putDouble + , putDoubleList + , putDoubleOpt + , putDoublePacked + , putEnum + , putEnumList + , putEnumOpt + , putEnumPacked + , putFixed32 + , putFixed32List + , putFixed32Opt + , putFixed32Packed + , putFixed64 + , putFixed64List + , putFixed64Opt + , putFixed64Packed + , putFloat + , putFloatList + , putFloatOpt + , putFloatPacked + , putGroup + , putGroupOpt + , putInt32 + , putInt32List + , putInt32Opt + , putInt32Packed + , putInt64 + , putInt64List + , putInt64Opt + , putInt64Packed + , putSFixed32 + , putSFixed32List + , putSFixed32Opt + , putSFixed32Packed + , putSFixed64 + , putSFixed64List + , putSFixed64Opt + , putSFixed64Packed + , putSInt32 + , putSInt32List + , putSInt32Opt + , putSInt32Packed + , putSInt64 + , putSInt64List + , putSInt64Opt + , putSInt64Packed + , putMessage + , putMessageList + , putMessageOpt + , putString + , putStringList + , putStringOpt + , putUInt32 + , putUInt32List + , putUInt32Opt + , putUInt32Packed + , putUInt64 + , putUInt64List + , putUInt64Opt + , putUInt64Packed + , putWireTag + ) where + + +import Data.Binary.Get (Get, getLazyByteString, getWord8, getWord32le, getWord64le, isEmpty, runGetOrFail) +import Data.Binary.IEEE754 (getFloat32le, getFloat64le, putFloat32le, putFloat64le) +import Data.Binary.Put ( Put, putLazyByteString, putWord8, putWord32le, putWord64le, runPut) +import Data.Bits (Bits, (.|.), (.&.), shiftL, shiftR, setBit, testBit) +import Data.ByteString.Lazy (ByteString) +import Data.Foldable (forM_) +import Data.Int (Int32, Int64) +import Data.ProtoBuf.Default +import Data.ProtoBuf.FieldNumber +import Data.ProtoBuf.Mergeable +import Data.ProtoBuf.Required +import Data.ProtoBuf.WireEnum +import Data.ProtoBuf.WireMessage +import Data.ProtoBuf.WireTag +import Data.ProtoBuf.WireType +import Data.Sequence (Seq, (|>)) +import Data.Text.Lazy (Text) +import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8) +import Data.Word (Word8, Word32, Word64) + +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ProtoBuf.ZigZag as ZZ +import qualified Data.Sequence as Seq +import qualified Data.Set as Set + + +-- | Decode a ByteString into either the data-type or an error message. +-- +-- Decode CustomType: +-- +-- > decCustomType :: ByteString -> Either String CustomType +-- > decCustomType = decode +decode :: (Default a, Required a, WireMessage a) => ByteString -> Either String a +decode bytes = case runGetOrFail getGroup bytes of + Left (_, _, err) -> Left err + Right (_, _, obj) -> Right obj + + +-- | Encode a data-type into a ByteString. +-- +-- Encode CustomType: +-- +-- > encCustomType :: CustomType -> ByteString +-- > encCustomType = encode +encode :: (WireMessage a) => a -> ByteString +encode obj = runPut (putGroup obj) + + +-- | Decode a required bool field. +getBool :: Get Bool +getBool = do + val <- getVarInt :: Get Word8 + if val == 0 + then return False + else return True + + +-- | Decode an optional bool field. +getBoolOpt :: Get (Maybe Bool) +getBoolOpt = getOpt getBool + + +-- | Decode a packed repeated bool field. +getBoolPacked :: Get (Seq Bool) +getBoolPacked = getPacked getBool + + +-- | Decode a required bytes field. +getBytes :: Get ByteString +getBytes = do + len <- getVarInt + getLazyByteString len + + +-- | Decode an optional bytes field. +getBytesOpt :: Get (Maybe ByteString) +getBytesOpt = getOpt getBytes + + +-- | Decode a required double field. +getDouble :: Get Double +getDouble = getFloat64le + + +-- | Decode an optional double field. +getDoubleOpt :: Get (Maybe Double) +getDoubleOpt = getOpt getDouble + + +-- | Decode a packed repeated double field. +getDoublePacked :: Get (Seq Double) +getDoublePacked = getPacked getDouble + + +-- | Decode a required enum field. +getEnum :: (WireEnum a) => Get a +getEnum = intToEnum <$> getInt32 + + +-- | Decode an optional enum field. +getEnumOpt :: (WireEnum a) => Get (Maybe a) +getEnumOpt = getOpt getEnum + + +-- | Decode a packed repeated enum field. +getEnumPacked :: (WireEnum a) => Get (Seq a) +getEnumPacked = getPacked getEnum + + +-- | Decode a required fixed32 field. +getFixed32 :: Get Word32 +getFixed32 = getWord32le + + +-- | Decode an optional fixed32 field. +getFixed32Opt :: Get (Maybe Word32) +getFixed32Opt = getOpt getFixed32 + + +-- | Decode a packed repeated fixed32 field. +getFixed32Packed :: Get (Seq Word32) +getFixed32Packed = getPacked getFixed32 + + +-- | Decode a required fixed64 field. +getFixed64 :: Get Word64 +getFixed64 = getWord64le + + +-- | Decode an optional fixed64 field. +getFixed64Opt :: Get (Maybe Word64) +getFixed64Opt = getOpt getFixed64 + + +-- | Decode a packed repeated fixed64 field. +getFixed64Packed :: Get (Seq Word64) +getFixed64Packed = getPacked getFixed64 + + +-- | Decode a required float field. +getFloat :: Get Float +getFloat = getFloat32le + + +-- | Decode an optional float field. +getFloatOpt :: Get (Maybe Float) +getFloatOpt = getOpt getFloat + + +-- | Decode a packed repeated float field. +getFloatPacked :: Get (Seq Float) +getFloatPacked = getPacked getFloat + + +-- | Decode a required group field. +getGroup :: (Default a, Required a, WireMessage a) => Get a +getGroup = loop defaultMsg reqTagSet + where + loop msg reqs | Set.null reqs = do + done <- isEmpty + if done + then return msg + else do + tag <- getWireTag + msg' <- fieldToValue tag msg + loop msg' reqs + loop msg reqs | otherwise = do + done <- isEmpty + if done + then fail "Missing required field(s)" + else do + tag <- getWireTag + msg' <- fieldToValue tag msg + loop msg' (Set.delete tag reqs) + defaultMsg = defaultVal + reqTagSet = reqTags defaultMsg + + +-- | Decode an optional group field. +getGroupOpt :: (Default a, Required a, WireMessage a) => Get (Maybe a) +getGroupOpt = getOpt getGroup + + +-- | Decode a required int32 field. +getInt32 :: Get Int32 +getInt32 = getVarInt + + +-- | Decode an optional int32 field. +getInt32Opt :: Get (Maybe Int32) +getInt32Opt = getOpt getInt32 + + +-- | Decode a packed repeated int32 field. +getInt32Packed :: Get (Seq Int32) +getInt32Packed = getPacked getInt32 + + +-- | Decode a required int64 field. +getInt64 :: Get Int64 +getInt64 = getVarInt + + +-- | Decode an optional int64 field. +getInt64Opt :: Get (Maybe Int64) +getInt64Opt = getOpt getInt64 + + +-- | Decode a packed repeated int64 field. +getInt64Packed :: Get (Seq Int64) +getInt64Packed = getPacked getInt64 + + +-- | Decode a required message field. +getMessage :: (Default a, Required a, WireMessage a) => Get a +getMessage = do + bytes <- getBytes + case runGetOrFail getGroup bytes of + Left (_, _, err) -> fail err + Right (_, _, obj) -> return obj + + +-- | Decode an optional message field. +getMessageOpt :: (Default a, Required a, WireMessage a) => Get (Maybe a) +getMessageOpt = getOpt getMessage + + +-- | Decode a required sfixed32 field. +getSFixed32 :: Get Int32 +getSFixed32 = fromIntegral <$> getWord32le + + +-- | Decode an optional sfixed32 field. +getSFixed32Opt :: Get (Maybe Int32) +getSFixed32Opt = getOpt getSFixed32 + + +-- | Decode a packed repeated sfixed32 field. +getSFixed32Packed :: Get (Seq Int32) +getSFixed32Packed = getPacked getSFixed32 + + +-- | Decode a required sfixed64 field. +getSFixed64 :: Get Int64 +getSFixed64 = fromIntegral <$> getWord64le + + +-- | Decode an optional sfixed64 field. +getSFixed64Opt :: Get (Maybe Int64) +getSFixed64Opt = getOpt getSFixed64 + + +-- | Decode a packed repeated sfixed64 field. +getSFixed64Packed :: Get (Seq Int64) +getSFixed64Packed = getPacked getSFixed64 + + +-- | Decode a required sint32 field. +getSInt32 :: Get Int32 +getSInt32 = ZZ.decode32 <$> getVarInt + + +-- | Decode an optional sint32 field. +getSInt32Opt :: Get (Maybe Int32) +getSInt32Opt = getOpt getSInt32 + + +-- | Decode a packed repeated sint32 field. +getSInt32Packed :: Get (Seq Int32) +getSInt32Packed = getPacked getSInt32 + + +-- | Decode a required sint64 field. +getSInt64 :: Get Int64 +getSInt64 = ZZ.decode64 <$> getVarInt + + +-- | Decode an optional sint64 field. +getSInt64Opt :: Get (Maybe Int64) +getSInt64Opt = getOpt getSInt64 + + +-- | Decode a packed repeated sint64 field. +getSInt64Packed :: Get (Seq Int64) +getSInt64Packed = getPacked getSInt64 + + +-- | Decode a required string. +getString :: Get Text +getString = do + bytes <- getBytes + case decodeUtf8' bytes of + Right text -> return text + Left err -> fail $ "Invalid UTF8: " ++ show err + + +-- | Decode an optional string. +getStringOpt :: Get (Maybe Text) +getStringOpt = getOpt getString + + +-- | Decode a required uint32 field. +getUInt32 :: Get Word32 +getUInt32 = getVarInt + + +-- | Decode an optional uint32 field. +getUInt32Opt :: Get (Maybe Word32) +getUInt32Opt = getOpt getUInt32 + + +-- | Decode a packed repeated uint32 field. +getUInt32Packed :: Get (Seq Word32) +getUInt32Packed = getPacked getUInt32 + + +-- | Decode a required uint64 field. +getUInt64 :: Get Word64 +getUInt64 = getVarInt + + +-- | Decode an optional uint64 field. +getUInt64Opt :: Get (Maybe Word64) +getUInt64Opt = getOpt getUInt64 + + +-- | Decode a packed repeated uint64 field. +getUInt64Packed :: Get (Seq Word64) +getUInt64Packed = getPacked getUInt64 + + +-- | Skip an unknown field. +getUnknown :: WireTag -> a -> Get a +getUnknown (WireTag _ VarInt) a = (getVarInt :: Get Int64) >> return a +getUnknown (WireTag _ Bit64) a = getWord64le >> return a +getUnknown (WireTag _ LenDelim) a = getBytes >> return a +getUnknown (WireTag _ Bit32) a = getWord32le >> return a + + +-- | Decode a wire tag. +getWireTag :: Get WireTag +getWireTag = do + int <- getVarInt + case toWireTag int of + Right tag -> return tag + Left err -> fail err + + +-- | Encode a required bool field. +putBool :: WireTag -> Bool -> Put +putBool tag val = do + putWireTag tag + putVarInt $ boolToWord8 val + + +-- | Encode a repeated bool field. +putBoolList :: WireTag -> Seq Bool -> Put +putBoolList = putList putBool + + +-- | Encode an optional bool field. +putBoolOpt :: WireTag -> Maybe Bool -> Put +putBoolOpt = putOpt putBool + + +-- | Encode a packed repeated bool field. +putBoolPacked :: WireTag -> Seq Bool -> Put +putBoolPacked = putPacked (putVarInt . boolToWord8) + + +-- | Encode a required bytes field. +putBytes :: WireTag -> ByteString -> Put +putBytes tag bs = do + putWireTag tag + putVarInt $ BSL.length bs + putLazyByteString bs + + +-- | Encode a repeated bytes field. +putBytesList :: WireTag -> Seq ByteString -> Put +putBytesList = putList putBytes + + +-- | Encode an optional bytes field. +putBytesOpt :: WireTag -> Maybe ByteString -> Put +putBytesOpt = putOpt putBytes + + +-- | Encode a required double field. +putDouble :: WireTag -> Double -> Put +putDouble tag d = do + putWireTag tag + putFloat64le d + + +-- | Encode a repeated double field. +putDoubleList :: WireTag -> Seq Double -> Put +putDoubleList = putList putDouble + + +-- | Encode an optional double field. +putDoubleOpt :: WireTag -> Maybe Double -> Put +putDoubleOpt = putOpt putDouble + + +-- | Encode a packed repeated double field. +putDoublePacked :: WireTag -> Seq Double -> Put +putDoublePacked = putPacked putFloat64le + + +-- | Encode a required enum field. +putEnum :: WireEnum a => WireTag -> a -> Put +putEnum tag a = putInt32 tag $ enumToInt a + + +-- | Encode a repeated enum field. +putEnumList :: WireEnum a => WireTag -> Seq a -> Put +putEnumList = putList putEnum + + +-- | Encode an optional enum field. +putEnumOpt :: WireEnum a => WireTag -> Maybe a -> Put +putEnumOpt = putOpt putEnum + + +-- | Encode a packed repeated enum field. +putEnumPacked :: WireEnum a => WireTag -> Seq a -> Put +putEnumPacked = putPacked (putVarInt . enumToInt) + + +-- | Encode a required fixed32 field. +putFixed32 :: WireTag -> Word32 -> Put +putFixed32 tag f = do + putWireTag tag + putWord32le f + + +-- | Encode a repeated fixed32 field. +putFixed32List :: WireTag -> Seq Word32 -> Put +putFixed32List = putList putFixed32 + + +-- | Encode an optional fixed32 field. +putFixed32Opt :: WireTag -> Maybe Word32 -> Put +putFixed32Opt = putOpt putFixed32 + + +-- | Encode a packed repeated fixed32 field. +putFixed32Packed :: WireTag -> Seq Word32 -> Put +putFixed32Packed = putPacked putWord32le + + +-- | Encode a required fixed64 field. +putFixed64 :: WireTag -> Word64 -> Put +putFixed64 tag f = do + putWireTag tag + putWord64le f + + +-- | Encode a repeated fixed64 field. +putFixed64List :: WireTag -> Seq Word64 -> Put +putFixed64List = putList putFixed64 + + +-- | Encode an optional fixed64 field. +putFixed64Opt :: WireTag -> Maybe Word64 -> Put +putFixed64Opt = putOpt putFixed64 + + +-- | Encode a packed repeated fixed64 field. +putFixed64Packed :: WireTag -> Seq Word64 -> Put +putFixed64Packed = putPacked putWord64le + + +-- | Encode a required float field. +putFloat :: WireTag -> Float -> Put +putFloat tag f = do + putWireTag tag + putFloat32le f + + +-- | Encode a repeated float field. +putFloatList :: WireTag -> Seq Float -> Put +putFloatList = putList putFloat + + +-- | Encode an optional float field. +putFloatOpt :: WireTag -> Maybe Float -> Put +putFloatOpt = putOpt putFloat + + +-- | Encode a packed repeated float field. +putFloatPacked :: WireTag -> Seq Float -> Put +putFloatPacked = putPacked putFloat32le + + +-- | Encode a required group field. +putGroup :: WireMessage a => a -> Put +putGroup = messageToFields + + +-- | Encode an optional group field. +putGroupOpt :: WireMessage a => Maybe a -> Put +putGroupOpt (Just val) = putGroup val +putGroupOpt Nothing = return () + + +-- | Encode a required int32 field. +putInt32 :: WireTag -> Int32 -> Put +putInt32 tag i = do + putWireTag tag + putVarInt i + + +-- | Encode a repeated int32 field. +putInt32List :: WireTag -> Seq Int32 -> Put +putInt32List = putList putInt32 + + +-- | Encode an optional int32 field. +putInt32Opt :: WireTag -> Maybe Int32 -> Put +putInt32Opt = putOpt putInt32 + + +-- | Encode a packed repeated int32 field. +putInt32Packed :: WireTag -> Seq Int32 -> Put +putInt32Packed = putPacked putVarInt + + +-- | Encode a required int64 field. +putInt64 :: WireTag -> Int64 -> Put +putInt64 tag i = do + putWireTag tag + putVarInt i + + +-- | Encode a repeated int64 field. +putInt64List :: WireTag -> Seq Int64 -> Put +putInt64List = putList putInt64 + + +-- | Encode an optional int64 field. +putInt64Opt :: WireTag -> Maybe Int64 -> Put +putInt64Opt = putOpt putInt64 + + +-- | Encode a packed repeated int64 field. +putInt64Packed :: WireTag -> Seq Int64 -> Put +putInt64Packed = putPacked putVarInt + + +-- | Encode a required sfixed32 field. +putSFixed32 :: WireTag -> Int32 -> Put +putSFixed32 tag f = do + putWireTag tag + putWord32le $ fromIntegral f + + +-- | Encode a repeated sfixed32 field. +putSFixed32List :: WireTag -> Seq Int32 -> Put +putSFixed32List = putList putSFixed32 + + +-- | Encode an optional sfixed32 field. +putSFixed32Opt :: WireTag -> Maybe Int32 -> Put +putSFixed32Opt = putOpt putSFixed32 + + +-- | Encode a packed repeated sfixed32 field. +putSFixed32Packed :: WireTag -> Seq Int32 -> Put +putSFixed32Packed = putPacked (putWord32le . fromIntegral) + + +-- | Encode a required sfixed64 field. +putSFixed64 :: WireTag -> Int64 -> Put +putSFixed64 tag f = do + putWireTag tag + putWord64le $ fromIntegral f + + +-- | Encode a repeated sfixed64 field. +putSFixed64List :: WireTag -> Seq Int64 -> Put +putSFixed64List = putList putSFixed64 + + +-- | Encode an optional sfixed64 field. +putSFixed64Opt :: WireTag -> Maybe Int64 -> Put +putSFixed64Opt = putOpt putSFixed64 + + +-- | Encode a packed repeated sfixed64 field. +putSFixed64Packed :: WireTag -> Seq Int64 -> Put +putSFixed64Packed = putPacked (putWord64le . fromIntegral) + + +-- | Encode a required sint32 field. +putSInt32 :: WireTag -> Int32 -> Put +putSInt32 tag i = do + putWireTag tag + putVarInt $ ZZ.encode32 i + + +-- | Encode a repeated sint32 field. +putSInt32List :: WireTag -> Seq Int32 -> Put +putSInt32List = putList putSInt32 + + +-- | Encode an optional sint32 field. +putSInt32Opt :: WireTag -> Maybe Int32 -> Put +putSInt32Opt = putOpt putSInt32 + + +-- | Encode a packed repeated sint32 field. +putSInt32Packed :: WireTag -> Seq Int32 -> Put +putSInt32Packed = putPacked (putVarInt . ZZ.encode32) + + +-- | Encode a required sint64 field. +putSInt64 :: WireTag -> Int64 -> Put +putSInt64 tag i = do + putWireTag tag + putVarInt $ ZZ.encode64 i + + +-- | Encode a repeated sint64 field. +putSInt64List :: WireTag -> Seq Int64 -> Put +putSInt64List = putList putSInt64 + + +-- | Encode an optional sint64 field. +putSInt64Opt :: WireTag -> Maybe Int64 -> Put +putSInt64Opt = putOpt putSInt64 + + +-- | Encode a packed repeated sint64 field. +putSInt64Packed :: WireTag -> Seq Int64 -> Put +putSInt64Packed = putPacked (putVarInt . ZZ.encode64) + + +-- | Encode a required message field. +putMessage :: WireMessage a => WireTag -> a -> Put +putMessage tag a = putBytes tag $ runPut (putGroup a) + + +-- | Encode a repeated message field. +putMessageList :: WireMessage a => WireTag -> Seq a -> Put +putMessageList = putList putMessage + + +-- | Encode an optional message field. +putMessageOpt :: WireMessage a => WireTag -> Maybe a -> Put +putMessageOpt = putOpt putMessage + + +-- | Encode a required string field. +putString :: WireTag -> Text -> Put +putString tag txt = putBytes tag $ encodeUtf8 txt + + +-- | Encode a repeated string field. +putStringList :: WireTag -> Seq Text -> Put +putStringList = putList putString + + +-- | Encode an optional string field. +putStringOpt :: WireTag -> Maybe Text -> Put +putStringOpt = putOpt putString + + +-- | Encode a required uint32 field. +putUInt32 :: WireTag -> Word32 -> Put +putUInt32 tag i = do + putWireTag tag + putVarInt i + + +-- | Encode a repeated uint32 field. +putUInt32List :: WireTag -> Seq Word32 -> Put +putUInt32List = putList putUInt32 + + +-- | Encode an optional uint32 field. +putUInt32Opt :: WireTag -> Maybe Word32 -> Put +putUInt32Opt = putOpt putUInt32 + + +-- | Encode a packed repeated uint32 field. +putUInt32Packed :: WireTag -> Seq Word32 -> Put +putUInt32Packed = putPacked putVarInt + + +-- | Encode a required uint64 field. +putUInt64 :: WireTag -> Word64 -> Put +putUInt64 tag i = do + putWireTag tag + putVarInt i + + +-- | Encode a repeated uint64 field. +putUInt64List :: WireTag -> Seq Word64 -> Put +putUInt64List = putList putUInt64 + + +-- | Encode an optional uint64 field. +putUInt64Opt :: WireTag -> Maybe Word64 -> Put +putUInt64Opt = putOpt putUInt64 + + +-- | Encode a packed repeated uint64 field. +putUInt64Packed :: WireTag -> Seq Word64 -> Put +putUInt64Packed = putPacked putVarInt + + +-- | Encode a wire tag. +putWireTag :: WireTag -> Put +putWireTag = putVarInt . fromWireTag + + + +{- Internal -} + + +getOpt :: Get a -> Get (Maybe a) +getOpt = fmap Just + + +getPacked :: Get a -> Get (Seq a) +getPacked f = do + bytes <- getBytes + case runGetOrFail (loop Seq.empty) bytes of + Left (_, _, err) -> fail err + Right (_, _, obj) -> return obj + where + loop xs = do + done <- isEmpty + if done + then return xs + else do + val <- f + loop (xs |> val) + + +getVarInt :: (Bits a, Integral a) => Get a +getVarInt = getVarIntBytes 0 0 + + +type Shift = Int + + +getVarIntBytes :: (Bits a, Integral a) => a -> Shift -> Get a +getVarIntBytes prev shift = do + (isLast, newVal, newShift) <- getVarIntByte prev shift + if isLast + then return newVal + else getVarIntBytes newVal newShift + + +getVarIntByte :: (Bits a, Integral a) => a -> Shift -> Get (Bool, a, Shift) +getVarIntByte prev shift = do + byte <- getWord8 + let isLast = not $ testBit byte 7 + let newVal = prev .|. (fromIntegral (byte .&. 0x7F) `shiftL` shift) + let newShift = shift + 7 + return (isLast, newVal, newShift) + + +putVarInt :: (Bits a, Integral a) => a -> Put +putVarInt i + | i < 0 = putNegVarInt i + | otherwise = putPosVarInt i + + +putNegVarInt :: (Bits a, Integral a) => a -> Put +putNegVarInt i = putNegVarInt' i 10 + + +putNegVarInt' :: (Bits a, Integral a) => a -> Int -> Put +putNegVarInt' i 1 = putWord8 $ fromIntegral $ i .&. 1 +putNegVarInt' i n = do + putWord8 (fromIntegral $ setBit (i .&. 0x7F) 7) + putNegVarInt' (shiftR i 7) (n - 1) + + +putPosVarInt :: (Bits a, Integral a) => a -> Put +putPosVarInt i + | i < 128 = putWord8 $ fromIntegral i + | otherwise = do + putWord8 (fromIntegral $ setBit (i .&. 0x7F) 7) + putPosVarInt (shiftR i 7) + + +putList :: (WireTag -> a -> Put) -> WireTag -> Seq a -> Put +putList f tag = mapM_ (f tag) + + +putPacked :: (a -> Put) -> WireTag -> Seq a -> Put +putPacked f tag xs + | len == 0 = return () + | otherwise = putBytes tag $ runPut (forM_ xs f) + where len = Seq.length xs + + +putOpt :: (WireTag -> a -> Put) -> WireTag -> Maybe a -> Put +putOpt f tag (Just val) = f tag val +putOpt _ _ Nothing = return () + + +boolToWord8 :: Bool -> Word8 +boolToWord8 True = 1 +boolToWord8 False = 0 diff --git a/src/Data/ProtoBuf/WireMessage.hs b/src/Data/ProtoBuf/WireMessage.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/WireMessage.hs @@ -0,0 +1,26 @@ +-- | +-- Module: Data.ProtoBuf.WireMessage +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- WireMessage typeclass. + +module Data.ProtoBuf.WireMessage + ( WireMessage(..) + ) where + + +import Data.Binary.Get (Get) +import Data.Binary.Put (Put) +import Data.ProtoBuf.WireTag (WireTag) + + +-- | Typeclass to handle encoding and decoding of messages. +class WireMessage a where + + -- | Decode a field and merge it with the existing value in the message. + fieldToValue :: WireTag -> a -> Get a + + -- | Encode all the fields of the message. + messageToFields :: a -> Put diff --git a/src/Data/ProtoBuf/WireTag.hs b/src/Data/ProtoBuf/WireTag.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/WireTag.hs @@ -0,0 +1,38 @@ +-- | +-- Module: Data.ProtoBuf.WireTag +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- WireTag type and functions. + +module Data.ProtoBuf.WireTag + ( WireTag(..) + , fromWireTag + , toWireTag + ) where + + +import Data.Bits ((.|.)) +import Data.ProtoBuf.FieldNumber +import Data.ProtoBuf.WireType +import Data.Word (Word32) + + +-- | Type to represent a wire tag. +data WireTag = WireTag FieldNumber WireType + deriving (Show, Eq, Ord) + + +-- | Convert a WireTag into a Word32. +fromWireTag :: WireTag -> Word32 +fromWireTag (WireTag fn wt) = fromFieldNumber fn .|. fromWireType wt + + +-- | Convert a Word32 into a WireTag or an error. +toWireTag :: Word32 -> Either String WireTag +toWireTag i = do + fieldNumber <- toFieldNumber i + wireType <- toWireType i + return $ WireTag fieldNumber wireType + diff --git a/src/Data/ProtoBuf/WireType.hs b/src/Data/ProtoBuf/WireType.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/WireType.hs @@ -0,0 +1,51 @@ +-- | +-- Module: Data.ProtoBuf.WireType +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- WireType type and functions. + +module Data.ProtoBuf.WireType + ( WireType(..) + , fromWireType + , toWireType + ) where + + +import Data.Bits ((.&.)) +import Data.Word (Word32) + + +-- | Type to represent the Protocol Buffers wire type. +data WireType + -- | The varint type: int32, int64, uint32, sint32, sint64, bool enum + = VarInt + -- | The 64-bit type: fixed64, sfixed64, double + | Bit64 + -- | The length-delimited: string, bytes, embedded messages, packed repeated fields + | LenDelim + -- | The 32-bit type: fixed32, sfixed32, float + | Bit32 + deriving (Show, Eq, Ord) + + +-- | Convert a WireType into a Word32. +fromWireType :: WireType -> Word32 +fromWireType VarInt = 0 +fromWireType Bit64 = 1 +fromWireType LenDelim = 2 +fromWireType Bit32 = 5 + + +-- | Convert a Word32 into a WireType or an error. +toWireType :: Word32 -> Either String WireType +toWireType i + | wType == 0 = Right VarInt + | wType == 1 = Right Bit64 + | wType == 2 = Right LenDelim + | wType == 3 = Left "Deprecated WireType: 3 (Start Group)" + | wType == 4 = Left "Deprecated WireType: 4 (End Group)" + | wType == 5 = Right Bit32 + | otherwise = Left $ "Invalid WireType: " ++ show wType + where wType = i .&. 7 diff --git a/src/Data/ProtoBuf/ZigZag.hs b/src/Data/ProtoBuf/ZigZag.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBuf/ZigZag.hs @@ -0,0 +1,38 @@ +-- | +-- Module: Data.ProtoBuf.ZigZag +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Functions to ZigZag encode and decode Int32 and Int64. + +module Data.ProtoBuf.ZigZag + ( decode32 + , decode64 + , encode32 + , encode64 + ) where + +import Data.Bits ((.&.), shiftL, shiftR, xor) +import Data.Int (Int32, Int64) +import Data.Word (Word32, Word64) + + +-- | Decode a ZigZag encoded Int32. +decode32 :: Word32 -> Int32 +decode32 x = xor (fromIntegral $ shiftR x 1) (negate (fromIntegral $ x .&. 1)) + + +-- | Decode a ZigZag encoded Int64. +decode64 :: Word64 -> Int64 +decode64 x = xor (fromIntegral $ shiftR x 1) (negate (fromIntegral $ x .&. 1)) + + +-- | ZigZag encode an Int32. +encode32 :: Int32 -> Word32 +encode32 x = fromIntegral $ xor (shiftL x 1) (shiftR x 31) + + +-- | ZigZag encode an Int64. +encode64 :: Int64 -> Word64 +encode64 x = fromIntegral $ xor (shiftL x 1) (shiftR x 63) diff --git a/src/Data/ProtoBufInt.hs b/src/Data/ProtoBufInt.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoBufInt.hs @@ -0,0 +1,49 @@ +-- | +-- Module: Data.ProtoBufInt +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Internal functions used by the generated types. + +module Data.ProtoBufInt + ( module Data.ProtoBuf.Default + , module Data.ProtoBuf.FieldNumber + , module Data.ProtoBuf.Mergeable + , module Data.ProtoBuf.Required + , module Data.ProtoBuf.WireEnum + , module Data.ProtoBuf.WireFormat + , module Data.ProtoBuf.WireMessage + , module Data.ProtoBuf.WireTag + , module Data.ProtoBuf.WireType + , module Export + , append + ) where + + +import Data.ProtoBuf.Default +import Data.ProtoBuf.FieldNumber +import Data.ProtoBuf.Mergeable +import Data.ProtoBuf.Required +import Data.ProtoBuf.WireEnum +import Data.ProtoBuf.WireFormat +import Data.ProtoBuf.WireMessage +import Data.ProtoBuf.WireTag +import Data.ProtoBuf.WireType + +import Data.Sequence (Seq, (|>)) + +import Data.Bool as Export (Bool(..)) +import Data.ByteString.Lazy as Export (ByteString) +import Data.Int as Export (Int32, Int64) +import Data.Maybe as Export (Maybe(..)) +import Data.Sequence as Export (Seq) +import Data.Set as Export (fromList) +import Data.Text.Lazy as Export (Text, pack) +import Data.Word as Export (Word32, Word64) +import Prelude as Export (Double, Eq, Float, Ord, Show) + + +-- | Append a value to a Seq. +append :: Seq a -> a -> Seq a +append seq val = seq |> val diff --git a/src/Parser/CaseUtils.hs b/src/Parser/CaseUtils.hs new file mode 100644 --- /dev/null +++ b/src/Parser/CaseUtils.hs @@ -0,0 +1,39 @@ +-- | +-- Module: Parser.CaseUtils +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Utility functions for converting string cases. + +module Parser.CaseUtils + ( fromSnake + , toCamel + , toPascal + ) where + + +import Data.Char (toLower, toUpper) +import Data.List.Split (splitOn) + + +fromSnake :: String -> [String] +fromSnake = splitOn "_" + + +toCamel :: [String] -> String +toCamel (w:ws) = toLowerWord w ++ concatMap toPascalWord ws +toCamel [] = "" + + +toPascal :: [String] -> String +toPascal = concatMap toPascalWord + + +toLowerWord :: String -> String +toLowerWord = map toLower + + +toPascalWord :: String -> String +toPascalWord (c:cs) = toUpper c : map toLower cs +toPascalWord [] = "" diff --git a/src/Parser/CodeInfo.hs b/src/Parser/CodeInfo.hs new file mode 100644 --- /dev/null +++ b/src/Parser/CodeInfo.hs @@ -0,0 +1,21 @@ +-- | +-- Module: Parser.CodeInfo +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- CodeInfo type. + +module Parser.CodeInfo where + +import Data.Text.Lazy (Text) +import System.FilePath (FilePath) +import Prelude (Show, String) + + +data CodeInfo = CodeInfo + { directories :: !FilePath + , filename :: !String + , code :: !Text + } deriving Show + diff --git a/src/Parser/EnumDesc.hs b/src/Parser/EnumDesc.hs new file mode 100644 --- /dev/null +++ b/src/Parser/EnumDesc.hs @@ -0,0 +1,66 @@ +-- | +-- Module: Parser.EnumDesc +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Enum Descriptor type and functions. + +module Parser.EnumDesc + ( EnumDesc + , new + , getName + , addValueDesc + , addValueDescs + , getValueDescs + , getAllowAlias + , setAllowAlias + ) where + + +import Data.Foldable (toList) +import Data.Sequence ((|>), (><)) +import Prelude (Maybe(..), (.)) + +import qualified Data.Sequence +import qualified Data.Sequence as Seq +import qualified Parser.EnumValueDesc as Parser +import qualified Prelude + + +data EnumDesc = EnumDesc + { name :: Prelude.String + , valueDescs :: Data.Sequence.Seq Parser.EnumValueDesc + , allowAlias :: Prelude.Maybe Prelude.Bool + } deriving (Prelude.Show, Prelude.Eq) + + +type EnumName = Prelude.String + + +new :: EnumName -> EnumDesc +new n = EnumDesc n Seq.empty Nothing + + +getName :: EnumDesc -> EnumName +getName = name + + +addValueDesc :: Parser.EnumValueDesc -> EnumDesc -> EnumDesc +addValueDesc val self = self{valueDescs = valueDescs self |> val} + + +addValueDescs :: [Parser.EnumValueDesc] -> EnumDesc -> EnumDesc +addValueDescs vs self = self{valueDescs = valueDescs self >< Seq.fromList vs} + + +getValueDescs :: EnumDesc -> [Parser.EnumValueDesc] +getValueDescs = toList . valueDescs + + +getAllowAlias :: EnumDesc -> Maybe Prelude.Bool +getAllowAlias = allowAlias + + +setAllowAlias :: Prelude.Bool -> EnumDesc -> EnumDesc +setAllowAlias val self = self{allowAlias = Just val} diff --git a/src/Parser/EnumGenerator.hs b/src/Parser/EnumGenerator.hs new file mode 100644 --- /dev/null +++ b/src/Parser/EnumGenerator.hs @@ -0,0 +1,148 @@ +-- | +-- Module: Parser.EnumGenerator +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Generate code for Enum types. + +module Parser.EnumGenerator + ( getEnumCode + ) where + +import Control.Monad.State (State) +import Data.List (foldl', groupBy, intersperse, sortOn) +import Data.Monoid ((<>)) +import Data.Text.Lazy (Text) +import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) +import Parser.EnumDesc (EnumDesc) +import Parser.EnumValueDesc (EnumValueDesc) +import Parser.FileDesc (FileDesc) +import Parser.GeneratorUtils + +import qualified Parser.EnumDesc as EnumDesc +import qualified Parser.EnumValueDesc as EnumValueDesc +import qualified Parser.FileDesc as FileDesc + + +getEnumCode :: FileDesc -> EnumDesc -> State GenState Text +getEnumCode f ed = do + commentLine <- getComment + moduleLine <- getModule f ed + importLines <- getImports f ed + typeLines <- getType f ed + defaultInst <- getDefaultInst ed + mergeableInst <- getMergeableInst ed + wireEnumInst <- getWireEnumInst ed + return $ toLazyText $ + commentLine <> nl <> + moduleLine <> nl <> + importLines <> nl <> + typeLines <> nl <> + defaultInst <> nl <> + mergeableInst <> nl <> + wireEnumInst <> nl + + +getModule :: FileDesc -> EnumDesc -> State GenState Builder +getModule f ed = do + modName <- getModuleName f ed + return $ + fromString "module " <> + fromString modName <> + fromString " where" <> nl + + +getModuleName :: FileDesc -> EnumDesc -> State GenState String +getModuleName f ed = return $ case FileDesc.getPackage f of + Just package -> package ++ "." ++ enumName + Nothing -> fileName ++ "." ++ enumName + where + fileName = FileDesc.getName f + enumName = EnumDesc.getName ed + + +getImports :: FileDesc -> EnumDesc -> State GenState Builder +getImports _ _ = return $ + getUnqualifiedImport "Prelude" "" <> + getQualifiedAsImport "Data.ProtoBufInt" "PB" + + +getType :: FileDesc -> EnumDesc -> State GenState Builder +getType f ed = do + enumValues <- getEnumValues f ed + return $ + fromString "data " <> + fromString name <> + fromString " = " <> + enumValues <> + nl <> + tab <> + fromString "deriving (PB.Show, PB.Eq, PB.Ord)" <> nl + where name = EnumDesc.getName ed + + +getEnumValues :: FileDesc -> EnumDesc -> State GenState Builder +getEnumValues _ ed = fmap (foldl' (<>) empty) ivalues + where + ivalues = fmap (intersperse separator) fvalues + fvalues = mapM getEnumValue (EnumDesc.getValueDescs ed) + separator = fromString " | " + + +getEnumValue :: EnumValueDesc -> State GenState Builder +getEnumValue = return . fromString . EnumValueDesc.getName + + +getDefaultInst :: EnumDesc -> State GenState Builder +getDefaultInst ed = return $ + fromString "instance PB.Default " <> fromString name <> fromString " where" <> nl <> + tab <> fromString "defaultVal = " <> fromString first <> nl + where + name = EnumDesc.getName ed + first = EnumValueDesc.getName $ head $ EnumDesc.getValueDescs ed + + +getMergeableInst :: EnumDesc -> State GenState Builder +getMergeableInst ed = return $ + fromString "instance PB.Mergeable " <> fromString name <> fromString " where" <> nl + where + name = EnumDesc.getName ed + + +getWireEnumInst :: EnumDesc -> State GenState Builder +getWireEnumInst ed = return $ + fromString "instance PB.WireEnum " <> fromString name <> fromString " where" <> nl <> + intToEnumLines <> nl <> + enumToIntLines <> nl + where + name = EnumDesc.getName ed + intToEnumLines = getIntToEnumLines (EnumDesc.getValueDescs ed) + enumToIntLines = getEnumToIntLines (EnumDesc.getValueDescs ed) + + +getIntToEnumLines :: [EnumValueDesc] -> Builder +getIntToEnumLines es = + foldl' (<>) empty (map getIntToEnumLine $ uniqEs es) <> + tab <> fromString "intToEnum _ = PB.defaultVal" <> nl + where + uniqEs = map head . groupBy areEq . sortOn EnumValueDesc.getNumber + areEq a b = EnumValueDesc.getNumber a == EnumValueDesc.getNumber b + + +getIntToEnumLine :: EnumValueDesc -> Builder +getIntToEnumLine e = tab <> fromString "intToEnum " <> number <> fromString " = " <> name <> nl + where + name = fromString $ EnumValueDesc.getName e + number = fromString $ show $ EnumValueDesc.getNumber e + + +getEnumToIntLines :: [EnumValueDesc] -> Builder +getEnumToIntLines es = foldl' (<>) empty (map getEnumToIntLine es) + + +getEnumToIntLine :: EnumValueDesc -> Builder +getEnumToIntLine e = tab <> fromString "enumToInt " <> name <> fromString " = " <> number <> nl + where + name = fromString $ EnumValueDesc.getName e + number = fromString $ show $ EnumValueDesc.getNumber e diff --git a/src/Parser/EnumValueDesc.hs b/src/Parser/EnumValueDesc.hs new file mode 100644 --- /dev/null +++ b/src/Parser/EnumValueDesc.hs @@ -0,0 +1,40 @@ +-- | +-- Module: Parser.EnumValueDesc +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Enum Value Descriptor type and functions. + +module Parser.EnumValueDesc + ( EnumValueDesc + , new + , getName + , getNumber + ) where + + +import qualified Data.Int +import qualified Prelude + + +type ValueName = Prelude.String +type ValueNumber = Data.Int.Int32 + + +data EnumValueDesc = EnumValueDesc + { name :: Prelude.String + , number :: Data.Int.Int32 + } deriving (Prelude.Show, Prelude.Eq) + + +new :: ValueName -> ValueNumber -> EnumValueDesc +new = EnumValueDesc + + +getName :: EnumValueDesc -> ValueName +getName = name + + +getNumber :: EnumValueDesc -> ValueNumber +getNumber = number diff --git a/src/Parser/FieldDesc.hs b/src/Parser/FieldDesc.hs new file mode 100644 --- /dev/null +++ b/src/Parser/FieldDesc.hs @@ -0,0 +1,119 @@ +-- | +-- Module: Parser.FieldDesc +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Field Descriptor type and functions. + +module Parser.FieldDesc + ( FieldDesc + , new + , getName + , getNumber + , getLabel + , getType + , setType + , getTypeName + , getDefaultValue + , setDefaultValue + , getPacked + , setPacked + , isCustom + , isRequired + ) where + + +import Data.Maybe (isNothing) +import Parser.Label (Label(..)) +import Prelude (Maybe(..), Bool(..), (==)) + +import qualified Data.Int +import qualified Parser.Label as Parser +import qualified Parser.Type as Parser +import qualified Parser.Type as Type +import qualified Prelude + + +data FieldDesc = FieldDesc + { name :: Prelude.String + , number :: Data.Int.Int32 + , label :: Parser.Label + , fieldType :: Prelude.Maybe Parser.Type + , fieldTypeName :: Prelude.String + , defaultValue :: Prelude.Maybe Prelude.String + , packed :: Prelude.Maybe Prelude.Bool + } deriving (Prelude.Show, Prelude.Eq) + + +type FieldName = Prelude.String +type FieldNumber = Data.Int.Int32 +type FieldTypeName = Prelude.String +type FieldDefault = Prelude.String + + +new :: FieldName -> FieldNumber -> Parser.Label -> FieldTypeName -> FieldDesc +new n num lbl "bool" = FieldDesc n num lbl (Just Type.Bool) "bool" Nothing Nothing +new n num lbl "bytes" = FieldDesc n num lbl (Just Type.Bytes) "bytes" Nothing Nothing +new n num lbl "double" = FieldDesc n num lbl (Just Type.Double) "double" Nothing Nothing +new n num lbl "fixed32" = FieldDesc n num lbl (Just Type.Fixed32) "fixed32" Nothing Nothing +new n num lbl "fixed64" = FieldDesc n num lbl (Just Type.Fixed64) "fixed64" Nothing Nothing +new n num lbl "float" = FieldDesc n num lbl (Just Type.Float) "float" Nothing Nothing +new n num lbl "int32" = FieldDesc n num lbl (Just Type.Int32) "int32" Nothing Nothing +new n num lbl "int64" = FieldDesc n num lbl (Just Type.Int64) "int64" Nothing Nothing +new n num lbl "sfixed32" = FieldDesc n num lbl (Just Type.SFixed32) "sfixed32" Nothing Nothing +new n num lbl "sfixed64" = FieldDesc n num lbl (Just Type.SFixed64) "sfixed64" Nothing Nothing +new n num lbl "sint32" = FieldDesc n num lbl (Just Type.SInt32) "sint32" Nothing Nothing +new n num lbl "sint64" = FieldDesc n num lbl (Just Type.SInt64) "sint64" Nothing Nothing +new n num lbl "string" = FieldDesc n num lbl (Just Type.String) "string" Nothing Nothing +new n num lbl "uint32" = FieldDesc n num lbl (Just Type.UInt32) "uint32" Nothing Nothing +new n num lbl "uint64" = FieldDesc n num lbl (Just Type.UInt64) "uint64" Nothing Nothing +new n num lbl ft = FieldDesc n num lbl Nothing ft Nothing Nothing + + +getName :: FieldDesc -> FieldName +getName = name + + +getNumber :: FieldDesc -> FieldNumber +getNumber = number + + +getLabel :: FieldDesc -> Parser.Label +getLabel = label + + +getType :: FieldDesc -> Maybe Parser.Type +getType = fieldType + + +setType :: Parser.Type -> FieldDesc -> FieldDesc +setType val self = self{fieldType = Just val} + + +getTypeName :: FieldDesc -> FieldTypeName +getTypeName = fieldTypeName + + +getDefaultValue :: FieldDesc -> Maybe FieldDefault +getDefaultValue = defaultValue + + +setDefaultValue :: FieldDefault -> FieldDesc -> FieldDesc +setDefaultValue val self = self{defaultValue = Just val} + + +getPacked :: FieldDesc -> Maybe Prelude.Bool +getPacked = packed + + +setPacked :: Prelude.Bool -> FieldDesc -> FieldDesc +setPacked val self = self{packed = Just val} + + +isCustom :: FieldDesc -> Bool +isCustom FieldDesc { fieldType = f } = isNothing f + + +isRequired :: FieldDesc -> Bool +isRequired FieldDesc { label = l } = l == Required diff --git a/src/Parser/FileDesc.hs b/src/Parser/FileDesc.hs new file mode 100644 --- /dev/null +++ b/src/Parser/FileDesc.hs @@ -0,0 +1,84 @@ +-- | +-- Module: Parser.FileDesc +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- File Descriptor type and functions. + +module Parser.FileDesc + ( FileDesc + , new + , getName + , getPackage + , setPackage + , addMessageDesc + , addMessageDescs + , getMessageDescs + , addEnumDesc + , addEnumDescs + , getEnumDescs + ) where + + +import Prelude (Maybe(..), (.)) +import Data.Foldable (toList) +import Data.Sequence ((|>), (><)) + +import qualified Data.Sequence +import qualified Data.Sequence as Seq +import qualified Parser.EnumDesc as Parser +import qualified Parser.MessageDesc as Parser +import qualified Prelude + + +data FileDesc = FileDesc + { name :: Prelude.String + , package :: Prelude.Maybe Prelude.String + , messageDescs :: Data.Sequence.Seq Parser.MessageDesc + , enumDescs :: Data.Sequence.Seq Parser.EnumDesc + } deriving (Prelude.Show, Prelude.Eq) + + +type FileName = Prelude.String +type Package = Prelude.String + + +new :: FileName -> FileDesc +new fn = FileDesc fn Nothing Seq.empty Seq.empty + + +getName :: FileDesc -> FileName +getName = name + + +getPackage :: FileDesc -> Maybe Package +getPackage = package + + +setPackage :: Package -> FileDesc -> FileDesc +setPackage val self = self{package = Just val} + + +addMessageDesc :: Parser.MessageDesc -> FileDesc -> FileDesc +addMessageDesc val self = self{messageDescs = messageDescs self |> val} + + +addMessageDescs :: [Parser.MessageDesc] -> FileDesc -> FileDesc +addMessageDescs vs self = self{messageDescs = messageDescs self >< Seq.fromList vs} + + +getMessageDescs :: FileDesc -> [Parser.MessageDesc] +getMessageDescs = toList . messageDescs + + +addEnumDesc :: Parser.EnumDesc -> FileDesc -> FileDesc +addEnumDesc val self = self{enumDescs = enumDescs self |> val} + + +addEnumDescs :: [Parser.EnumDesc] -> FileDesc -> FileDesc +addEnumDescs vs self = self{enumDescs = enumDescs self >< Seq.fromList vs} + + +getEnumDescs :: FileDesc -> [Parser.EnumDesc] +getEnumDescs = toList . enumDescs diff --git a/src/Parser/FileWriter.hs b/src/Parser/FileWriter.hs new file mode 100644 --- /dev/null +++ b/src/Parser/FileWriter.hs @@ -0,0 +1,31 @@ +-- | +-- Module: Parser.FileWriter +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Functions to create type files. + +module Parser.FileWriter + ( write + ) where + +import Data.Text.Lazy.IO (writeFile) +import Parser.CodeInfo +import System.Directory (createDirectoryIfMissing) +import System.FilePath (()) +import Prelude hiding (writeFile) + + +write :: [CodeInfo] -> IO () +write = mapM_ createProtoFile + + +createProtoFile :: CodeInfo -> IO () +createProtoFile i = do + createDirectories i + writeFile (directories i filename i) (code i) + + +createDirectories :: CodeInfo -> IO () +createDirectories = createDirectoryIfMissing True . directories diff --git a/src/Parser/Generator.hs b/src/Parser/Generator.hs new file mode 100644 --- /dev/null +++ b/src/Parser/Generator.hs @@ -0,0 +1,146 @@ +-- | +-- Module: Parser.Generator +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Generator for the data types. + +module Parser.Generator + ( generate + ) where + + +import Control.Monad.State (State, execState, get, put) +import Data.List (foldl') +import Data.List.Split (splitOn) +import Parser.CodeInfo +import Parser.EnumDesc (EnumDesc) +import Parser.EnumGenerator (getEnumCode) +import Parser.FileDesc (FileDesc) +import Parser.GeneratorUtils +import Parser.MessageDesc (MessageDesc) +import Parser.MessageGenerator (getMessageCode) +import System.FilePath (joinPath) + +import qualified Data.Set as Set +import qualified Parser.EnumDesc as EnumDesc +import qualified Parser.FileDesc as FileDesc +import qualified Parser.MessageDesc as MessageDesc + + +generate :: [FileDesc] -> [CodeInfo] +generate fs = codeInfos $ execState (mapM_ addFileCodeInfos fs) state + where + state = GenState fs [] mset eset + mset = getMessageSet fs + eset = getEnumSet fs + + +addFileCodeInfos :: FileDesc -> State GenState () +addFileCodeInfos f = do + mapM_ (addMessageCodeInfo f) $ getMessageDescs f + mapM_ (addEnumCodeInfo f) $ getEnumDescs f + + +addMessageCodeInfo :: FileDesc -> MessageDesc -> State GenState () +addMessageCodeInfo fd md = do + state <- get + fdirs <- getDirectories fd + fname <- getMessageFilename md + fcode <- getMessageCode fd md + put $ state{codeInfos = CodeInfo fdirs fname fcode : codeInfos state} + + +addEnumCodeInfo :: FileDesc -> EnumDesc -> State GenState () +addEnumCodeInfo fd ed = do + state <- get + fdirs <- getDirectories fd + fname <- getEnumFilename ed + fcode <- getEnumCode fd ed + put $ state{codeInfos = CodeInfo fdirs fname fcode : codeInfos state} + + +getMessageDescs :: FileDesc -> [MessageDesc] +getMessageDescs f = addMessageDescs [] $ FileDesc.getMessageDescs f + + +addMessageDescs :: [MessageDesc] -> [MessageDesc] -> [MessageDesc] +addMessageDescs = foldl' addMessageDesc + + +addMessageDesc :: [MessageDesc] -> MessageDesc -> [MessageDesc] +addMessageDesc mlist m = case MessageDesc.getMessageDescs m of + [] -> m : mlist + ns -> addMessageDescs (m : mlist) ns + + +getEnumDescs :: FileDesc -> [EnumDesc] +getEnumDescs f = insertSubEnums (insertEnums [] f) f + where + insertEnums elist fd = addEnumDescs elist (FileDesc.getEnumDescs fd) + insertSubEnums elist fd = addSubEnumDescs elist (FileDesc.getMessageDescs fd) + + +addEnumDescs :: [EnumDesc] -> [EnumDesc] -> [EnumDesc] +addEnumDescs = foldl' addEnumDesc + + +addEnumDesc :: [EnumDesc] -> EnumDesc -> [EnumDesc] +addEnumDesc elist e = e : elist + + +addSubEnumDescs :: [EnumDesc] -> [MessageDesc] -> [EnumDesc] +addSubEnumDescs = foldl' addSubEnumDesc + + +addSubEnumDesc :: [EnumDesc] -> MessageDesc -> [EnumDesc] +addSubEnumDesc elist m = case MessageDesc.getMessageDescs m of + [] -> case MessageDesc.getEnumDescs m of + [] -> elist + es -> addEnumDescs elist es + ms -> case MessageDesc.getEnumDescs m of + [] -> addSubEnumDescs elist ms + es -> addSubEnumDescs (addEnumDescs elist es) ms + + +getMessageSet :: [FileDesc] -> MessageSet +getMessageSet = foldl' insertMany Set.empty + where + insertMany mset fd = foldl' (insertOne fd) mset $ getMessageDescs fd + insertOne fd mset md = Set.insert (getFullMessageName fd md) mset + + +getEnumSet :: [FileDesc] -> EnumSet +getEnumSet = foldl' insertMany Set.empty + where + insertMany eset fd = foldl' (insertOne fd) eset $ getEnumDescs fd + insertOne fd eset ed = Set.insert (getFullEnumName fd ed) eset + + +getDirectories :: FileDesc -> State GenState FilePath +getDirectories fd = case FileDesc.getPackage fd of + Just val -> return $ joinPath $ splitOn "." val + Nothing -> return $ FileDesc.getName fd + + +getMessageFilename :: MessageDesc -> State GenState FilePath +getMessageFilename md = return $ MessageDesc.getName md ++ ".hs" + + +getEnumFilename :: EnumDesc -> State GenState FilePath +getEnumFilename ed = return $ EnumDesc.getName ed ++ ".hs" + + +getFullEnumName :: FileDesc -> EnumDesc -> String +getFullEnumName fd ed = case FileDesc.getPackage fd of + Just val -> val ++ "." ++ name + Nothing -> name + where name = EnumDesc.getName ed + + +getFullMessageName :: FileDesc -> MessageDesc -> String +getFullMessageName fd md = case FileDesc.getPackage fd of + Just val -> val ++ "." ++ name + Nothing -> name + where name = MessageDesc.getName md diff --git a/src/Parser/GeneratorUtils.hs b/src/Parser/GeneratorUtils.hs new file mode 100644 --- /dev/null +++ b/src/Parser/GeneratorUtils.hs @@ -0,0 +1,121 @@ +-- | +-- Module: Parser.GeneratorUtils +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Utility functions for the code generators. + +module Parser.GeneratorUtils where + +import Control.Monad.State (State) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Data.Set (Set) +import Data.Text.Lazy.Builder (Builder, fromString, singleton) +import Parser.CodeInfo +import Parser.FieldDesc (FieldDesc) +import Parser.FileDesc (FileDesc) + +import qualified Data.Set as Set +import qualified Parser.FieldDesc as FieldDesc +import qualified Parser.FileDesc as FileDesc +import qualified Parser.Type as Type + + +data GenState = GenState + { fileDescs :: ![FileDesc] + , codeInfos :: ![CodeInfo] + , messageSet :: !MessageSet + , enumSet :: !EnumSet + } + deriving (Show) + + +type EnumName = String +type EnumSet = Set EnumName +type MessageName = String +type MessageSet = Set MessageName +type Packed = Bool + + +isEnum :: FileDesc -> FieldDesc -> GenState -> Bool +isEnum f fd state = Set.member fqTypeName (enumSet state) + where + fqTypeName = getNamespace f ++ "." ++ FieldDesc.getTypeName fd + + +isPackable :: FileDesc -> FieldDesc -> GenState -> Bool +isPackable f fd state = case FieldDesc.getType fd of + (Just Type.Bool) -> True + (Just Type.Bytes) -> False + (Just Type.Double) -> True + (Just Type.Fixed32) -> True + (Just Type.Fixed64) -> True + (Just Type.Float) -> True + (Just Type.Int32) -> True + (Just Type.Int64) -> True + (Just Type.SFixed32) -> True + (Just Type.SFixed64) -> True + (Just Type.SInt32) -> True + (Just Type.SInt64) -> True + (Just Type.String) -> False + (Just Type.UInt32) -> True + (Just Type.UInt64) -> True + _ -> isEnum f fd state + + +isPacked :: FileDesc -> FieldDesc -> GenState -> Bool +isPacked f fd state = isPackable f fd state && optPack + where + optPack = fromMaybe False (FieldDesc.getPacked fd) + + +getComment :: State GenState Builder +getComment = return $ fromString "-- Generated by protobuf-simple. DO NOT EDIT!" + + +getNamespace :: FileDesc -> String +getNamespace fd = fromMaybe (FileDesc.getName fd) (FileDesc.getPackage fd) + + +getUnqualifiedImport :: String -> String -> Builder +getUnqualifiedImport name funcs = + fromString "import " <> + fromString name <> + fromString " (" <> + fromString funcs <> + fromString ")" <> + nl + + +getQualifiedImport :: String -> Builder +getQualifiedImport name = + fromString "import qualified " <> + fromString name <> + nl + + +getQualifiedAsImport :: String -> String -> Builder +getQualifiedAsImport name alias = + fromString "import qualified " <> + fromString name <> + fromString " as " <> + fromString alias <> + nl + + +empty :: Builder +empty = fromString "" + + +nl :: Builder +nl = singleton '\n' + + +space :: Builder +space = singleton ' ' + + +tab :: Builder +tab = fromString " " diff --git a/src/Parser/Label.hs b/src/Parser/Label.hs new file mode 100644 --- /dev/null +++ b/src/Parser/Label.hs @@ -0,0 +1,17 @@ +-- | +-- Module: Parser.Label +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Label type. + +module Parser.Label where + +import qualified Prelude + +data Label = Optional + | Required + | Repeated + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) + diff --git a/src/Parser/MessageDesc.hs b/src/Parser/MessageDesc.hs new file mode 100644 --- /dev/null +++ b/src/Parser/MessageDesc.hs @@ -0,0 +1,88 @@ +-- | +-- Module: Parser.MessgeDesc +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Message Descriptor type and functions. + +module Parser.MessageDesc + ( MessageDesc + , new + , getName + , addField + , addFields + , getFields + , addMessageDesc + , addMessageDescs + , getMessageDescs + , addEnumDesc + , addEnumDescs + , getEnumDescs + ) where + + +import Data.Foldable (toList) +import Data.Sequence ((|>), (><)) +import Prelude ((.)) + +import qualified Data.Sequence +import qualified Data.Sequence as Seq +import qualified Parser.EnumDesc as Parser +import qualified Parser.FieldDesc as Parser +import qualified Prelude + + +data MessageDesc = MessageDesc + { name :: Prelude.String + , fields :: Data.Sequence.Seq Parser.FieldDesc + , messageDescs :: Data.Sequence.Seq MessageDesc + , enumDescs :: Data.Sequence.Seq Parser.EnumDesc + } deriving (Prelude.Show, Prelude.Eq) + + +type MessageName = Prelude.String + + +new :: MessageName -> MessageDesc +new n = MessageDesc n Seq.empty Seq.empty Seq.empty + + +getName :: MessageDesc -> MessageName +getName = name + + +addField :: Parser.FieldDesc -> MessageDesc -> MessageDesc +addField val self = self{fields = fields self |> val} + + +addFields :: [Parser.FieldDesc] -> MessageDesc -> MessageDesc +addFields vs self = self{fields = fields self >< Seq.fromList vs} + + +getFields :: MessageDesc -> [Parser.FieldDesc] +getFields = toList . fields + + +addMessageDesc :: MessageDesc -> MessageDesc -> MessageDesc +addMessageDesc val self = self{messageDescs = messageDescs self |> val} + + +addMessageDescs :: [MessageDesc] -> MessageDesc -> MessageDesc +addMessageDescs vs self = self{messageDescs = messageDescs self >< Seq.fromList vs} + + +getMessageDescs :: MessageDesc -> [MessageDesc] +getMessageDescs = toList . messageDescs + + +addEnumDesc :: Parser.EnumDesc -> MessageDesc -> MessageDesc +addEnumDesc val self = self{enumDescs = enumDescs self |> val} + + +addEnumDescs :: [Parser.EnumDesc] -> MessageDesc -> MessageDesc +addEnumDescs vs self = self{enumDescs = enumDescs self >< Seq.fromList vs} + + +getEnumDescs :: MessageDesc -> [Parser.EnumDesc] +getEnumDescs = toList . enumDescs diff --git a/src/Parser/MessageGenerator.hs b/src/Parser/MessageGenerator.hs new file mode 100644 --- /dev/null +++ b/src/Parser/MessageGenerator.hs @@ -0,0 +1,549 @@ +-- | +-- Module: Parser.MessageGenerator +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Generate code for Message types. + +module Parser.MessageGenerator + ( getMessageCode + ) where + +import Control.Monad.State (State, get) +import Data.List (foldl', intersperse) +import Data.Monoid ((<>)) +import Data.Text.Lazy (Text) +import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) +import Parser.CaseUtils (toPascal) +import Parser.FieldDesc (FieldDesc) +import Parser.FileDesc (FileDesc) +import Parser.GeneratorUtils +import Parser.MessageDesc (MessageDesc) + +import qualified Parser.FieldDesc as FieldDesc +import qualified Parser.FileDesc as FileDesc +import qualified Parser.Label as Label +import qualified Parser.MessageDesc as MessageDesc +import qualified Parser.Type as Type + + +getMessageCode :: FileDesc -> MessageDesc -> State GenState Text +getMessageCode f md = do + commentLine <- getComment + moduleLine <- getModule f md + importLines <- getImports f md + typeLines <- getType f md + defaultInst <- getDefaultInst f md + mergeableInst <- getMergeableInst md + requiredInst <- getRequiredInst f md + wireMessageInst <- getWireMessageInst f md + return $ toLazyText $ + commentLine <> nl <> + moduleLine <> nl <> + importLines <> nl <> + typeLines <> nl <> + defaultInst <> nl <> + mergeableInst <> nl <> + requiredInst <> nl <> + wireMessageInst <> nl + + +getModule :: FileDesc -> MessageDesc -> State GenState Builder +getModule f md = do + modName <- getModuleName f md + return $ + fromString "module " <> + fromString modName <> + fromString " where" <> nl + + +getModuleName :: FileDesc -> MessageDesc -> State GenState String +getModuleName f md = return $ case FileDesc.getPackage f of + Just package -> package ++ "." ++ messageName + Nothing -> fileName ++ "." ++ messageName + where + fileName = FileDesc.getName f + messageName = MessageDesc.getName md + + +getImports :: FileDesc -> MessageDesc -> State GenState Builder +getImports f md = return $ + getUnqualifiedImport "Control.Applicative" "(<$>)" <> + getUnqualifiedImport "Prelude" "" <> + getQualifiedAsImport "Data.ProtoBufInt" "PB" <> + getExtraImports f md + + +getExtraImports :: FileDesc -> MessageDesc -> Builder +getExtraImports f md = foldl' (<>) empty imports + where + imports = map (getExtraImport f) cfields + cfields = filter FieldDesc.isCustom $ MessageDesc.getFields md + + +getExtraImport :: FileDesc -> FieldDesc -> Builder +getExtraImport f fd = getQualifiedImport $ getNamespace f ++ "." ++ typeName + where + typeName = FieldDesc.getTypeName fd + + +getType :: FileDesc -> MessageDesc -> State GenState Builder +getType f md = case MessageDesc.getFields md of + [] -> getUnitType f md + [fd] -> getNewtypeType f md fd + fds -> getDataType f md fds + + +getUnitType :: FileDesc -> MessageDesc -> State GenState Builder +getUnitType _ md = return $ + fromString "data " <> + fromString name <> + fromString " = " <> + fromString name <> + nl <> + tab <> + fromString "deriving (PB.Show, PB.Eq, PB.Ord)" <> + nl + where name = MessageDesc.getName md + + +getNewtypeType :: FileDesc -> MessageDesc -> FieldDesc -> State GenState Builder +getNewtypeType f md fd = do + fieldLine <- getFieldLine f md fd + return $ + fromString "newtype " <> + fromString name <> + fromString " = " <> + fromString name <> + nl <> + tab <> + fromString "{ " <> + fieldLine <> + nl <> + tab <> + fromString "} deriving (PB.Show, PB.Eq, PB.Ord)" <> + nl + where + name = MessageDesc.getName md + + +getDataType :: FileDesc -> MessageDesc -> [FieldDesc] -> State GenState Builder +getDataType f md fds = do + fieldLines <- getFieldLines f md fds + return $ + fromString "data " <> + fromString name <> + fromString " = " <> + fromString name <> + nl <> tab <> + fromString "{ " <> + fieldLines <> + nl <> + tab <> + fromString "} deriving (PB.Show, PB.Eq, PB.Ord)" <> nl + where name = MessageDesc.getName md + + +getDefaultInst :: FileDesc -> MessageDesc -> State GenState Builder +getDefaultInst f md = do + defaultLines <- getDefaultLines f fields + return $ + fromString "instance PB.Default " <> fromString name <> fromString " where" <> nl <> + tab <> fromString "defaultVal = " <> fromString name <> nl <> + tab <> tab <> fromString "{ " <> + defaultLines <> nl <> + tab <> tab <> fromString "}" <> nl + where + name = MessageDesc.getName md + fields = MessageDesc.getFields md + + +getDefaultLines :: FileDesc -> [FieldDesc] -> State GenState Builder +getDefaultLines f fds = fmap (foldl' (<>) empty) ilines + where + ilines = fmap (intersperse separator) flines + flines = mapM (getDefaultLine f) fds + separator = nl <> tab <> tab <> fromString ", " + + +getDefaultLine :: FileDesc -> FieldDesc -> State GenState Builder +getDefaultLine f fd = do + dval <- getDefaultValue f fd + return $ fname <> fromString " = " <> dval + where fname = fromString $ FieldDesc.getName fd + + +getDefaultValue :: FileDesc -> FieldDesc -> State GenState Builder +getDefaultValue f fd = do + state <- get + return $ fromString $ case FieldDesc.getLabel fd of + Label.Required -> "PB.defaultVal" + Label.Repeated -> "PB.defaultVal" + Label.Optional -> case FieldDesc.getDefaultValue fd of + Nothing -> "PB.defaultVal" + Just val -> case FieldDesc.getType fd of + (Just Type.Bool) -> if val == "true" + then "PB.Just PB.True" + else "PB.Just PB.False" + (Just Type.Bytes) -> "PB.DefaultVal" + (Just Type.String) -> "PB.Just (PB.pack " ++ val ++ ")" + (Just Type.Double) -> "PB.Just " ++ val + (Just Type.Fixed32) -> "PB.Just " ++ val + (Just Type.Fixed64) -> "PB.Just " ++ val + (Just Type.Float) -> "PB.Just " ++ val + (Just Type.Int32) -> "PB.Just " ++ val + (Just Type.Int64) -> "PB.Just " ++ val + (Just Type.SFixed32) -> "PB.Just " ++ val + (Just Type.SFixed64) -> "PB.Just " ++ val + (Just Type.SInt32) -> "PB.Just " ++ val + (Just Type.SInt64) -> "PB.Just " ++ val + (Just Type.UInt32) -> "PB.Just " ++ val + (Just Type.UInt64) -> "PB.Just " ++ val + _ -> if isEnum f fd state + then "PB.Just " ++ enumValue val + else "PB.DefaultVal" + where + enumValue v = namespace ++ "." ++ enumType ++ "." ++ enumName v + namespace = getNamespace f + enumType = FieldDesc.getTypeName fd + enumName v = toPascal [v] + + +getFieldLines :: FileDesc -> MessageDesc -> [FieldDesc] -> State GenState Builder +getFieldLines f md fds = fmap (foldl' (<>) empty) ilines + where + ilines = fmap (intersperse separator) flines + flines = mapM (getFieldLine f md) fds + separator = nl <> tab <> fromString ", " + + +getFieldLine :: FileDesc -> MessageDesc -> FieldDesc -> State GenState Builder +getFieldLine f md fd = do + fname <- getFieldName fd + ftype <- getFieldType f md fd + return $ fname <> fromString " :: " <> ftype + + +getFieldName :: FieldDesc -> State GenState Builder +getFieldName = return . fromString . FieldDesc.getName + + +getFieldType :: FileDesc -> MessageDesc -> FieldDesc -> State GenState Builder +getFieldType f md fd = return $ case FieldDesc.getLabel fd of + Label.Optional -> + if fieldCount > 1 + then fromString "!(PB.Maybe " <> innerType <> fromString ")" + else fromString "PB.Maybe " <> innerType + Label.Required -> + if fieldCount > 1 + then fromString "!" <> innerType + else innerType + Label.Repeated -> + if fieldCount > 1 + then fromString "!(PB.Seq " <> innerType <> fromString ")" + else fromString "PB.Seq " <> innerType + where + fieldCount = length $ MessageDesc.getFields md + innerType = getFieldInnerType f fd + + +getFieldInnerType :: FileDesc -> FieldDesc -> Builder +getFieldInnerType f fd = fromString $ case FieldDesc.getType fd of + (Just Type.Bool) -> "PB.Bool" + (Just Type.Bytes) -> "PB.ByteString" + (Just Type.Double) -> "PB.Double" + (Just Type.Fixed32) -> "PB.Word32" + (Just Type.Fixed64) -> "PB.Word64" + (Just Type.Float) -> "PB.Float" + (Just Type.Int32) -> "PB.Int32" + (Just Type.Int64) -> "PB.Int64" + (Just Type.SFixed32) -> "PB.Int32" + (Just Type.SFixed64) -> "PB.Int64" + (Just Type.SInt32) -> "PB.Int32" + (Just Type.SInt64) -> "PB.Int64" + (Just Type.String) -> "PB.Text" + (Just Type.UInt32) -> "PB.Word32" + (Just Type.UInt64) -> "PB.Word64" + _ -> namespace ++ "." ++ typeName ++ "." ++ typeName + where + namespace = getNamespace f + typeName = FieldDesc.getTypeName fd + + +getMergeableInst :: MessageDesc -> State GenState Builder +getMergeableInst md = do + mergeableLines <- getMergeableLines fields + return $ + fromString "instance PB.Mergeable " <> fromString name <> fromString " where" <> nl <> + tab <> fromString "merge a b = " <> fromString name <> nl <> + tab <> tab <> fromString "{ " <> + mergeableLines <> nl <> + tab <> tab <> fromString "}" <> nl + where + name = MessageDesc.getName md + fields = MessageDesc.getFields md + + +getMergeableLines :: [FieldDesc] -> State GenState Builder +getMergeableLines fds = fmap (foldl' (<>) empty) ilines + where + ilines = fmap (intersperse separator) flines + flines = mapM getMergeableLine fds + separator = nl <> tab <> tab <> fromString ", " + + +getMergeableLine :: FieldDesc -> State GenState Builder +getMergeableLine fd = return $ + fieldName <> + fromString " = PB.merge (" <> + fieldName <> + fromString " a) (" <> + fieldName <> + fromString " b)" + where fieldName = fromString $ FieldDesc.getName fd + + +getRequiredInst :: FileDesc -> MessageDesc -> State GenState Builder +getRequiredInst f md = do + reqTags <- getRequiredWireTags f fields + return $ + fromString "instance PB.Required " <> name <> fromString " where" <> nl <> + tab <> fromString "reqTags _ = PB.fromList [" <> + reqTags <> + fromString "]" <> nl + where + name = fromString $ MessageDesc.getName md + fields = MessageDesc.getFields md + + +getRequiredWireTags :: FileDesc -> [FieldDesc] -> State GenState Builder +getRequiredWireTags f fds = do + tags <- mapM (getWireTag False f) rfields + return $ foldl' (<>) empty (intersperse separator tags) + where + separator = fromString ", " + rfields = filter FieldDesc.isRequired fds + + +getWireTag :: Packed -> FileDesc -> FieldDesc -> State GenState Builder +getWireTag packed f fd = do + wireType <- getWireType packed f fd + return $ header <> space <> fieldNumber <> space <> wireType + where + header = fromString "PB.WireTag" + fieldNumber = fromString $ show $ FieldDesc.getNumber fd + + +getWireType :: Packed -> FileDesc -> FieldDesc -> State GenState Builder +getWireType packed f fd = do + state <- get + return $ fromString $ if packed + then "PB.LenDelim" + else case FieldDesc.getType fd of + (Just Type.Bool) -> "PB.VarInt" + (Just Type.Bytes) -> "PB.LenDelim" + (Just Type.Double) -> "PB.Bit64" + (Just Type.Fixed32) -> "PB.Bit32" + (Just Type.Fixed64) -> "PB.Bit64" + (Just Type.Float) -> "PB.Bit32" + (Just Type.Int32) -> "PB.VarInt" + (Just Type.Int64) -> "PB.VarInt" + (Just Type.SFixed32) -> "PB.Bit32" + (Just Type.SFixed64) -> "PB.Bit64" + (Just Type.SInt32) -> "PB.VarInt" + (Just Type.SInt64) -> "PB.VarInt" + (Just Type.String) -> "PB.LenDelim" + (Just Type.UInt32) -> "PB.VarInt" + (Just Type.UInt64) -> "PB.VarInt" + _ -> if isEnum f fd state + then "PB.VarInt" + else "PB.LenDelim" + + +getWireMessageInst :: FileDesc -> MessageDesc -> State GenState Builder +getWireMessageInst f md = do + mlines <- getMessageToFieldLines f fields + flines <- getFieldToValueLines f fields + return $ + fromString "instance PB.WireMessage " <> fromString name <> fromString " where" <> nl <> + flines <> nl <> + tab <> fromString "messageToFields self = do" <> nl <> + mlines <> nl + where + name = MessageDesc.getName md + fields = MessageDesc.getFields md + + +getMessageToFieldLines :: FileDesc -> [FieldDesc] -> State GenState Builder +getMessageToFieldLines f fds = do + flines <- mapM (getMessageToFieldLine f) fds + return $ foldl' (<>) empty flines + + +getMessageToFieldLine :: FileDesc -> FieldDesc -> State GenState Builder +getMessageToFieldLine f fd = do + state <- get + fun <- getMessageToFieldFun f fd + tag <- getWireTag (isPacked f fd state) f fd + return $ + tab <> tab <> + fun <> + fromString " (" <> + tag <> + fromString ") (" <> + name <> + fromString " self)" <> + nl + where + name = fromString $ FieldDesc.getName fd + + +getMessageToFieldFun :: FileDesc -> FieldDesc -> State GenState Builder +getMessageToFieldFun f fd = case FieldDesc.getLabel fd of + Label.Optional -> getMessageToFieldFunOpt f fd + Label.Repeated -> getMessageToFieldFunRep f fd + Label.Required -> getMessageToFieldFunReq f fd + + +getMessageToFieldFunOpt :: FileDesc -> FieldDesc -> State GenState Builder +getMessageToFieldFunOpt f fd = do + fun <- getMessageToFieldFunReq f fd + return $ fun <> fromString "Opt" + + +getMessageToFieldFunRep :: FileDesc -> FieldDesc -> State GenState Builder +getMessageToFieldFunRep f fd = do + state <- get + fun <- getMessageToFieldFunReq f fd + return $ fun <> if isPacked f fd state + then fromString "Packed" + else fromString "List" + + +getMessageToFieldFunReq :: FileDesc -> FieldDesc -> State GenState Builder +getMessageToFieldFunReq f fd = do + state <- get + return $ fromString $ case FieldDesc.getType fd of + (Just Type.Bool) -> "PB.putBool" + (Just Type.Bytes) -> "PB.putBytes" + (Just Type.Double) -> "PB.putDouble" + (Just Type.Fixed32) -> "PB.putFixed32" + (Just Type.Fixed64) -> "PB.putFixed64" + (Just Type.Float) -> "PB.putFloat" + (Just Type.Int32) -> "PB.putInt32" + (Just Type.Int64) -> "PB.putInt64" + (Just Type.SFixed32) -> "PB.putSFixed32" + (Just Type.SFixed64) -> "PB.putSFixed64" + (Just Type.SInt32) -> "PB.putSInt32" + (Just Type.SInt64) -> "PB.putSInt64" + (Just Type.String) -> "PB.putString" + (Just Type.UInt32) -> "PB.putUInt32" + (Just Type.UInt64) -> "PB.putUInt64" + _ -> if isEnum f fd state + then "PB.putEnum" + else "PB.putMessage" + + +getFieldToValueDefault :: Builder +getFieldToValueDefault = + tab <> + fromString "fieldToValue tag self = PB.getUnknown tag self" <> + nl + + +getFieldToValueLines :: FileDesc -> [FieldDesc] -> State GenState Builder +getFieldToValueLines f fds = do + flines <- mapM (getFieldToValueLine f) fds + return $ foldl' (<>) empty flines <> getFieldToValueDefault + + +getFieldToValueLine :: FileDesc -> FieldDesc -> State GenState Builder +getFieldToValueLine f fd = case FieldDesc.getLabel fd of + Label.Optional -> (<> nl) <$> getFieldToValueOpt f fd + Label.Repeated -> (<> nl) <$> getFieldToValueRep f fd + Label.Required -> (<> nl) <$> getFieldToValueReq f fd + + +getFieldToValueOpt :: FileDesc -> FieldDesc -> State GenState Builder +getFieldToValueOpt f fd = do + line <- getFieldToValueReq f fd + return $ line <> fromString "Opt" + + +getFieldToValueRep :: FileDesc -> FieldDesc -> State GenState Builder +getFieldToValueRep f fd = do + state <- get + if isPacked f fd state + then do + packedLine <- getFieldToValueRepPacked f fd + listLine <- getFieldToValueRepList f fd + return $ packedLine <> nl <> listLine + else getFieldToValueRepList f fd + + +getFieldToValueRepList :: FileDesc -> FieldDesc -> State GenState Builder +getFieldToValueRepList f fd = do + fun <- getFieldToValueFun f fd + tag <- getWireTag False f fd + return $ + tab <> + fromString "fieldToValue (" <> + tag <> + fromString ") self = (\\v -> self{" <> + name <> + fromString " = PB.append (" <> + name <> + fromString " self) v}) <$> " <> + fun + where + name = fromString $ FieldDesc.getName fd + + +getFieldToValueRepPacked :: FileDesc -> FieldDesc -> State GenState Builder +getFieldToValueRepPacked f fd = do + line <- getFieldToValueReq f fd + return $ line <> fromString "Packed" + + +getFieldToValueReq :: FileDesc -> FieldDesc -> State GenState Builder +getFieldToValueReq f fd = do + state <- get + fun <- getFieldToValueFun f fd + tag <- getWireTag (isPacked f fd state) f fd + return $ + tab <> + fromString "fieldToValue (" <> + tag <> + fromString ") self = (\\v -> self{" <> + name <> + fromString " = PB.merge (" <> + name <> + fromString " self) v}) <$> " <> + fun + where + name = fromString $ FieldDesc.getName fd + + +getFieldToValueFun :: FileDesc -> FieldDesc -> State GenState Builder +getFieldToValueFun f fd = do + state <- get + return $ fromString $ case FieldDesc.getType fd of + (Just Type.Bool) -> "PB.getBool" + (Just Type.Bytes) -> "PB.getBytes" + (Just Type.Double) -> "PB.getDouble" + (Just Type.Fixed32) -> "PB.getFixed32" + (Just Type.Fixed64) -> "PB.getFixed64" + (Just Type.Float) -> "PB.getFloat" + (Just Type.Int32) -> "PB.getInt32" + (Just Type.Int64) -> "PB.getInt64" + (Just Type.SFixed32) -> "PB.getSFixed32" + (Just Type.SFixed64) -> "PB.getSFixed64" + (Just Type.SInt32) -> "PB.getSInt32" + (Just Type.SInt64) -> "PB.getSInt64" + (Just Type.String) -> "PB.getString" + (Just Type.UInt32) -> "PB.getUInt32" + (Just Type.UInt64) -> "PB.getUInt64" + _ -> if isEnum f fd state + then "PB.getEnum" + else "PB.getMessage" diff --git a/src/Parser/OptimizeMode.hs b/src/Parser/OptimizeMode.hs new file mode 100644 --- /dev/null +++ b/src/Parser/OptimizeMode.hs @@ -0,0 +1,17 @@ +-- | +-- Module: Parser.OptimizeMode +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- OptimizeMode type. + +module Parser.OptimizeMode where + +import qualified Prelude + +data OptimizeMode = Speed + | CodeSize + | LiteRuntime + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) + diff --git a/src/Parser/ProtoParser.hs b/src/Parser/ProtoParser.hs new file mode 100644 --- /dev/null +++ b/src/Parser/ProtoParser.hs @@ -0,0 +1,460 @@ +-- | +-- Module: Parser.ProtoParser +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Parser for proto files. + +module Parser.ProtoParser + ( parseProto + ) where + + +import Control.Monad (void) +import Data.Int (Int32) +import Parser.CaseUtils (fromSnake, toCamel, toPascal) +import Parser.EnumDesc (EnumDesc) +import Parser.FieldDesc (FieldDesc) +import Parser.FileDesc (FileDesc) +import Parser.Label (Label) +import Parser.MessageDesc (MessageDesc) +import Parser.OptimizeMode (OptimizeMode) +import System.FilePath (dropExtensions, splitFileName) +import Text.Parsec + +import qualified Parser.EnumDesc as EnumDesc +import qualified Parser.EnumValueDesc as EnumValueDesc +import qualified Parser.FieldDesc as FieldDesc +import qualified Parser.FileDesc as FileDesc +import qualified Parser.Label as Label +import qualified Parser.MessageDesc as MessageDesc +import qualified Parser.OptimizeMode as OptimizeMode + + +parseProto :: String -> String -> Either String FileDesc +parseProto filePath input = + case parse (file $ FileDesc.new $ getName filePath) filePath input of + Right fileDesc -> Right fileDesc + Left parseError -> Left $ show parseError + + +getName :: String -> String +getName = dropExtensions . snd . splitFileName + + +-- FileDesc functions +file :: FileDesc -> Parsec String u FileDesc +file s = (eof >> return s) <|> (choice + [ package s + , fileOption s + , enumDesc s + , messageDesc s + ] >>= file) + + +package :: FileDesc -> Parsec String u FileDesc +package s = do + void $ keyword "package" + val <- dString + void $ symbol ';' + return $ FileDesc.setPackage val s + + +fileOption :: FileDesc -> Parsec String u FileDesc +fileOption s = choice + [ try $ fileCcGenericServices s + , try $ fileDeprecated s + , try $ fileGoPackage s + , try $ fileJavaGenerateEqualsAndHash s + , try $ fileJavaGenericServices s + , try $ fileJavaPackage s + , try $ fileJavaOuterClassname s + , try $ fileJavaMultipleFiles s + , try $ fileJavaStringCheckUtf8 s + , try $ fileOptimizeFor s + , try $ filePyGenericServices s + ] + + +fileCcGenericServices :: FileDesc -> Parsec String u FileDesc +fileCcGenericServices s = + getFileOption "cc_generic_services" bool >> return s + + +fileDeprecated :: FileDesc -> Parsec String u FileDesc +fileDeprecated s = + getFileOption "deprecated" bool >> return s + + +fileGoPackage :: FileDesc -> Parsec String u FileDesc +fileGoPackage s = + getFileOption "go_package" qString >> return s + + +fileJavaGenerateEqualsAndHash :: FileDesc -> Parsec String u FileDesc +fileJavaGenerateEqualsAndHash s = + getFileOption "java_generate_equals_and_hash" bool >> return s + + +fileJavaGenericServices :: FileDesc -> Parsec String u FileDesc +fileJavaGenericServices s = + getFileOption "java_generic_services" bool >> return s + + +fileJavaMultipleFiles :: FileDesc -> Parsec String u FileDesc +fileJavaMultipleFiles s = + getFileOption "java_multiple_files" bool >> return s + + +fileJavaOuterClassname :: FileDesc -> Parsec String u FileDesc +fileJavaOuterClassname s = + getFileOption "java_outer_classname" qString >> return s + + +fileJavaPackage :: FileDesc -> Parsec String u FileDesc +fileJavaPackage s = + getFileOption "java_package" qString >> return s + + +fileJavaStringCheckUtf8 :: FileDesc -> Parsec String u FileDesc +fileJavaStringCheckUtf8 s = + getFileOption "java_string_check_utf8" bool >> return s + + +fileOptimizeFor :: FileDesc -> Parsec String u FileDesc +fileOptimizeFor s = + getFileOption "optimize_for" optimizeMode >> return s + + +optimizeMode :: Parsec String u OptimizeMode +optimizeMode = choice + [ string "SPEED" *> return OptimizeMode.Speed + , string "CODE_SIZE" *> return OptimizeMode.CodeSize + , string "LITE_RUNTIME" *> return OptimizeMode.LiteRuntime + ] + + +filePyGenericServices :: FileDesc -> Parsec String u FileDesc +filePyGenericServices s = + getFileOption "py_generic_services" bool >> return s + + +getFileOption :: String -> Parsec String u t -> Parsec String u t +getFileOption name parser = do + void $ keyword "option" + void $ keyword name + void $ symbol '=' + val <- parser + void $ symbol ';' + return val + + +-- MessageDesc functions +messageDesc :: FileDesc -> Parsec String u FileDesc +messageDesc s = do + void $ keyword "message" + name <- messageName + void $ symbol '{' + desc <- messageContent $ MessageDesc.new name + return $ FileDesc.addMessageDesc desc s + + +subMessageDesc :: MessageDesc -> Parsec String u MessageDesc +subMessageDesc s = do + void $ keyword "message" + name <- messageName + void $ symbol '{' + desc <- messageContent $ MessageDesc.new name + return $ MessageDesc.addMessageDesc desc s + + +messageContent :: MessageDesc -> Parsec String u MessageDesc +messageContent s = messageEnd s <|> (choice + [ try $ fieldDesc s + , try $ messageOption s + , try $ subMessageDesc s + , try $ subEnumDesc s + ] >>= messageContent) + + +messageEnd :: MessageDesc -> Parsec String u MessageDesc +messageEnd s = symbol '}' >> return s + + +messageName :: Parsec String u String +messageName = identifier + + +messageOption :: MessageDesc -> Parsec String u MessageDesc +messageOption s = choice + [ try $ messageDeprecated s + , try $ messageSetWireFormat s + , try $ noStandardDescriptorAccessor s + ] + + +messageDeprecated :: MessageDesc -> Parsec String u MessageDesc +messageDeprecated s = + getMessageOption "deprecated" bool >> return s + + +messageSetWireFormat :: MessageDesc -> Parsec String u MessageDesc +messageSetWireFormat s = + getMessageOption "message_set_wire_format" bool >> return s + + +noStandardDescriptorAccessor :: MessageDesc -> Parsec String u MessageDesc +noStandardDescriptorAccessor s = + getMessageOption "no_standard_descriptor_accessor" bool >> return s + + +getMessageOption :: String -> Parsec String u t -> Parsec String u t +getMessageOption name parser = do + void $ keyword "option" + void $ keyword name + void $ symbol '=' + val <- parser + void $ symbol ';' + return val + + +-- EnumDesc functions +enumDesc :: FileDesc -> Parsec String u FileDesc +enumDesc s = do + void $ keyword "enum" + name <- enumName + void $ symbol '{' + desc <- enumContent $ EnumDesc.new name + return $ FileDesc.addEnumDesc desc s + + +subEnumDesc :: MessageDesc -> Parsec String u MessageDesc +subEnumDesc s = do + void $ keyword "enum" + name <- enumName + void $ symbol '{' + desc <- enumContent $ EnumDesc.new name + return $ MessageDesc.addEnumDesc desc s + + +enumContent :: EnumDesc -> Parsec String u EnumDesc +enumContent s = enumEnd s <|> (choice + [ try $ enumOption s + , try $ enumValueDesc s + ] >>= enumContent) + + +enumEnd :: EnumDesc -> Parsec String u EnumDesc +enumEnd s = symbol '}' >> return s + + +enumName :: Parsec String u String +enumName = identifier + + +enumOption :: EnumDesc -> Parsec String u EnumDesc +enumOption s = choice + [ try $ enumAllowAlias s + , try $ enumDeprecated s + ] + + +enumAllowAlias :: EnumDesc -> Parsec String u EnumDesc +enumAllowAlias s = do + val <- getEnumOption "allow_alias" bool + return $ EnumDesc.setAllowAlias val s + + +enumDeprecated :: EnumDesc -> Parsec String u EnumDesc +enumDeprecated s = + getEnumOption "deprecated" bool >> return s + + +getEnumOption :: String -> Parsec String u t -> Parsec String u t +getEnumOption name parser = do + void $ keyword "option" + void $ keyword name + void $ symbol '=' + val <- parser + void $ symbol ';' + return val + + +enumValueDesc :: EnumDesc -> Parsec String u EnumDesc +enumValueDesc s = do + name <- enumValueName + void $ symbol '=' + number <- enumValueNumber + void $ symbol ';' + return $ EnumDesc.addValueDesc (EnumValueDesc.new name number) s + + +enumValueName :: Parsec String u String +enumValueName = fmap (toPascal . fromSnake) identifier + + +enumValueNumber :: Parsec String u Int32 +enumValueNumber = int32 + + +-- FieldDesc functions +fieldDesc :: MessageDesc -> Parsec String u MessageDesc +fieldDesc s = do + flabel <- fieldLabel + tname <- typeName + name <- fieldName + void $ symbol '=' + fnum <- fieldNumber + new <- fieldOptions (FieldDesc.new name fnum flabel tname) + void $ symbol ';' + return $ MessageDesc.addField new s + + +fieldLabel :: Parsec String u Label +fieldLabel = choice + [ try $ keyword "optional" *> return Label.Optional + , try $ keyword "required" *> return Label.Required + , try $ keyword "repeated" *> return Label.Repeated + ] + + +typeName :: Parsec String u String +typeName = identifier + + +fieldName :: Parsec String u String +fieldName = fmap (toCamel . fromSnake) identifier + + +fieldNumber :: Parsec String u Int32 +fieldNumber = int32 + + +fieldOptions :: FieldDesc -> Parsec String u FieldDesc +fieldOptions s = option s (do + void $ symbol '[' + s' <- fieldOption s + void $ symbol ']' + return s' + ) + + +fieldOption :: FieldDesc -> Parsec String u FieldDesc +fieldOption s = choice + [ try $ fieldDefault s + , try $ fieldDeprecated s + , try $ fieldLazy s + , try $ fieldPacked s + ] + + +fieldDefault :: FieldDesc -> Parsec String u FieldDesc +fieldDefault s = do + val <- getFieldOption "default" defaultValue + return $ FieldDesc.setDefaultValue val s + + +fieldDeprecated :: FieldDesc -> Parsec String u FieldDesc +fieldDeprecated s = + getFieldOption "deprecated" bool >> return s + + +fieldLazy :: FieldDesc -> Parsec String u FieldDesc +fieldLazy s = + getFieldOption "lazy" bool >> return s + + +fieldPacked :: FieldDesc -> Parsec String u FieldDesc +fieldPacked s = do + val <- getFieldOption "packed" bool + return $ FieldDesc.setPacked val s + + +getFieldOption :: String -> Parsec String u t -> Parsec String u t +getFieldOption name parser = do + void $ keyword name + void $ symbol '=' + val <- parser + return val + + +-- General functions +bool :: Parsec String u Bool +bool = choice + [try (keyword "FALSE") *> return False + ,keyword "False" *> return False + ,keyword "false" *> return False + ,try (keyword "TRUE") *> return True + ,keyword "True" *> return True + ,keyword "true" *> return True + ] + + +defaultValue :: Parsec String u String +defaultValue = lexeme (manyTill anyChar (lookAhead $ char ']')) + + +dot :: Parsec String u Char +dot = char '.' + + +dQuote :: Parsec String u Char +dQuote = lexeme $ char '"' + + +dString :: Parsec String u String +dString = lexeme ((:) <$> startChar <*> many nextChar) + where + startChar = letter <|> underscore + nextChar = startChar <|> digit <|> dot + + +eol :: Parsec String u String +eol = try (string "\n\r") + <|> try (string "\r\n") + <|> string "\n" + <|> string "\r" + "end of line" + + +identifier :: Parsec String u String +identifier = lexeme ((:) <$> startChar <*> many nextChar) + where + startChar = letter <|> underscore + nextChar = startChar <|> digit + + +int32 :: Parsec String u Int32 +int32 = read <$> lexeme (many1 digit) + + +keyword :: String -> Parsec String u String +keyword k = lexeme $ string k + + +lexeme :: Parsec String u a -> Parsec String u a +lexeme p = p <* whitespace + + +qString :: Parsec String u String +qString = dQuote *> many (noneOf "\"") <* dQuote + + +symbol :: Char -> Parsec String u Char +symbol s = lexeme $ char s + + +underscore :: Parsec String u Char +underscore = char '_' + + +whitespace :: Parsec String u () +whitespace = choice + [ whiteChar *> whitespace + , comment *> whitespace + , return () + ] + where + comment = try (string "//") *> manyTill anyChar (void eol <|> eof) + whiteChar = void $ many1 (oneOf " \t\n\r") diff --git a/src/Parser/Type.hs b/src/Parser/Type.hs new file mode 100644 --- /dev/null +++ b/src/Parser/Type.hs @@ -0,0 +1,28 @@ +-- | +-- Module: Parser.Type +-- Copyright: (c) 2015-2016 Martijn Rijkeboer +-- License: MIT +-- Maintainer: Martijn Rijkeboer +-- +-- Protocol Buffers scalar types type. + +module Parser.Type where + +import qualified Prelude + +data Type = Bool + | Bytes + | Double + | Fixed32 + | Fixed64 + | Float + | Int32 + | Int64 + | SFixed32 + | SFixed64 + | SInt32 + | SInt64 + | String + | UInt64 + | UInt32 + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) diff --git a/test/Data/ProtoBuf/ZigZagSpec.hs b/test/Data/ProtoBuf/ZigZagSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/ProtoBuf/ZigZagSpec.hs @@ -0,0 +1,23 @@ +module Data.ProtoBuf.ZigZagSpec + ( main + , spec + ) where + +import Data.ProtoBuf.ZigZag +import Test.Hspec +import Test.QuickCheck +import Test.QuickCheck.Instances () + + +main :: IO () +main = hspec spec + + +spec :: Spec +spec = + describe "ZigZag" $ do + it "decode32 inverses encode32" $ property $ + \x -> (decode32 . encode32) x == x + + it "decode64 inverses encode64" $ property $ + \x -> (decode64 . encode64) x == x diff --git a/test/Data/ProtoBufSpec.hs b/test/Data/ProtoBufSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/ProtoBufSpec.hs @@ -0,0 +1,699 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.ProtoBufSpec + ( main + , spec + ) where + +import Data.ByteString.Lazy (ByteString, pack, readFile) +import Data.ProtoBuf (decode, encode) +import Prelude hiding (Enum, readFile) +import System.FilePath (()) +import Test.Hspec +import Test.QuickCheck +import Test.QuickCheck.Instances () + +import Types.BoolList (BoolList(..)) +import Types.BoolListPacked (BoolListPacked(..)) +import Types.BoolMsg (BoolMsg(..)) +import Types.BoolOptMsg (BoolOptMsg(..)) + +import Types.BytesList (BytesList(..)) +import Types.BytesMsg (BytesMsg(..)) +import Types.BytesOptMsg (BytesOptMsg(..)) + +import Types.DoubleList (DoubleList(..)) +import Types.DoubleListPacked (DoubleListPacked(..)) +import Types.DoubleMsg (DoubleMsg(..)) +import Types.DoubleOptMsg (DoubleOptMsg(..)) + +import Types.Enum (Enum(..)) +import Types.EnumList (EnumList(..)) +import Types.EnumListPacked (EnumListPacked(..)) +import Types.EnumMsg (EnumMsg(..)) +import Types.EnumOptMsg (EnumOptMsg(..)) + +import Types.Fixed32List (Fixed32List(..)) +import Types.Fixed32ListPacked (Fixed32ListPacked(..)) +import Types.Fixed32Msg (Fixed32Msg(..)) +import Types.Fixed32OptMsg (Fixed32OptMsg(..)) + +import Types.Fixed64List (Fixed64List(..)) +import Types.Fixed64ListPacked (Fixed64ListPacked(..)) +import Types.Fixed64Msg (Fixed64Msg(..)) +import Types.Fixed64OptMsg (Fixed64OptMsg(..)) + +import Types.FloatList (FloatList(..)) +import Types.FloatListPacked (FloatListPacked(..)) +import Types.FloatMsg (FloatMsg(..)) +import Types.FloatOptMsg (FloatOptMsg(..)) + +import Types.Int32List (Int32List(..)) +import Types.Int32ListPacked (Int32ListPacked(..)) +import Types.Int32Msg (Int32Msg(..)) +import Types.Int32OptMsg (Int32OptMsg(..)) + +import Types.Int64List (Int64List(..)) +import Types.Int64ListPacked (Int64ListPacked(..)) +import Types.Int64Msg (Int64Msg(..)) +import Types.Int64OptMsg (Int64OptMsg(..)) + +import Types.Message (Message(..)) +import Types.MessageList (MessageList(..)) +import Types.MessageMsg (MessageMsg(..)) +import Types.MessageOptMsg (MessageOptMsg(..)) + +import Types.SFixed32List (SFixed32List(..)) +import Types.SFixed32ListPacked (SFixed32ListPacked(..)) +import Types.SFixed32Msg (SFixed32Msg(..)) +import Types.SFixed32OptMsg (SFixed32OptMsg(..)) + +import Types.SFixed64List (SFixed64List(..)) +import Types.SFixed64ListPacked (SFixed64ListPacked(..)) +import Types.SFixed64Msg (SFixed64Msg(..)) +import Types.SFixed64OptMsg (SFixed64OptMsg(..)) + +import Types.SInt32List (SInt32List(..)) +import Types.SInt32ListPacked (SInt32ListPacked(..)) +import Types.SInt32Msg (SInt32Msg(..)) +import Types.SInt32OptMsg (SInt32OptMsg(..)) + +import Types.SInt64List (SInt64List(..)) +import Types.SInt64ListPacked (SInt64ListPacked(..)) +import Types.SInt64Msg (SInt64Msg(..)) +import Types.SInt64OptMsg (SInt64OptMsg(..)) + +import Types.StringList (StringList(..)) +import Types.StringMsg (StringMsg(..)) +import Types.StringOptMsg (StringOptMsg(..)) + +import Types.UInt32List (UInt32List(..)) +import Types.UInt32ListPacked (UInt32ListPacked(..)) +import Types.UInt32Msg (UInt32Msg(..)) +import Types.UInt32OptMsg (UInt32OptMsg(..)) + +import Types.UInt64List (UInt64List(..)) +import Types.UInt64ListPacked (UInt64ListPacked(..)) +import Types.UInt64Msg (UInt64Msg(..)) +import Types.UInt64OptMsg (UInt64OptMsg(..)) + +import qualified Data.ProtoBufInt as PB +import qualified Data.Sequence as Seq + + +main :: IO () +main = hspec spec + + +spec :: Spec +spec = do + describe "Bool" $ do + typeTests boolList "BoolList" + typeTests boolListPacked "BoolListPacked" + typeTests boolMsg "BoolMsg" + typeTests boolOptMsg "BoolOptMsg" + + describe "Bytes" $ do + typeTests bytesList "BytesList" + typeTests bytesMsg "BytesMsg" + typeTests bytesOptMsg "BytesOptMsg" + + describe "Double" $ do + typeTests doubleList "DoubleList" + typeTests doubleListPacked "DoubleListPacked" + typeTests doubleMsg "DoubleMsg" + typeTests doubleOptMsg "DoubleOptMsg" + + describe "Enum" $ do + typeTests enumList "EnumList" + typeTests enumListPacked "EnumListPacked" + typeTests enumMsg "EnumMsg" + typeTests enumOptMsg "EnumOptMsg" + + describe "Fixed32" $ do + typeTests fixed32List "Fixed32List" + typeTests fixed32ListPacked "Fixed32ListPacked" + typeTests fixed32Msg "Fixed32Msg" + typeTests fixed32OptMsg "Fixed32OptMsg" + + describe "Fixed64" $ do + typeTests fixed64List "Fixed64List" + typeTests fixed64ListPacked "Fixed64ListPacked" + typeTests fixed64Msg "Fixed64Msg" + typeTests fixed64OptMsg "Fixed64OptMsg" + + describe "Float" $ do + typeTests floatList "FloatList" + typeTests floatListPacked "FloatListPacked" + typeTests floatMsg "FloatMsg" + typeTests floatOptMsg "FloatOptMsg" + + describe "Int32" $ do + typeTests int32List "Int32List" + typeTests int32ListPacked "Int32ListPacked" + typeTests int32Msg "Int32Msg" + typeTests int32OptMsg "Int32OptMsg" + + describe "Int64" $ do + typeTests int64List "Int64List" + typeTests int64ListPacked "Int64ListPacked" + typeTests int64Msg "Int64Msg" + typeTests int64OptMsg "Int64OptMsg" + + describe "Message" $ do + typeTests messageList "MessageList" + typeTests messageMsg "MessageMsg" + typeTests messageOptMsg "MessageOptMsg" + + describe "SFixed32" $ do + typeTests sfixed32List "SFixed32List" + typeTests sfixed32ListPacked "SFixed32ListPacked" + typeTests sfixed32Msg "SFixed32Msg" + typeTests sfixed32OptMsg "SFixed32OptMsg" + + describe "SFixed64" $ do + typeTests sfixed64List "SFixed64List" + typeTests sfixed64ListPacked "SFixed64ListPacked" + typeTests sfixed64Msg "SFixed64Msg" + typeTests sfixed64OptMsg "SFixed64OptMsg" + + describe "SInt32" $ do + typeTests sint32List "SInt32List" + typeTests sint32ListPacked "SInt32ListPacked" + typeTests sint32Msg "SInt32Msg" + typeTests sint32OptMsg "SInt32OptMsg" + + describe "SInt64" $ do + typeTests sint64List "SInt64List" + typeTests sint64ListPacked "SInt64ListPacked" + typeTests sint64Msg "SInt64Msg" + typeTests sint64OptMsg "SInt64OptMsg" + + describe "String" $ do + typeTests stringList "StringList" + typeTests stringMsg "StringMsg" + typeTests stringOptMsg "StringOptMsg" + + describe "UInt32" $ do + typeTests uint32List "UInt32List" + typeTests uint32ListPacked "UInt32ListPacked" + typeTests uint32Msg "UInt32Msg" + typeTests uint32OptMsg "UInt32OptMsg" + + describe "UInt64" $ do + typeTests uint64List "UInt64List" + typeTests uint64ListPacked "UInt64ListPacked" + typeTests uint64Msg "UInt64Msg" + typeTests uint64OptMsg "UInt64OptMsg" + + +typeTests :: (Eq a, Show a, PB.Required a, PB.WireMessage a, PB.Default a, Arbitrary a) => a -> String -> SpecWith() +typeTests t name = + context name $ do + it "decode inverses encode" $ property $ + \x -> (decode . encode) x == Right (x `asTypeOf` t) + + it ("decode " ++ filename ++ " returns correct data") $ do + file <- readBinFile filename + decode file `shouldBe` Right t + + it ("encode " ++ name ++ " returns correct data") $ do + file <- readBinFile filename + encode t `shouldBe` file + where + filename = name ++ ".bin" + + +readBinFile :: String -> IO ByteString +readBinFile file = readFile ("data" file) + + +-- Bool + +boolList :: BoolList +boolList = BoolList (Seq.fromList [False, True]) + +boolListPacked :: BoolListPacked +boolListPacked = BoolListPacked (Seq.fromList [False, True]) + +boolMsg :: BoolMsg +boolMsg = BoolMsg True + +boolOptMsg :: BoolOptMsg +boolOptMsg = BoolOptMsg Nothing + + +instance Arbitrary BoolList where + arbitrary = BoolList <$> arbitrary + +instance Arbitrary BoolListPacked where + arbitrary = BoolListPacked <$> arbitrary + +instance Arbitrary BoolMsg where + arbitrary = BoolMsg <$> arbitrary + +instance Arbitrary BoolOptMsg where + arbitrary = BoolOptMsg <$> arbitrary + + +-- Bytes + +bytesList :: BytesList +bytesList = BytesList (Seq.fromList [pack [0,1], pack [127,255]]) + +bytesMsg :: BytesMsg +bytesMsg = BytesMsg (pack [0,1,255]) + +bytesOptMsg :: BytesOptMsg +bytesOptMsg = BytesOptMsg Nothing + + +instance Arbitrary BytesList where + arbitrary = BytesList <$> arbitrary + +instance Arbitrary BytesMsg where + arbitrary = BytesMsg <$> arbitrary + +instance Arbitrary BytesOptMsg where + arbitrary = BytesOptMsg <$> arbitrary + + +-- Double + +doubleList :: DoubleList +doubleList = DoubleList (Seq.fromList [-10.5, -1, 0, 1, 10.5]) + +doubleListPacked :: DoubleListPacked +doubleListPacked = DoubleListPacked (Seq.fromList [-10.5, -1, 0, 1, 10.5]) + +doubleMsg :: DoubleMsg +doubleMsg = DoubleMsg 1.1 + +doubleOptMsg :: DoubleOptMsg +doubleOptMsg = DoubleOptMsg Nothing + + +instance Arbitrary DoubleList where + arbitrary = DoubleList <$> arbitrary + +instance Arbitrary DoubleListPacked where + arbitrary = DoubleListPacked <$> arbitrary + +instance Arbitrary DoubleMsg where + arbitrary = DoubleMsg <$> arbitrary + +instance Arbitrary DoubleOptMsg where + arbitrary = DoubleOptMsg <$> arbitrary + + +-- Enum + +enumList :: EnumList +enumList = EnumList (Seq.fromList [Zero, One, Two, Three, Four, Five, Six, Seven, Eight, Nine]) + +enumListPacked :: EnumListPacked +enumListPacked = EnumListPacked (Seq.fromList [Zero, One, Two, Three, Four, Five, Six, Seven, Eight, Nine]) + +enumMsg :: EnumMsg +enumMsg = EnumMsg Nine + +enumOptMsg :: EnumOptMsg +enumOptMsg = EnumOptMsg Nothing + + +instance Arbitrary Enum where + arbitrary = elements [Zero, One, Two, Three, Four, Five, Six, Seven, Eight, Nine] + +instance Arbitrary EnumList where + arbitrary = EnumList <$> arbitrary + +instance Arbitrary EnumListPacked where + arbitrary = EnumListPacked <$> arbitrary + +instance Arbitrary EnumMsg where + arbitrary = EnumMsg <$> arbitrary + +instance Arbitrary EnumOptMsg where + arbitrary = EnumOptMsg <$> arbitrary + + +-- Fixed32 + +fixed32List :: Fixed32List +fixed32List = Fixed32List (Seq.fromList [0, 1, 3000000000]) + +fixed32ListPacked :: Fixed32ListPacked +fixed32ListPacked = Fixed32ListPacked (Seq.fromList [0, 1, 3000000000]) + +fixed32Msg :: Fixed32Msg +fixed32Msg = Fixed32Msg 0 + +fixed32OptMsg :: Fixed32OptMsg +fixed32OptMsg = Fixed32OptMsg Nothing + + +instance Arbitrary Fixed32List where + arbitrary = Fixed32List <$> arbitrary + +instance Arbitrary Fixed32ListPacked where + arbitrary = Fixed32ListPacked <$> arbitrary + +instance Arbitrary Fixed32Msg where + arbitrary = Fixed32Msg <$> arbitrary + +instance Arbitrary Fixed32OptMsg where + arbitrary = Fixed32OptMsg <$> arbitrary + + +-- Fixed64 + +fixed64List :: Fixed64List +fixed64List = Fixed64List (Seq.fromList [0, 1, 9000000000]) + +fixed64ListPacked :: Fixed64ListPacked +fixed64ListPacked = Fixed64ListPacked (Seq.fromList [0, 1, 9000000000]) + +fixed64Msg :: Fixed64Msg +fixed64Msg = Fixed64Msg 0 + +fixed64OptMsg :: Fixed64OptMsg +fixed64OptMsg = Fixed64OptMsg Nothing + + +instance Arbitrary Fixed64List where + arbitrary = Fixed64List <$> arbitrary + +instance Arbitrary Fixed64ListPacked where + arbitrary = Fixed64ListPacked <$> arbitrary + +instance Arbitrary Fixed64Msg where + arbitrary = Fixed64Msg <$> arbitrary + +instance Arbitrary Fixed64OptMsg where + arbitrary = Fixed64OptMsg <$> arbitrary + + +-- Float + +floatList :: FloatList +floatList = FloatList (Seq.fromList [-10.5, -1, 0, 1, 10.5]) + +floatListPacked :: FloatListPacked +floatListPacked = FloatListPacked (Seq.fromList [-10.5, -1, 0, 1, 10.5]) + +floatMsg :: FloatMsg +floatMsg = FloatMsg 1.1 + +floatOptMsg :: FloatOptMsg +floatOptMsg = FloatOptMsg Nothing + + +instance Arbitrary FloatList where + arbitrary = FloatList <$> arbitrary + +instance Arbitrary FloatListPacked where + arbitrary = FloatListPacked <$> arbitrary + +instance Arbitrary FloatMsg where + arbitrary = FloatMsg <$> arbitrary + +instance Arbitrary FloatOptMsg where + arbitrary = FloatOptMsg <$> arbitrary + + +-- Int32 + +int32List :: Int32List +int32List = Int32List (Seq.fromList [-2000000000, -1, 0, 1, 2000000000]) + +int32ListPacked :: Int32ListPacked +int32ListPacked = Int32ListPacked (Seq.fromList [-2000000000, -1, 0, 1, 2000000000]) + +int32Msg :: Int32Msg +int32Msg = Int32Msg 1 + +int32OptMsg :: Int32OptMsg +int32OptMsg = Int32OptMsg Nothing + + +instance Arbitrary Int32List where + arbitrary = Int32List <$> arbitrary + +instance Arbitrary Int32ListPacked where + arbitrary = Int32ListPacked <$> arbitrary + +instance Arbitrary Int32Msg where + arbitrary = Int32Msg <$> arbitrary + +instance Arbitrary Int32OptMsg where + arbitrary = Int32OptMsg <$> arbitrary + + +-- Int64 + +int64List :: Int64List +int64List = Int64List (Seq.fromList [-8000000000, -1, 0, 1, 8000000000]) + +int64ListPacked :: Int64ListPacked +int64ListPacked = Int64ListPacked (Seq.fromList [-8000000000, -1, 0, 1, 8000000000]) + +int64Msg :: Int64Msg +int64Msg = Int64Msg 1 + +int64OptMsg :: Int64OptMsg +int64OptMsg = Int64OptMsg Nothing + + +instance Arbitrary Int64List where + arbitrary = Int64List <$> arbitrary + +instance Arbitrary Int64ListPacked where + arbitrary = Int64ListPacked <$> arbitrary + +instance Arbitrary Int64Msg where + arbitrary = Int64Msg <$> arbitrary + +instance Arbitrary Int64OptMsg where + arbitrary = Int64OptMsg <$> arbitrary + + +-- Message + +message :: Message +message = Message False bs is + where + bs = Just $ pack [1,2] + is = Seq.singleton int32Msg + +messageList :: MessageList +messageList = MessageList (Seq.singleton message) + +messageMsg :: MessageMsg +messageMsg = MessageMsg message + +messageOptMsg :: MessageOptMsg +messageOptMsg = MessageOptMsg Nothing + + +instance Arbitrary Message where + arbitrary = Message <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary MessageList where + arbitrary = MessageList <$> arbitrary + +instance Arbitrary MessageMsg where + arbitrary = MessageMsg <$> arbitrary + +instance Arbitrary MessageOptMsg where + arbitrary = MessageOptMsg <$> arbitrary + + +-- SFixed32 + +sfixed32List :: SFixed32List +sfixed32List = SFixed32List (Seq.fromList [-2000000000, -1, 0, 1, 2000000000]) + +sfixed32ListPacked :: SFixed32ListPacked +sfixed32ListPacked = SFixed32ListPacked (Seq.fromList [-2000000000, -1, 0, 1, 2000000000]) + +sfixed32Msg :: SFixed32Msg +sfixed32Msg = SFixed32Msg 0 + +sfixed32OptMsg :: SFixed32OptMsg +sfixed32OptMsg = SFixed32OptMsg Nothing + + +instance Arbitrary SFixed32List where + arbitrary = SFixed32List <$> arbitrary + +instance Arbitrary SFixed32ListPacked where + arbitrary = SFixed32ListPacked <$> arbitrary + +instance Arbitrary SFixed32Msg where + arbitrary = SFixed32Msg <$> arbitrary + +instance Arbitrary SFixed32OptMsg where + arbitrary = SFixed32OptMsg <$> arbitrary + + +-- SFixed64 + +sfixed64List :: SFixed64List +sfixed64List = SFixed64List (Seq.fromList [-9000000000, -1, 0, 1, 9000000000]) + +sfixed64ListPacked :: SFixed64ListPacked +sfixed64ListPacked = SFixed64ListPacked (Seq.fromList [-9000000000, -1, 0, 1, 9000000000]) + +sfixed64Msg :: SFixed64Msg +sfixed64Msg = SFixed64Msg 0 + +sfixed64OptMsg :: SFixed64OptMsg +sfixed64OptMsg = SFixed64OptMsg Nothing + + +instance Arbitrary SFixed64List where + arbitrary = SFixed64List <$> arbitrary + +instance Arbitrary SFixed64ListPacked where + arbitrary = SFixed64ListPacked <$> arbitrary + +instance Arbitrary SFixed64Msg where + arbitrary = SFixed64Msg <$> arbitrary + +instance Arbitrary SFixed64OptMsg where + arbitrary = SFixed64OptMsg <$> arbitrary + + +-- SInt32 + +sint32List :: SInt32List +sint32List = SInt32List (Seq.fromList [-2000000000, -1, 0, 1, 2000000000]) + +sint32ListPacked :: SInt32ListPacked +sint32ListPacked = SInt32ListPacked (Seq.fromList [-2000000000, -1, 0, 1, 2000000000]) + +sint32Msg :: SInt32Msg +sint32Msg = SInt32Msg 1 + +sint32OptMsg :: SInt32OptMsg +sint32OptMsg = SInt32OptMsg Nothing + + +instance Arbitrary SInt32List where + arbitrary = SInt32List <$> arbitrary + +instance Arbitrary SInt32ListPacked where + arbitrary = SInt32ListPacked <$> arbitrary + +instance Arbitrary SInt32Msg where + arbitrary = SInt32Msg <$> arbitrary + +instance Arbitrary SInt32OptMsg where + arbitrary = SInt32OptMsg <$> arbitrary + + +-- SInt64 + +sint64List :: SInt64List +sint64List = SInt64List (Seq.fromList [-8000000000, -1, 0, 1, 8000000000]) + +sint64ListPacked :: SInt64ListPacked +sint64ListPacked = SInt64ListPacked (Seq.fromList [-8000000000, -1, 0, 1, 8000000000]) + +sint64Msg :: SInt64Msg +sint64Msg = SInt64Msg 1 + +sint64OptMsg :: SInt64OptMsg +sint64OptMsg = SInt64OptMsg Nothing + + +instance Arbitrary SInt64List where + arbitrary = SInt64List <$> arbitrary + +instance Arbitrary SInt64ListPacked where + arbitrary = SInt64ListPacked <$> arbitrary + +instance Arbitrary SInt64Msg where + arbitrary = SInt64Msg <$> arbitrary + +instance Arbitrary SInt64OptMsg where + arbitrary = SInt64OptMsg <$> arbitrary + + +-- String + +stringList :: StringList +stringList = StringList (Seq.fromList ["Foo", "Bar", "Baz"]) + +stringMsg :: StringMsg +stringMsg = StringMsg "Foo" + +stringOptMsg :: StringOptMsg +stringOptMsg = StringOptMsg Nothing + + +instance Arbitrary StringList where + arbitrary = StringList <$> arbitrary + +instance Arbitrary StringMsg where + arbitrary = StringMsg <$> arbitrary + +instance Arbitrary StringOptMsg where + arbitrary = StringOptMsg <$> arbitrary + + +-- UInt32 + +uint32List :: UInt32List +uint32List = UInt32List (Seq.fromList [0, 1, 3000000000]) + +uint32ListPacked :: UInt32ListPacked +uint32ListPacked = UInt32ListPacked (Seq.fromList [0, 1, 3000000000]) + +uint32Msg :: UInt32Msg +uint32Msg = UInt32Msg 0 + +uint32OptMsg :: UInt32OptMsg +uint32OptMsg = UInt32OptMsg Nothing + + +instance Arbitrary UInt32List where + arbitrary = UInt32List <$> arbitrary + +instance Arbitrary UInt32ListPacked where + arbitrary = UInt32ListPacked <$> arbitrary + +instance Arbitrary UInt32Msg where + arbitrary = UInt32Msg <$> arbitrary + +instance Arbitrary UInt32OptMsg where + arbitrary = UInt32OptMsg <$> arbitrary + + +-- UInt64 + +uint64List :: UInt64List +uint64List = UInt64List (Seq.fromList [0, 1, 9000000000]) + +uint64ListPacked :: UInt64ListPacked +uint64ListPacked = UInt64ListPacked (Seq.fromList [0, 1, 9000000000]) + +uint64Msg :: UInt64Msg +uint64Msg = UInt64Msg 0 + +uint64OptMsg :: UInt64OptMsg +uint64OptMsg = UInt64OptMsg Nothing + + +instance Arbitrary UInt64List where + arbitrary = UInt64List <$> arbitrary + +instance Arbitrary UInt64ListPacked where + arbitrary = UInt64ListPacked <$> arbitrary + +instance Arbitrary UInt64Msg where + arbitrary = UInt64Msg <$> arbitrary + +instance Arbitrary UInt64OptMsg where + arbitrary = UInt64OptMsg <$> arbitrary diff --git a/test/Parser/ProtoParserSpec.hs b/test/Parser/ProtoParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/Parser/ProtoParserSpec.hs @@ -0,0 +1,414 @@ +module Parser.ProtoParserSpec + ( main + , spec + ) where + +import Parser.ProtoParser (parseProto) +import Test.Hspec + +import qualified Parser.EnumDesc as EnumDesc +import qualified Parser.EnumValueDesc as EnumValueDesc +import qualified Parser.FieldDesc as FieldDesc +import qualified Parser.FileDesc as FileDesc +import qualified Parser.Label as Label +import qualified Parser.MessageDesc as MessageDesc + +main :: IO () +main = hspec spec + + +spec :: Spec +spec = describe "parseProto" $ do + + it "sets the file name" $ + parseProto "misc/Filename.proto" "" + `shouldParse` + FileDesc.new "Filename" + + + it "parses empty input" $ + parseProto "Test.proto" "" + `shouldParse` + FileDesc.new "Test" + + + it "parses package name" $ + parseProto "Test.proto" "package Google.ProtoBuf;" + `shouldParse` + FileDesc.setPackage "Google.ProtoBuf" (FileDesc.new "Test") + + + it "ignores file option: cc_generic_services" $ + parseProto "Test.proto" "option cc_generic_services = True;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: deprecated" $ + parseProto "Test.proto" "option deprecated = TRUE;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: go_package" $ + parseProto "Test.proto" "option go_package = \"Google.ProtoBuf\";" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: java_generate_equals_and_hash" $ + parseProto "Test.proto" "option java_generate_equals_and_hash = true;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: java_generic_services" $ + parseProto "Test.proto" "option java_generic_services = False;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: java_multiple_files" $ + parseProto "Test.proto" "option java_multiple_files = FALSE;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: java_outer_classname" $ + parseProto "Test.proto" "option java_outer_classname = \"Parser\";" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: java_package" $ + parseProto "Test.proto" "option java_package = \"com.google.protobuf\";" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: java_string_check_utf8" $ + parseProto "Test.proto" "option java_string_check_utf8 = True;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: optimize_for with SPEED" $ + parseProto "Test.proto" "option optimize_for = SPEED;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: optimize_for with CODE_SIZE" $ + parseProto "Test.proto" "option optimize_for = CODE_SIZE;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: optimize_for with LITE_RUNTIME" $ + parseProto "Test.proto" "option optimize_for = LITE_RUNTIME;" + `shouldParse` + FileDesc.new "Test" + + + it "ignores file option: py_generic_services" $ + parseProto "Test.proto" "option py_generic_services = True;" + `shouldParse` + FileDesc.new "Test" + + + it "parses an empty message" $ + parseProto "Test.proto" "message Empty {}" + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.new "Empty") + (FileDesc.new "Test") + + + it "parses a message with scalar fields" $ + parseProto "Test.proto" (unlines + [ "message Scalars {" + , " optional bool f01 = 1;" + , " optional bytes f02 = 2;" + , " optional double f03 = 3;" + , " optional fixed32 f04 = 4;" + , " optional fixed64 f05 = 5;" + , " optional float f06 = 6;" + , " optional int32 f07 = 7;" + , " optional int64 f08 = 8;" + , " optional sfixed32 f09 = 9;" + , " optional sfixed64 f10 = 10;" + , " optional sint32 f11 = 11;" + , " optional sint64 f12 = 12;" + , " optional string f13 = 13;" + , " optional uint32 f14 = 14;" + , " optional uint64 f15 = 15;" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.addFields + [ FieldDesc.new "f01" 1 Label.Optional "bool" + , FieldDesc.new "f02" 2 Label.Optional "bytes" + , FieldDesc.new "f03" 3 Label.Optional "double" + , FieldDesc.new "f04" 4 Label.Optional "fixed32" + , FieldDesc.new "f05" 5 Label.Optional "fixed64" + , FieldDesc.new "f06" 6 Label.Optional "float" + , FieldDesc.new "f07" 7 Label.Optional "int32" + , FieldDesc.new "f08" 8 Label.Optional "int64" + , FieldDesc.new "f09" 9 Label.Optional "sfixed32" + , FieldDesc.new "f10" 10 Label.Optional "sfixed64" + , FieldDesc.new "f11" 11 Label.Optional "sint32" + , FieldDesc.new "f12" 12 Label.Optional "sint64" + , FieldDesc.new "f13" 13 Label.Optional "string" + , FieldDesc.new "f14" 14 Label.Optional "uint32" + , FieldDesc.new "f15" 15 Label.Optional "uint64" + ] + (MessageDesc.new "Scalars") + ) + (FileDesc.new "Test") + + + it "parses a message with a message field" $ + parseProto "Test.proto" (unlines + [ "message OtherMessageTypes {" + , " repeated OtherType result = 1;" + , "}" + , "message OtherType {" + , " required string name = 1;" + , " required string type = 2;" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDescs + [ MessageDesc.addField + (FieldDesc.new "result" 1 Label.Repeated "OtherType") + (MessageDesc.new "OtherMessageTypes") + , MessageDesc.addFields + [ (FieldDesc.new "name" 1 Label.Required "string") + , (FieldDesc.new "type" 2 Label.Required "string") + ] + (MessageDesc.new "OtherType") + ] + (FileDesc.new "Test") + + + it "parses a message with a enum field" $ + parseProto "Test.proto" (unlines + [ "message EnumMessage {" + , " optional EnumType value = 1;" + , "}" + , "enum EnumType {" + , " UNKNOWN = 0;" + , " INIT = 1;" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.addField + (FieldDesc.new "value" 1 Label.Optional "EnumType") + (MessageDesc.new "EnumMessage") + ) + (FileDesc.addEnumDesc + (EnumDesc.addValueDescs + [ EnumValueDesc.new "Unknown" 0 + , EnumValueDesc.new "Init" 1 + ] + (EnumDesc.new "EnumType") + ) + (FileDesc.new "Test") + ) + + + it "parses a message with a nested message" $ + parseProto "Test.proto" (unlines + [ "message OtherMessageTypes {" + , " repeated OtherType result = 1;" + , " message OtherType {" + , " required string name = 1;" + , " required string type = 2;" + , " }" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.addField + (FieldDesc.new "result" 1 Label.Repeated "OtherType") + (MessageDesc.addMessageDesc + (MessageDesc.addFields + [ (FieldDesc.new "name" 1 Label.Required "string") + , (FieldDesc.new "type" 2 Label.Required "string") + ] + (MessageDesc.new "OtherType") + ) + (MessageDesc.new "OtherMessageTypes") + ) + ) + (FileDesc.new "Test") + + + it "parses a message with a nested enum field" $ + parseProto "Test.proto" (unlines + [ "message EnumMessage {" + , " optional EnumType value = 1;" + , " enum EnumType {" + , " UNKNOWN = 0;" + , " INIT = 1;" + , " }" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.addField + (FieldDesc.new "value" 1 Label.Optional "EnumType") + (MessageDesc.addEnumDesc + ( EnumDesc.addValueDescs + [ EnumValueDesc.new "Unknown" 0 + , EnumValueDesc.new "Init" 1 + ] + (EnumDesc.new "EnumType") + ) + (MessageDesc.new "EnumMessage") + ) + ) + (FileDesc.new "Test") + + + it "ignores message option: message_set_wire_format" $ + parseProto "Test.proto" (unlines + [ "message Option {" + , " option message_set_wire_format = true;" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.new "Option") + (FileDesc.new "Test") + + + it "ignores message option: no_standard_descriptor_accessor" $ + parseProto "Test.proto" (unlines + [ "message Option {" + , " option no_standard_descriptor_accessor = true;" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.new "Option") + (FileDesc.new "Test") + + + it "ignores message option: deprecated" $ + parseProto "Test.proto" (unlines + [ "message Option {" + , " option deprecated = true;" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.new "Option") + (FileDesc.new "Test") + + + it "parses field option: default" $ + parseProto "Test.proto" (unlines + [ "message Msg {" + , " optional int32 field = 1 [default=10];" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.addField + (FieldDesc.setDefaultValue + "10" + (FieldDesc.new "field" 1 Label.Optional "int32") + ) + (MessageDesc.new "Msg") + ) + (FileDesc.new "Test") + + + it "parses field option: packed" $ + parseProto "Test.proto" (unlines + [ "message Msg {" + , " optional int32 field = 1 [packed=true];" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.addField + (FieldDesc.setPacked + True + (FieldDesc.new "field" 1 Label.Optional "int32") + ) + (MessageDesc.new "Msg") + ) + (FileDesc.new "Test") + + + it "ignores field option: deprecated" $ + parseProto "Test.proto" (unlines + [ "message Msg {" + , " optional int32 field = 1 [deprecated=true];" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.addField + (FieldDesc.new "field" 1 Label.Optional "int32") + (MessageDesc.new "Msg") + ) + (FileDesc.new "Test") + + + it "ignores field option: lazy" $ + parseProto "Test.proto" (unlines + [ "message Msg {" + , " optional int32 field = 1 [lazy=true];" + , "}" + ]) + `shouldParse` + FileDesc.addMessageDesc + (MessageDesc.addField + (FieldDesc.new "field" 1 Label.Optional "int32") + (MessageDesc.new "Msg") + ) + (FileDesc.new "Test") + + + it "parses enum option: allow_alias" $ + parseProto "Test.proto" (unlines + [ "enum EnumType {" + , " option allow_alias = true;" + , " UNKNOWN = 0;" + , "}" + ]) + `shouldParse` + FileDesc.addEnumDesc + (EnumDesc.setAllowAlias + True + (EnumDesc.addValueDesc + (EnumValueDesc.new "Unknown" 0) + (EnumDesc.new "EnumType") + ) + ) + (FileDesc.new "Test") + + + it "ignores enum option: deprecated" $ + parseProto "Test.proto" (unlines + [ "enum EnumType {" + , " option deprecated = true;" + , " UNKNOWN = 0;" + , "}" + ]) + `shouldParse` + FileDesc.addEnumDesc + (EnumDesc.addValueDesc + (EnumValueDesc.new "Unknown" 0) + (EnumDesc.new "EnumType") + ) + (FileDesc.new "Test") + + +shouldParse :: (Show a, Show l, Eq a, Eq l) => Either l a -> a -> Expectation +shouldParse actual expected = actual `shouldBe` Right expected diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Types/BoolList.hs b/test/Types/BoolList.hs new file mode 100644 --- /dev/null +++ b/test/Types/BoolList.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.BoolList where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype BoolList = BoolList + { value :: PB.Seq PB.Bool + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default BoolList where + defaultVal = BoolList + { value = PB.defaultVal + } + +instance PB.Mergeable BoolList where + merge a b = BoolList + { value = PB.merge (value a) (value b) + } + +instance PB.Required BoolList where + reqTags _ = PB.fromList [] + +instance PB.WireMessage BoolList where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getBool + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putBoolList (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/BoolListPacked.hs b/test/Types/BoolListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/BoolListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.BoolListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype BoolListPacked = BoolListPacked + { value :: PB.Seq PB.Bool + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default BoolListPacked where + defaultVal = BoolListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable BoolListPacked where + merge a b = BoolListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required BoolListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage BoolListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getBoolPacked + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getBool + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putBoolPacked (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/BoolMsg.hs b/test/Types/BoolMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/BoolMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.BoolMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype BoolMsg = BoolMsg + { value :: PB.Bool + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default BoolMsg where + defaultVal = BoolMsg + { value = PB.defaultVal + } + +instance PB.Mergeable BoolMsg where + merge a b = BoolMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required BoolMsg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage BoolMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getBool + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putBool (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/BoolOptMsg.hs b/test/Types/BoolOptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/BoolOptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.BoolOptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype BoolOptMsg = BoolOptMsg + { value :: PB.Maybe PB.Bool + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default BoolOptMsg where + defaultVal = BoolOptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable BoolOptMsg where + merge a b = BoolOptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required BoolOptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage BoolOptMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getBoolOpt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putBoolOpt (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/BytesList.hs b/test/Types/BytesList.hs new file mode 100644 --- /dev/null +++ b/test/Types/BytesList.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.BytesList where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype BytesList = BytesList + { value :: PB.Seq PB.ByteString + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default BytesList where + defaultVal = BytesList + { value = PB.defaultVal + } + +instance PB.Mergeable BytesList where + merge a b = BytesList + { value = PB.merge (value a) (value b) + } + +instance PB.Required BytesList where + reqTags _ = PB.fromList [] + +instance PB.WireMessage BytesList where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getBytes + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putBytesList (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/BytesMsg.hs b/test/Types/BytesMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/BytesMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.BytesMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype BytesMsg = BytesMsg + { value :: PB.ByteString + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default BytesMsg where + defaultVal = BytesMsg + { value = PB.defaultVal + } + +instance PB.Mergeable BytesMsg where + merge a b = BytesMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required BytesMsg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.LenDelim] + +instance PB.WireMessage BytesMsg where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getBytes + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putBytes (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/BytesOptMsg.hs b/test/Types/BytesOptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/BytesOptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.BytesOptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype BytesOptMsg = BytesOptMsg + { value :: PB.Maybe PB.ByteString + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default BytesOptMsg where + defaultVal = BytesOptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable BytesOptMsg where + merge a b = BytesOptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required BytesOptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage BytesOptMsg where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getBytesOpt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putBytesOpt (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/DoubleList.hs b/test/Types/DoubleList.hs new file mode 100644 --- /dev/null +++ b/test/Types/DoubleList.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.DoubleList where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype DoubleList = DoubleList + { value :: PB.Seq PB.Double + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default DoubleList where + defaultVal = DoubleList + { value = PB.defaultVal + } + +instance PB.Mergeable DoubleList where + merge a b = DoubleList + { value = PB.merge (value a) (value b) + } + +instance PB.Required DoubleList where + reqTags _ = PB.fromList [] + +instance PB.WireMessage DoubleList where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getDouble + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putDoubleList (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/DoubleListPacked.hs b/test/Types/DoubleListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/DoubleListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.DoubleListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype DoubleListPacked = DoubleListPacked + { value :: PB.Seq PB.Double + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default DoubleListPacked where + defaultVal = DoubleListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable DoubleListPacked where + merge a b = DoubleListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required DoubleListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage DoubleListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getDoublePacked + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getDouble + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putDoublePacked (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/DoubleMsg.hs b/test/Types/DoubleMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/DoubleMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.DoubleMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype DoubleMsg = DoubleMsg + { value :: PB.Double + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default DoubleMsg where + defaultVal = DoubleMsg + { value = PB.defaultVal + } + +instance PB.Mergeable DoubleMsg where + merge a b = DoubleMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required DoubleMsg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.Bit64] + +instance PB.WireMessage DoubleMsg where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getDouble + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putDouble (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/DoubleOptMsg.hs b/test/Types/DoubleOptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/DoubleOptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.DoubleOptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype DoubleOptMsg = DoubleOptMsg + { value :: PB.Maybe PB.Double + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default DoubleOptMsg where + defaultVal = DoubleOptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable DoubleOptMsg where + merge a b = DoubleOptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required DoubleOptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage DoubleOptMsg where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getDoubleOpt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putDoubleOpt (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/Enum.hs b/test/Types/Enum.hs new file mode 100644 --- /dev/null +++ b/test/Types/Enum.hs @@ -0,0 +1,39 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Enum where + +import Prelude () +import qualified Data.ProtoBufInt as PB + +data Enum = Zero | One | Two | Three | Four | Five | Six | Seven | Eight | Nine + deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Enum where + defaultVal = Zero + +instance PB.Mergeable Enum where + +instance PB.WireEnum Enum where + intToEnum 0 = Zero + intToEnum 1 = One + intToEnum 2 = Two + intToEnum 3 = Three + intToEnum 4 = Four + intToEnum 5 = Five + intToEnum 6 = Six + intToEnum 7 = Seven + intToEnum 8 = Eight + intToEnum 9 = Nine + intToEnum _ = PB.defaultVal + + enumToInt Zero = 0 + enumToInt One = 1 + enumToInt Two = 2 + enumToInt Three = 3 + enumToInt Four = 4 + enumToInt Five = 5 + enumToInt Six = 6 + enumToInt Seven = 7 + enumToInt Eight = 8 + enumToInt Nine = 9 + + diff --git a/test/Types/EnumList.hs b/test/Types/EnumList.hs new file mode 100644 --- /dev/null +++ b/test/Types/EnumList.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.EnumList where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB +import qualified Types.Enum + +newtype EnumList = EnumList + { value :: PB.Seq Types.Enum.Enum + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default EnumList where + defaultVal = EnumList + { value = PB.defaultVal + } + +instance PB.Mergeable EnumList where + merge a b = EnumList + { value = PB.merge (value a) (value b) + } + +instance PB.Required EnumList where + reqTags _ = PB.fromList [] + +instance PB.WireMessage EnumList where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getEnum + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putEnumList (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/EnumListPacked.hs b/test/Types/EnumListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/EnumListPacked.hs @@ -0,0 +1,34 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.EnumListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB +import qualified Types.Enum + +newtype EnumListPacked = EnumListPacked + { value :: PB.Seq Types.Enum.Enum + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default EnumListPacked where + defaultVal = EnumListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable EnumListPacked where + merge a b = EnumListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required EnumListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage EnumListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getEnumPacked + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getEnum + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putEnumPacked (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/EnumMsg.hs b/test/Types/EnumMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/EnumMsg.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.EnumMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB +import qualified Types.Enum + +newtype EnumMsg = EnumMsg + { value :: Types.Enum.Enum + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default EnumMsg where + defaultVal = EnumMsg + { value = PB.defaultVal + } + +instance PB.Mergeable EnumMsg where + merge a b = EnumMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required EnumMsg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage EnumMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getEnum + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putEnum (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/EnumOptMsg.hs b/test/Types/EnumOptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/EnumOptMsg.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.EnumOptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB +import qualified Types.Enum + +newtype EnumOptMsg = EnumOptMsg + { value :: PB.Maybe Types.Enum.Enum + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default EnumOptMsg where + defaultVal = EnumOptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable EnumOptMsg where + merge a b = EnumOptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required EnumOptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage EnumOptMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getEnumOpt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putEnumOpt (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/Fixed32List.hs b/test/Types/Fixed32List.hs new file mode 100644 --- /dev/null +++ b/test/Types/Fixed32List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Fixed32List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Fixed32List = Fixed32List + { value :: PB.Seq PB.Word32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Fixed32List where + defaultVal = Fixed32List + { value = PB.defaultVal + } + +instance PB.Mergeable Fixed32List where + merge a b = Fixed32List + { value = PB.merge (value a) (value b) + } + +instance PB.Required Fixed32List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Fixed32List where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getFixed32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFixed32List (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/Fixed32ListPacked.hs b/test/Types/Fixed32ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/Fixed32ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Fixed32ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Fixed32ListPacked = Fixed32ListPacked + { value :: PB.Seq PB.Word32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Fixed32ListPacked where + defaultVal = Fixed32ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable Fixed32ListPacked where + merge a b = Fixed32ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required Fixed32ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Fixed32ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFixed32Packed + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getFixed32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFixed32Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/Fixed32Msg.hs b/test/Types/Fixed32Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/Fixed32Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Fixed32Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Fixed32Msg = Fixed32Msg + { value :: PB.Word32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Fixed32Msg where + defaultVal = Fixed32Msg + { value = PB.defaultVal + } + +instance PB.Mergeable Fixed32Msg where + merge a b = Fixed32Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required Fixed32Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.Bit32] + +instance PB.WireMessage Fixed32Msg where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFixed32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFixed32 (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/Fixed32OptMsg.hs b/test/Types/Fixed32OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/Fixed32OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Fixed32OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Fixed32OptMsg = Fixed32OptMsg + { value :: PB.Maybe PB.Word32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Fixed32OptMsg where + defaultVal = Fixed32OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable Fixed32OptMsg where + merge a b = Fixed32OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required Fixed32OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Fixed32OptMsg where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFixed32Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFixed32Opt (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/Fixed64List.hs b/test/Types/Fixed64List.hs new file mode 100644 --- /dev/null +++ b/test/Types/Fixed64List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Fixed64List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Fixed64List = Fixed64List + { value :: PB.Seq PB.Word64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Fixed64List where + defaultVal = Fixed64List + { value = PB.defaultVal + } + +instance PB.Mergeable Fixed64List where + merge a b = Fixed64List + { value = PB.merge (value a) (value b) + } + +instance PB.Required Fixed64List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Fixed64List where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getFixed64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFixed64List (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/Fixed64ListPacked.hs b/test/Types/Fixed64ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/Fixed64ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Fixed64ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Fixed64ListPacked = Fixed64ListPacked + { value :: PB.Seq PB.Word64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Fixed64ListPacked where + defaultVal = Fixed64ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable Fixed64ListPacked where + merge a b = Fixed64ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required Fixed64ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Fixed64ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFixed64Packed + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getFixed64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFixed64Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/Fixed64Msg.hs b/test/Types/Fixed64Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/Fixed64Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Fixed64Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Fixed64Msg = Fixed64Msg + { value :: PB.Word64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Fixed64Msg where + defaultVal = Fixed64Msg + { value = PB.defaultVal + } + +instance PB.Mergeable Fixed64Msg where + merge a b = Fixed64Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required Fixed64Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.Bit64] + +instance PB.WireMessage Fixed64Msg where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFixed64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFixed64 (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/Fixed64OptMsg.hs b/test/Types/Fixed64OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/Fixed64OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Fixed64OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Fixed64OptMsg = Fixed64OptMsg + { value :: PB.Maybe PB.Word64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Fixed64OptMsg where + defaultVal = Fixed64OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable Fixed64OptMsg where + merge a b = Fixed64OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required Fixed64OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Fixed64OptMsg where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFixed64Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFixed64Opt (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/FloatList.hs b/test/Types/FloatList.hs new file mode 100644 --- /dev/null +++ b/test/Types/FloatList.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.FloatList where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype FloatList = FloatList + { value :: PB.Seq PB.Float + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default FloatList where + defaultVal = FloatList + { value = PB.defaultVal + } + +instance PB.Mergeable FloatList where + merge a b = FloatList + { value = PB.merge (value a) (value b) + } + +instance PB.Required FloatList where + reqTags _ = PB.fromList [] + +instance PB.WireMessage FloatList where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getFloat + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFloatList (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/FloatListPacked.hs b/test/Types/FloatListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/FloatListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.FloatListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype FloatListPacked = FloatListPacked + { value :: PB.Seq PB.Float + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default FloatListPacked where + defaultVal = FloatListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable FloatListPacked where + merge a b = FloatListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required FloatListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage FloatListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFloatPacked + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getFloat + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFloatPacked (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/FloatMsg.hs b/test/Types/FloatMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/FloatMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.FloatMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype FloatMsg = FloatMsg + { value :: PB.Float + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default FloatMsg where + defaultVal = FloatMsg + { value = PB.defaultVal + } + +instance PB.Mergeable FloatMsg where + merge a b = FloatMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required FloatMsg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.Bit32] + +instance PB.WireMessage FloatMsg where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFloat + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFloat (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/FloatOptMsg.hs b/test/Types/FloatOptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/FloatOptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.FloatOptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype FloatOptMsg = FloatOptMsg + { value :: PB.Maybe PB.Float + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default FloatOptMsg where + defaultVal = FloatOptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable FloatOptMsg where + merge a b = FloatOptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required FloatOptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage FloatOptMsg where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getFloatOpt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putFloatOpt (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/Int32List.hs b/test/Types/Int32List.hs new file mode 100644 --- /dev/null +++ b/test/Types/Int32List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Int32List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Int32List = Int32List + { value :: PB.Seq PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Int32List where + defaultVal = Int32List + { value = PB.defaultVal + } + +instance PB.Mergeable Int32List where + merge a b = Int32List + { value = PB.merge (value a) (value b) + } + +instance PB.Required Int32List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Int32List where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putInt32List (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/Int32ListPacked.hs b/test/Types/Int32ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/Int32ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Int32ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Int32ListPacked = Int32ListPacked + { value :: PB.Seq PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Int32ListPacked where + defaultVal = Int32ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable Int32ListPacked where + merge a b = Int32ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required Int32ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Int32ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getInt32Packed + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putInt32Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/Int32Msg.hs b/test/Types/Int32Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/Int32Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Int32Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Int32Msg = Int32Msg + { value :: PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Int32Msg where + defaultVal = Int32Msg + { value = PB.defaultVal + } + +instance PB.Mergeable Int32Msg where + merge a b = Int32Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required Int32Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage Int32Msg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putInt32 (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/Int32OptMsg.hs b/test/Types/Int32OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/Int32OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Int32OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Int32OptMsg = Int32OptMsg + { value :: PB.Maybe PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Int32OptMsg where + defaultVal = Int32OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable Int32OptMsg where + merge a b = Int32OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required Int32OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Int32OptMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getInt32Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putInt32Opt (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/Int64List.hs b/test/Types/Int64List.hs new file mode 100644 --- /dev/null +++ b/test/Types/Int64List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Int64List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Int64List = Int64List + { value :: PB.Seq PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Int64List where + defaultVal = Int64List + { value = PB.defaultVal + } + +instance PB.Mergeable Int64List where + merge a b = Int64List + { value = PB.merge (value a) (value b) + } + +instance PB.Required Int64List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Int64List where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putInt64List (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/Int64ListPacked.hs b/test/Types/Int64ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/Int64ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Int64ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Int64ListPacked = Int64ListPacked + { value :: PB.Seq PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Int64ListPacked where + defaultVal = Int64ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable Int64ListPacked where + merge a b = Int64ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required Int64ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Int64ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getInt64Packed + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putInt64Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/Int64Msg.hs b/test/Types/Int64Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/Int64Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Int64Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Int64Msg = Int64Msg + { value :: PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Int64Msg where + defaultVal = Int64Msg + { value = PB.defaultVal + } + +instance PB.Mergeable Int64Msg where + merge a b = Int64Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required Int64Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage Int64Msg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putInt64 (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/Int64OptMsg.hs b/test/Types/Int64OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/Int64OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Int64OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype Int64OptMsg = Int64OptMsg + { value :: PB.Maybe PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Int64OptMsg where + defaultVal = Int64OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable Int64OptMsg where + merge a b = Int64OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required Int64OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage Int64OptMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getInt64Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putInt64Opt (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/Message.hs b/test/Types/Message.hs new file mode 100644 --- /dev/null +++ b/test/Types/Message.hs @@ -0,0 +1,43 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.Message where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB +import qualified Types.Int32Msg + +data Message = Message + { bool :: !PB.Bool + , bytes :: !(PB.Maybe PB.ByteString) + , int32msgs :: !(PB.Seq Types.Int32Msg.Int32Msg) + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default Message where + defaultVal = Message + { bool = PB.defaultVal + , bytes = PB.defaultVal + , int32msgs = PB.defaultVal + } + +instance PB.Mergeable Message where + merge a b = Message + { bool = PB.merge (bool a) (bool b) + , bytes = PB.merge (bytes a) (bytes b) + , int32msgs = PB.merge (int32msgs a) (int32msgs b) + } + +instance PB.Required Message where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage Message where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{bool = PB.merge (bool self) v}) <$> PB.getBool + fieldToValue (PB.WireTag 2 PB.LenDelim) self = (\v -> self{bytes = PB.merge (bytes self) v}) <$> PB.getBytesOpt + fieldToValue (PB.WireTag 3 PB.LenDelim) self = (\v -> self{int32msgs = PB.append (int32msgs self) v}) <$> PB.getMessage + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putBool (PB.WireTag 1 PB.VarInt) (bool self) + PB.putBytesOpt (PB.WireTag 2 PB.LenDelim) (bytes self) + PB.putMessageList (PB.WireTag 3 PB.LenDelim) (int32msgs self) + + diff --git a/test/Types/MessageList.hs b/test/Types/MessageList.hs new file mode 100644 --- /dev/null +++ b/test/Types/MessageList.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.MessageList where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB +import qualified Types.Message + +newtype MessageList = MessageList + { value :: PB.Seq Types.Message.Message + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default MessageList where + defaultVal = MessageList + { value = PB.defaultVal + } + +instance PB.Mergeable MessageList where + merge a b = MessageList + { value = PB.merge (value a) (value b) + } + +instance PB.Required MessageList where + reqTags _ = PB.fromList [] + +instance PB.WireMessage MessageList where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getMessage + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putMessageList (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/MessageMsg.hs b/test/Types/MessageMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/MessageMsg.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.MessageMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB +import qualified Types.Message + +newtype MessageMsg = MessageMsg + { value :: Types.Message.Message + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default MessageMsg where + defaultVal = MessageMsg + { value = PB.defaultVal + } + +instance PB.Mergeable MessageMsg where + merge a b = MessageMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required MessageMsg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.LenDelim] + +instance PB.WireMessage MessageMsg where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getMessage + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putMessage (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/MessageOptMsg.hs b/test/Types/MessageOptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/MessageOptMsg.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.MessageOptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB +import qualified Types.Message + +newtype MessageOptMsg = MessageOptMsg + { value :: PB.Maybe Types.Message.Message + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default MessageOptMsg where + defaultVal = MessageOptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable MessageOptMsg where + merge a b = MessageOptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required MessageOptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage MessageOptMsg where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getMessageOpt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putMessageOpt (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/SFixed32List.hs b/test/Types/SFixed32List.hs new file mode 100644 --- /dev/null +++ b/test/Types/SFixed32List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SFixed32List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SFixed32List = SFixed32List + { value :: PB.Seq PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SFixed32List where + defaultVal = SFixed32List + { value = PB.defaultVal + } + +instance PB.Mergeable SFixed32List where + merge a b = SFixed32List + { value = PB.merge (value a) (value b) + } + +instance PB.Required SFixed32List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SFixed32List where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getSFixed32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSFixed32List (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/SFixed32ListPacked.hs b/test/Types/SFixed32ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/SFixed32ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SFixed32ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SFixed32ListPacked = SFixed32ListPacked + { value :: PB.Seq PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SFixed32ListPacked where + defaultVal = SFixed32ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable SFixed32ListPacked where + merge a b = SFixed32ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required SFixed32ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SFixed32ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSFixed32Packed + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getSFixed32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSFixed32Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/SFixed32Msg.hs b/test/Types/SFixed32Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/SFixed32Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SFixed32Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SFixed32Msg = SFixed32Msg + { value :: PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SFixed32Msg where + defaultVal = SFixed32Msg + { value = PB.defaultVal + } + +instance PB.Mergeable SFixed32Msg where + merge a b = SFixed32Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required SFixed32Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.Bit32] + +instance PB.WireMessage SFixed32Msg where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSFixed32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSFixed32 (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/SFixed32OptMsg.hs b/test/Types/SFixed32OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/SFixed32OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SFixed32OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SFixed32OptMsg = SFixed32OptMsg + { value :: PB.Maybe PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SFixed32OptMsg where + defaultVal = SFixed32OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable SFixed32OptMsg where + merge a b = SFixed32OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required SFixed32OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SFixed32OptMsg where + fieldToValue (PB.WireTag 1 PB.Bit32) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSFixed32Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSFixed32Opt (PB.WireTag 1 PB.Bit32) (value self) + + diff --git a/test/Types/SFixed64List.hs b/test/Types/SFixed64List.hs new file mode 100644 --- /dev/null +++ b/test/Types/SFixed64List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SFixed64List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SFixed64List = SFixed64List + { value :: PB.Seq PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SFixed64List where + defaultVal = SFixed64List + { value = PB.defaultVal + } + +instance PB.Mergeable SFixed64List where + merge a b = SFixed64List + { value = PB.merge (value a) (value b) + } + +instance PB.Required SFixed64List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SFixed64List where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getSFixed64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSFixed64List (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/SFixed64ListPacked.hs b/test/Types/SFixed64ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/SFixed64ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SFixed64ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SFixed64ListPacked = SFixed64ListPacked + { value :: PB.Seq PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SFixed64ListPacked where + defaultVal = SFixed64ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable SFixed64ListPacked where + merge a b = SFixed64ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required SFixed64ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SFixed64ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSFixed64Packed + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getSFixed64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSFixed64Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/SFixed64Msg.hs b/test/Types/SFixed64Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/SFixed64Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SFixed64Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SFixed64Msg = SFixed64Msg + { value :: PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SFixed64Msg where + defaultVal = SFixed64Msg + { value = PB.defaultVal + } + +instance PB.Mergeable SFixed64Msg where + merge a b = SFixed64Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required SFixed64Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.Bit64] + +instance PB.WireMessage SFixed64Msg where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSFixed64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSFixed64 (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/SFixed64OptMsg.hs b/test/Types/SFixed64OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/SFixed64OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SFixed64OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SFixed64OptMsg = SFixed64OptMsg + { value :: PB.Maybe PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SFixed64OptMsg where + defaultVal = SFixed64OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable SFixed64OptMsg where + merge a b = SFixed64OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required SFixed64OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SFixed64OptMsg where + fieldToValue (PB.WireTag 1 PB.Bit64) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSFixed64Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSFixed64Opt (PB.WireTag 1 PB.Bit64) (value self) + + diff --git a/test/Types/SInt32List.hs b/test/Types/SInt32List.hs new file mode 100644 --- /dev/null +++ b/test/Types/SInt32List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SInt32List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SInt32List = SInt32List + { value :: PB.Seq PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SInt32List where + defaultVal = SInt32List + { value = PB.defaultVal + } + +instance PB.Mergeable SInt32List where + merge a b = SInt32List + { value = PB.merge (value a) (value b) + } + +instance PB.Required SInt32List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SInt32List where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getSInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSInt32List (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/SInt32ListPacked.hs b/test/Types/SInt32ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/SInt32ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SInt32ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SInt32ListPacked = SInt32ListPacked + { value :: PB.Seq PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SInt32ListPacked where + defaultVal = SInt32ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable SInt32ListPacked where + merge a b = SInt32ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required SInt32ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SInt32ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSInt32Packed + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getSInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSInt32Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/SInt32Msg.hs b/test/Types/SInt32Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/SInt32Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SInt32Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SInt32Msg = SInt32Msg + { value :: PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SInt32Msg where + defaultVal = SInt32Msg + { value = PB.defaultVal + } + +instance PB.Mergeable SInt32Msg where + merge a b = SInt32Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required SInt32Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage SInt32Msg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSInt32 (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/SInt32OptMsg.hs b/test/Types/SInt32OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/SInt32OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SInt32OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SInt32OptMsg = SInt32OptMsg + { value :: PB.Maybe PB.Int32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SInt32OptMsg where + defaultVal = SInt32OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable SInt32OptMsg where + merge a b = SInt32OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required SInt32OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SInt32OptMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSInt32Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSInt32Opt (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/SInt64List.hs b/test/Types/SInt64List.hs new file mode 100644 --- /dev/null +++ b/test/Types/SInt64List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SInt64List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SInt64List = SInt64List + { value :: PB.Seq PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SInt64List where + defaultVal = SInt64List + { value = PB.defaultVal + } + +instance PB.Mergeable SInt64List where + merge a b = SInt64List + { value = PB.merge (value a) (value b) + } + +instance PB.Required SInt64List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SInt64List where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getSInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSInt64List (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/SInt64ListPacked.hs b/test/Types/SInt64ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/SInt64ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SInt64ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SInt64ListPacked = SInt64ListPacked + { value :: PB.Seq PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SInt64ListPacked where + defaultVal = SInt64ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable SInt64ListPacked where + merge a b = SInt64ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required SInt64ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SInt64ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSInt64Packed + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getSInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSInt64Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/SInt64Msg.hs b/test/Types/SInt64Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/SInt64Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SInt64Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SInt64Msg = SInt64Msg + { value :: PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SInt64Msg where + defaultVal = SInt64Msg + { value = PB.defaultVal + } + +instance PB.Mergeable SInt64Msg where + merge a b = SInt64Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required SInt64Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage SInt64Msg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSInt64 (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/SInt64OptMsg.hs b/test/Types/SInt64OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/SInt64OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.SInt64OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype SInt64OptMsg = SInt64OptMsg + { value :: PB.Maybe PB.Int64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default SInt64OptMsg where + defaultVal = SInt64OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable SInt64OptMsg where + merge a b = SInt64OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required SInt64OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage SInt64OptMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getSInt64Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putSInt64Opt (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/StringList.hs b/test/Types/StringList.hs new file mode 100644 --- /dev/null +++ b/test/Types/StringList.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.StringList where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype StringList = StringList + { value :: PB.Seq PB.Text + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default StringList where + defaultVal = StringList + { value = PB.defaultVal + } + +instance PB.Mergeable StringList where + merge a b = StringList + { value = PB.merge (value a) (value b) + } + +instance PB.Required StringList where + reqTags _ = PB.fromList [] + +instance PB.WireMessage StringList where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getString + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putStringList (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/StringMsg.hs b/test/Types/StringMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/StringMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.StringMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype StringMsg = StringMsg + { value :: PB.Text + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default StringMsg where + defaultVal = StringMsg + { value = PB.defaultVal + } + +instance PB.Mergeable StringMsg where + merge a b = StringMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required StringMsg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.LenDelim] + +instance PB.WireMessage StringMsg where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getString + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putString (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/StringOptMsg.hs b/test/Types/StringOptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/StringOptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.StringOptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype StringOptMsg = StringOptMsg + { value :: PB.Maybe PB.Text + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default StringOptMsg where + defaultVal = StringOptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable StringOptMsg where + merge a b = StringOptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required StringOptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage StringOptMsg where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getStringOpt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putStringOpt (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/UInt32List.hs b/test/Types/UInt32List.hs new file mode 100644 --- /dev/null +++ b/test/Types/UInt32List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.UInt32List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype UInt32List = UInt32List + { value :: PB.Seq PB.Word32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default UInt32List where + defaultVal = UInt32List + { value = PB.defaultVal + } + +instance PB.Mergeable UInt32List where + merge a b = UInt32List + { value = PB.merge (value a) (value b) + } + +instance PB.Required UInt32List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage UInt32List where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getUInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putUInt32List (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/UInt32ListPacked.hs b/test/Types/UInt32ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/UInt32ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.UInt32ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype UInt32ListPacked = UInt32ListPacked + { value :: PB.Seq PB.Word32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default UInt32ListPacked where + defaultVal = UInt32ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable UInt32ListPacked where + merge a b = UInt32ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required UInt32ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage UInt32ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getUInt32Packed + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getUInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putUInt32Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/UInt32Msg.hs b/test/Types/UInt32Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/UInt32Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.UInt32Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype UInt32Msg = UInt32Msg + { value :: PB.Word32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default UInt32Msg where + defaultVal = UInt32Msg + { value = PB.defaultVal + } + +instance PB.Mergeable UInt32Msg where + merge a b = UInt32Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required UInt32Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage UInt32Msg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getUInt32 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putUInt32 (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/UInt32OptMsg.hs b/test/Types/UInt32OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/UInt32OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.UInt32OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype UInt32OptMsg = UInt32OptMsg + { value :: PB.Maybe PB.Word32 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default UInt32OptMsg where + defaultVal = UInt32OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable UInt32OptMsg where + merge a b = UInt32OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required UInt32OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage UInt32OptMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getUInt32Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putUInt32Opt (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/UInt64List.hs b/test/Types/UInt64List.hs new file mode 100644 --- /dev/null +++ b/test/Types/UInt64List.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.UInt64List where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype UInt64List = UInt64List + { value :: PB.Seq PB.Word64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default UInt64List where + defaultVal = UInt64List + { value = PB.defaultVal + } + +instance PB.Mergeable UInt64List where + merge a b = UInt64List + { value = PB.merge (value a) (value b) + } + +instance PB.Required UInt64List where + reqTags _ = PB.fromList [] + +instance PB.WireMessage UInt64List where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getUInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putUInt64List (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/UInt64ListPacked.hs b/test/Types/UInt64ListPacked.hs new file mode 100644 --- /dev/null +++ b/test/Types/UInt64ListPacked.hs @@ -0,0 +1,33 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.UInt64ListPacked where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype UInt64ListPacked = UInt64ListPacked + { value :: PB.Seq PB.Word64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default UInt64ListPacked where + defaultVal = UInt64ListPacked + { value = PB.defaultVal + } + +instance PB.Mergeable UInt64ListPacked where + merge a b = UInt64ListPacked + { value = PB.merge (value a) (value b) + } + +instance PB.Required UInt64ListPacked where + reqTags _ = PB.fromList [] + +instance PB.WireMessage UInt64ListPacked where + fieldToValue (PB.WireTag 1 PB.LenDelim) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getUInt64Packed + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.append (value self) v}) <$> PB.getUInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putUInt64Packed (PB.WireTag 1 PB.LenDelim) (value self) + + diff --git a/test/Types/UInt64Msg.hs b/test/Types/UInt64Msg.hs new file mode 100644 --- /dev/null +++ b/test/Types/UInt64Msg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.UInt64Msg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype UInt64Msg = UInt64Msg + { value :: PB.Word64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default UInt64Msg where + defaultVal = UInt64Msg + { value = PB.defaultVal + } + +instance PB.Mergeable UInt64Msg where + merge a b = UInt64Msg + { value = PB.merge (value a) (value b) + } + +instance PB.Required UInt64Msg where + reqTags _ = PB.fromList [PB.WireTag 1 PB.VarInt] + +instance PB.WireMessage UInt64Msg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getUInt64 + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putUInt64 (PB.WireTag 1 PB.VarInt) (value self) + + diff --git a/test/Types/UInt64OptMsg.hs b/test/Types/UInt64OptMsg.hs new file mode 100644 --- /dev/null +++ b/test/Types/UInt64OptMsg.hs @@ -0,0 +1,32 @@ +-- Generated by protobuf-simple. DO NOT EDIT! +module Types.UInt64OptMsg where + +import Control.Applicative ((<$>)) +import Prelude () +import qualified Data.ProtoBufInt as PB + +newtype UInt64OptMsg = UInt64OptMsg + { value :: PB.Maybe PB.Word64 + } deriving (PB.Show, PB.Eq, PB.Ord) + +instance PB.Default UInt64OptMsg where + defaultVal = UInt64OptMsg + { value = PB.defaultVal + } + +instance PB.Mergeable UInt64OptMsg where + merge a b = UInt64OptMsg + { value = PB.merge (value a) (value b) + } + +instance PB.Required UInt64OptMsg where + reqTags _ = PB.fromList [] + +instance PB.WireMessage UInt64OptMsg where + fieldToValue (PB.WireTag 1 PB.VarInt) self = (\v -> self{value = PB.merge (value self) v}) <$> PB.getUInt64Opt + fieldToValue tag self = PB.getUnknown tag self + + messageToFields self = do + PB.putUInt64Opt (PB.WireTag 1 PB.VarInt) (value self) + +