@@ -19,41 +19,26 @@ module ProtocPlugin.Main (main) where
1919
2020import Prelude
2121
22−import Effect (Effect)
23−import Data.Maybe (Maybe(..),fromMaybe,maybe)
24−import Data.Either (Either(..))
25−import Data.Array (concatMap, mapMaybe)
22+import Data.Array (catMaybes, concatMap, mapMaybe)
2623import Data.Array as Array
24+import Data.ArrayBuffer.Builder (execPut)
25+import Data.ArrayBuffer.DataView as DV
26+import Data.Either (Either(..))
27+import Data.Maybe (Maybe(..), fromMaybe, maybe)
2728import Data.String as String
2829import Data.String.Pattern as String.Pattern
2930import Data.String.Regex as String.Regex
3031import Data.String.Regex.Flags as String.Regex.Flags
31−
32−import Text.Parsing.Parser (runParserT)
33−import Data.ArrayBuffer.Builder (execPut)
34−import Node.Process (stdin, stdout, stderr)
35−import Node.Stream (read, write, writeString, onReadable)
32+import Data.Traversable (sequence, traverse)
33+import Effect (Effect)
34+import Google.Protobuf.Compiler.Plugin (CodeGeneratorRequest(..), CodeGeneratorResponse(..), CodeGeneratorResponse_File(..), parseCodeGeneratorRequest, putCodeGeneratorResponse)
35+import Google.Protobuf.Descriptor (DescriptorProto(..), EnumDescriptorProto(..), EnumValueDescriptorProto(..), FieldDescriptorProto(..), FieldDescriptorProto_Label(..), FieldDescriptorProto_Type(..), FileDescriptorProto(..), OneofDescriptorProto(..))
3636import Node.Buffer (toArrayBuffer, fromArrayBuffer)
3737import Node.Encoding (Encoding(..))
3838import Node.Path (basenameWithoutExt)
39−import Data.ArrayBuffer.DataView as DV
40−
41−import Google.Protobuf.Compiler.Plugin
42− ( CodeGeneratorRequest(..), parseCodeGeneratorRequest
43− , CodeGeneratorResponse(..), putCodeGeneratorResponse
44− , CodeGeneratorResponse_File(..)
45− )
46−
47−import Google.Protobuf.Descriptor
48− ( FileDescriptorProto(..)
49− , DescriptorProto(..)
50− , FieldDescriptorProto(..)
51− , OneofDescriptorProto(..)
52− , EnumDescriptorProto(..)
53− , EnumValueDescriptorProto(..)
54− , FieldDescriptorProto_Type(..)
55− , FieldDescriptorProto_Label(..)
56− )
39+import Node.Process (stdin, stdout, stderr)
40+import Node.Stream (read, write, writeString, onReadable)
41+import Text.Parsing.Parser (runParserT)
5742
5843
5944main :: Effect Unit
@@ -78,12 +63,20 @@ main = do
7863
7964
8065generate :: CodeGeneratorRequest -> CodeGeneratorResponse
81−generate (CodeGeneratorRequest{file_to_generate,parameter,proto_file,compiler_version}) =
82− CodeGeneratorResponse
83− { error: Nothing
84− , file: map (genFile proto_file) proto_file
85− , __unknown_fields : []
86− }
66+generate (CodeGeneratorRequest{file_to_generate,parameter,proto_file,compiler_version}) = do
67+ case traverse (genFile proto_file) proto_file of
68+ Right file ->
69+ CodeGeneratorResponse
70+ { error: Nothing
71+ , file: file
72+ , __unknown_fields: []
73+ }
74+ Left err ->
75+ CodeGeneratorResponse
76+ { error: Just err
77+ , file: []
78+ , __unknown_fields: []
79+ }
8780
8881 -- | Names of parent messages for a message or enum.
8982type NameSpace = Array String
@@ -97,8 +90,10 @@ data ScopedEnum = ScopedEnum NameSpace EnumDescriptorProto
9790-- | Scoped field name which has the qualified package namespace and the field name.
9891data ScopedField = ScopedField NameSpace String
9992
93+-- | This is how we'll return errors while trying to generate the response from the request.
94+type Resp a = Either String a
10095
101−genFile :: Array FileDescriptorProto -> FileDescriptorProto -> CodeGeneratorResponse_File
96+genFile :: Array FileDescriptorProto -> FileDescriptorProto -> Resp CodeGeneratorResponse_File
10297genFile proto_file (FileDescriptorProto
10398 { name: fileName
10499 , package
@@ -107,48 +102,744 @@ genFile proto_file (FileDescriptorProto
107102 , message_type
108103 , enum_type
109104 , syntax
110− }) = CodeGeneratorResponse_File
111− { name : Just fileNameOut
112− , insertion_point : Nothing
113− , content : Just content
114− , __unknown_fields : []
115− }
116− where
117− capitalize :: String -> String
118− capitalize s = String.toUpper (String.take 1 s) <> String.drop 1 s
119− decapitalize :: String -> String
120− decapitalize s = String.toLower (String.take 1 s) <> String.drop 1 s
105+ }) = do
106+
107+ let baseName = case fileName of
108+ Nothing -> "Generated"
109+ Just "" -> "Generated"
110+ Just n -> basenameWithoutExt n ".proto"
111+
112+ messages :: Array ScopedMsg <- sequence $ flattenMessages [] message_type
113+
114+ enums :: Array ScopedEnum <- Right (ScopedEnum [] <$> enum_type) <> sequence (flattenEnums [] message_type)
115+
116+ let packageName = case package of -- Optional package, https://developers.google.com/protocol-buffers/docs/proto3#packages
117+ Nothing -> []
118+ Just ps -> String.split (String.Pattern.Pattern ".") ps
119+
120+ let fileNameOut = baseName <> "." <> (String.joinWith "." ((map capitalize packageName))) <> ".purs"
121+
121122
122− baseName = case fileName of
123− Nothing -> "Generated"
124− Just "" -> "Generated"
125− Just n -> basenameWithoutExt n ".proto"
123+ -- We have to import the modules qualified in the way because
124+ -- 1. When protoc "fully qualifies" a field type from an imported
125+ -- desriptor, the qualification consists of only the package name
126+ -- 2. protoc allows multiple files to have the same package name,
127+ -- such as descriptor.proto and any.proto (package "google.protobuf")
128+ -- but Purescript requires each file to have a different module name.
129+ let genImport :: String -> Resp String
130+ genImport fpath = do
131+ pkg <- lookupPackageByFilepath
132+ let moduleName = mkImportName fpath pkg
133+ let qualifiedName = Array.dropEnd 1 moduleName
134+ Right $ "import " <> make moduleName <> " as " <> make qualifiedName
135+ where
136+ make = String.joinWith "." <<< map capitalize
137+ lookupPackageByFilepath :: Resp (Array String)
138+ lookupPackageByFilepath =
139+ case Array.find (\(FileDescriptorProto f) -> maybe false (_ == fpath) f.name) proto_file of
140+ Just (FileDescriptorProto {package: Just p}) -> Right $ String.split (String.Pattern.Pattern ".") p
141+ _ -> Left $ "Failed lookupPackageByFilepath " <> fpath
142+ mkImportName
143+ :: String -- file path
144+ -> Array String -- package name
145+ -> Array String
146+ mkImportName fileString packages = map mkModuleName $ packages <> file
147+ where
148+ file = [basenameWithoutExt fileString ".proto"]
149+
150+
151+ let mkFieldType
152+ :: String -- prefix for the name, i.e. "put" "parse"
153+ -> String -- package-qualified period-separated field name
154+ -> String
155+ mkFieldType prefix s =
156+ let (ScopedField names name) = parseFieldName s
157+ in
158+ if names `beginsWith` packageName && (isLocalMessageName name || isLocalEnumName name)
159+ then
160+ -- it's a name in this package
161+ prefix <> (mkTypeName $ Array.drop (Array.length packageName) names <> [name])
162+ else
163+ -- it's a name in the top-level of an imported package
164+ String.joinWith "." $ (map mkModuleName $ names) <> [prefix <> capitalize name]
165+ where
166+ isLocalMessageName :: String -> Boolean
167+ isLocalMessageName fname = maybe false (const true) $
168+ flip Array.find messages $ \(ScopedMsg _ (DescriptorProto {name})) ->
169+ maybe false (fname == _) name
170+ isLocalEnumName :: String -> Boolean
171+ isLocalEnumName ename = maybe false (const true) $
172+ flip Array.find enums $ \(ScopedEnum _(EnumDescriptorProto {name})) ->
173+ maybe false (ename == _) name
174+ parseFieldName :: String -> ScopedField
175+ parseFieldName fname =
176+ if String.take 1 fname == "."
177+ then
178+ -- fully qualified
179+ let names = Array.dropWhile (_ == "") $ String.split (String.Pattern.Pattern ".") fname
180+ in
181+ ScopedField (Array.dropEnd 1 names) (fromMaybe "" $ Array.last names)
182+ else
183+ ScopedField [] fname -- this case should never occur, protoc always qualifies the names for us
184+ beginsWith :: Array String -> Array String -> Boolean
185+ beginsWith xs x = x == Array.take (Array.length x) xs
186+
187+
188+ let genTypeOneof
189+ :: NameSpace
190+ -> Array FieldDescriptorProto
191+ -> Int
192+ -> OneofDescriptorProto
193+ -> Resp String
194+ genTypeOneof nameSpace pfields indexOneof (OneofDescriptorProto {name: Just oname}) = do
195+ fields <- catMaybes <$> traverse go pfields
196+ Right $ String.joinWith "\n"
197+ [ "data " <> cname
198+ , " = " <> String.joinWith "\n | " fields
199+ , "derive instance generic" <> cname <> " :: Generic.Rep.Generic " <> cname <> " _"
200+ , "derive instance eq" <> cname <> " :: Eq.Eq " <> cname
201+ , "instance show" <> cname <> " :: Show.Show " <> cname <> " where show = Generic.Rep.Show.genericShow"
202+ ]
203+ where
204+ cname = String.joinWith "_" $ map capitalize $ nameSpace <> [oname]
205+ go :: FieldDescriptorProto -> Resp (Maybe String)
206+ -- go = case _ of
207+ -- FieldDescriptorProto {oneof_index: Just index} | index /= indexOneof -> Right Nothing -- skip this Oneof
208+ go (FieldDescriptorProto {name: Just fname, oneof_index: Just index, type: Just ftype, type_name}) = do
209+ if index == indexOneof
210+ then do
211+ fieldType <- genFieldType ftype type_name
212+ Right $ Just $ (String.joinWith "_" $ map capitalize [cname,fname]) <> " " <> fieldType
213+ else Right Nothing -- skip this Oneof
214+ where
215+ genFieldType :: FieldDescriptorProto_Type -> Maybe String -> Resp String
216+ genFieldType FieldDescriptorProto_Type_TYPE_DOUBLE _ = Right "Number"
217+ genFieldType FieldDescriptorProto_Type_TYPE_FLOAT _ = Right "Float32.Float32"
218+ genFieldType FieldDescriptorProto_Type_TYPE_INT64 _ = Right "(Long.Long Long.Signed)"
219+ genFieldType FieldDescriptorProto_Type_TYPE_UINT64 _ = Right "(Long.Long Long.Unsigned)"
220+ genFieldType FieldDescriptorProto_Type_TYPE_INT32 _ = Right "Int"
221+ genFieldType FieldDescriptorProto_Type_TYPE_FIXED64 _ = Right "(Long.Long Long.Unsigned)"
222+ genFieldType FieldDescriptorProto_Type_TYPE_FIXED32 _ = Right "UInt.UInt"
223+ genFieldType FieldDescriptorProto_Type_TYPE_BOOL _ = Right "Boolean"
224+ genFieldType FieldDescriptorProto_Type_TYPE_STRING _ = Right "String"
225+ genFieldType FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = Right $ mkFieldType "" tname
226+ genFieldType FieldDescriptorProto_Type_TYPE_MESSAGE _ = Left "Failed genTypeOneof missing FieldDescriptorProto type_name"
227+ genFieldType FieldDescriptorProto_Type_TYPE_BYTES _ = Right "Common.Bytes"
228+ genFieldType FieldDescriptorProto_Type_TYPE_UINT32 _ = Right "UInt.UInt"
229+ genFieldType FieldDescriptorProto_Type_TYPE_ENUM (Just tname) = Right $ mkFieldType "" tname
230+ genFieldType FieldDescriptorProto_Type_TYPE_ENUM _ = Left "Failed genTypeOneof missing FieldDescriptorProto type_name"
231+ genFieldType FieldDescriptorProto_Type_TYPE_SFIXED32 _ = Right "Int"
232+ genFieldType FieldDescriptorProto_Type_TYPE_SFIXED64 _ = Right "(Long.Long Long.Signed)"
233+ genFieldType FieldDescriptorProto_Type_TYPE_SINT32 _ = Right "Int"
234+ genFieldType FieldDescriptorProto_Type_TYPE_SINT64 _ = Right "(Long.Long Long.Signed)"
235+ genFieldType FieldDescriptorProto_Type_TYPE_GROUP _ = Left "Failed genTypeOneof GROUP not supported."
236+ -- go arg = Left $ "Failed genTypeOneof missing FieldDescriptorProto fields\n" <> show arg
237+ go _ = Right Nothing
238+ genTypeOneof _ _ _ arg = Left $ "Failed genTypeOneof missing OneofDescriptorProto name\n" <> show arg
239+
240+
241+ let genOneofPut :: NameSpace -> Array FieldDescriptorProto -> Int -> OneofDescriptorProto -> Resp String
242+ genOneofPut nameSpace field oindex (OneofDescriptorProto {name: Just oname}) =
243+ map (String.joinWith "\n") $ sequence $
244+ [ Right $ " case r." <> decapitalize oname <> " of"
245+ , Right " Maybe.Nothing -> pure unit"
246+ ]
247+ <>
248+ (map genOneofFieldPut myfields)
249+ where
250+ myfields = Array.filter ismine field
251+ ismine f@(FieldDescriptorProto {oneof_index: Just i}) = i == oindex
252+ ismine _ = false
253+ genOneofFieldPut :: FieldDescriptorProto -> Resp String
254+ genOneofFieldPut (FieldDescriptorProto
255+ { name: Just name'
256+ , number: Just fnumber
257+ , type: Just ftype
258+ , type_name
259+ }) = go ftype type_name
260+ where
261+ fname = decapitalize name'
262+ go FieldDescriptorProto_Type_TYPE_DOUBLE _ =
263+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.double"
264+ go FieldDescriptorProto_Type_TYPE_FLOAT _ =
265+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.float"
266+ go FieldDescriptorProto_Type_TYPE_INT64 _ =
267+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.int64"
268+ go FieldDescriptorProto_Type_TYPE_UINT64 _ =
269+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.uint64"
270+ go FieldDescriptorProto_Type_TYPE_INT32 _ =
271+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.int32"
272+ go FieldDescriptorProto_Type_TYPE_FIXED64 _ =
273+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.fixed64"
274+ go FieldDescriptorProto_Type_TYPE_FIXED32 _ =
275+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.fixed32"
276+ go FieldDescriptorProto_Type_TYPE_BOOL _ =
277+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.bool"
278+ go FieldDescriptorProto_Type_TYPE_STRING _ =
279+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.string"
280+ go FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) =
281+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) $ Runtime.putLenDel " <> mkFieldType "put" tname
282+ go FieldDescriptorProto_Type_TYPE_MESSAGE _ = Left "Failed genOneofPut missing FieldDescriptorProto type_name"
283+ go FieldDescriptorProto_Type_TYPE_BYTES _ =
284+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.bytes"
285+ go FieldDescriptorProto_Type_TYPE_UINT32 _ =
286+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.uint32"
287+ go FieldDescriptorProto_Type_TYPE_ENUM _ =
288+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Runtime.putEnum"
289+ go FieldDescriptorProto_Type_TYPE_SFIXED32 _ =
290+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.sfixed32"
291+ go FieldDescriptorProto_Type_TYPE_SFIXED64 _ =
292+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.sfixed64"
293+ go FieldDescriptorProto_Type_TYPE_SINT32 _ =
294+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.sint32"
295+ go FieldDescriptorProto_Type_TYPE_SINT64 _ =
296+ Right $ " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.sint64"
297+ go FieldDescriptorProto_Type_TYPE_GROUP _ = Left "Failed genOneofPut GROUP not supported."
298+ genOneofFieldPut _ = Left "Failed genOneofPut missing FieldDescriptorProto name or number or type"
299+ genOneofPut _ _ _ _ = Left "Failed genOneofPut missing OneofDescriptoroProto name"
300+
301+
302+
303+ let genFieldPut :: NameSpace -> FieldDescriptorProto -> Resp (Maybe String)
304+ genFieldPut nameSpace (FieldDescriptorProto
305+ { name: Just name'
306+ , number: Just fnumber
307+ , label: Just flabel
308+ , type: Just ftype
309+ , type_name
310+ , oneof_index: Nothing -- must not be a member of a oneof, that case handled seperately
311+ }) = go flabel ftype type_name
312+ where
313+ fname = decapitalize name'
314+ -- For repeated fields of primitive numeric types, always put the packed
315+ -- encoding.
316+ -- https://developers.google.com/protocol-buffers/docs/encoding?hl=en#packed
317+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_DOUBLE _ =
318+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.double'"
319+ go _ FieldDescriptorProto_Type_TYPE_DOUBLE _ =
320+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.double"
321+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FLOAT _ =
322+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.float'"
323+ go _ FieldDescriptorProto_Type_TYPE_FLOAT _ =
324+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.float"
325+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT64 _ =
326+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.int64'"
327+ go _ FieldDescriptorProto_Type_TYPE_INT64 _ =
328+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.int64"
329+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT64 _ =
330+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.uint64'"
331+ go _ FieldDescriptorProto_Type_TYPE_UINT64 _ =
332+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.uint64"
333+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT32 _ =
334+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.int32'"
335+ go _ FieldDescriptorProto_Type_TYPE_INT32 _ =
336+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.int32"
337+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED64 _ =
338+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.fixed64'"
339+ go _ FieldDescriptorProto_Type_TYPE_FIXED64 _ =
340+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.fixed64"
341+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED32 _ =
342+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.fixed32'"
343+ go _ FieldDescriptorProto_Type_TYPE_FIXED32 _ =
344+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.fixed32"
345+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BOOL _ =
346+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.bool'"
347+ go _ FieldDescriptorProto_Type_TYPE_BOOL _ =
348+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.bool"
349+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_STRING _ =
350+ Right $ Just $ " Runtime.putRepeated " <> show fnumber <> " r." <> fname <> " Encode.string"
351+ go _ FieldDescriptorProto_Type_TYPE_STRING _ =
352+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.string"
353+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) =
354+ Right $ Just $ " Runtime.putRepeated " <> show fnumber <> " r." <> fname <> " $ Runtime.putLenDel " <> mkFieldType "put" tname
355+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_MESSAGE _ =
356+ Left "Failed genFieldPut missing FieldDescriptorProto type_name"
357+ go _ FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) =
358+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " $ Runtime.putLenDel " <> mkFieldType "put" tname
359+ go _ FieldDescriptorProto_Type_TYPE_MESSAGE _ =
360+ Left "Failed genFieldPut missing FieldDescriptorProto type_name"
361+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BYTES _ =
362+ Right $ Just $ " Runtime.putRepeated " <> show fnumber <> " r." <> fname <> " $ Encode.bytes"
363+ go _ FieldDescriptorProto_Type_TYPE_BYTES _ =
364+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.bytes"
365+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT32 _ =
366+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.uint32'"
367+ go _ FieldDescriptorProto_Type_TYPE_UINT32 _ =
368+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.uint32"
369+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_ENUM _ =
370+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Runtime.putEnum'"
371+ go _ FieldDescriptorProto_Type_TYPE_ENUM _ =
372+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Runtime.putEnum"
373+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED32 _ =
374+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.sfixed32'"
375+ go _ FieldDescriptorProto_Type_TYPE_SFIXED32 _ =
376+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.sfixed32"
377+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED64 _ =
378+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.sfixed64'"
379+ go _ FieldDescriptorProto_Type_TYPE_SFIXED64 _ =
380+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.sfixed64"
381+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT32 _ =
382+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.sint32'"
383+ go _ FieldDescriptorProto_Type_TYPE_SINT32 _ =
384+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.sint32"
385+ go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT64 _ =
386+ Right $ Just $ " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.sint64'"
387+ go _ FieldDescriptorProto_Type_TYPE_SINT64 _ =
388+ Right $ Just $ " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.sint64"
389+ go _ FieldDescriptorProto_Type_TYPE_GROUP _ = Left "Failed genFieldPut GROUP not supported"
390+ genFieldPut _ (FieldDescriptorProto { oneof_index: Just _ }) = Right Nothing -- It's a Oneof, this case is handled separately
391+ genFieldPut _ arg = Left $ "Failed genFieldPut missing FieldDescriptorProto name or number or label or type\n" <> show arg
392+
393+ let genFieldParser :: NameSpace -> Array OneofDescriptorProto -> FieldDescriptorProto -> Resp String
394+ genFieldParser nameSpace oneof_decl (FieldDescriptorProto
395+ { name: Just name'
396+ , number: Just fnumber
397+ , label: Just flabel
398+ , type: Just ftype
399+ , type_name
400+ , oneof_index
401+ }) = go (lookupOneof oneof_index) flabel ftype type_name
402+ where
403+ lookupOneof :: Maybe Int -> Maybe String
404+ lookupOneof Nothing = Nothing
405+ lookupOneof (Just i) =
406+ case Array.index oneof_decl i of
407+ Just (OneofDescriptorProto {name}) -> name
408+ _-> Nothing
409+
410+ fname = decapitalize name'
411+ mkConstructor oname = mkTypeName (nameSpace <> [oname,name'])
126412
127− messages :: Array ScopedMsg
128− messages = flattenMessages [] message_type
413+ -- For repeated fields of primitive numeric types, also parse the packed
414+ -- encoding.
415+ -- https://developers.google.com/protocol-buffers/docs/encoding?hl=en#packed
416+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_DOUBLE _ = Right $ String.joinWith "\n"
417+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
418+ , " x <- Decode.double"
419+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
420+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
421+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.double"
422+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
423+ ]
424+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FLOAT _ = Right $ String.joinWith "\n"
425+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
426+ , " x <- Decode.float"
427+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
428+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
429+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.float"
430+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
431+ ]
432+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT64 _ = Right $ String.joinWith "\n"
433+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
434+ , " x <- Decode.int64"
435+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
436+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
437+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.int64"
438+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
439+ ]
440+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT64 _ = Right $ String.joinWith "\n"
441+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
442+ , " x <- Decode.uint64"
443+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
444+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
445+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.uint64"
446+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
447+ ]
448+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT32 _ = Right $ String.joinWith "\n"
449+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
450+ , " x <- Decode.int32"
451+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
452+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
453+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.int32"
454+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
455+ ]
456+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED64 _ = Right $ String.joinWith "\n"
457+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
458+ , " x <- Decode.fixed64"
459+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
460+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
461+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.fixed64"
462+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
463+ ]
464+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED32 _ = Right $ String.joinWith "\n"
465+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
466+ , " x <- Decode.fixed32"
467+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
468+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
469+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.fixed32"
470+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
471+ ]
472+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BOOL _ = Right $ String.joinWith "\n"
473+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
474+ , " x <- Decode.bool"
475+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
476+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
477+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.bool"
478+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
479+ ]
480+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_STRING _ = Right $ String.joinWith "\n"
481+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
482+ , " x <- Decode.string"
483+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
484+ ]
485+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = Right $ String.joinWith "\n"
486+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
487+ , " x <- Runtime.parseLenDel " <> mkFieldType "parse" tname
488+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
489+ ]
490+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BYTES _ = Right $ String.joinWith "\n"
491+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
492+ , " x <- Decode.bytes"
493+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
494+ ]
495+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT32 _ = Right $ String.joinWith "\n"
496+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
497+ , " x <- Decode.uint32"
498+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
499+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
500+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.uint32"
501+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
502+ ]
503+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_ENUM _ = Right $ String.joinWith "\n"
504+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
505+ , " x <- Runtime.parseEnum"
506+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
507+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
508+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Runtime.parseEnum"
509+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
510+ ]
511+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED32 _ = Right $ String.joinWith "\n"
512+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
513+ , " x <- Decode.sfixed32"
514+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
515+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
516+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.sfixed32"
517+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
518+ ]
519+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED64 _ = Right $ String.joinWith "\n"
520+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
521+ , " x <- Decode.sfixed64"
522+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
523+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
524+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.sfixed64"
525+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
526+ ]
527+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT32 _ = Right $ String.joinWith "\n"
528+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
529+ , " x <- Decode.sint32"
530+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
531+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
532+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.sint32"
533+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
534+ ]
535+ go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT64 _ = Right $ String.joinWith "\n"
536+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
537+ , " x <- Decode.sint64"
538+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
539+ , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
540+ , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.sint64"
541+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
542+ ]
129543
130− enums :: Array ScopedEnum
131− enums = (ScopedEnum [] <$> enum_type) <> flattenEnums [] message_type
544+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_DOUBLE _ = Right $ String.joinWith "\n"
545+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
546+ , " x <- Decode.double"
547+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
548+ ]
549+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_FLOAT _ = Right $ String.joinWith "\n"
550+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
551+ , " x <- Decode.float"
552+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
553+ ]
554+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_INT64 _ = Right $ String.joinWith "\n"
555+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
556+ , " x <- Decode.int64"
557+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
558+ ]
559+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_UINT64 _ = Right $ String.joinWith "\n"
560+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
561+ , " x <- Decode.uint64"
562+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
563+ ]
564+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_INT32 _ = Right $ String.joinWith "\n"
565+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
566+ , " x <- Decode.int32"
567+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
568+ ]
569+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_FIXED64 _ = Right $ String.joinWith "\n"
570+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
571+ , " x <- Decode.fixed64"
572+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
573+ ]
574+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_FIXED32 _ = Right $ String.joinWith "\n"
575+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
576+ , " x <- Decode.fixed32"
577+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
578+ ]
579+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_BOOL _ = Right $ String.joinWith "\n"
580+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
581+ , " x <- Decode.bool"
582+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
583+ ]
584+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_STRING _ = Right $ String.joinWith "\n"
585+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
586+ , " x <- Decode.string"
587+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
588+ ]
589+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = Right $ String.joinWith "\n"
590+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
591+ , " x <- Runtime.parseLenDel " <> mkFieldType "parse" tname
592+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
593+ ]
594+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_BYTES _ = Right $ String.joinWith "\n"
595+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
596+ , " x <- Decode.bytes"
597+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
598+ ]
599+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_UINT32 _ = Right $ String.joinWith "\n"
600+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
601+ , " x <- Decode.uint32"
602+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
603+ ]
604+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_ENUM _ = Right $ String.joinWith "\n"
605+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
606+ , " x <- Runtime.parseEnum"
607+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
608+ ]
609+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_SFIXED32 _ = Right $ String.joinWith "\n"
610+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
611+ , " x <- Decode.sfixed32"
612+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
613+ ]
614+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_SFIXED64 _ = Right $ String.joinWith "\n"
615+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
616+ , " x <- Decode.sfixed64"
617+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
618+ ]
619+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_SINT32 _ = Right $ String.joinWith "\n"
620+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
621+ , " x <- Decode.sint32"
622+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
623+ ]
624+ go (Just oname) _ FieldDescriptorProto_Type_TYPE_SINT64 _ = Right $ String.joinWith "\n"
625+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
626+ , " x <- Decode.sint64"
627+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
628+ ]
132629
133− fileNameOut = baseName <> "." <> (String.joinWith "." ((map capitalize packageName))) <> ".purs"
630+ go _ _ FieldDescriptorProto_Type_TYPE_DOUBLE _ = Right $ String.joinWith "\n"
631+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
632+ , " x <- Decode.double"
633+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
634+ ]
635+ go _ _ FieldDescriptorProto_Type_TYPE_FLOAT _ = Right $ String.joinWith "\n"
636+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
637+ , " x <- Decode.float"
638+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
639+ ]
640+ go _ _ FieldDescriptorProto_Type_TYPE_INT64 _ = Right $ String.joinWith "\n"
641+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
642+ , " x <- Decode.int64"
643+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
644+ ]
645+ go _ _ FieldDescriptorProto_Type_TYPE_UINT64 _ = Right $ String.joinWith "\n"
646+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
647+ , " x <- Decode.uint64"
648+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
649+ ]
650+ go _ _ FieldDescriptorProto_Type_TYPE_INT32 _ = Right $ String.joinWith "\n"
651+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
652+ , " x <- Decode.int32"
653+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
654+ ]
655+ go _ _ FieldDescriptorProto_Type_TYPE_FIXED64 _ = Right $ String.joinWith "\n"
656+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
657+ , " x <- Decode.fixed64"
658+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
659+ ]
660+ go _ _ FieldDescriptorProto_Type_TYPE_FIXED32 _ = Right $ String.joinWith "\n"
661+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
662+ , " x <- Decode.fixed32"
663+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
664+ ]
665+ go _ _ FieldDescriptorProto_Type_TYPE_BOOL _ = Right $ String.joinWith "\n"
666+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
667+ , " x <- Decode.bool"
668+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
669+ ]
670+ go _ _ FieldDescriptorProto_Type_TYPE_STRING _ = Right $ String.joinWith "\n"
671+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
672+ , " x <- Decode.string"
673+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
674+ ]
675+ go _ _ FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = Right $ String.joinWith "\n"
676+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
677+ , " x <- Runtime.parseLenDel " <> mkFieldType "parse" tname
678+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
679+ ]
680+ go _ _ FieldDescriptorProto_Type_TYPE_MESSAGE _ = Left "Failed genFieldParser missing FieldDescriptorProto type_name"
681+ go _ _ FieldDescriptorProto_Type_TYPE_BYTES _ = Right $ String.joinWith "\n"
682+ [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
683+ , " x <- Decode.bytes"
684+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
685+ ]
686+ go _ _ FieldDescriptorProto_Type_TYPE_UINT32 _ = Right $ String.joinWith "\n"
687+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
688+ , " x <- Decode.uint32"
689+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
690+ ]
691+ go _ _ FieldDescriptorProto_Type_TYPE_ENUM _ = Right $ String.joinWith "\n"
692+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
693+ , " x <- Runtime.parseEnum"
694+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
695+ ]
696+ go _ _ FieldDescriptorProto_Type_TYPE_SFIXED32 _ = Right $ String.joinWith "\n"
697+ [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
698+ , " x <- Decode.sfixed32"
699+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
700+ ]
701+ go _ _ FieldDescriptorProto_Type_TYPE_SFIXED64 _ = Right $ String.joinWith "\n"
702+ [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
703+ , " x <- Decode.sfixed64"
704+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
705+ ]
706+ go _ _ FieldDescriptorProto_Type_TYPE_SINT32 _ = Right $ String.joinWith "\n"
707+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
708+ , " x <- Decode.sint32"
709+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
710+ ]
711+ go _ _ FieldDescriptorProto_Type_TYPE_SINT64 _ = Right $ String.joinWith "\n"
712+ [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
713+ , " x <- Decode.sint64"
714+ , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
715+ ]
716+ go _ _ FieldDescriptorProto_Type_TYPE_GROUP _ = Left "Failed genFieldParser GROUP not supported"
717+ genFieldParser _ _ _ = Left "Failed genFieldParser missing FieldDescriptorProto name or number or label or type"
134718
135− packageName = case package of
136− Nothing -> []
137− Just ps -> String.split (String.Pattern.Pattern ".") ps
719+ -- | For embedded message fields, the parser merges multiple instances of the same field,
720+ -- | https://developers.google.com/protocol-buffers/docs/encoding?hl=en#optional
721+ let genFieldRecord :: NameSpace -> FieldDescriptorProto -> Resp (Maybe String)
722+ genFieldRecord nameSpace (FieldDescriptorProto
723+ { name: Just name'
724+ , number: Just fnumber
725+ , label: Just flabel
726+ , type: Just ftype
727+ , type_name
728+ , oneof_index
729+ }) = (map<<<map) (\x -> fname <> " :: " <> x) $ ptype oneof_index flabel ftype type_name
730+ where
731+ fname = decapitalize name'
732+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_DOUBLE _ = Right $ Just "Array Number"
733+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FLOAT _ = Right $ Just "Array Float32.Float32"
734+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT64 _ = Right $ Just "Array (Long.Long Long.Signed)"
735+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT64 _ = Right $ Just "Array (Long.Long Long.Unsigned)"
736+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT32 _ = Right $ Just "Array Int"
737+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED64 _ = Right $ Just "Array (Long.Long Long.Unsigned)"
738+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED32 _ = Right $ Just "Array UInt.UInt"
739+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BOOL _ = Right $ Just "Array Boolean"
740+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_STRING _ = Right $ Just "Array String"
741+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = Right $ Just $ "Array " <> mkFieldType "" tname
742+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_MESSAGE _ = Left "Failed genFieldRecord missing FieldDescriptorProto type_name"
743+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BYTES _ = Right $ Just "Array Common.Bytes"
744+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT32 _ = Right $ Just "Array UInt.UInt"
745+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_ENUM (Just tname) = Right $ Just $ "Array " <> mkFieldType "" tname
746+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_ENUM _ = Left "Failed genFieldRecord missing FieldDescriptorProto type_name"
747+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED32 _ = Right $ Just "Array Int"
748+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED64 _ = Right $ Just "Array (Long.Long Long.Signed)"
749+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT32 _ = Right $ Just "Array Int"
750+ ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT64 _ = Right $ Just "Array (Long.Long Long.Signed)"
751+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_DOUBLE _ = Right $ Just "Maybe.Maybe Number"
752+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_FLOAT _ = Right $ Just "Maybe.Maybe Float32.Float32"
753+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_INT64 _ = Right $ Just "Maybe.Maybe (Long.Long Long.Signed)"
754+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_UINT64 _ = Right $ Just "Maybe.Maybe (Long.Long Long.Unsigned)"
755+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_INT32 _ = Right $ Just "Maybe.Maybe Int"
756+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_FIXED64 _ = Right $ Just "Maybe.Maybe (Long.Long Long.Unsigned)"
757+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_FIXED32 _ = Right $ Just "Maybe.Maybe UInt.UInt"
758+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_BOOL _ = Right $ Just "Maybe.Maybe Boolean"
759+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_STRING _ = Right $ Just "Maybe.Maybe String"
760+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = Right $ Just $ "Maybe.Maybe " <> mkFieldType "" tname
761+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_MESSAGE _ = Left "Failed genFieldRecord missing FieldDescriptorProto type_name"
762+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_BYTES _ = Right $ Just "Maybe.Maybe Common.Bytes"
763+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_UINT32 _ = Right $ Just "Maybe.Maybe UInt.UInt"
764+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_ENUM (Just tname) = Right $ Just $ "Maybe.Maybe " <> mkFieldType "" tname
765+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_ENUM _ = Left "Failed genFieldRecord missing FieldDescriptorProto type_name"
766+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_SFIXED32 _ = Right $ Just "Maybe.Maybe Int"
767+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_SFIXED64 _ = Right $ Just "Maybe.Maybe (Long.Long Long.Signed)"
768+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_SINT32 _ = Right $ Just "Maybe.Maybe Int"
769+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_SINT64 _ = Right $ Just "Maybe.Maybe (Long.Long Long.Signed)"
770+ ptype Nothing _ FieldDescriptorProto_Type_TYPE_GROUP _ = Left "Failed genFieldRecord GROUP not supported"
771+ ptype (Just _) _ _ _ = Right Nothing -- It's a Oneof, and that case is handled separately
772+ genFieldRecord _ _ = Left "Failed genFieldRecord missing FieldDescriptorProtocol name or number or label or type"
138773
774+-- | We need to wrap our structural record types in a nominal
775+-- | data type so that we can nest records, otherwise we get
776+-- | https://github.com/purescript/documentation/blob/master/errors/CycleInTypeSynonym.md
777+-- | And so that we can assign instances.
778+ let genMessage :: ScopedMsg -> Resp String
779+ genMessage (ScopedMsg nameSpace (DescriptorProto {name: Just msgName, field, oneof_decl})) =
780+ let tname = mkTypeName $ nameSpace <> [msgName]
781+ in
782+ map (String.joinWith "\n") $ sequence
783+ [ Right $ "\ntype " <> tname <> "Row ="
784+ , Right " ( "
785+ <>
786+ ( map (String.joinWith "\n , ") $
787+ ( (catMaybes <$> traverse (genFieldRecord nameSpace) field)
788+ <> (traverse (genFieldRecordOneof (nameSpace <> [msgName])) oneof_decl)
789+ <> Right ["__unknown_fields :: Array Runtime.UnknownField"]
790+ )
791+ )
792+ , Right " )"
793+ , Right $ "type " <> tname <> "R = Record " <> tname <> "Row"
794+ , Right $ "newtype " <> tname <> " = " <> tname <> " " <> tname <> "R"
795+ , Right $ "derive instance generic" <> tname <> " :: Generic.Rep.Generic " <> tname <> " _"
796+ , Right $ "derive instance newtype" <> tname <> " :: Newtype.Newtype " <> tname <> " _"
797+ , Right $ "derive instance eq" <> tname <> " :: Eq.Eq " <> tname
798+ -- https://github.com/purescript/purescript/issues/2975#issuecomment-313650710
799+ , Right $ "instance show" <> tname <> " :: Show.Show " <> tname <> " where show x = Generic.Rep.Show.genericShow x"
800+ , Right ""
801+ , Right $ "put" <> tname <> " :: forall m. MonadEffect m => " <> tname <> " -> ArrayBuffer.Builder.PutM m Unit.Unit"
802+ , Right $ "put" <> tname <> " (" <> tname <> " r) = do"
803+ , map (String.joinWith "\n") $
804+ (map catMaybes $ traverse (genFieldPut nameSpace) field) <> (sequence $ Array.mapWithIndex (genOneofPut (nameSpace <> [msgName]) field) oneof_decl)
805+ , Right " Traversable.traverse_ Runtime.putFieldUnknown r.__unknown_fields"
806+ , Right ""
807+ , Right $ "parse" <> tname <> " :: forall m. MonadEffect m => MonadRec m => Int -> Parser.ParserT ArrayBuffer.Types.DataView m " <> tname
808+ , Right $ "parse" <> tname <> " length = Runtime.label \"" <> msgName <> " / \" $"
809+ , Right $ " Runtime.parseMessage " <> tname <> " default" <> tname <> " parseField length"
810+ , Right " where"
811+ , Right " parseField"
812+ , Right " :: Runtime.FieldNumberInt"
813+ , Right " -> Common.WireType"
814+ , Right $ " -> Parser.ParserT ArrayBuffer.Types.DataView m (Record.Builder.Builder " <> tname <> "R " <> tname <> "R)"
815+ , map (String.joinWith "\n") (traverse (genFieldParser (nameSpace <> [msgName]) oneof_decl) field)
816+ , Right " parseField fieldNumber wireType = Runtime.parseFieldUnknown fieldNumber wireType"
817+ , Right ""
818+ , Right $ "default" <> tname <> " :: " <> tname <> "R"
819+ , Right $ "default" <> tname <> " ="
820+ , Right " { "
821+ <>
822+ ( map (String.joinWith "\n , ") $
823+ ( (map catMaybes $ traverse genFieldDefault field)
824+ <> (traverse genFieldDefaultOneof oneof_decl)
825+ <> Right ["__unknown_fields: []"]
826+ )
827+ )
828+ , Right " }"
829+ , Right ""
830+ , Right $ "mk" <> tname <> " :: forall r1 r3. Prim.Row.Union r1 " <> tname <> "Row r3 => Prim.Row.Nub r3 " <> tname <> "Row => Record r1 -> " <> tname
831+ , Right $ "mk" <> tname <> " r = " <> tname <> " $ Record.merge r default" <> tname
832+ , map (String.joinWith "\n") $ sequence $ (Array.mapWithIndex (genTypeOneof (nameSpace <> [msgName]) field) oneof_decl)
833+ ]
834+ genMessage _ = Left "Failed genMessage no DescriptorProto name"
139835
140− lookupPackageByFilepath :: String -> Maybe (Array String)
141− lookupPackageByFilepath fpath =
142− case Array.find (\(FileDescriptorProto f) -> maybe false (_ == fpath) f.name) proto_file of
143− Just (FileDescriptorProto {package: Just p}) -> Just $ String.split (String.Pattern.Pattern ".") p
144− _ -> Nothing
145836
146− content = String.joinWith "\n" $
147− [ "-- | Generated by __purescript-protobuf__ from file `" <> fromMaybe "<unknown>" fileName <> "`"
148− , "module " <> (String.joinWith "." ((map mkModuleName packageName))) <> "." <> mkModuleName baseName
149− , "( " <> (String.joinWith "\n, "
150− ((map genMessageExport messages) <> (map genEnumExport enums)))
151− , """)
837+ contents <-
838+ sequence
839+ [ Right $ "-- | Generated by __purescript-protobuf__ from file `" <> fromMaybe "<unknown>" fileName <> "`"
840+ , Right $ "module " <> (String.joinWith "." ((map mkModuleName packageName))) <> "." <> mkModuleName baseName
841+ , Right "( " <> (map (String.joinWith "\n, ") ((traverse genMessageExport messages) <> (traverse genEnumExport enums)))
842+ , Right """)
152843where
153844
154845import Prelude
@@ -188,44 +879,35 @@ import Protobuf.Runtime as Runtime
188879"""
189880 ]
190881 <>
191− (map genImport dependency)
882+ (traverse genImport dependency)
192883 <>
193− ["\n"]
884+ Right ["\n"]
194885 <>
195− (map genMessage messages)
886+ (traverse genMessage messages)
196887 <>
197− (map genEnum enums)
888+ (traverse genEnum enums)
198889 <>
199− ["\n"]
890+ Right ["\n"]
200891
201892
202− -- We have to import the modules qualified in the way because
203− -- 1. When protoc "fully qualifies" a field type from an imported
204− -- desriptor, the qualification consists of only the package name
205− -- 2. protoc allows multiple files to have the same package name,
206− -- such as descriptor.proto and any.proto (package "google.protobuf")
207− -- but Purescript requires each file to have a different module name.
208− genImport :: String -> String
209− genImport fpath = "import " <> make moduleName <> " as " <> make qualifiedName
210− where
211− pkg = lookupPackageByFilepath fpath
212− moduleName = mkImportName (Just fpath) pkg
213− qualifiedName = Array.dropEnd 1 moduleName
214− make = String.joinWith "." <<< map capitalize
893+ Right $ CodeGeneratorResponse_File
894+ { name : Just fileNameOut
895+ , insertion_point : Nothing
896+ , content : Just $ String.joinWith "\n" contents
897+ , __unknown_fields : []
898+ }
215899
216− mkImportName
217− :: Maybe String -- file path
218− -> Maybe (Array String) -- package name
219− -> Array String
220− mkImportName fileString packages = map mkModuleName $ pkg <> file
221− where
222− file = case fileString of
223− Nothing -> []
224− Just f -> [basenameWithoutExt f ".proto"]
225− pkg = case packages of
226− Nothing -> []
227− Just ps -> ps
228900
901+ where
902+
903+ mkTypeName :: Array String -> String
904+ mkTypeName ns = String.joinWith "_" $ map capitalize ns
905+
906+ capitalize :: String -> String
907+ capitalize s = String.toUpper (String.take 1 s) <> String.drop 1 s
908+
909+ decapitalize :: String -> String
910+ decapitalize s = String.toLower (String.take 1 s) <> String.drop 1 s
229911
230912 -- | underscores and primes are not allowed in module names
231913 -- | https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md
@@ -250,781 +932,113 @@ import Protobuf.Runtime as Runtime
250932 String.replaceAll (String.Pattern.Pattern "_") (String.Pattern.Replacement "") <<<
251933 String.replaceAll (String.Pattern.Pattern "'") (String.Pattern.Replacement "1")
252934
253−
254935 -- | Pull all of the enums out of of the nested messages and bring them
255936 -- | to the top, with their namespace.
256− flattenEnums :: NameSpace -> Array DescriptorProto -> Array ScopedEnum
937+ flattenEnums :: NameSpace -> Array DescriptorProto -> Array (Resp ScopedEnum)
257938 flattenEnums namespace msgarray = concatMap go msgarray
258939 where
259− go :: DescriptorProto -> Array ScopedEnum
940+ go :: DescriptorProto -> Array (Resp ScopedEnum)
260941 go (DescriptorProto {name: Just msgName, nested_type, enum_type: msgEnums}) =
261− (ScopedEnum (namespace <> [msgName]) <$> msgEnums)
942+ (Right <$> ScopedEnum (namespace <> [msgName]) <$> msgEnums)
262943 <> flattenEnums (namespace <> [msgName]) nested_type
263− go _ = [] -- error no name
944+ go _ = [ Left "Failed flattenEnums missing DescriptorProto name" ]
264945
265− genEnumExport :: ScopedEnum -> String
946+ genEnumExport :: ScopedEnum -> Resp String
266947 genEnumExport (ScopedEnum namespace (EnumDescriptorProto {name: Just eName})) =
267− (mkTypeName $ namespace <> [eName]) <> "(..)"
268− genEnumExport _ = "" -- error, no name
948+ Right $ (mkTypeName $ namespace <> [eName]) <> "(..)"
949+ genEnumExport _ = Left "Failed genEnumExport missing EnumDescriptorProto name"
269950
270− genEnum :: ScopedEnum -> String
951+ genEnum :: ScopedEnum -> Resp String
271952 genEnum (ScopedEnum namespace (EnumDescriptorProto {name: Just eName, value})) =
272− let tname = mkTypeName $ namespace <> [eName]
273− in
274− String.joinWith "\n" $
275− [ "\ndata " <> tname
276− , " = " <> String.joinWith "\n | " (genEnumConstruct <$> value)
277− , "derive instance generic" <> tname <> " :: Generic.Rep.Generic " <> tname <> " _"
278− , "derive instance eq" <> tname <> " :: Eq.Eq " <> tname
279− , "instance show" <> tname <> " :: Show.Show " <> tname <> " where show = Generic.Rep.Show.genericShow"
280− , "instance ord" <> tname <> " :: Ord.Ord " <> tname <> " where compare = Generic.Rep.Ord.genericCompare"
281− , "instance bounded" <> tname <> " :: Bounded.Bounded " <> tname
282− , " where"
283− , " bottom = Generic.Rep.Bounded.genericBottom"
284− , " top = Generic.Rep.Bounded.genericTop"
285− , "instance enum" <> tname <> " :: Enum.Enum " <> tname
286− , " where"
287− , " succ = Generic.Rep.Enum.genericSucc"
288− , " pred = Generic.Rep.Enum.genericPred"
289− , "instance boundedenum" <> tname <> " :: Enum.BoundedEnum " <> tname
290− , " where"
291− , " cardinality = Generic.Rep.Enum.genericCardinality"
292− ]
293− <>
294− (map genEnumTo value)
295− <>
296− [ " toEnum _ = Maybe.Nothing"]
297− <>
298− (map genEnumFrom value)
953+ do
954+ let tname = mkTypeName $ namespace <> [eName]
955+ enumConstruct <- traverse genEnumConstruct value
956+ enumTo <- traverse genEnumTo value
957+ enumFrom <- traverse genEnumFrom value
958+ Right $ String.joinWith "\n" $
959+ [ "\ndata " <> tname
960+ , " = " <> String.joinWith "\n | " enumConstruct
961+ , "derive instance generic" <> tname <> " :: Generic.Rep.Generic " <> tname <> " _"
962+ , "derive instance eq" <> tname <> " :: Eq.Eq " <> tname
963+ , "instance show" <> tname <> " :: Show.Show " <> tname <> " where show = Generic.Rep.Show.genericShow"
964+ , "instance ord" <> tname <> " :: Ord.Ord " <> tname <> " where compare = Generic.Rep.Ord.genericCompare"
965+ , "instance bounded" <> tname <> " :: Bounded.Bounded " <> tname
966+ , " where"
967+ , " bottom = Generic.Rep.Bounded.genericBottom"
968+ , " top = Generic.Rep.Bounded.genericTop"
969+ , "instance enum" <> tname <> " :: Enum.Enum " <> tname
970+ , " where"
971+ , " succ = Generic.Rep.Enum.genericSucc"
972+ , " pred = Generic.Rep.Enum.genericPred"
973+ , "instance boundedenum" <> tname <> " :: Enum.BoundedEnum " <> tname
974+ , " where"
975+ , " cardinality = Generic.Rep.Enum.genericCardinality"
976+ ]
977+ <>
978+ enumTo
979+ <>
980+ [ " toEnum _ = Maybe.Nothing"]
981+ <>
982+ enumFrom
299983 where
300− genEnumConstruct (EnumValueDescriptorProto {name: Just name}) =
301− mkEnumName name
302− genEnumConstruct _ = "" -- error no name
984+ genEnumConstruct (EnumValueDescriptorProto {name: Just name}) = Right $ mkEnumName name
985+ genEnumConstruct arg = Left $ "Failed genEnumConstruct\n" <> show arg
303986 genEnumTo (EnumValueDescriptorProto {name: Just name,number: Just number}) =
304− " toEnum " <> show number <> " = Maybe.Just " <> mkEnumName name
305− genEnumTo _ = "" -- error no name
987+ Right $ " toEnum " <> show number <> " = Maybe.Just " <> mkEnumName name
988+ genEnumTo arg = Left $ "Failed genEnumTo\n" <> show arg
306989 genEnumFrom (EnumValueDescriptorProto {name: Just name,number: Just number}) =
307− " fromEnum " <> mkEnumName name <> " = " <> show number
308− genEnumFrom _ = "" -- error no name
990+ Right $ " fromEnum " <> mkEnumName name <> " = " <> show number
991+ genEnumFrom arg = Left $ "Failed genEnumFrom\n" <> show arg
309992 mkEnumName name = mkTypeName $ namespace <> [eName] <> [name]
310− genEnum _ = "" -- error no name
993+ genEnum _ = Left $ "Failed genEnum no EnumDescriptorProto name"
311994
312995 -- | Pull all of the nested messages out of of the messages and bring them
313996 -- | to the top, with their namespace.
314− flattenMessages :: NameSpace -> Array DescriptorProto -> Array ScopedMsg
997+ flattenMessages :: NameSpace -> Array DescriptorProto -> Array (Resp ScopedMsg)
315998 flattenMessages namespace msgarray = concatMap go msgarray
316999 where
317− go :: DescriptorProto -> Array ScopedMsg
1000+ go :: DescriptorProto -> Array (Resp ScopedMsg)
3181001 go (DescriptorProto r@{name: Just msgName, nested_type}) =
319− [ScopedMsg namespace (DescriptorProto r)]
1002+ [Right $ ScopedMsg namespace (DescriptorProto r)]
3201003 <> flattenMessages (namespace <> [msgName]) nested_type
321− go _ = [] -- error no name
322−
1004+ go _ = [ Left "Failed flattenMessages missing DescriptorProto name"]
3231005
324− genMessageExport :: ScopedMsg -> String
325− genMessageExport (ScopedMsg namespace (DescriptorProto {name: Just msgName, oneof_decl})) =
1006+ genMessageExport :: ScopedMsg -> Resp String
1007+ genMessageExport (ScopedMsg namespace (DescriptorProto {name: Just msgName, oneof_decl})) = (Right $
3261008 tname <> "(..), " <> tname <> "Row, " <> tname <> "R, parse" <> tname <> ", put" <> tname <> ", default" <> tname <> ", mk" <> tname
327− <> String.joinWith "" (map genOneofExport oneof_decl)
1009+ )
1010+ <>
1011+ (map (String.joinWith "") (traverse genOneofExport oneof_decl))
3281012 where
3291013 tname = mkTypeName $ namespace <> [msgName]
330− genOneofExport (OneofDescriptorProto {name: Just oname}) = ", " <> mkTypeName (namespace <> [msgName,oname]) <> "(..)"
331− genOneofExport _ = "" -- error, no oname
332− genMessageExport _ = "" -- error, no name
333−
334−
335−
336−-- | We need to wrap our structural record types in a nominal
337−-- | data type so that we can nest records, otherwise we get
338−-- | https://github.com/purescript/documentation/blob/master/errors/CycleInTypeSynonym.md
339−-- | And so that we can assign instances.
340− genMessage :: ScopedMsg -> String
341− genMessage (ScopedMsg nameSpace (DescriptorProto {name: Just msgName, field, oneof_decl})) =
342− let tname = mkTypeName $ nameSpace <> [msgName]
343− in
344− String.joinWith "\n" $
345− [ "\ntype " <> tname <> "Row ="
346− , " ( " <> String.joinWith "\n , "
347− ( (mapMaybe (genFieldRecord nameSpace) field)
348− <> (map (genFieldRecordOneof (nameSpace <> [msgName])) oneof_decl)
349− <> ["__unknown_fields :: Array Runtime.UnknownField"]
350− )
351− , " )"
352− , "type " <> tname <> "R = Record " <> tname <> "Row"
353− , "newtype " <> tname <> " = " <> tname <> " " <> tname <> "R"
354− , "derive instance generic" <> tname <> " :: Generic.Rep.Generic " <> tname <> " _"
355− , "derive instance newtype" <> tname <> " :: Newtype.Newtype " <> tname <> " _"
356− , "derive instance eq" <> tname <> " :: Eq.Eq " <> tname
357− -- https://github.com/purescript/purescript/issues/2975#issuecomment-313650710
358− , "instance show" <> tname <> " :: Show.Show " <> tname <> " where show x = Generic.Rep.Show.genericShow x"
359− , ""
360− , "put" <> tname <> " :: forall m. MonadEffect m => " <> tname <> " -> ArrayBuffer.Builder.PutM m Unit.Unit"
361− , "put" <> tname <> " (" <> tname <> " r) = do"
362− , String.joinWith "\n" $ Array.catMaybes
363− $ (map (genFieldPut nameSpace) field)
364− <> (Array.mapWithIndex (genOneofPut (nameSpace <> [msgName]) field) oneof_decl)
365− , " Traversable.traverse_ Runtime.putFieldUnknown r.__unknown_fields"
366− , ""
367− , "parse" <> tname <> " :: forall m. MonadEffect m => MonadRec m => Int -> Parser.ParserT ArrayBuffer.Types.DataView m " <> tname
368− , "parse" <> tname <> " length = Runtime.label \"" <> msgName <> " / \" $"
369− , " Runtime.parseMessage " <> tname <> " default" <> tname <> " parseField length"
370− , " where"
371− , " parseField"
372− , " :: Runtime.FieldNumberInt"
373− , " -> Common.WireType"
374− , " -> Parser.ParserT ArrayBuffer.Types.DataView m (Record.Builder.Builder " <> tname <> "R " <> tname <> "R)"
375− , String.joinWith "\n" (map (genFieldParser (nameSpace <> [msgName]) oneof_decl) field)
376− , " parseField fieldNumber wireType = Runtime.parseFieldUnknown fieldNumber wireType"
377− , ""
378− , "default" <> tname <> " :: " <> tname <> "R"
379− , "default" <> tname <> " ="
380− , " { " <> String.joinWith "\n , "
381− ( (mapMaybe genFieldDefault field)
382− <> (map genFieldDefaultOneof oneof_decl)
383− <> ["__unknown_fields: []"]
384− )
385− , " }"
386− , ""
387− , "mk" <> tname <> " :: forall r1 r3. Prim.Row.Union r1 " <> tname <> "Row r3 => Prim.Row.Nub r3 " <> tname <> "Row => Record r1 -> " <> tname
388− , "mk" <> tname <> " r = " <> tname <> " $ Record.merge r default" <> tname
389− , String.joinWith "\n" (Array.mapWithIndex (genTypeOneof (nameSpace <> [msgName]) field) oneof_decl)
390− ]
391− genMessage _ = "" -- error not enough information
392−
393− genTypeOneof
394− :: NameSpace
395− -> Array FieldDescriptorProto
396− -> Int
397− -> OneofDescriptorProto
398− -> String
399− genTypeOneof nameSpace field indexOneof (OneofDescriptorProto {name: Just oname}) = String.joinWith "\n"
400− [ "data " <> cname
401− , " = " <> (String.joinWith "\n | " (mapMaybe go field))
402− , "derive instance generic" <> cname <> " :: Generic.Rep.Generic " <> cname <> " _"
403− , "derive instance eq" <> cname <> " :: Eq.Eq " <> cname
404− , "instance show" <> cname <> " :: Show.Show " <> cname <> " where show = Generic.Rep.Show.genericShow"
405− ]
406− where
407− cname = String.joinWith "_" $ map capitalize $ nameSpace <> [oname]
408− go :: FieldDescriptorProto -> Maybe String
409− go f@(FieldDescriptorProto
410− {name: Just fname
411− , oneof_index: Just index
412− , type: Just ftype
413− , type_name
414− }) =
415− if index == indexOneof
416− then Just $ (String.joinWith "_" $ map capitalize [cname,fname]) <> " " <> genFieldType ftype type_name
417− else Nothing
418− where
419− genFieldType :: FieldDescriptorProto_Type -> Maybe String -> String
420− genFieldType FieldDescriptorProto_Type_TYPE_DOUBLE _ = "Number"
421− genFieldType FieldDescriptorProto_Type_TYPE_FLOAT _ = "Float32.Float32"
422− genFieldType FieldDescriptorProto_Type_TYPE_INT64 _ = "(Long.Long Long.Signed)"
423− genFieldType FieldDescriptorProto_Type_TYPE_UINT64 _ = "(Long.Long Long.Unsigned)"
424− genFieldType FieldDescriptorProto_Type_TYPE_INT32 _ = "Int"
425− genFieldType FieldDescriptorProto_Type_TYPE_FIXED64 _ = "(Long.Long Long.Unsigned)"
426− genFieldType FieldDescriptorProto_Type_TYPE_FIXED32 _ = "UInt.UInt"
427− genFieldType FieldDescriptorProto_Type_TYPE_BOOL _ = "Boolean"
428− genFieldType FieldDescriptorProto_Type_TYPE_STRING _ = "String"
429− genFieldType FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = mkFieldType "" tname
430− genFieldType FieldDescriptorProto_Type_TYPE_BYTES _ = "Common.Bytes"
431− genFieldType FieldDescriptorProto_Type_TYPE_UINT32 _ = "UInt.UInt"
432− genFieldType FieldDescriptorProto_Type_TYPE_ENUM (Just tname) = mkFieldType "" tname
433− genFieldType FieldDescriptorProto_Type_TYPE_SFIXED32 _ = "Int"
434− genFieldType FieldDescriptorProto_Type_TYPE_SFIXED64 _ = "(Long.Long Long.Signed)"
435− genFieldType FieldDescriptorProto_Type_TYPE_SINT32 _ = "Int"
436− genFieldType FieldDescriptorProto_Type_TYPE_SINT64 _ = "(Long.Long Long.Signed)"
437− genFieldType FieldDescriptorProto_Type_TYPE_GROUP _ = "" -- error ignore
438− genFieldType _ _ = "" -- error, not enough information
439− go _ = Nothing
440− genTypeOneof _ _ _ _ = "" -- error no name
441−
442−
443− genOneofPut :: NameSpace -> Array FieldDescriptorProto -> Int -> OneofDescriptorProto -> Maybe String
444− genOneofPut nameSpace field oindex (OneofDescriptorProto {name: Just oname}) =
445− Just $ String.joinWith "\n" $
446− [ " case r." <> decapitalize oname <> " of"
447− , " Maybe.Nothing -> pure unit"
448− ]
449− <> map genOneofFieldPut myfields
450− where
451− myfields = Array.filter ismine field
452− ismine f@(FieldDescriptorProto {oneof_index: Just i}) = i == oindex
453− ismine _ = false
454− genOneofFieldPut (FieldDescriptorProto
455− { name: Just name'
456− , number: Just fnumber
457− , type: Just ftype
458− , type_name
459− }) = go ftype type_name
460− where
461− fname = decapitalize name'
462− go FieldDescriptorProto_Type_TYPE_DOUBLE _ =
463− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.double"
464− go FieldDescriptorProto_Type_TYPE_FLOAT _ =
465− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.float"
466− go FieldDescriptorProto_Type_TYPE_INT64 _ =
467− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.int64"
468− go FieldDescriptorProto_Type_TYPE_UINT64 _ =
469− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.uint64"
470− go FieldDescriptorProto_Type_TYPE_INT32 _ =
471− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.int32"
472− go FieldDescriptorProto_Type_TYPE_FIXED64 _ =
473− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.fixed64"
474− go FieldDescriptorProto_Type_TYPE_FIXED32 _ =
475− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.fixed32"
476− go FieldDescriptorProto_Type_TYPE_BOOL _ =
477− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.bool"
478− go FieldDescriptorProto_Type_TYPE_STRING _ =
479− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.string"
480− go FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) =
481− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) $ Runtime.putLenDel " <> mkFieldType "put" tname
482− go FieldDescriptorProto_Type_TYPE_BYTES _ =
483− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.bytes"
484− go FieldDescriptorProto_Type_TYPE_UINT32 _ =
485− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.uint32"
486− go FieldDescriptorProto_Type_TYPE_ENUM _ =
487− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Runtime.putEnum"
488− go FieldDescriptorProto_Type_TYPE_SFIXED32 _ =
489− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.sfixed32"
490− go FieldDescriptorProto_Type_TYPE_SFIXED64 _ =
491− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.sfixed64"
492− go FieldDescriptorProto_Type_TYPE_SINT32 _ =
493− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.sint32"
494− go FieldDescriptorProto_Type_TYPE_SINT64 _ =
495− " Maybe.Just (" <> mkTypeName (nameSpace <> [oname,name'])<> " x) -> Runtime.putOptional " <> show fnumber <> " (Maybe.Just x) Encode.sint64"
496− go _ _ = "" -- error maybe its a TYPE_GROUP?
497− genOneofFieldPut _ = "" -- error not enough information
498− genOneofPut _ _ _ _ = Nothing -- error no name
499−
500−
501−
502− genFieldPut :: NameSpace -> FieldDescriptorProto -> Maybe String
503− genFieldPut nameSpace (FieldDescriptorProto
504− { name: Just name'
505− , number: Just fnumber
506− , label: Just flabel
507− , type: Just ftype
508− , type_name
509− , oneof_index: Nothing -- must not be a member of a oneof, that case handled seperately
510− }) = Just $ go flabel ftype type_name
511− where
512− fname = decapitalize name'
513− -- For repeated fields of primitive numeric types, always put the packed
514− -- encoding.
515− -- https://developers.google.com/protocol-buffers/docs/encoding?hl=en#packed
516− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_DOUBLE _ =
517− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.double'"
518− go _ FieldDescriptorProto_Type_TYPE_DOUBLE _ =
519− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.double"
520− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FLOAT _ =
521− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.float'"
522− go _ FieldDescriptorProto_Type_TYPE_FLOAT _ =
523− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.float"
524− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT64 _ =
525− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.int64'"
526− go _ FieldDescriptorProto_Type_TYPE_INT64 _ =
527− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.int64"
528− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT64 _ =
529− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.uint64'"
530− go _ FieldDescriptorProto_Type_TYPE_UINT64 _ =
531− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.uint64"
532− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT32 _ =
533− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.int32'"
534− go _ FieldDescriptorProto_Type_TYPE_INT32 _ =
535− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.int32"
536− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED64 _ =
537− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.fixed64'"
538− go _ FieldDescriptorProto_Type_TYPE_FIXED64 _ =
539− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.fixed64"
540− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED32 _ =
541− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.fixed32'"
542− go _ FieldDescriptorProto_Type_TYPE_FIXED32 _ =
543− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.fixed32"
544− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BOOL _ =
545− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.bool'"
546− go _ FieldDescriptorProto_Type_TYPE_BOOL _ =
547− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.bool"
548− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_STRING _ =
549− " Runtime.putRepeated " <> show fnumber <> " r." <> fname <> " Encode.string"
550− go _ FieldDescriptorProto_Type_TYPE_STRING _ =
551− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.string"
552− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) =
553− " Runtime.putRepeated " <> show fnumber <> " r." <> fname <> " $ Runtime.putLenDel " <> mkFieldType "put" tname
554− go _ FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) =
555− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " $ Runtime.putLenDel " <> mkFieldType "put" tname
556− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BYTES _ =
557− " Runtime.putRepeated " <> show fnumber <> " r." <> fname <> " $ Encode.bytes"
558− go _ FieldDescriptorProto_Type_TYPE_BYTES _ =
559− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.bytes"
560− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT32 _ =
561− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.uint32'"
562− go _ FieldDescriptorProto_Type_TYPE_UINT32 _ =
563− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.uint32"
564− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_ENUM _ =
565− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Runtime.putEnum'"
566− go _ FieldDescriptorProto_Type_TYPE_ENUM _ =
567− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Runtime.putEnum"
568− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED32 _ =
569− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.sfixed32'"
570− go _ FieldDescriptorProto_Type_TYPE_SFIXED32 _ =
571− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.sfixed32"
572− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED64 _ =
573− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.sfixed64'"
574− go _ FieldDescriptorProto_Type_TYPE_SFIXED64 _ =
575− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.sfixed64"
576− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT32 _ =
577− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.sint32'"
578− go _ FieldDescriptorProto_Type_TYPE_SINT32 _ =
579− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.sint32"
580− go FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT64 _ =
581− " Runtime.putPacked " <> show fnumber <> " r." <> fname <> " Encode.sint64'"
582− go _ FieldDescriptorProto_Type_TYPE_SINT64 _ =
583− " Runtime.putOptional " <> show fnumber <> " r." <> fname <> " Encode.sint64"
584− go _ _ _ = "" -- error, maybe its a TYPE_GROUP
585− genFieldPut _ _ = Nothing -- it's a oneof, or error not enough information
586−
587− genFieldParser :: NameSpace -> Array OneofDescriptorProto -> FieldDescriptorProto -> String
588− genFieldParser nameSpace oneof_decl (FieldDescriptorProto
589− { name: Just name'
590− , number: Just fnumber
591− , label: Just flabel
592− , type: Just ftype
593− , type_name
594− , oneof_index
595− }) = go (lookupOneof oneof_index) flabel ftype type_name
596− where
597− lookupOneof :: Maybe Int -> Maybe String
598− lookupOneof Nothing = Nothing
599− lookupOneof (Just i) =
600− case Array.index oneof_decl i of
601− Just (OneofDescriptorProto {name}) -> name
602− _-> Nothing
603−
604− fname = decapitalize name'
605− mkConstructor oname = mkTypeName (nameSpace <> [oname,name'])
606−
607− -- For repeated fields of primitive numeric types, also parse the packed
608− -- encoding.
609− -- https://developers.google.com/protocol-buffers/docs/encoding?hl=en#packed
610− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_DOUBLE _ = String.joinWith "\n"
611− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
612− , " x <- Decode.double"
613− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
614− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
615− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.double"
616− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
617− ]
618− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FLOAT _ = String.joinWith "\n"
619− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
620− , " x <- Decode.float"
621− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
622− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
623− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.float"
624− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
625− ]
626− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT64 _ = String.joinWith "\n"
627− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
628− , " x <- Decode.int64"
629− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
630− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
631− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.int64"
632− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
633− ]
634− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT64 _ = String.joinWith "\n"
635− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
636− , " x <- Decode.uint64"
637− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
638− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
639− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.uint64"
640− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
641− ]
642− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT32 _ = String.joinWith "\n"
643− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
644− , " x <- Decode.int32"
645− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
646− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
647− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.int32"
648− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
649− ]
650− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED64 _ = String.joinWith "\n"
651− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
652− , " x <- Decode.fixed64"
653− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
654− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
655− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.fixed64"
656− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
657− ]
658− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED32 _ = String.joinWith "\n"
659− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
660− , " x <- Decode.fixed32"
661− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
662− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
663− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.fixed32"
664− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
665− ]
666− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BOOL _ = String.joinWith "\n"
667− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
668− , " x <- Decode.bool"
669− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
670− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
671− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.bool"
672− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
673− ]
674− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_STRING _ = String.joinWith "\n"
675− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
676− , " x <- Decode.string"
677− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
678− ]
679− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = String.joinWith "\n"
680− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
681− , " x <- Runtime.parseLenDel " <> mkFieldType "parse" tname
682− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
683− ]
684− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BYTES _ = String.joinWith "\n"
685− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
686− , " x <- Decode.bytes"
687− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
688− ]
689− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT32 _ = String.joinWith "\n"
690− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
691− , " x <- Decode.uint32"
692− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
693− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
694− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.uint32"
695− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
696− ]
697− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_ENUM _ = String.joinWith "\n"
698− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
699− , " x <- Runtime.parseEnum"
700− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
701− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
702− , " x <- Runtime.parseLenDel $ Runtime.manyLength Runtime.parseEnum"
703− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
704− ]
705− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED32 _ = String.joinWith "\n"
706− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
707− , " x <- Decode.sfixed32"
708− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
709− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
710− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.sfixed32"
711− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
712− ]
713− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED64 _ = String.joinWith "\n"
714− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
715− , " x <- Decode.sfixed64"
716− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
717− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
718− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.sfixed64"
719− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
720− ]
721− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT32 _ = String.joinWith "\n"
722− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
723− , " x <- Decode.sint32"
724− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
725− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
726− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.sint32"
727− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
728− ]
729− go _ FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT64 _ = String.joinWith "\n"
730− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
731− , " x <- Decode.sint64"
732− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Array.snoc x"
733− , " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
734− , " x <- Runtime.parseLenDel $ Runtime.manyLength Decode.sint64"
735− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.flip Semigroup.append x"
736− ]
737−
738− go (Just oname) _ FieldDescriptorProto_Type_TYPE_DOUBLE _ = String.joinWith "\n"
739− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
740− , " x <- Decode.double"
741− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
742− ]
743− go (Just oname) _ FieldDescriptorProto_Type_TYPE_FLOAT _ = String.joinWith "\n"
744− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
745− , " x <- Decode.float"
746− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
747− ]
748− go (Just oname) _ FieldDescriptorProto_Type_TYPE_INT64 _ = String.joinWith "\n"
749− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
750− , " x <- Decode.int64"
751− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
752− ]
753− go (Just oname) _ FieldDescriptorProto_Type_TYPE_UINT64 _ = String.joinWith "\n"
754− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
755− , " x <- Decode.uint64"
756− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
757− ]
758− go (Just oname) _ FieldDescriptorProto_Type_TYPE_INT32 _ = String.joinWith "\n"
759− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
760− , " x <- Decode.int32"
761− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
762− ]
763− go (Just oname) _ FieldDescriptorProto_Type_TYPE_FIXED64 _ = String.joinWith "\n"
764− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
765− , " x <- Decode.fixed64"
766− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
767− ]
768− go (Just oname) _ FieldDescriptorProto_Type_TYPE_FIXED32 _ = String.joinWith "\n"
769− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
770− , " x <- Decode.fixed32"
771− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
772− ]
773− go (Just oname) _ FieldDescriptorProto_Type_TYPE_BOOL _ = String.joinWith "\n"
774− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
775− , " x <- Decode.bool"
776− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
777− ]
778− go (Just oname) _ FieldDescriptorProto_Type_TYPE_STRING _ = String.joinWith "\n"
779− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
780− , " x <- Decode.string"
781− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
782− ]
783− go (Just oname) _ FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = String.joinWith "\n"
784− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
785− , " x <- Runtime.parseLenDel " <> mkFieldType "parse" tname
786− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
787− ]
788− go (Just oname) _ FieldDescriptorProto_Type_TYPE_BYTES _ = String.joinWith "\n"
789− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
790− , " x <- Decode.bytes"
791− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
792− ]
793− go (Just oname) _ FieldDescriptorProto_Type_TYPE_UINT32 _ = String.joinWith "\n"
794− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
795− , " x <- Decode.uint32"
796− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
797− ]
798− go (Just oname) _ FieldDescriptorProto_Type_TYPE_ENUM _ = String.joinWith "\n"
799− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
800− , " x <- Runtime.parseEnum"
801− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
802− ]
803− go (Just oname) _ FieldDescriptorProto_Type_TYPE_SFIXED32 _ = String.joinWith "\n"
804− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
805− , " x <- Decode.sfixed32"
806− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
807− ]
808− go (Just oname) _ FieldDescriptorProto_Type_TYPE_SFIXED64 _ = String.joinWith "\n"
809− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
810− , " x <- Decode.sfixed64"
811− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
812− ]
813− go (Just oname) _ FieldDescriptorProto_Type_TYPE_SINT32 _ = String.joinWith "\n"
814− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
815− , " x <- Decode.sint32"
816− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
817− ]
818− go (Just oname) _ FieldDescriptorProto_Type_TYPE_SINT64 _ = String.joinWith "\n"
819− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
820− , " x <- Decode.sint64"
821− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> decapitalize oname <> "\") $ Function.const $ Maybe.Just (" <> mkConstructor oname <> " x)"
822− ]
823−
824− go _ _ FieldDescriptorProto_Type_TYPE_DOUBLE _ = String.joinWith "\n"
825− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
826− , " x <- Decode.double"
827− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
828− ]
829− go _ _ FieldDescriptorProto_Type_TYPE_FLOAT _ = String.joinWith "\n"
830− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
831− , " x <- Decode.float"
832− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
833− ]
834− go _ _ FieldDescriptorProto_Type_TYPE_INT64 _ = String.joinWith "\n"
835− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
836− , " x <- Decode.int64"
837− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
838− ]
839− go _ _ FieldDescriptorProto_Type_TYPE_UINT64 _ = String.joinWith "\n"
840− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
841− , " x <- Decode.uint64"
842− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
843− ]
844− go _ _ FieldDescriptorProto_Type_TYPE_INT32 _ = String.joinWith "\n"
845− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
846− , " x <- Decode.int32"
847− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
848− ]
849− go _ _ FieldDescriptorProto_Type_TYPE_FIXED64 _ = String.joinWith "\n"
850− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
851− , " x <- Decode.fixed64"
852− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
853− ]
854− go _ _ FieldDescriptorProto_Type_TYPE_FIXED32 _ = String.joinWith "\n"
855− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
856− , " x <- Decode.fixed32"
857− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
858− ]
859− go _ _ FieldDescriptorProto_Type_TYPE_BOOL _ = String.joinWith "\n"
860− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
861− , " x <- Decode.bool"
862− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
863− ]
864− go _ _ FieldDescriptorProto_Type_TYPE_STRING _ = String.joinWith "\n"
865− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
866− , " x <- Decode.string"
867− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
868− ]
869− go _ _ FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = String.joinWith "\n"
870− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
871− , " x <- Runtime.parseLenDel " <> mkFieldType "parse" tname
872− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
873− ]
874− go _ _ FieldDescriptorProto_Type_TYPE_BYTES _ = String.joinWith "\n"
875− [ " parseField " <> show fnumber <> " Common.LenDel = Runtime.label \"" <> name' <> " / \" $ do"
876− , " x <- Decode.bytes"
877− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
878− ]
879− go _ _ FieldDescriptorProto_Type_TYPE_UINT32 _ = String.joinWith "\n"
880− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
881− , " x <- Decode.uint32"
882− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
883− ]
884− go _ _ FieldDescriptorProto_Type_TYPE_ENUM _ = String.joinWith "\n"
885− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
886− , " x <- Runtime.parseEnum"
887− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
888− ]
889− go _ _ FieldDescriptorProto_Type_TYPE_SFIXED32 _ = String.joinWith "\n"
890− [ " parseField " <> show fnumber <> " Common.Bits32 = Runtime.label \"" <> name' <> " / \" $ do"
891− , " x <- Decode.sfixed32"
892− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
893− ]
894− go _ _ FieldDescriptorProto_Type_TYPE_SFIXED64 _ = String.joinWith "\n"
895− [ " parseField " <> show fnumber <> " Common.Bits64 = Runtime.label \"" <> name' <> " / \" $ do"
896− , " x <- Decode.sfixed64"
897− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
898− ]
899− go _ _ FieldDescriptorProto_Type_TYPE_SINT32 _ = String.joinWith "\n"
900− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
901− , " x <- Decode.sint32"
902− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
903− ]
904− go _ _ FieldDescriptorProto_Type_TYPE_SINT64 _ = String.joinWith "\n"
905− [ " parseField " <> show fnumber <> " Common.VarInt = Runtime.label \"" <> name' <> " / \" $ do"
906− , " x <- Decode.sint64"
907− , " pure $ Record.Builder.modify (Symbol.SProxy :: Symbol.SProxy \"" <> fname <> "\") $ Function.const $ Maybe.Just x"
908− ]
909− go _ _ _ _ = "" -- error, maybe its a TYPE_GROUP
910− genFieldParser _ _ _ = "" -- error, not enough information
911−
912− -- | For embedded message fields, the parser merges multiple instances of the same field,
913− -- | https://developers.google.com/protocol-buffers/docs/encoding?hl=en#optional
914− genFieldRecord :: NameSpace -> FieldDescriptorProto -> Maybe String
915− genFieldRecord nameSpace (FieldDescriptorProto
916− { name: Just name'
917− , number: Just fnumber
918− , label: Just flabel
919− , type: Just ftype
920− , type_name
921− , oneof_index
922− }) = (\x -> fname <> " :: " <> x) <$> ptype oneof_index flabel ftype type_name
923− where
924− fname = decapitalize name'
925− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_DOUBLE _ = Just "Array Number"
926− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FLOAT _ = Just "Array Float32.Float32"
927− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT64 _ = Just "Array (Long.Long Long.Signed)"
928− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT64 _ = Just "Array (Long.Long Long.Unsigned)"
929− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_INT32 _ = Just "Array Int"
930− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED64 _ = Just "Array (Long.Long Long.Unsigned)"
931− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_FIXED32 _ = Just "Array UInt.UInt"
932− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BOOL _ = Just "Array Boolean"
933− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_STRING _ = Just "Array String"
934− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = Just $ "Array " <> mkFieldType "" tname
935− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_BYTES _ = Just "Array Common.Bytes"
936− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_UINT32 _ = Just "Array UInt.UInt"
937− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_ENUM (Just tname) = Just $"Array " <> mkFieldType "" tname
938− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED32 _ = Just "Array Int"
939− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SFIXED64 _ = Just "Array (Long.Long Long.Signed)"
940− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT32 _ = Just "Array Int"
941− ptype Nothing FieldDescriptorProto_Label_LABEL_REPEATED FieldDescriptorProto_Type_TYPE_SINT64 _ = Just "Array (Long.Long Long.Signed)"
942− ptype Nothing _ FieldDescriptorProto_Type_TYPE_DOUBLE _ = Just "Maybe.Maybe Number"
943− ptype Nothing _ FieldDescriptorProto_Type_TYPE_FLOAT _ = Just "Maybe.Maybe Float32.Float32"
944− ptype Nothing _ FieldDescriptorProto_Type_TYPE_INT64 _ = Just "Maybe.Maybe (Long.Long Long.Signed)"
945− ptype Nothing _ FieldDescriptorProto_Type_TYPE_UINT64 _ = Just "Maybe.Maybe (Long.Long Long.Unsigned)"
946− ptype Nothing _ FieldDescriptorProto_Type_TYPE_INT32 _ = Just "Maybe.Maybe Int"
947− ptype Nothing _ FieldDescriptorProto_Type_TYPE_FIXED64 _ = Just "Maybe.Maybe (Long.Long Long.Unsigned)"
948− ptype Nothing _ FieldDescriptorProto_Type_TYPE_FIXED32 _ = Just "Maybe.Maybe UInt.UInt"
949− ptype Nothing _ FieldDescriptorProto_Type_TYPE_BOOL _ = Just "Maybe.Maybe Boolean"
950− ptype Nothing _ FieldDescriptorProto_Type_TYPE_STRING _ = Just "Maybe.Maybe String"
951− ptype Nothing _ FieldDescriptorProto_Type_TYPE_MESSAGE (Just tname) = Just $ "Maybe.Maybe " <> mkFieldType "" tname
952− ptype Nothing _ FieldDescriptorProto_Type_TYPE_BYTES _ = Just "Maybe.Maybe Common.Bytes"
953− ptype Nothing _ FieldDescriptorProto_Type_TYPE_UINT32 _ = Just "Maybe.Maybe UInt.UInt"
954− ptype Nothing _ FieldDescriptorProto_Type_TYPE_ENUM (Just tname) = Just $ "Maybe.Maybe " <> mkFieldType "" tname
955− ptype Nothing _ FieldDescriptorProto_Type_TYPE_SFIXED32 _ = Just "Maybe.Maybe Int"
956− ptype Nothing _ FieldDescriptorProto_Type_TYPE_SFIXED64 _ = Just "Maybe.Maybe (Long.Long Long.Signed)"
957− ptype Nothing _ FieldDescriptorProto_Type_TYPE_SINT32 _ = Just "Maybe.Maybe Int"
958− ptype Nothing _ FieldDescriptorProto_Type_TYPE_SINT64 _ = Just "Maybe.Maybe (Long.Long Long.Signed)"
959− ptype Nothing _ FieldDescriptorProto_Type_TYPE_GROUP _ = Nothing -- ignore
960− ptype _ _ _ _ = Nothing -- its a Oneof
961− genFieldRecord _ _ = Nothing -- error, not enough information
1014+ genOneofExport (OneofDescriptorProto {name: Just oname}) = Right $ ", " <> mkTypeName (namespace <> [msgName,oname]) <> "(..)"
1015+ genOneofExport _ = Left "Failed genMessageExport missing OneofDescriptorProto name" -- error, no oname
1016+ genMessageExport _ = Left "Failed genMessageExport missing DescriptorProto name" -- error, no name
9621017
1018+ -- https://developers.google.com/protocol-buffers/docs/proto3#oneof_features
1019+ -- “A oneof cannot be repeated.”
1020+ genFieldDefaultOneof :: OneofDescriptorProto -> Resp String
1021+ genFieldDefaultOneof (OneofDescriptorProto {name: Just fname}) = Right $
1022+ decapitalize fname <> ": Maybe.Nothing"
1023+ genFieldDefaultOneof _ = Left "Failed genFieldDefaultOneof missing name"
9631024
9641025 -- https://developers.google.com/protocol-buffers/docs/proto3#oneof_features
9651026 -- “A oneof cannot be repeated.”
966− genFieldRecordOneof :: NameSpace -> OneofDescriptorProto -> String
967− genFieldRecordOneof nameSpace (OneofDescriptorProto {name: Just fname}) =
1027+ genFieldRecordOneof :: NameSpace -> OneofDescriptorProto -> Resp String
1028+ genFieldRecordOneof nameSpace (OneofDescriptorProto {name: Just fname}) = Right $
9681029 decapitalize fname <> " :: Maybe.Maybe " <> (String.joinWith "_" $ map capitalize $ nameSpace <> [fname])
969− genFieldRecordOneof _ _ = "" -- error no name
1030+ genFieldRecordOneof _ _ = Left "Failed genFieldRecordOneof missing OneofDescriptorProto name"
9701031
971− genFieldDefault :: FieldDescriptorProto -> Maybe String
1032+ genFieldDefault :: FieldDescriptorProto -> Resp (Maybe String)
9721033 genFieldDefault (FieldDescriptorProto
9731034 { name: Just name'
9741035 , label: Just flabel
9751036 , oneof_index
976− }) = (\x -> fname <> ": " <> x) <$> dtype oneof_index flabel
1037+ }) = Right $ (\x -> fname <> ": " <> x) <$> dtype oneof_index flabel
9771038 where
9781039 fname = decapitalize name'
9791040 dtype Nothing FieldDescriptorProto_Label_LABEL_REPEATED = Just "[]"
9801041 dtype Nothing _ = Just "Maybe.Nothing"
981− dtype _ _ = Nothing -- it's a Oneof
982− genFieldDefault _ = Nothing -- error, not enough information
983−
984− -- https://developers.google.com/protocol-buffers/docs/proto3#oneof_features
985− -- “A oneof cannot be repeated.”
986− genFieldDefaultOneof :: OneofDescriptorProto -> String
987− genFieldDefaultOneof (OneofDescriptorProto {name: Just fname}) =
988− decapitalize fname <> ": Maybe.Nothing"
989− genFieldDefaultOneof _ = "" -- error no name
990−
991−
992− mkFieldType
993− :: String -- prefix for the name, i.e. "put" "parse"
994− -> String -- package-qualified period-separated field name
995− -> String
996− mkFieldType prefix s =
997− let (ScopedField names name) = parseFieldName s
998− in
999− if names `beginsWith` packageName && (isLocalMessageName name || isLocalEnumName name)
1000− then
1001− -- it's a name in this package
1002− prefix <> (mkTypeName $ Array.drop (Array.length packageName) names <> [name])
1003− else
1004− -- it's a name in the top-level of an imported package
1005− String.joinWith "." $ (map mkModuleName $ names) <> [prefix <> capitalize name]
1006− where
1007− isLocalMessageName :: String -> Boolean
1008− isLocalMessageName fname = maybe false (const true) $
1009− flip Array.find messages $ \(ScopedMsg _ (DescriptorProto {name})) ->
1010− maybe false (fname == _) name
1011− isLocalEnumName :: String -> Boolean
1012− isLocalEnumName ename = maybe false (const true) $
1013− flip Array.find enums $ \(ScopedEnum _(EnumDescriptorProto {name})) ->
1014− maybe false (ename == _) name
1015− parseFieldName :: String -> ScopedField
1016− parseFieldName fname =
1017− if String.take 1 fname == "."
1018− then
1019− -- fully qualified
1020− let names = Array.dropWhile (_ == "") $ String.split (String.Pattern.Pattern ".") fname
1021− in
1022− ScopedField (Array.dropEnd 1 names) (fromMaybe "" $ Array.last names)
1023− else
1024− ScopedField [] fname -- this case should never occur, protoc always qualifies the names for us
1025− beginsWith :: Array String -> Array String -> Boolean
1026− beginsWith xs x = x == Array.take (Array.length x) xs
1027−
1028− mkTypeName :: Array String -> String
1029− mkTypeName ns = String.joinWith "_" $ map capitalize ns
1042+ dtype (Just _) _ = Nothing -- It's a Oneof so skip it, this case it handled separately.
1043+ genFieldDefault _ = Left "Failed genFieldDefault missing FieldDescriptorProto name or label"
10301044