@@ -19,7 +19,7 @@ module ProtocPlugin.Main (main) where
1919
2020import Prelude
2121
22−import Data.Array (catMaybes, concatMap)
22+import Data.Array (catMaybes, concatMap, filter)
2323import Data.Array as Array
2424import Data.ArrayBuffer.Builder (execPut)
2525import Data.ArrayBuffer.DataView as DV
@@ -31,6 +31,7 @@ import Data.String.Pattern as String.Pattern
3131import Data.String.Regex as String.Regex
3232import Data.String.Regex.Flags as String.Regex.Flags
3333import Data.Traversable (sequence, traverse)
34+import Data.TraversableWithIndex (traverseWithIndex)
3435import Effect (Effect)
3536import Google.Protobuf.Compiler.Plugin (CodeGeneratorRequest(..), CodeGeneratorResponse(..), CodeGeneratorResponse_File(..), parseCodeGeneratorRequest, putCodeGeneratorResponse)
3637import Google.Protobuf.Descriptor (DescriptorProto(..), EnumDescriptorProto(..), EnumValueDescriptorProto(..), FieldDescriptorProto(..), FieldDescriptorProto_Label(..), FieldDescriptorProto_Type(..), FileDescriptorProto(..), OneofDescriptorProto(..))
@@ -186,6 +187,7 @@ genFile proto_file (FileDescriptorProto
186187 beginsWith xs x = x == Array.take (Array.length x) xs
187188
188189 -- We have an r and we're merging an l.
190+ -- About merging: https://github.com/protocolbuffers/protobuf/blob/master/docs/field_presence.md
189191 let genFieldMerge :: FieldDescriptorProto -> Resp (Maybe String)
190192 genFieldMerge (FieldDescriptorProto
191193 { oneof_index: Just _
@@ -193,7 +195,8 @@ genFile proto_file (FileDescriptorProto
193195 genFieldMerge (FieldDescriptorProto
194196 { name: Just name'
195197 , label: Just FieldDescriptorProto_Label_LABEL_REPEATED
196− }) = Right $ Just $ fname <> ": r." <> fname <> " <> l." <> fname
198+ -- }) = Right $ Just $ fname <> ": r." <> fname <> " <> l." <> fname
199+ }) = Right $ Just $ fname <> ": Runtime.mergeScalar l." <> fname <> " r." <> fname
197200 where fname = decapitalize name'
198201 genFieldMerge (FieldDescriptorProto
199202 { name: Just name'
@@ -218,10 +221,41 @@ genFile proto_file (FileDescriptorProto
218221 { name: Just name'
219222 , label: Just _
220223 , type: Just _
221− }) = Right $ Just $ fname <> ": Alt.alt l." <> fname <> " r." <> fname
224+ -- }) = Right $ Just $ fname <> ": Alt.alt l." <> fname <> " r." <> fname
225+ }) = Right $ Just $ fname <> ": Runtime.mergeScalar l." <> fname <> " r." <> fname
222226 where fname = decapitalize name'
223227 genFieldMerge _ = Left "Failed genFieldDefault missing FieldDescriptorProto name or label"
224228
229+ let genFieldMergeOneof :: Array String -> Array FieldDescriptorProto -> Int -> OneofDescriptorProto -> Resp String
230+ genFieldMergeOneof nameSpace allfields oneof_index (OneofDescriptorProto {name: Just oname}) =
231+ -- Right $ fname <> ": Alt.alt l." <> fname <> " r." <> fname
232+ -- | FieldDescriptorProto_Type_TYPE_MESSAGE
233+ Right $ fname <> ": case Tuple.Tuple l." <> fname <> " r." <> fname <> " of\n"
234+ <> (String.joinWith "\n" (catMaybes $ map genField fields))
235+ -- <> " _ -> Alt.alt l." <> fname <> " r." <> fname
236+ <> " _ -> Runtime.mergeScalar l." <> fname <> " r." <> fname
237+ where
238+ fields = filter ownfield allfields
239+ ownfield (FieldDescriptorProto {oneof_index: Just i}) = i == oneof_index
240+ ownfield _ = false
241+ fname = decapitalize oname
242+ cname = String.joinWith "_" $ map capitalize $ nameSpace <> [oname]
243+ genField :: FieldDescriptorProto -> Maybe String
244+ -- genField (FieldDescriptorProto
245+ -- { type_name: Just tname}) = Just $ tname <> "\n"
246+ -- { type: Just FieldDescriptorProto_Type_TYPE_MESSAGE}) = Just "message"
247+ genField (FieldDescriptorProto
248+ { type: Just FieldDescriptorProto_Type_TYPE_MESSAGE
249+ , name: Just name_inner
250+ , type_name: Just tname
251+ -- }) = Just $ " (Just (" <> fname_inner <> " x)) (Just (" <> fname_inner <> " y)) -> Just $ mergeWith " <> mkFieldType "merge" tname <> " l." <> fname <> " r." <> fname <> "\n"
252+ }) = Just $ " Tuple.Tuple (Maybe.Just (" <> fname_inner <> " l')) (Maybe.Just (" <> fname_inner <> " r')) -> map " <> fname_inner <> " $ Runtime.mergeWith " <> mkFieldType "merge" tname <> " (Maybe.Just l') (Maybe.Just r')\n"
253+ -- Just $ tname <> " " <> show t <> "\n"
254+ where
255+ -- fname_inner = decapitalize name_inner
256+ fname_inner = String.joinWith "_" $ map capitalize [cname,name_inner]
257+ genField _ = Nothing
258+ genFieldMergeOneof _ _ _ _ = Left "Failed genFieldMergeOneof missing name"
225259
226260 let genTypeOneof
227261 :: NameSpace
@@ -888,7 +922,8 @@ genFile proto_file (FileDescriptorProto
888922 <>
889923 (map (String.joinWith "\n , ")
890924 ( (map catMaybes $ traverse genFieldMerge field)
891− <> (traverse genFieldMergeOneof oneof_decl)
925+ -- <> (traverse genFieldMergeOneof oneof_decl)
926+ <> (traverseWithIndex (genFieldMergeOneof (nameSpace <> [msgName]) field) oneof_decl)
892927 <> Right ["__unknown_fields: r.__unknown_fields <> l.__unknown_fields"]
893928 )
894929 )
@@ -932,6 +967,7 @@ import Data.String as String
932967import Data.Symbol as Symbol
933968import Record as Record
934969import Data.Traversable as Traversable
970+import Data.Tuple as Tuple
935971import Data.UInt as UInt
936972import Data.Unit as Unit
937973import Prim.Row as Prim.Row
@@ -1109,8 +1145,8 @@ import Protobuf.Runtime as Runtime
11091145 dtype (Just _) _ = Nothing -- It's a Oneof so skip it, this case it handled separately.
11101146 genFieldDefault _ = Left "Failed genFieldDefault missing FieldDescriptorProto name or label"
11111147
1112− genFieldMergeOneof :: OneofDescriptorProto -> Resp String
1113− genFieldMergeOneof (OneofDescriptorProto {name: Just name'}) = Right $ fname <> ": Alt.alt l." <> fname <> " r." <> fname
1114− where
1115− fname = decapitalize name'
1116− genFieldMergeOneof _ = Left "Failed genFieldMergeOneof missing fields"
1148+ -- genFieldMergeOneof :: OneofDescriptorProto -> Resp String
1149+ -- genFieldMergeOneof (OneofDescriptorProto {name: Just name'}) = Right $ fname <> ": Alt.alt l." <> fname <> " r." <> fname
1150+ -- where
1151+ -- fname = decapitalize name'
1152+ -- genFieldMergeOneof _ = Left "Failed genFieldMergeOneof missing fields"