on master help sign in
Make errorUnsupported in Serialize.TH more expressive
bf1dbb7Adithya Kumar
core/src/Streamly/Internal/Data/Serialize/TH.hs+2−2
@@ -444,12 +444,12 @@ deriveSerializeWith conf mDecs = do
444 dt <- reifyDataType (getMainTypeName dec headTy)
444 dt <- reifyDataType (getMainTypeName dec headTy)
445 let cons = dtCons dt
445 let cons = dtCons dt
446 deriveSerializeInternal conf headTy cons (next inst)
446 deriveSerializeInternal conf headTy cons (next inst)
447− _ -> errorUnsupported
447+ _ -> errorUnsupported (errorMessage dec)
448 where
448 where
449
449
450 next (InstanceD mo preds headTyWC []) methods =
450 next (InstanceD mo preds headTyWC []) methods =
451 pure [InstanceD mo preds headTyWC methods]
451 pure [InstanceD mo preds headTyWC methods]
452− next _ _ = errorUnsupported
452+ next dec _ = errorUnsupported (errorMessage dec)
453
453
454 errorMessage dec =
454 errorMessage dec =
455 error $ unlines
455 error $ unlines
core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs+10−4
@@ -355,20 +355,26 @@ litProxy = litE . IntegerL . fromIntegral . Unbox.sizeOf
355-- Error codes
355-- Error codes
356--------------------------------------------------------------------------------
356--------------------------------------------------------------------------------
357
357
358−errorUnsupported :: a
358+errorUnsupported :: String -> a
359−errorUnsupported =
359+errorUnsupported err =
360 error
360 error
361 $ unlines
361 $ unlines
362− [ "Unsupported."
362+ [ "Unsupported"
363+ , "==========="
363 , "There is improper use of the library."
364 , "There is improper use of the library."
364 , "This case is unsupported."
365 , "This case is unsupported."
365 , "Please contact the developer if this case is of interest."
366 , "Please contact the developer if this case is of interest."
367+ , ""
368+ , "Message"
369+ , "-------"
370+ , err
366 ]
371 ]
367
372
368errorUnimplemented :: a
373errorUnimplemented :: a
369errorUnimplemented =
374errorUnimplemented =
370 error
375 error
371 $ unlines
376 $ unlines
372− [ "Unimplemented."
377+ [ "Unimplemented"
378+ , "============="
373 , "Please contact the developer if this case is of interest."
379 , "Please contact the developer if this case is of interest."
374 ]
380 ]
core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs+6−2
@@ -203,13 +203,16 @@ headerValue (SimpleDataCon _ fields) =
203 in if lenFields <= 255
203 in if lenFields <= 255
204 then lenFields
204 then lenFields
205 else errorUnsupported
205 else errorUnsupported
206+ "Number of fields in the record should be <= 255."
206 lengthPrependedFieldEncoding field =
207 lengthPrependedFieldEncoding field =
207 let fEnc =
208 let fEnc =
208 let fEnc_ = map c2w (fieldToNameBase field)
209 let fEnc_ = map c2w (fieldToNameBase field)
209 lenFEnc = length fEnc_
210 lenFEnc = length fEnc_
210 in if lenFEnc <= 255
211 in if lenFEnc <= 255
211 then fEnc_
212 then fEnc_
213+ else
212− else errorUnsupported
214+ errorUnsupported
215+ "Length of any key should be <= 255."
213 in (int_w8 (length fEnc)) : fEnc
216 in (int_w8 (length fEnc)) : fEnc
214
217
215--------------------------------------------------------------------------------
218--------------------------------------------------------------------------------
@@ -336,7 +339,8 @@ mkDeserializeKeysDec funcName updateFunc (SimpleDataCon cname fields) = do
336 Just off -> do
339 Just off -> do
337 val <- deserializeWithSize off $(varE arr) $(varE endOff)
340 val <- deserializeWithSize off $(varE arr) $(varE endOff)
338 pure $ snd val|]
341 pure $ snd val|]
339− deserializeFieldExpr _ = errorUnsupported
342+ deserializeFieldExpr _ =
343+ errorUnsupported "The datatype should use record syntax."
340 method <-
344 method <-
341 [|do (dataOff, hlist :: CompactList (CompactList Word8)) <-
345 [|do (dataOff, hlist :: CompactList (CompactList Word8)) <-
342 deserialize $(varE hOff) $(varE arr) $(varE endOff)
346 deserialize $(varE hOff) $(varE arr) $(varE endOff)