@@ -10,6 +10,8 @@
1010--
1111module Streamly.Internal.Data.Serialize.TH
1212 ( deriveSerialize
13+ , SerializeTHConfig(..)
14+ , defaultSerializeTHConfig
1315 , deriveSerializeWith
1416 ) where
1517
@@ -362,28 +364,72 @@ deriveSerializeInternal preds headTy cons = do
362364 ]
363365 return [plainInstanceD preds (AppT (ConT ''Serialize) headTy) methods]
364366
365−-- | Similar to 'deriveSerialize,' but with the ability to specify which type
366−-- variables should not be subjected to the 'Serialize' constraint and how to
367−-- replace these variables when defining the 'Serialize' instance for the
368−-- primary data type.
367+-- | Config to control how the 'Serialize' instance is generated.
368+data SerializeTHConfig =
369+ SerializeTHConfig
370+ { unconstrainedTypeVars :: [String]
371+ -- ^ Type variables that should not have the 'Serialize' constraint.
372+ --
373+ -- @
374+ -- data CustomDataType a b c d = CustomDataType a c
375+ -- @
376+ --
377+ -- @
378+ -- conf = defaultConf {unconstrainedTypeVars = ["b", "d"]}
379+ -- $(deriveSerializeWith conf ''CustomDataType)
380+ -- @
381+ --
382+ -- @
383+ -- instance (Serialize a, Serialize c) => Serialize (CustomDataType a b c d) where
384+ -- ...
385+ -- @
386+ , typeVarSubstitutions :: [(String, Type)]
387+ -- ^ Substitute the type variable with the given type. All type
388+ -- variables listed here will not have the 'Serialize' constriant as
389+ -- they are replaced.
390+ --
391+ -- @
392+ -- data CustomDataType f a = CustomDataType (f a)
393+ -- @
394+ --
395+ -- @
396+ -- conf = defaultConf {typeVarSubstitutions = [("f", ''Identity)]}
397+ -- $(deriveSerializeWith conf ''CustomDataType)
398+ -- @
399+ --
400+ -- @
401+ -- instance (Serialize a) => Serialize (CustomDataType Identity a) where
402+ -- ...
403+ -- @
404+ --
405+ -- @f@ is replaced with 'Identity' and becomes unconstrained.
406+{-
407+ , inlineSize :: Inline
408+ -- ^ Inline value for 'size'.
409+ , inlineSerialize :: Inline
410+ -- ^ Inline value for 'serialize'.
411+ , inlineDeserialize :: Inline
412+ -- ^ Inline value for 'deserialize'.
413+ , constructorTagAsString :: Bool
414+ -- ^ If True, encode constructors as Latin-1 byte sequence. This
415+ -- allows addition, removal, and reordering of constructors. If False
416+ -- encode them as numbers. The default value is 'False'.
417+ , recordSyntaxWithHeader :: Bool
418+ -- ^ If True, constructors with record syntax will be encoded in a
419+ -- more compatible way. Allows addition, removal, and reordering of
420+ -- fields. The default value is 'False'.
421+-}
422+ }
423+
424+defaultSerializeTHConfig :: SerializeTHConfig
425+defaultSerializeTHConfig = SerializeTHConfig {unconstrainedTypeVars = [], typeVarSubstitutions = []}
426+
427+-- | Similar to 'deriveSerialize,' but take a 'SerializeTHConfig' to control how
428+-- the instance is generated.
369429--
370−-- Consider the datatype:
371−-- @
372−-- data CustomDataType a f c = CDT a (f Int)
373−-- @
374−--
375−-- Usage: @$(deriveSerializeWith ["c", "f"] [("f", ConT ''Identity)] ''CustomDataType)@
376−--
377−-- @
378−-- instance (Serialize a) => Serialize (CustomDataType a Identity c) where
379−-- ...
380−-- @
381−--
382−-- In the above example, 'Serialize' constraint is omitted for @f@ and @c@, and
383−-- @f@ is replaced with 'Identity' when defining the 'Serialize' instance for
384−-- the primary data type.
385−deriveSerializeWith :: [String] -> [(String, Type)] -> Name -> Q [Dec]
386−deriveSerializeWith ignoring substitutions name = do
430+-- Usage: @$(deriveSerializeWith config ''CustomDataType)@
431+deriveSerializeWith :: SerializeTHConfig -> Name -> Q [Dec]
432+deriveSerializeWith (SerializeTHConfig {..}) name = do
387433 dt <- reifyDataType name
388434 let preds = map (unboxPred . VarT) (filterOutVars (dtTvs dt))
389435 headTy = appsT (ConT name) (map substituteVar (dtTvs dt))
@@ -391,11 +437,14 @@ deriveSerializeWith ignoring substitutions name = do
391437 deriveSerializeInternal preds headTy cons
392438
393439 where
394−
440+ allUnconstrainedTypeVars =
441+ unconstrainedTypeVars ++ map fst typeVarSubstitutions
395442 filterOutVars vs =
396− map mkName $ filter (not . flip elem ignoring) $ map nameBase vs
443+ map mkName
444+ $ filter (not . flip elem allUnconstrainedTypeVars)
445+ $ map nameBase vs
397446 substituteVar v =
398− case lookup (nameBase v) substitutions of
447+ case lookup (nameBase v) typeVarSubstitutions of
399448 Nothing -> VarT v
400449 Just ty -> ty
401450
@@ -425,6 +474,6 @@ deriveSerializeWith ignoring substitutions name = do
425474-- To control which type variables don't get the Serialize constraint, use
426475-- 'deriveSerializeWith'.
427476--
428−-- >>> deriveSerialize = deriveSerializeWith [] []
477+-- >>> deriveSerialize = deriveSerializeWith 'defaultSerializeTHConfig'
429478deriveSerialize :: Name -> Q [Dec]
430−deriveSerialize name = deriveSerializeWith [] [] name
479+deriveSerialize name = deriveSerializeWith defaultSerializeTHConfig name