on master help sign in
Make errorUnsupported in Serialize.TH more expressive
commitbf1dbb714d22f43269765a529eb0c056d4fa2d74 authorAdithya Kumar <adithya@composewell.com> dateFri 22 Sep 2023, 14:51 (3 years ago) parenteaf313d
3 files changed+18−8
core/src/Streamly/Internal/Data/Serialize/TH.hs+2−2 core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs+10−4 core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs+6−2
core/src/Streamly/Internal/Data/Serialize/TH.hs+2−2
@@ -444,12 +444,12 @@ deriveSerializeWith conf mDecs = do
444444 dt <- reifyDataType (getMainTypeName dec headTy)
445445 let cons = dtCons dt
446446 deriveSerializeInternal conf headTy cons (next inst)
447− _ -> errorUnsupported
447+ _ -> errorUnsupported (errorMessage dec)
448448 where
449449
450450 next (InstanceD mo preds headTyWC []) methods =
451451 pure [InstanceD mo preds headTyWC methods]
452− next _ _ = errorUnsupported
452+ next dec _ = errorUnsupported (errorMessage dec)
453453
454454 errorMessage dec =
455455 error $ unlines
core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs+10−4
@@ -355,20 +355,26 @@ litProxy = litE . IntegerL . fromIntegral . Unbox.sizeOf
355355-- Error codes
356356--------------------------------------------------------------------------------
357357
358−errorUnsupported :: a
359−errorUnsupported =
358+errorUnsupported :: String -> a
359+errorUnsupported err =
360360 error
361361 $ unlines
362− [ "Unsupported."
362+ [ "Unsupported"
363+ , "==========="
363364 , "There is improper use of the library."
364365 , "This case is unsupported."
365366 , "Please contact the developer if this case is of interest."
367+ , ""
368+ , "Message"
369+ , "-------"
370+ , err
366371 ]
367372
368373errorUnimplemented :: a
369374errorUnimplemented =
370375 error
371376 $ unlines
372− [ "Unimplemented."
377+ [ "Unimplemented"
378+ , "============="
373379 , "Please contact the developer if this case is of interest."
374380 ]
core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs+6−2
@@ -203,13 +203,16 @@ headerValue (SimpleDataCon _ fields) =
203203 in if lenFields <= 255
204204 then lenFields
205205 else errorUnsupported
206+ "Number of fields in the record should be <= 255."
206207 lengthPrependedFieldEncoding field =
207208 let fEnc =
208209 let fEnc_ = map c2w (fieldToNameBase field)
209210 lenFEnc = length fEnc_
210211 in if lenFEnc <= 255
211212 then fEnc_
212− else errorUnsupported
213+ else
214+ errorUnsupported
215+ "Length of any key should be <= 255."
213216 in (int_w8 (length fEnc)) : fEnc
214217
215218--------------------------------------------------------------------------------
@@ -336,7 +339,8 @@ mkDeserializeKeysDec funcName updateFunc (SimpleDataCon cname fields) = do
336339 Just off -> do
337340 val <- deserializeWithSize off $(varE arr) $(varE endOff)
338341 pure $ snd val|]
339− deserializeFieldExpr _ = errorUnsupported
342+ deserializeFieldExpr _ =
343+ errorUnsupported "The datatype should use record syntax."
340344 method <-
341345 [|do (dataOff, hlist :: CompactList (CompactList Word8)) <-
342346 deserialize $(varE hOff) $(varE arr) $(varE endOff)