mirror of
https://github.com/composewell/streamly.git
synced 2024-08-16 23:10:36 +03:00
Implement deriveSerialize using deriveSerializeWith
This commit is contained in:
parent
1d89961700
commit
7d50e5e03e
@ -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
|
||||
|
@ -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|])
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
Loading…
Reference in New Issue
Block a user