13f91aa · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Change the API and update doc of a few APIs in Serialize.TH

13f91aaAdithya Kumar3 years ago

core/src/Streamly/Internal/Data/Serialize/TH.hs+36−33

compare with master

unifiedsplit

@@ -10,8 +10,8 @@

10--

11module Streamly.Internal.Data.Serialize.TH

12 ( deriveSerialize

13− , SerializeTHConfig(..)

13+ , Config(..)

14− , defaultSerializeTHConfig

14+ , defaultConfig

15 , deriveSerializeWith

16 ) where

@@ -324,7 +324,7 @@ mkSerializeExpr tyOfTy =

324-- Usage:

325-- @

326-- $(deriveSerializeInternal

327−-- defaultSerializeTHConfig

327+-- defaultConfig

328-- [AppT (ConT ''Serialize) (VarT (mkName "b"))]

329-- (AppT

330-- (AppT (ConT ''CustomDataType) (VarT (mkName "a")))

@@ -339,8 +339,8 @@ mkSerializeExpr tyOfTy =

339-- ])

340-- @

341deriveSerializeInternal ::

342− SerializeTHConfig -> Cxt -> Type -> [DataCon] -> Q [Dec]

342+ Config -> Cxt -> Type -> [DataCon] -> Q [Dec]

343−deriveSerializeInternal (SerializeTHConfig{..}) preds headTy cons = do

343+deriveSerializeInternal (Config{..}) preds headTy cons = do

344 sizeOfMethod <- mkSizeOfExpr (typeOfType headTy cons)

345 peekMethod <- mkDeserializeExpr headTy (typeOfType headTy cons)

346 pokeMethod <- mkSerializeExpr (typeOfType headTy cons)

@@ -373,9 +373,9 @@ deriveSerializeInternal (SerializeTHConfig{..}) preds headTy cons = do

373 return [plainInstanceD preds (AppT (ConT ''Serialize) headTy) methods]

374

375-- | Config to control how the 'Serialize' instance is generated.

376−data SerializeTHConfig =

376+data Config =

377− SerializeTHConfig

377+ Config

378− { unconstrainedTypeVars :: [String]

378+ { unconstrained :: [String]

379 -- ^ Type variables that should not have the 'Serialize' constraint.

380 --

381 -- @

@@ -383,26 +383,26 @@ data SerializeTHConfig =

383 -- @

384 --

385 -- @

386− -- conf = defaultConf {unconstrainedTypeVars = ["b", "d"]}

386+ -- conf = defaultConf {unconstrained = ["b", "d"]}

387− -- $(deriveSerializeWith conf ''CustomDataType)

387+ -- \$(deriveSerializeWith conf ''CustomDataType)

388 -- @

389 --

390 -- @

391 -- instance (Serialize a, Serialize c) => Serialize (CustomDataType a b c d) where

392 -- ...

393 -- @

394− , typeVarSubstitutions :: [(String, Type)]

394+ , specializations :: [(String, Type)]

395− -- ^ Substitute the type variable with the given type. All type

395+ -- ^ Specialize the type variable with the given type. All type

396 -- variables listed here will not have the 'Serialize' constriant as

397− -- they are replaced.

397+ -- they are specialized.

398 --

399 -- @

400 -- data CustomDataType f a = CustomDataType (f a)

401 -- @

402 --

403 -- @

404− -- conf = defaultConf {typeVarSubstitutions = [("f", ''Identity)]}

404+ -- conf = defaultConf {specializations = [("f", ''Identity)]}

405− -- $(deriveSerializeWith conf ''CustomDataType)

405+ -- \$(deriveSerializeWith conf ''CustomDataType)

406 -- @

407 --

408 -- @

@@ -418,20 +418,22 @@ data SerializeTHConfig =

418 , inlineDeserialize :: Inline

419 -- ^ Inline value for 'deserialize'. Default is Inline.

420 , constructorTagAsString :: Bool

421+ -- ^ __Experimental__

422+ --

421− -- ^ If True, encode constructors as Latin-1 byte sequence. This

423+ -- If True, encode constructors using the constructor names as Latin-1

422− -- allows addition, removal, and reordering of constructors. If False

424+ -- byte sequence.

423− -- encode them as numbers. The default value is 'False'.

424 , recordSyntaxWithHeader :: Bool

425 , recordSyntaxWithHeader :: Bool

425− -- ^ If True, constructors with record syntax will be encoded in a

426+ -- ^ __Experimental__

426− -- more compatible way. Allows addition, removal, and reordering of

427+ --

427− -- fields. The default value is 'False'.

428+ -- If True, encode the keys of the record as a header and then

429+ -- serialize the data.

428 }

430 }

