c4794aa · streamly · git.iko.soy

git.iko.soy/streamly

Add tests for the Serialize template haskell deriving

commitc4794aab93a22a70f291892506bfae57e7e770fa authorAdithya Kumar <adithya@composewell.com> dateWed 2 Aug 2023, 18:59 (3 years ago) parente55662e

4 files changed+125−6

compare with master

unifiedsplit

streamly.cabal+2 test/Streamly/Test/Data/Serialize.hs+40−6 test/Streamly/Test/Data/Serialize/TH.hs+82 test/streamly-tests.cabal+1

streamly.cabal+2

@@ -131,6 +131,8 @@ extra-source-files:

131131 test/Streamly/Test/Unicode/extra/NormalizationTest.txt

132132 test/Streamly/Test/Data/Unbox.hs

133133 test/Streamly/Test/Data/Unbox/*.hs

134+ test/Streamly/Test/Data/Serialize.hs

135+ test/Streamly/Test/Data/Serialize/*.hs

134136 benchmark/Streamly/Benchmark/Unicode/data/AllChars.txt

135137 benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txt

136138 benchmark/Streamly/Benchmark/Unicode/data/Japanese.txt

test/Streamly/Test/Data/Serialize.hs+40−6

@@ -1,3 +1,5 @@

1+{-# LANGUAGE TemplateHaskell #-}

13-- |

24-- Module : Streamly.Test.Data.Serialize

@@ -16,26 +18,37 @@ import Streamly.Internal.Data.Unbox (newBytes)

1618

1719import Test.Hspec as H

1820

21+import Streamly.Internal.Data.Serialize.TH (deriveSerialize)

22+-- import Streamly.Internal.Data.Serialize (Serialize(..))

23+

1924import qualified Streamly.Internal.Data.Serialize as Serialize

2025

26+import Streamly.Test.Data.Serialize.TH (genDatatype)

27+

28+import Test.Hspec.QuickCheck

29+

30+--------------------------------------------------------------------------------

31+-- Generated types

32+--------------------------------------------------------------------------------

33+

34+$(genDatatype "CustomDatatype" 15)

35+$(deriveSerialize ''CustomDatatype)

36+

2137--------------------------------------------------------------------------------

2238-- Test helpers

2339--------------------------------------------------------------------------------

2440

25−testSerializeList

41+roundtrip

2642 :: forall a. (Eq a, Show a, Serialize.Serialize a)

27− => Int

28− -> a

43+ => a

2944 -> IO ()

30−testSerializeList sizeOfA val = do

45+roundtrip val = do

3146

3247 let sz =

3348 case Serialize.size :: Serialize.Size a of

3449 Serialize.VarSize f -> f val

3550 Serialize.ConstSize csz -> csz

3651

37− sz `shouldBe` sizeOfA

38−

3952 arr <- newBytes sz

4053

4154 off1 <- Serialize.serialize 0 arr val

@@ -43,6 +56,22 @@ testSerializeList sizeOfA val = do

4356 val2 `shouldBe` val

4457 off2 `shouldBe` off1

4558

59+testSerializeList

60+ :: forall a. (Eq a, Show a, Serialize.Serialize a)

61+ => Int

62+ -> a

63+ -> IO ()

64+testSerializeList sizeOfA val = do

65+

66+ let sz =

67+ case Serialize.size :: Serialize.Size a of

68+ Serialize.VarSize f -> f val

69+ Serialize.ConstSize csz -> csz

70+

71+ sz `shouldBe` sizeOfA

72+

73+ roundtrip val

74+

4675--------------------------------------------------------------------------------

4776-- Tests

4877--------------------------------------------------------------------------------

@@ -57,6 +86,11 @@ testCases = do

5786 (8 + 3 * 8 + 6 * 8)

5887 ([[1], [1, 2], [1, 2, 3]] :: [[Int]])

5988

89+ prop "CustomDatatype"

90+ $ \(x :: CustomDatatype) -> roundtrip x

91+ prop "[CustomDatatype]"

92+ $ \(x :: [CustomDatatype]) -> roundtrip x

93+

6094--------------------------------------------------------------------------------

6195-- Main function

6296--------------------------------------------------------------------------------

test/Streamly/Test/Data/Serialize/TH.hsnew file+82

@@ -0,0 +1,82 @@

1+{-# LANGUAGE TemplateHaskell #-}

3+-- |

4+-- Module : Streamly.Test.Data.Serialize.TH

6+-- License : BSD-3-Clause

7+-- Maintainer : streamly@composewell.com

8+-- Stability : experimental

9+-- Portability : GHC

10+

11+module Streamly.Test.Data.Serialize.TH (genDatatype) where

12+

13+--------------------------------------------------------------------------------

14+-- Imports

15+--------------------------------------------------------------------------------

16+

17+import Language.Haskell.TH

18+

19+import Test.QuickCheck.Arbitrary (Arbitrary(..))

20+import Test.QuickCheck.Gen (oneof)

21+

22+--------------------------------------------------------------------------------

23+-- Generated types

24+--------------------------------------------------------------------------------

25+

26+genDatatype :: String -> Int -> Q [Dec]

27+genDatatype tyName numCons =

28+ sequence

29+ ([ dataD

30+ (pure [])

31+ (mkName tyName)

32+ []

33+ Nothing

34+ (mkCon <$> [0 .. (numCons - 1)])

35+ [derivClause Nothing [conT ''Eq, conT ''Show]]

36+ , instanceD

37+ (pure [])

38+ (appT (conT ''Arbitrary) (conT (mkName tyName)))

39+ [ funD

40+ 'arbitrary

41+ [ clause

42+ []

43+ (normalB

44+ (appE

45+ (varE 'oneof)

46+ (listE

47+ (mkArbitraryExp <$>

48+ [0 .. (numCons - 1)]))))

49+ []

50+ ]

51+ ]

52+ ])

53+

54+ where

55+

56+ fieldTypeChoices =

57+ [ conT ''Int

58+ , conT ''Char

59+ , conT ''String

60+ , appT listT (conT ''Int)

61+ , appT listT (conT ''String)

62+ , appT listT (appT listT (conT ''Int))

63+ , appT listT (appT listT (conT ''String))

64+ ]

65+

66+ chooseCycle i xs = xs !! (i `mod` length xs)

67+

68+ mkArbitraryExp i =

69+ foldl

70+ (\b a -> [|$(b) <*> $(a)|])

71+ [|pure $(conE (mkName ("Constructor" ++ show i)))|]

72+ (replicate i (varE 'arbitrary))

73+

74+ mkCon i =

75+ normalC

76+ (mkName ("Constructor" ++ show i))

77+ (mkField <$> [0..(i - 1)])

78+

79+ mkField i =

80+ bangType

81+ (bang noSourceUnpackedness noSourceStrictness)

82+ (chooseCycle i fieldTypeChoices)

test/streamly-tests.cabal+1

@@ -286,6 +286,7 @@ test-suite Data.Serialize

286286 import: test-options

287287 type: exitcode-stdio-1.0

288288 main-is: Streamly/Test/Data/Serialize.hs

289+ other-modules: Streamly.Test.Data.Serialize.TH

289290 ghc-options: -main-is Streamly.Test.Data.Serialize.main

290291

291292test-suite Data.Array.Stream