Implement deriveSerialize using deriveSerializeWith

benchmark/Streamly/Benchmark/Data/Serialize.hs

@@ -42,12 +42,12 @@ import Streamly.Benchmark.Data.Serialize.RecNonCompatible
 
 #ifdef USE_UNBOX
 #define SERIALIZE_CLASS Unbox
-#define DERIVE_CLASS deriveUnbox
+#define DERIVE_CLASS(typ) $(deriveUnbox ''typ)
 #define SERIALIZE_OP pokeByteIndex
 #define DESERIALIZE_OP peekByteIndex
 #else
 #define SERIALIZE_CLASS Serialize
-#define DERIVE_CLASS deriveSerialize
+#define DERIVE_CLASS(typ) $(deriveSerialize [d|instance Serialize typ|])
 #define SERIALIZE_OP serialize
 #define DESERIALIZE_OP deserialize
 #endif
@@ -62,7 +62,7 @@ data Unit = Unit
 #ifndef USE_TH
 instance SERIALIZE_CLASS Unit
 #else
-$(DERIVE_CLASS ''Unit)
+DERIVE_CLASS(Unit)
 #endif
 
 instance NFData Unit where
@@ -77,7 +77,7 @@ data Sum2
 #ifndef USE_TH
 instance SERIALIZE_CLASS Sum2
 #else
-$(DERIVE_CLASS ''Sum2)
+DERIVE_CLASS(Sum2)
 #endif
 
 instance NFData Sum2 where
@@ -115,7 +115,7 @@ data Sum25
 #ifndef USE_TH
 instance SERIALIZE_CLASS Sum25
 #else
-$(DERIVE_CLASS ''Sum25)
+DERIVE_CLASS(Sum25)
 #endif
 
 instance NFData Sum25 where
@@ -154,7 +154,7 @@ data Product25
 #ifndef USE_TH
 instance SERIALIZE_CLASS Product25
 #else
-$(DERIVE_CLASS ''Product25)
+DERIVE_CLASS(Product25)
 #endif
 
 instance NFData Product25 where
@@ -234,7 +234,7 @@ data CustomDT1
 #ifndef USE_TH
 instance SERIALIZE_CLASS CustomDT1
 #else
-$(DERIVE_CLASS ''CustomDT1)
+DERIVE_CLASS(CustomDT1)
 #endif
 
 instance NFData CustomDT1 where
@@ -257,7 +257,7 @@ data BinTree a
 #ifndef USE_TH
 instance Serialize (BinTree a)
 #else
-$(deriveSerialize ''BinTree)
+$(deriveSerialize [d|instance Serialize a => Serialize (BinTree a)|])
 #endif
 
 instance NFData a => NFData (BinTree a) where

benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs

@@ -18,4 +18,4 @@ import qualified Streamly.Internal.Data.Serialize as Serialize
 --------------------------------------------------------------------------------
 
 $(genLargeRecord "RecNonCompatible" 50)
-$(Serialize.deriveSerialize ''RecNonCompatible)
+$(Serialize.deriveSerialize [d|instance Serialize.Serialize RecNonCompatible|])

core/src/Streamly/Internal/Data/Serialize/TH.hs

@@ -36,7 +36,6 @@ import Streamly.Internal.Data.Serialize.Type
 import Streamly.Internal.Data.Unbox.TH
     ( DataCon(..)
     , DataType(..)
-    , appsT
     , reifyDataType
     )
 
@@ -454,7 +453,7 @@ deriveSerializeInternal conf headTy cons next = do
 -- for the given instance are generated according to the supplied @config@
 -- parameter.
 --
--- For example:
+-- Usage:
 --
 -- @
 -- \$(deriveSerializeWith
@@ -503,40 +502,16 @@ deriveSerializeWith conf mDecs = do
         go (AppT l _) = go l
         go _ = errorMessage dec
 
-
--- | @deriveSerialize dataTypeName@ generates a template Haskell splice
--- consisting of a declaration of the 'Serialize' instance for the given
--- dataTypeName, all type parameters of dataTypeName are required to have the
--- 'Serialize' constraint.
+-- | Given a 'Serialize' instance declaration splice without the methods,
+-- generate a full instance declaration including all the type class methods.
 --
--- For example,
+-- >>> deriveSerialize = deriveSerializeWith defaultConfig
+--
+-- Usage:
 --
 -- @
--- data CustomDataType a b c = ...
--- \$(deriveSerialize ''CustomDataType)
+-- \$(deriveSerialize
+--       [d|instance Serialize a => Serialize (Maybe a)|])
 -- @
---
--- Generates the following code:
---
--- @
--- instance (Serialize a, Serialize b, Serialize c) => Serialize (CustomDataType a b c) where
--- ...
--- @
---
--- To control which type parameters get the Serialize constraint, use
--- 'deriveSerializeWith'.
-deriveSerialize :: Name -> Q [Dec]
-deriveSerialize name = do
-    dt <- reifyDataType name
-    let preds = map (unboxPred . VarT) (dtTvs dt)
-        headTy = appsT (ConT name) (map VarT (dtTvs dt))
-        cons = dtCons dt
-    deriveSerializeInternal defaultConfig headTy cons (next preds headTy)
-
-
-    where
-
-    next preds headTy methods =
-        pure [InstanceD Nothing preds (AppT (ConT ''Serialize) headTy) methods]
-
-    unboxPred ty = AppT (ConT ''Serialize) ty
+deriveSerialize :: Q [Dec] -> Q [Dec]
+deriveSerialize = deriveSerializeWith defaultConfig

test/Streamly/Test/Data/Unbox.hs

@@ -41,7 +41,7 @@ import Test.Hspec as H
 #ifdef USE_SERIALIZE
 
 #define MODULE_NAME "Data.Serialize.Deriving.TH"
-#define DERIVE_UNBOX(typ) $(Serialize.deriveSerialize ''typ)
+#define DERIVE_UNBOX(typ) $(Serialize.deriveSerialize [d|instance Serialize typ|])
 #define PEEK(i, arr, sz) (deserialize i arr sz)
 #define POKE(i, arr, val) (serialize i arr val)
 #define TYPE_CLASS Serialize
@@ -168,12 +168,15 @@ DERIVE_UNBOX(NestedSOP)
 deriving instance Generic (Ratio Int)
 
 #if defined(USE_SERIALIZE)
-$(Serialize.deriveSerialize ''Complex)
-$(Serialize.deriveSerialize ''Ratio)
+$(Serialize.deriveSerialize
+    [d|instance Serialize a => Serialize (Complex a)|])
+$(Serialize.deriveSerialize
+    [d|instance Serialize a => Serialize (Ratio a)|])
 $(Serialize.deriveSerializeWith
-      Serialize.defaultConfig
-      [d|instance Serialize a => Serialize (Const a b)|])
-$(Serialize.deriveSerialize ''Identity)
+    Serialize.defaultConfig
+    [d|instance Serialize a => Serialize (Const a b)|])
+$(Serialize.deriveSerialize
+    [d|instance Serialize a => Serialize (Identity a)|])
 #endif
 
 --------------------------------------------------------------------------------