429

431

430−defaultSerializeTHConfig :: SerializeTHConfig

432+defaultConfig :: Config

431−defaultSerializeTHConfig =

433+defaultConfig =

432− SerializeTHConfig

434+ Config

433− { unconstrainedTypeVars = []

435+ { unconstrained = []

434− , typeVarSubstitutions = []

436+ , specializations = []

435 , inlineSize = Inline

437 , inlineSize = Inline

436 , inlineSerialize = Inline

438 , inlineSerialize = Inline

437 , inlineDeserialize = Inline

439 , inlineDeserialize = Inline

@@ -439,12 +441,12 @@ defaultSerializeTHConfig =

439 , recordSyntaxWithHeader = False

441 , recordSyntaxWithHeader = False

440 }

442 }

441

443

442−-- | Similar to 'deriveSerialize,' but take a 'SerializeTHConfig' to control how

444+-- | Similar to 'deriveSerialize,' but take a 'Config' to control how

443-- the instance is generated.

445-- the instance is generated.

444--

446--

445-- Usage: @$(deriveSerializeWith config ''CustomDataType)@

447-- Usage: @$(deriveSerializeWith config ''CustomDataType)@

446−deriveSerializeWith :: SerializeTHConfig -> Name -> Q [Dec]

448+deriveSerializeWith :: Config -> Name -> Q [Dec]

447−deriveSerializeWith conf@(SerializeTHConfig {..}) name = do

449+deriveSerializeWith conf@(Config {..}) name = do

448 dt <- reifyDataType name

450 dt <- reifyDataType name

449 let preds = map (unboxPred . VarT) (filterOutVars (dtTvs dt))

451 let preds = map (unboxPred . VarT) (filterOutVars (dtTvs dt))

450 headTy = appsT (ConT name) (map substituteVar (dtTvs dt))

452 headTy = appsT (ConT name) (map substituteVar (dtTvs dt))

@@ -453,13 +455,13 @@ deriveSerializeWith conf@(SerializeTHConfig {..}) name = do

453

455

454 where

456 where

455 allUnconstrainedTypeVars =

457 allUnconstrainedTypeVars =

456− unconstrainedTypeVars ++ map fst typeVarSubstitutions

458+ unconstrained ++ map fst specializations

457 filterOutVars vs =

459 filterOutVars vs =

458 map mkName

460 map mkName

459 $ filter (not . flip elem allUnconstrainedTypeVars)

461 $ filter (not . flip elem allUnconstrainedTypeVars)

460 $ map nameBase vs

462 $ map nameBase vs

461 substituteVar v =

463 substituteVar v =

462− case lookup (nameBase v) typeVarSubstitutions of

464+ case lookup (nameBase v) specializations of

463 Nothing -> VarT v

465 Nothing -> VarT v

464 Just ty -> ty

466 Just ty -> ty

465

467

@@ -489,6 +491,7 @@ deriveSerializeWith conf@(SerializeTHConfig {..}) name = do

489-- To control which type variables don't get the Serialize constraint, use

491-- To control which type variables don't get the Serialize constraint, use

490-- 'deriveSerializeWith'.

492-- 'deriveSerializeWith'.

491--

493--

494+-- >>> import qualified Streamly.Internal.Data.Serialize.TH as Serialize

492−-- >>> deriveSerialize = deriveSerializeWith 'defaultSerializeTHConfig'

495+-- >>> deriveSerialize = Serialize.deriveSerializeWith Serialize.defaultConfig

493deriveSerialize :: Name -> Q [Dec]

496deriveSerialize :: Name -> Q [Dec]

