git.iko.soy/streamly
on master help sign in
Add tests for the Serialize template haskell deriving
c4794aaAdithya Kumar
streamly.cabal+2
compare with master
unifiedsplit
@@ -131,6 +131,8 @@ extra-source-files:
131 test/Streamly/Test/Unicode/extra/NormalizationTest.txt
131 test/Streamly/Test/Unicode/extra/NormalizationTest.txt
132 test/Streamly/Test/Data/Unbox.hs
132 test/Streamly/Test/Data/Unbox.hs
133 test/Streamly/Test/Data/Unbox/*.hs
133 test/Streamly/Test/Data/Unbox/*.hs
134+ test/Streamly/Test/Data/Serialize.hs
135+ test/Streamly/Test/Data/Serialize/*.hs
134 benchmark/Streamly/Benchmark/Unicode/data/AllChars.txt
136 benchmark/Streamly/Benchmark/Unicode/data/AllChars.txt
135 benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txt
137 benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txt
136 benchmark/Streamly/Benchmark/Unicode/data/Japanese.txt
138 benchmark/Streamly/Benchmark/Unicode/data/Japanese.txt
test/Streamly/Test/Data/Serialize.hs+40−6
@@ -1,3 +1,5 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
1-- |
3-- |
2-- Module : Streamly.Test.Data.Serialize
4-- Module : Streamly.Test.Data.Serialize
3-- Copyright : (c) 2022 Composewell technologies
5-- Copyright : (c) 2022 Composewell technologies
@@ -16,26 +18,37 @@ import Streamly.Internal.Data.Unbox (newBytes)
16
18
17import Test.Hspec as H
19import Test.Hspec as H
18
20
21+import Streamly.Internal.Data.Serialize.TH (deriveSerialize)
22+-- import Streamly.Internal.Data.Serialize (Serialize(..))
23+
19import qualified Streamly.Internal.Data.Serialize as Serialize
24import qualified Streamly.Internal.Data.Serialize as Serialize
20
25
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+
21--------------------------------------------------------------------------------
37--------------------------------------------------------------------------------
22-- Test helpers
38-- Test helpers
23--------------------------------------------------------------------------------
39--------------------------------------------------------------------------------
24
40
25−testSerializeList
41+roundtrip
26 :: forall a. (Eq a, Show a, Serialize.Serialize a)
42 :: forall a. (Eq a, Show a, Serialize.Serialize a)
27− => Int
28− -> a
43+ => a
29 -> IO ()
44 -> IO ()
30−testSerializeList sizeOfA val = do
45+roundtrip val = do
31
46
32 let sz =
47 let sz =
33 case Serialize.size :: Serialize.Size a of
48 case Serialize.size :: Serialize.Size a of
34 Serialize.VarSize f -> f val
49 Serialize.VarSize f -> f val
35 Serialize.ConstSize csz -> csz
50 Serialize.ConstSize csz -> csz
36
51
37− sz `shouldBe` sizeOfA
38−
39 arr <- newBytes sz
52 arr <- newBytes sz
40
53
41 off1 <- Serialize.serialize 0 arr val
54 off1 <- Serialize.serialize 0 arr val
@@ -43,6 +56,22 @@ testSerializeList sizeOfA val = do
43 val2 `shouldBe` val
56 val2 `shouldBe` val
44 off2 `shouldBe` off1
57 off2 `shouldBe` off1
45
58
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+
46--------------------------------------------------------------------------------
75--------------------------------------------------------------------------------
47-- Tests
76-- Tests
48--------------------------------------------------------------------------------
77--------------------------------------------------------------------------------
@@ -57,6 +86,11 @@ testCases = do
57 (8 + 3 * 8 + 6 * 8)
86 (8 + 3 * 8 + 6 * 8)
58 ([[1], [1, 2], [1, 2, 3]] :: [[Int]])
87 ([[1], [1, 2], [1, 2, 3]] :: [[Int]])
59
88
89+ prop "CustomDatatype"
90+ $ \(x :: CustomDatatype) -> roundtrip x
91+ prop "[CustomDatatype]"
92+ $ \(x :: [CustomDatatype]) -> roundtrip x
93+
60--------------------------------------------------------------------------------
94--------------------------------------------------------------------------------
61-- Main function
95-- Main function
62--------------------------------------------------------------------------------
96--------------------------------------------------------------------------------
test/Streamly/Test/Data/Serialize/TH.hsnew file+82
@@ -0,0 +1,82 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+-- |
4+-- Module : Streamly.Test.Data.Serialize.TH
5+-- Copyright : (c) 2022 Composewell technologies
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
286 import: test-options
286 import: test-options
287 type: exitcode-stdio-1.0
287 type: exitcode-stdio-1.0
288 main-is: Streamly/Test/Data/Serialize.hs
288 main-is: Streamly/Test/Data/Serialize.hs
289+ other-modules: Streamly.Test.Data.Serialize.TH
289 ghc-options: -main-is Streamly.Test.Data.Serialize.main
290 ghc-options: -main-is Streamly.Test.Data.Serialize.main
290
291
291test-suite Data.Array.Stream
292test-suite Data.Array.Stream