From 7d50e5e03ee139588378f893b79bb6757e0ae9fa Mon Sep 17 00:00:00 2001
From: Harendra Kumar <harendra@composewell.com>
Date: Wed, 22 Nov 2023 00:07:58 +0530
Subject: [PATCH] Implement deriveSerialize using deriveSerializeWith

---
 .../Streamly/Benchmark/Data/Serialize.hs      | 16 +++----
 .../Data/Serialize/RecNonCompatible.hs        |  2 +-
 .../Streamly/Internal/Data/Serialize/TH.hs    | 45 +++++--------------
 test/Streamly/Test/Data/Unbox.hs              | 15 ++++---
 4 files changed, 28 insertions(+), 50 deletions(-)

diff --git a/benchmark/Streamly/Benchmark/Data/Serialize.hs b/benchmark/Streamly/Benchmark/Data/Serialize.hs
index 6d50a0693..7a15b5ebb 100644
--- a/benchmark/Streamly/Benchmark/Data/Serialize.hs
+++ b/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
diff --git a/benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs b/benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs
index bf6ec69b9..231a36e26 100644
--- a/benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs
+++ b/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|])
diff --git a/core/src/Streamly/Internal/Data/Serialize/TH.hs b/core/src/Streamly/Internal/Data/Serialize/TH.hs
index 3d0521922..5330b6f88 100644
--- a/core/src/Streamly/Internal/Data/Serialize/TH.hs
+++ b/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
diff --git a/test/Streamly/Test/Data/Unbox.hs b/test/Streamly/Test/Data/Unbox.hs
index 99c65af72..ccaf7d687 100644
--- a/test/Streamly/Test/Data/Unbox.hs
+++ b/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
 
 --------------------------------------------------------------------------------