494−deriveSerialize name = deriveSerializeWith defaultSerializeTHConfig name

497+deriveSerialize name = deriveSerializeWith defaultConfig name

test/Streamly/Test/Data/Serialize.hs+9−9

@@ -23,11 +23,11 @@ module Streamly.Test.Data.Serialize (main) where

23import Streamly.Internal.Data.Unbox (newBytes)

24import GHC.Generics (Generic)

25import Streamly.Test.Data.Serialize.TH (genDatatype)

26−import Streamly.Internal.Data.Serialize.TH

26+import qualified Streamly.Internal.Data.Serialize.TH as Serialize

27 ( deriveSerialize

28 , deriveSerializeWith

29− , defaultSerializeTHConfig

29+ , defaultConfig

30− , SerializeTHConfig(..)

30+ , Config(..)

31 )

32import Data.Functor.Identity (Identity (..))

@@ -43,7 +43,7 @@ import Test.Hspec as H

43--------------------------------------------------------------------------------

45$(genDatatype "CustomDatatype" 15)

46−$(deriveSerialize ''CustomDatatype)

46+$(Serialize.deriveSerialize ''CustomDatatype)

48--------------------------------------------------------------------------------

49-- Types with functional parameters

@@ -61,10 +61,10 @@ instance (Eq (f Int), Eq (f Char)) => Eq (HigherOrderType f) where

61instance (Show (f Int), Show (f Char)) => Show (HigherOrderType f) where

62 show a = "HigherOrderType " ++ show (field0 a) ++ " " ++ show (field1 a)

64−$(deriveSerialize ''Identity)

64+$(Serialize.deriveSerialize ''Identity)

65−$(deriveSerializeWith

65+$(Serialize.deriveSerializeWith

66− (defaultSerializeTHConfig

66+ (Serialize.defaultConfig

67− {typeVarSubstitutions = [("f", ConT ''Identity)]})

67+ {Serialize.specializations = [("f", ConT ''Identity)]})

68 ''HigherOrderType)

70--------------------------------------------------------------------------------

@@ -77,7 +77,7 @@ data BinTree a

77 | Leaf a

78 deriving (Show, Read, Eq, Generic)

80−$(deriveSerialize ''BinTree)

80+$(Serialize.deriveSerialize ''BinTree)

82instance Arbitrary a => Arbitrary (BinTree a) where

83 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]

test/Streamly/Test/Data/Unbox.hs+7−7

@@ -30,7 +30,7 @@ import GHC.Real (Ratio(..))

30#ifdef USE_SERIALIZE

32import Streamly.Internal.Data.Serialize (Serialize(..))

33−import Streamly.Internal.Data.Serialize.TH

33+import qualified Streamly.Internal.Data.Serialize.TH as Serialize

35#else

@@ -63,7 +63,7 @@ import Test.Hspec as H

63#ifdef USE_SERIALIZE

65#define MODULE_NAME "Data.Serialize.Deriving.TH"

66−#define DERIVE_UNBOX(typ) $(deriveSerialize ''typ)

66+#define DERIVE_UNBOX(typ) $(Serialize.deriveSerialize ''typ)

67#define PEEK(i, arr, sz) (deserialize i arr sz)

68#define POKE(i, arr, val) (serialize i arr val)

69#define TYPE_CLASS Serialize

@@ -190,12 +190,12 @@ DERIVE_UNBOX(NestedSOP)

190deriving instance Generic (Ratio Int)

191

192#if defined(USE_SERIALIZE)

193−$(deriveSerialize ''Complex)

193+$(Serialize.deriveSerialize ''Complex)

194−$(deriveSerialize ''Ratio)

194+$(Serialize.deriveSerialize ''Ratio)

195−$(deriveSerializeWith

195+$(Serialize.deriveSerializeWith

196− (defaultSerializeTHConfig {unconstrainedTypeVars = ["b"]})

196+ (Serialize.defaultConfig {Serialize.unconstrained = ["b"]})

197 ''Const)

198−$(deriveSerialize ''Identity)

198+$(Serialize.deriveSerialize ''Identity)

199#endif

200

201--------------------------------------------------------------------------------