git.iko.soy/streamly
on master help sign in
Implement deriveSerialize using deriveSerializeWith
7d50e5eHarendra Kumar
benchmark/Streamly/Benchmark/Data/Serialize.hs+8−8
compare with master
unifiedsplit
@@ -42,12 +42,12 @@ import Streamly.Benchmark.Data.Serialize.RecNonCompatible
42
42
43#ifdef USE_UNBOX
43#ifdef USE_UNBOX
44#define SERIALIZE_CLASS Unbox
44#define SERIALIZE_CLASS Unbox
45−#define DERIVE_CLASS deriveUnbox
45+#define DERIVE_CLASS(typ) $(deriveUnbox ''typ)
46#define SERIALIZE_OP pokeByteIndex
46#define SERIALIZE_OP pokeByteIndex
47#define DESERIALIZE_OP peekByteIndex
47#define DESERIALIZE_OP peekByteIndex
48#else
48#else
49#define SERIALIZE_CLASS Serialize
49#define SERIALIZE_CLASS Serialize
50−#define DERIVE_CLASS deriveSerialize
50+#define DERIVE_CLASS(typ) $(deriveSerialize [d|instance Serialize typ|])
51#define SERIALIZE_OP serialize
51#define SERIALIZE_OP serialize
52#define DESERIALIZE_OP deserialize
52#define DESERIALIZE_OP deserialize
53#endif
53#endif
@@ -62,7 +62,7 @@ data Unit = Unit
62#ifndef USE_TH
62#ifndef USE_TH
63instance SERIALIZE_CLASS Unit
63instance SERIALIZE_CLASS Unit
64#else
64#else
65−$(DERIVE_CLASS ''Unit)
65+DERIVE_CLASS(Unit)
66#endif
66#endif
67
67
68instance NFData Unit where
68instance NFData Unit where
@@ -77,7 +77,7 @@ data Sum2
77#ifndef USE_TH
77#ifndef USE_TH
78instance SERIALIZE_CLASS Sum2
78instance SERIALIZE_CLASS Sum2
79#else
79#else
80−$(DERIVE_CLASS ''Sum2)
80+DERIVE_CLASS(Sum2)
81#endif
81#endif
82
82
83instance NFData Sum2 where
83instance NFData Sum2 where
@@ -115,7 +115,7 @@ data Sum25
115#ifndef USE_TH
115#ifndef USE_TH
116instance SERIALIZE_CLASS Sum25
116instance SERIALIZE_CLASS Sum25
117#else
117#else
118−$(DERIVE_CLASS ''Sum25)
118+DERIVE_CLASS(Sum25)
119#endif
119#endif
120
120
121instance NFData Sum25 where
121instance NFData Sum25 where
@@ -154,7 +154,7 @@ data Product25
154#ifndef USE_TH
154#ifndef USE_TH
155instance SERIALIZE_CLASS Product25
155instance SERIALIZE_CLASS Product25
156#else
156#else
157−$(DERIVE_CLASS ''Product25)
157+DERIVE_CLASS(Product25)
158#endif
158#endif
159
159
160instance NFData Product25 where
160instance NFData Product25 where
@@ -234,7 +234,7 @@ data CustomDT1
234#ifndef USE_TH
234#ifndef USE_TH
235instance SERIALIZE_CLASS CustomDT1
235instance SERIALIZE_CLASS CustomDT1
236#else
236#else
237−$(DERIVE_CLASS ''CustomDT1)
237+DERIVE_CLASS(CustomDT1)
238#endif
238#endif
239
239
240instance NFData CustomDT1 where
240instance NFData CustomDT1 where
@@ -257,7 +257,7 @@ data BinTree a
257#ifndef USE_TH
257#ifndef USE_TH
258instance Serialize (BinTree a)
258instance Serialize (BinTree a)
259#else
259#else
260−$(deriveSerialize ''BinTree)
260+$(deriveSerialize [d|instance Serialize a => Serialize (BinTree a)|])
261#endif
261#endif
262
262
263instance NFData a => NFData (BinTree a) where
263instance 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
18--------------------------------------------------------------------------------
18--------------------------------------------------------------------------------
19
19
20$(genLargeRecord "RecNonCompatible" 50)
20$(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
36import Streamly.Internal.Data.Unbox.TH
36import Streamly.Internal.Data.Unbox.TH
37 ( DataCon(..)
37 ( DataCon(..)
38 , DataType(..)
38 , DataType(..)
39− , appsT
40 , reifyDataType
39 , reifyDataType
41 )
40 )
42
41
@@ -454,7 +453,7 @@ deriveSerializeInternal conf headTy cons next = do
454-- for the given instance are generated according to the supplied @config@
453-- for the given instance are generated according to the supplied @config@
455-- parameter.
454-- parameter.
456--
455--
457−-- For example:
456+-- Usage:
458--
457--
459-- @
458-- @
460-- \$(deriveSerializeWith
459-- \$(deriveSerializeWith
@@ -503,40 +502,16 @@ deriveSerializeWith conf mDecs = do
503 go (AppT l _) = go l
502 go (AppT l _) = go l
504 go _ = errorMessage dec
503 go _ = errorMessage dec
505
504
506−
505+-- | Given a 'Serialize' instance declaration splice without the methods,
507−-- | @deriveSerialize dataTypeName@ generates a template Haskell splice
506+-- generate a full instance declaration including all the type class methods.
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.
511--
507--
512−-- For example,
508+-- >>> deriveSerialize = deriveSerializeWith defaultConfig
513--
509--
514−-- @
510+-- Usage:
515−-- data CustomDataType a b c = ...
516−-- \$(deriveSerialize ''CustomDataType)
517−-- @
518−--
519−-- Generates the following code:
520--
511--
521-- @
512-- @
513+-- \$(deriveSerialize
522−-- instance (Serialize a, Serialize b, Serialize c) => Serialize (CustomDataType a b c) where
514+-- [d|instance Serialize a => Serialize (Maybe a)|])
523−-- ...
524-- @
515-- @
525−--
526−-- To control which type parameters get the Serialize constraint, use
527−-- 'deriveSerializeWith'.
528−deriveSerialize :: Name -> Q [Dec]
516+deriveSerialize :: Q [Dec] -> Q [Dec]
529−deriveSerialize name = do
517+deriveSerialize = deriveSerializeWith defaultConfig
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
test/Streamly/Test/Data/Unbox.hs+9−6
@@ -41,7 +41,7 @@ import Test.Hspec as H
41#ifdef USE_SERIALIZE
41#ifdef USE_SERIALIZE
42
42
43#define MODULE_NAME "Data.Serialize.Deriving.TH"
43#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|])
45#define PEEK(i, arr, sz) (deserialize i arr sz)
45#define PEEK(i, arr, sz) (deserialize i arr sz)
46#define POKE(i, arr, val) (serialize i arr val)
46#define POKE(i, arr, val) (serialize i arr val)
47#define TYPE_CLASS Serialize
47#define TYPE_CLASS Serialize
@@ -168,12 +168,15 @@ DERIVE_UNBOX(NestedSOP)
168deriving instance Generic (Ratio Int)
168deriving instance Generic (Ratio Int)
169
169
170#if defined(USE_SERIALIZE)
170#if defined(USE_SERIALIZE)
171−$(Serialize.deriveSerialize ''Complex)
171+$(Serialize.deriveSerialize
172+ [d|instance Serialize a => Serialize (Complex a)|])
172−$(Serialize.deriveSerialize ''Ratio)
173+$(Serialize.deriveSerialize
174+ [d|instance Serialize a => Serialize (Ratio a)|])
173$(Serialize.deriveSerializeWith
175$(Serialize.deriveSerializeWith
174− Serialize.defaultConfig
176+ Serialize.defaultConfig
175− [d|instance Serialize a => Serialize (Const a b)|])
177+ [d|instance Serialize a => Serialize (Const a b)|])
176−$(Serialize.deriveSerialize ''Identity)
178+$(Serialize.deriveSerialize
179+ [d|instance Serialize a => Serialize (Identity a)|])
177#endif
180#endif
178
181
179--------------------------------------------------------------------------------
182--------------------------------------------------------------------------------