git.iko.soy/streamly
on master help sign in
Implement deriveSerialize using deriveSerializeWith
commit7d50e5e03ee139588378f893b79bb6757e0ae9fa authorHarendra Kumar <harendra@composewell.com> dateWed 22 Nov 2023, 00:07 (3 years ago) parent1d89961
4 files changed+27−49
compare with master
unifiedsplit
benchmark/Streamly/Benchmark/Data/Serialize.hs+8−8 benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs+1−1 core/src/Streamly/Internal/Data/Serialize/TH.hs+9−34 test/Streamly/Test/Data/Unbox.hs+9−6
benchmark/Streamly/Benchmark/Data/Serialize.hs+8−8
@@ -42,12 +42,12 @@ import Streamly.Benchmark.Data.Serialize.RecNonCompatible
4242
4343#ifdef USE_UNBOX
4444#define SERIALIZE_CLASS Unbox
45−#define DERIVE_CLASS deriveUnbox
45+#define DERIVE_CLASS(typ) $(deriveUnbox ''typ)
4646#define SERIALIZE_OP pokeByteIndex
4747#define DESERIALIZE_OP peekByteIndex
4848#else
4949#define SERIALIZE_CLASS Serialize
50−#define DERIVE_CLASS deriveSerialize
50+#define DERIVE_CLASS(typ) $(deriveSerialize [d|instance Serialize typ|])
5151#define SERIALIZE_OP serialize
5252#define DESERIALIZE_OP deserialize
5353#endif
@@ -62,7 +62,7 @@ data Unit = Unit
6262#ifndef USE_TH
6363instance SERIALIZE_CLASS Unit
6464#else
65−$(DERIVE_CLASS ''Unit)
65+DERIVE_CLASS(Unit)
6666#endif
6767
6868instance NFData Unit where
@@ -77,7 +77,7 @@ data Sum2
7777#ifndef USE_TH
7878instance SERIALIZE_CLASS Sum2
7979#else
80−$(DERIVE_CLASS ''Sum2)
80+DERIVE_CLASS(Sum2)
8181#endif
8282
8383instance NFData Sum2 where
@@ -115,7 +115,7 @@ data Sum25
115115#ifndef USE_TH
116116instance SERIALIZE_CLASS Sum25
117117#else
118−$(DERIVE_CLASS ''Sum25)
118+DERIVE_CLASS(Sum25)
119119#endif
120120
121121instance NFData Sum25 where
@@ -154,7 +154,7 @@ data Product25
154154#ifndef USE_TH
155155instance SERIALIZE_CLASS Product25
156156#else
157−$(DERIVE_CLASS ''Product25)
157+DERIVE_CLASS(Product25)
158158#endif
159159
160160instance NFData Product25 where
@@ -234,7 +234,7 @@ data CustomDT1
234234#ifndef USE_TH
235235instance SERIALIZE_CLASS CustomDT1
236236#else
237−$(DERIVE_CLASS ''CustomDT1)
237+DERIVE_CLASS(CustomDT1)
238238#endif
239239
240240instance NFData CustomDT1 where
@@ -257,7 +257,7 @@ data BinTree a
257257#ifndef USE_TH
258258instance Serialize (BinTree a)
259259#else
260−$(deriveSerialize ''BinTree)
260+$(deriveSerialize [d|instance Serialize a => Serialize (BinTree a)|])
261261#endif
262262
263263instance NFData a => NFData (BinTree a) where
benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs+1−1
@@ -18,4 +18,4 @@ import qualified Streamly.Internal.Data.Serialize as Serialize
1818--------------------------------------------------------------------------------
1919
2020$(genLargeRecord "RecNonCompatible" 50)
21−$(Serialize.deriveSerialize ''RecNonCompatible)
21+$(Serialize.deriveSerialize [d|instance Serialize.Serialize RecNonCompatible|])
core/src/Streamly/Internal/Data/Serialize/TH.hs+9−34
@@ -36,7 +36,6 @@ import Streamly.Internal.Data.Serialize.Type
3636import Streamly.Internal.Data.Unbox.TH
3737 ( DataCon(..)
3838 , DataType(..)
39− , appsT
4039 , reifyDataType
4140 )
4241
@@ -454,7 +453,7 @@ deriveSerializeInternal conf headTy cons next = do
454453-- for the given instance are generated according to the supplied @config@
455454-- parameter.
456455--
457−-- For example:
456+-- Usage:
458457--
459458-- @
460459-- \$(deriveSerializeWith
@@ -503,40 +502,16 @@ deriveSerializeWith conf mDecs = do
503502 go (AppT l _) = go l
504503 go _ = errorMessage dec
505504
506−
507−-- | @deriveSerialize dataTypeName@ generates a template Haskell splice
508−-- consisting of a declaration of the 'Serialize' instance for the given
509−-- dataTypeName, all type parameters of dataTypeName are required to have the
510−-- 'Serialize' constraint.
505+-- | Given a 'Serialize' instance declaration splice without the methods,
506+-- generate a full instance declaration including all the type class methods.
511507--
512−-- For example,
508+-- >>> deriveSerialize = deriveSerializeWith defaultConfig
513509--
514−-- @
515−-- data CustomDataType a b c = ...
516−-- \$(deriveSerialize ''CustomDataType)
517−-- @
518−--
519−-- Generates the following code:
510+-- Usage:
520511--
521512-- @
522−-- instance (Serialize a, Serialize b, Serialize c) => Serialize (CustomDataType a b c) where
523−-- ...
513+-- \$(deriveSerialize
514+-- [d|instance Serialize a => Serialize (Maybe a)|])
524515-- @
525−--
526−-- To control which type parameters get the Serialize constraint, use
527−-- 'deriveSerializeWith'.
528−deriveSerialize :: Name -> Q [Dec]
529−deriveSerialize name = do
530− dt <- reifyDataType name
531− let preds = map (unboxPred . VarT) (dtTvs dt)
532− headTy = appsT (ConT name) (map VarT (dtTvs dt))
533− cons = dtCons dt
534− deriveSerializeInternal defaultConfig headTy cons (next preds headTy)
535−
536−
537− where
538−
539− next preds headTy methods =
540− pure [InstanceD Nothing preds (AppT (ConT ''Serialize) headTy) methods]
541−
542− unboxPred ty = AppT (ConT ''Serialize) ty
516+deriveSerialize :: Q [Dec] -> Q [Dec]
517+deriveSerialize = deriveSerializeWith defaultConfig
test/Streamly/Test/Data/Unbox.hs+9−6
@@ -41,7 +41,7 @@ import Test.Hspec as H
4141#ifdef USE_SERIALIZE
4242
4343#define MODULE_NAME "Data.Serialize.Deriving.TH"
44−#define DERIVE_UNBOX(typ) $(Serialize.deriveSerialize ''typ)
44+#define DERIVE_UNBOX(typ) $(Serialize.deriveSerialize [d|instance Serialize typ|])
4545#define PEEK(i, arr, sz) (deserialize i arr sz)
4646#define POKE(i, arr, val) (serialize i arr val)
4747#define TYPE_CLASS Serialize
@@ -168,12 +168,15 @@ DERIVE_UNBOX(NestedSOP)
168168deriving instance Generic (Ratio Int)
169169
170170#if defined(USE_SERIALIZE)
171−$(Serialize.deriveSerialize ''Complex)
172−$(Serialize.deriveSerialize ''Ratio)
171+$(Serialize.deriveSerialize
172+ [d|instance Serialize a => Serialize (Complex a)|])
173+$(Serialize.deriveSerialize
174+ [d|instance Serialize a => Serialize (Ratio a)|])
173175$(Serialize.deriveSerializeWith
174− Serialize.defaultConfig
175− [d|instance Serialize a => Serialize (Const a b)|])
176−$(Serialize.deriveSerialize ''Identity)
176+ Serialize.defaultConfig
177+ [d|instance Serialize a => Serialize (Const a b)|])
178+$(Serialize.deriveSerialize
179+ [d|instance Serialize a => Serialize (Identity a)|])
177180#endif
178181
179182--------------------------------------------------------------------------------