@@ -83,6 +83,12 @@ import Streamly.Internal.Data.Serialize.TH.Common
8383-- parse the value.
8484-- * Construct @T@ after parsing all the data.
8585
86+-- Developer Notes
87+-- ===============
88+--
89+-- * Record update syntax is not robust across language extensions and common
90+-- record plugins (like record-dot-processor, large-records, etc.).
91+
8692--------------------------------------------------------------------------------
8793-- Compact lists
8894--------------------------------------------------------------------------------
@@ -255,9 +261,9 @@ deserializeWithSize ::
255261 Serialize a => Int -> MutableByteArray -> Int -> IO (Int, a)
256262deserializeWithSize off arr endOff = deserialize (off + 4) arr endOff
257263
258−conUpdateFuncDec :: Name -> Type -> [Field] -> Q [Dec]
259−conUpdateFuncDec funcName headTy fields = do
260− prevRec <- newName "prevRec"
264+conUpdateFuncDec :: Name -> [Field] -> Q [Dec]
265+conUpdateFuncDec funcName fields = do
266+ prevAcc <- newName "prevAcc"
261267 curOff <- newName "curOff"
262268 endOff <- newName "endOff"
263269 arr <- newName "arr"
@@ -266,7 +272,7 @@ conUpdateFuncDec funcName headTy fields = do
266272 (caseE
267273 (varE key)
268274 (concat
269− [ map (matchField arr endOff (prevRec, curOff)) fnames
275+ [ map (matchField arr endOff (prevAcc, curOff)) fnames
270276 , [ match
271277 wildP
272278 (normalB
@@ -276,7 +282,7 @@ conUpdateFuncDec funcName headTy fields = do
276282 $(varE arr)
277283 $(varE endOff)
278284 pure
279− ( $(varE prevRec)
285+ ( $(varE prevAcc)
280286 , valOff + w32_int valLen)|])
281287 []
282288 ]
@@ -288,7 +294,7 @@ conUpdateFuncDec funcName headTy fields = do
288294 [ Clause
289295 [ VarP arr
290296 , VarP endOff
291− , TupP [VarP prevRec, VarP curOff]
297+ , TupP [VarP prevAcc, VarP curOff]
292298 , VarP key
293299 ]
294300 (NormalB method)
@@ -300,21 +306,19 @@ conUpdateFuncDec funcName headTy fields = do
300306
301307 fnames = fmap (fromJust . fst) fields
302308 matchField :: Name -> Name -> (Name, Name) -> Name -> Q Match
303− matchField arr endOff (prevRec, currOff) fname = do
304− val <- newName "val"
305− newOff <- newName "newOff"
309+ matchField arr endOff (acc, currOff) fname = do
310+ let fnameLit = StringL (nameBase fname)
306311 match
307− (litP (StringL (nameBase fname)))
312+ (litP fnameLit)
308313 (normalB
309− [|do ($(varP newOff), $(varP val)) <-
310− deserializeWithSize
311− $(varE currOff)
312− $(varE arr)
313− $(varE endOff)
314+ [|do (valOff, valLen :: Word32) <-
315+ deserialize
316+ $(varE currOff)
317+ $(varE arr)
318+ $(varE endOff)
314319 pure
315− ( $(recUpdE (varE prevRec) [pure (fname, VarE val)])
316− :: $(pure headTy)
317− , $(varE newOff))|])
320+ ( ($(litE fnameLit), $(varE currOff)) : $(varE acc)
321+ , valOff + w32_int valLen)|])
318322 []
319323
320324mkDeserializeKeysDec :: Name -> Name -> SimpleDataCon -> Q [Dec]
@@ -323,16 +327,33 @@ mkDeserializeKeysDec funcName updateFunc (SimpleDataCon cname fields) = do
323327 finalOff <- newName "finalOff"
324328 arr <- newName "arr"
325329 endOff <- newName "endOff"
330+ kvEncoded <- newName "kvEncoded"
331+ finalRec <- newName "finalRec"
332+ let deserializeFieldExpr (Just name, ty) = do
333+ let nameLit = litE (StringL (nameBase name))
334+ [|case lookup $(nameLit) $(varE kvEncoded) of
335+ Nothing -> $(emptyTy name ty)
336+ Just off -> do
337+ val <- deserializeWithSize off $(varE arr) $(varE endOff)
338+ pure $ snd val|]
339+ deserializeFieldExpr _ = errorUnsupported
326340 method <-
327341 [|do (dataOff, hlist :: CompactList (CompactList Word8)) <-
328342 deserialize $(varE hOff) $(varE arr) $(varE endOff)
329343 let keys = wListToString . unCompactList <$> unCompactList hlist
330− (finalRec, _) <-
344+ ($(varP kvEncoded), _) <-
331345 foldlM
332346 ($(varE updateFunc) $(varE arr) $(varE endOff))
333− ($(emptyConExpr), dataOff)
347+ ([], dataOff)
334348 keys
335− pure ($(varE finalOff), finalRec)|]
349+ $(varP finalRec) <-
350+ $(foldl
351+ (\acc i ->
352+ [|$(acc) <*>
353+ $(deserializeFieldExpr i)|])
354+ [|pure $(conE cname)|]
355+ fields)
356+ pure ($(varE finalOff), $(varE finalRec))|]
336357 pure
337358 [ PragmaD (InlineP funcName NoInline FunLike AllPhases)
338359 , FunD
@@ -352,11 +373,9 @@ mkDeserializeKeysDec funcName updateFunc (SimpleDataCon cname fields) = do
352373
353374 emptyTy k ty =
354375 if isMaybeType ty
355− then [|Nothing|]
376+ then [|pure Nothing|]
356377 else [|error $(litE (StringL (nameBase k ++ " is not found.")))|]
357− fieldToEmptyRecC (Just name, ty) = (name, ) <$> emptyTy name ty
358− fieldToEmptyRecC _ = errorUnsupported
359− emptyConExpr = recConE cname (fmap fieldToEmptyRecC fields)
378+
360379
361380mkDeserializeExpr :: Name -> Name -> Name -> SimpleDataCon -> Q Exp
362381mkDeserializeExpr initialOff endOff deserializeWithKeys con = do