From 9393f55e7d8b78d6e0859c87e46fd6e13154d418 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Tue, 5 Sep 2023 12:39:43 +0530 Subject: [PATCH] Change the API and update doc of a few APIs in Serialize.TH --- .../Streamly/Internal/Data/Serialize/TH.hs | 69 ++++++++++--------- test/Streamly/Test/Data/Serialize.hs | 18 ++--- test/Streamly/Test/Data/Unbox.hs | 14 ++-- 3 files changed, 52 insertions(+), 49 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Serialize/TH.hs b/core/src/Streamly/Internal/Data/Serialize/TH.hs index 0f5fcb050..553abca82 100644 --- a/core/src/Streamly/Internal/Data/Serialize/TH.hs +++ b/core/src/Streamly/Internal/Data/Serialize/TH.hs @@ -10,8 +10,8 @@ -- module Streamly.Internal.Data.Serialize.TH ( deriveSerialize - , SerializeTHConfig(..) - , defaultSerializeTHConfig + , Config(..) + , defaultConfig , deriveSerializeWith ) where @@ -324,7 +324,7 @@ mkSerializeExpr tyOfTy = -- Usage: -- @ -- $(deriveSerializeInternal --- defaultSerializeTHConfig +-- defaultConfig -- [AppT (ConT ''Serialize) (VarT (mkName "b"))] -- (AppT -- (AppT (ConT ''CustomDataType) (VarT (mkName "a"))) @@ -339,8 +339,8 @@ mkSerializeExpr tyOfTy = -- ]) -- @ deriveSerializeInternal :: - SerializeTHConfig -> Cxt -> Type -> [DataCon] -> Q [Dec] -deriveSerializeInternal (SerializeTHConfig{..}) preds headTy cons = do + Config -> Cxt -> Type -> [DataCon] -> Q [Dec] +deriveSerializeInternal (Config{..}) preds headTy cons = do sizeOfMethod <- mkSizeOfExpr (typeOfType headTy cons) peekMethod <- mkDeserializeExpr headTy (typeOfType headTy cons) pokeMethod <- mkSerializeExpr (typeOfType headTy cons) @@ -373,9 +373,9 @@ deriveSerializeInternal (SerializeTHConfig{..}) preds headTy cons = do return [plainInstanceD preds (AppT (ConT ''Serialize) headTy) methods] -- | Config to control how the 'Serialize' instance is generated. -data SerializeTHConfig = - SerializeTHConfig - { unconstrainedTypeVars :: [String] +data Config = + Config + { unconstrained :: [String] -- ^ Type variables that should not have the 'Serialize' constraint. -- -- @ @@ -383,26 +383,26 @@ data SerializeTHConfig = -- @ -- -- @ - -- conf = defaultConf {unconstrainedTypeVars = ["b", "d"]} - -- $(deriveSerializeWith conf ''CustomDataType) + -- conf = defaultConf {unconstrained = ["b", "d"]} + -- \$(deriveSerializeWith conf ''CustomDataType) -- @ -- -- @ -- instance (Serialize a, Serialize c) => Serialize (CustomDataType a b c d) where -- ... -- @ - , typeVarSubstitutions :: [(String, Type)] - -- ^ Substitute the type variable with the given type. All type + , specializations :: [(String, Type)] + -- ^ Specialize the type variable with the given type. All type -- variables listed here will not have the 'Serialize' constriant as - -- they are replaced. + -- they are specialized. -- -- @ -- data CustomDataType f a = CustomDataType (f a) -- @ -- -- @ - -- conf = defaultConf {typeVarSubstitutions = [("f", ''Identity)]} - -- $(deriveSerializeWith conf ''CustomDataType) + -- conf = defaultConf {specializations = [("f", ''Identity)]} + -- \$(deriveSerializeWith conf ''CustomDataType) -- @ -- -- @ @@ -418,20 +418,22 @@ data SerializeTHConfig = , inlineDeserialize :: Inline -- ^ Inline value for 'deserialize'. Default is Inline. , constructorTagAsString :: Bool - -- ^ If True, encode constructors as Latin-1 byte sequence. This - -- allows addition, removal, and reordering of constructors. If False - -- encode them as numbers. The default value is 'False'. + -- ^ __Experimental__ + -- + -- If True, encode constructors using the constructor names as Latin-1 + -- byte sequence. , recordSyntaxWithHeader :: Bool - -- ^ If True, constructors with record syntax will be encoded in a - -- more compatible way. Allows addition, removal, and reordering of - -- fields. The default value is 'False'. + -- ^ __Experimental__ + -- + -- If True, encode the keys of the record as a header and then + -- serialize the data. } -defaultSerializeTHConfig :: SerializeTHConfig -defaultSerializeTHConfig = - SerializeTHConfig - { unconstrainedTypeVars = [] - , typeVarSubstitutions = [] +defaultConfig :: Config +defaultConfig = + Config + { unconstrained = [] + , specializations = [] , inlineSize = Inline , inlineSerialize = Inline , inlineDeserialize = Inline @@ -439,12 +441,12 @@ defaultSerializeTHConfig = , recordSyntaxWithHeader = False } --- | Similar to 'deriveSerialize,' but take a 'SerializeTHConfig' to control how +-- | Similar to 'deriveSerialize,' but take a 'Config' to control how -- the instance is generated. -- -- Usage: @$(deriveSerializeWith config ''CustomDataType)@ -deriveSerializeWith :: SerializeTHConfig -> Name -> Q [Dec] -deriveSerializeWith conf@(SerializeTHConfig {..}) name = do +deriveSerializeWith :: Config -> Name -> Q [Dec] +deriveSerializeWith conf@(Config {..}) name = do dt <- reifyDataType name let preds = map (unboxPred . VarT) (filterOutVars (dtTvs dt)) headTy = appsT (ConT name) (map substituteVar (dtTvs dt)) @@ -453,13 +455,13 @@ deriveSerializeWith conf@(SerializeTHConfig {..}) name = do where allUnconstrainedTypeVars = - unconstrainedTypeVars ++ map fst typeVarSubstitutions + unconstrained ++ map fst specializations filterOutVars vs = map mkName $ filter (not . flip elem allUnconstrainedTypeVars) $ map nameBase vs substituteVar v = - case lookup (nameBase v) typeVarSubstitutions of + case lookup (nameBase v) specializations of Nothing -> VarT v Just ty -> ty @@ -489,6 +491,7 @@ deriveSerializeWith conf@(SerializeTHConfig {..}) name = do -- To control which type variables don't get the Serialize constraint, use -- 'deriveSerializeWith'. -- --- >>> deriveSerialize = deriveSerializeWith 'defaultSerializeTHConfig' +-- >>> import qualified Streamly.Internal.Data.Serialize.TH as Serialize +-- >>> deriveSerialize = Serialize.deriveSerializeWith Serialize.defaultConfig deriveSerialize :: Name -> Q [Dec] -deriveSerialize name = deriveSerializeWith defaultSerializeTHConfig name +deriveSerialize name = deriveSerializeWith defaultConfig name diff --git a/test/Streamly/Test/Data/Serialize.hs b/test/Streamly/Test/Data/Serialize.hs index 43afad966..1129a00f6 100644 --- a/test/Streamly/Test/Data/Serialize.hs +++ b/test/Streamly/Test/Data/Serialize.hs @@ -23,11 +23,11 @@ module Streamly.Test.Data.Serialize (main) where import Streamly.Internal.Data.Unbox (newBytes) import GHC.Generics (Generic) import Streamly.Test.Data.Serialize.TH (genDatatype) -import Streamly.Internal.Data.Serialize.TH +import qualified Streamly.Internal.Data.Serialize.TH as Serialize ( deriveSerialize , deriveSerializeWith - , defaultSerializeTHConfig - , SerializeTHConfig(..) + , defaultConfig + , Config(..) ) import Data.Functor.Identity (Identity (..)) @@ -43,7 +43,7 @@ import Test.Hspec as H -------------------------------------------------------------------------------- $(genDatatype "CustomDatatype" 15) -$(deriveSerialize ''CustomDatatype) +$(Serialize.deriveSerialize ''CustomDatatype) -------------------------------------------------------------------------------- -- Types with functional parameters @@ -61,10 +61,10 @@ instance (Eq (f Int), Eq (f Char)) => Eq (HigherOrderType f) where instance (Show (f Int), Show (f Char)) => Show (HigherOrderType f) where show a = "HigherOrderType " ++ show (field0 a) ++ " " ++ show (field1 a) -$(deriveSerialize ''Identity) -$(deriveSerializeWith - (defaultSerializeTHConfig - {typeVarSubstitutions = [("f", ConT ''Identity)]}) +$(Serialize.deriveSerialize ''Identity) +$(Serialize.deriveSerializeWith + (Serialize.defaultConfig + {Serialize.specializations = [("f", ConT ''Identity)]}) ''HigherOrderType) -------------------------------------------------------------------------------- @@ -77,7 +77,7 @@ data BinTree a | Leaf a deriving (Show, Read, Eq, Generic) -$(deriveSerialize ''BinTree) +$(Serialize.deriveSerialize ''BinTree) instance Arbitrary a => Arbitrary (BinTree a) where arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary] diff --git a/test/Streamly/Test/Data/Unbox.hs b/test/Streamly/Test/Data/Unbox.hs index f4c52c7d6..dac1279d1 100644 --- a/test/Streamly/Test/Data/Unbox.hs +++ b/test/Streamly/Test/Data/Unbox.hs @@ -30,7 +30,7 @@ import GHC.Real (Ratio(..)) #ifdef USE_SERIALIZE import Streamly.Internal.Data.Serialize (Serialize(..)) -import Streamly.Internal.Data.Serialize.TH +import qualified Streamly.Internal.Data.Serialize.TH as Serialize #else @@ -63,7 +63,7 @@ import Test.Hspec as H #ifdef USE_SERIALIZE #define MODULE_NAME "Data.Serialize.Deriving.TH" -#define DERIVE_UNBOX(typ) $(deriveSerialize ''typ) +#define DERIVE_UNBOX(typ) $(Serialize.deriveSerialize ''typ) #define PEEK(i, arr, sz) (deserialize i arr sz) #define POKE(i, arr, val) (serialize i arr val) #define TYPE_CLASS Serialize @@ -190,12 +190,12 @@ DERIVE_UNBOX(NestedSOP) deriving instance Generic (Ratio Int) #if defined(USE_SERIALIZE) -$(deriveSerialize ''Complex) -$(deriveSerialize ''Ratio) -$(deriveSerializeWith - (defaultSerializeTHConfig {unconstrainedTypeVars = ["b"]}) +$(Serialize.deriveSerialize ''Complex) +$(Serialize.deriveSerialize ''Ratio) +$(Serialize.deriveSerializeWith + (Serialize.defaultConfig {Serialize.unconstrained = ["b"]}) ''Const) -$(deriveSerialize ''Identity) +$(Serialize.deriveSerialize ''Identity) #endif --------------------------------------------------------------------------------