git.iko.soy/streamly
on dc58c59 help sign in
streamly/test/Streamly/Test/Data/Serialize.hs
275 lines 8.5 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE TemplateHaskell #-}
4-- Required for Eq instance declaration of HigherOrderType
5{-# LANGUAGE UndecidableInstances #-}
7-- We are generating an orphan instance of Serialize for Identity.
8{-# OPTIONS_GHC -fno-warn-orphans #-}
10-- |
11-- Module : Streamly.Test.Data.Serialize
12-- Copyright : (c) 2022 Composewell technologies
13-- License : BSD-3-Clause
14-- Maintainer : streamly@composewell.com
15-- Stability : experimental
16-- Portability : GHC
18module Streamly.Test.Data.Serialize (main) where
20--------------------------------------------------------------------------------
21-- Imports
22--------------------------------------------------------------------------------
24import System.Random (randomRIO)
25import Streamly.Internal.Data.Serialize (MutByteArray, newByteArray)
26import GHC.Generics (Generic)
27import Streamly.Data.Serialize (Serialize)
28import Streamly.Test.Data.Serialize.TH (genDatatype)
30import Data.Functor.Identity (Identity (..))
32import qualified Streamly.Internal.Data.Array as Array
33import qualified Streamly.Internal.Data.Serialize as Serialize
35import qualified Streamly.Test.Data.Serialize.CompatV0 as CompatV0
36import qualified Streamly.Test.Data.Serialize.CompatV1 as CompatV1
38import Test.Hspec.QuickCheck
39import Test.QuickCheck
40import Test.Hspec as H
42--------------------------------------------------------------------------------
43-- Serialize configuration
44--------------------------------------------------------------------------------
46#ifdef ENABLE_constructorTagAsString
47#define CONF_NAME "ENABLE_constructorTagAsString"
48#define CONF (Serialize.encodeConstrNames True Serialize.serializeConfig)
49#else
50#define CONF_NAME "DEFAULT"
51#define CONF Serialize.serializeConfig
52#endif
54--------------------------------------------------------------------------------
55-- Edge case types
56--------------------------------------------------------------------------------
58data Unit =
59 Unit
60 deriving (Eq, Show)
61$(Serialize.deriveSerializeWith CONF [d|instance Serialize Unit|])
63data The =
64 The Unit Int Char
65 deriving (Eq, Show)
66$(Serialize.deriveSerializeWith CONF [d|instance Serialize The|])
68--------------------------------------------------------------------------------
69-- Generated types
70--------------------------------------------------------------------------------
72$(genDatatype "CustomDatatype" 15)
73$(Serialize.deriveSerializeWith CONF [d|instance Serialize CustomDatatype|])
75--------------------------------------------------------------------------------
76-- Types with functional parameters
77--------------------------------------------------------------------------------
79data HigherOrderType f =
80 HigherOrderType
81 { field0 :: f Int
82 , field1 :: f Char
83 }
85instance (Eq (f Int), Eq (f Char)) => Eq (HigherOrderType f) where
86 (==) a b = (field0 a == field0 b) && (field1 a == field1 b)
88instance (Show (f Int), Show (f Char)) => Show (HigherOrderType f) where
89 show a = "HigherOrderType " ++ show (field0 a) ++ " " ++ show (field1 a)
91$(Serialize.deriveSerializeWith CONF
92 [d|instance Serialize a => Serialize (Identity a)|])
93$(Serialize.deriveSerializeWith CONF
94 [d|instance Serialize (HigherOrderType Identity)|])
96--------------------------------------------------------------------------------
97-- Recursive type
98--------------------------------------------------------------------------------
100-- Recursive ADT
101data BinTree a
102 = Tree (BinTree a) (BinTree a)
103 | Leaf a
104 deriving (Show, Read, Eq, Generic)
106$(Serialize.deriveSerializeWith
107 CONF
108 [d|instance Serialize a => Serialize (BinTree a)|])
110instance Arbitrary a => Arbitrary (BinTree a) where
111 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
113--------------------------------------------------------------------------------
114-- Record syntax type
115--------------------------------------------------------------------------------
117upgradeRec :: (a -> b) -> CompatV0.Rec a -> CompatV1.Rec b
118upgradeRec f val =
119 CompatV1.Rec
120 { CompatV1.initialField = CompatV0.initialField val
121 , CompatV1.otherField = f (CompatV0.otherField val)
122 , CompatV1.theLastField = CompatV0.theLastField val
123 , CompatV1.aNewField = Nothing
124 }
126upgradeRiver :: CompatV0.River -> CompatV1.River
127upgradeRiver = read . show
129downgradeRec :: (a -> b) -> CompatV1.Rec a -> CompatV0.Rec b
130downgradeRec f val =
131 CompatV0.Rec
132 { CompatV0.initialField = CompatV1.initialField val
133 , CompatV0.otherField = f (CompatV1.otherField val)
134 , CompatV0.theLastField = CompatV1.theLastField val
135 }
137downgradeRiver :: CompatV1.River -> CompatV0.River
138downgradeRiver = read . show
140testCompatibility ::
141 CompatV0.Rec (CompatV0.Rec CompatV0.River)
142 -> CompatV1.Rec (CompatV1.Rec CompatV1.River)
143 -> IO ()
144testCompatibility v0 v1 = do
145 let upgradedV0 = upgradeRec (upgradeRec upgradeRiver) v0
146 downgradedV1 = downgradeRec (downgradeRec downgradeRiver) v1
148 res <- poke v0
149 peekAndVerify res upgradedV0
151 res1 <- poke v1
152 peekAndVerify res1 downgradedV1
154--------------------------------------------------------------------------------
155-- Test helpers
156--------------------------------------------------------------------------------
158poke ::
159 forall a. Serialize.Serialize a
160 => a
161 -> IO (MutByteArray, Int, Int)
162poke val = do
163 let sz = Serialize.size 0 val
165 let excessSize = 100
166 randomOff <- randomRIO (10, excessSize)
167 -- Use a proper slice to test instead of the array directly. This will catch
168 -- any hardcoded 0 offsets
169 let arrSize = sz + excessSize
170 serStartOff = randomOff
171 serEndOff = randomOff + sz
172 arr <- newByteArray arrSize
174 off1 <- Serialize.serialize serStartOff arr val
175 off1 `shouldBe` serEndOff
176 pure (arr, serStartOff, serEndOff)
178peekAndVerify ::
179 forall a. (Eq a, Show a, Serialize.Serialize a)
180 => (MutByteArray, Int, Int)
181 -> a
182 -> IO ()
183peekAndVerify (arr, serStartOff, serEndOff) val = do
184 (off2, val2) <- Serialize.deserialize serStartOff arr serEndOff
185 val2 `shouldBe` val
186 off2 `shouldBe` serEndOff
187 let slice = Array.Array arr serStartOff serEndOff
188 val `shouldBe` Serialize.decode slice
189 clonedSlice <- Array.clone slice
190 val `shouldBe` Serialize.decode clonedSlice
192roundtrip
193 :: forall a. (Eq a, Show a, Serialize.Serialize a)
194 => a
195 -> IO ()
196roundtrip val = do
198 val `shouldBe` Serialize.decode (Serialize.encode val)
200 res <- poke val
201 peekAndVerify res val
203testSerializeList
204 :: forall a. (Eq a, Show a, Serialize.Serialize a)
205 => Int
206 -> a
207 -> IO ()
208testSerializeList sizeOfA val = do
210 let sz = Serialize.size 0 val
212 sz `shouldBe` sizeOfA
214 roundtrip val
216--------------------------------------------------------------------------------
217-- Tests
218--------------------------------------------------------------------------------
220testCases :: Spec
221testCases = do
223 it "Serialize [Int]"
224 $ testSerializeList (8 + 4 * 8) ([1, 2, 3, 4] :: [Int])
225 it "Serialize [[Int]]"
226 $ testSerializeList
227 (8 + 3 * 8 + 6 * 8)
228 ([[1], [1, 2], [1, 2, 3]] :: [[Int]])
230 describe "Edge Cases" $ do
231 it "Unit" $ roundtrip Unit
232 it "The" $ roundtrip $ The Unit 1 'a'
234 it "HigherOrderType"
235 $ roundtrip $ HigherOrderType (Identity 5) (Identity 'e')
237 prop "Integer"
238 $ \(x :: Integer) -> roundtrip x
240 prop "([Integer], [Int])"
241 $ \(x :: ([Integer], [Int])) -> roundtrip x
243 prop "Array Int"
244 $ \(x :: [Int]) -> roundtrip (Array.fromList x)
246 prop "Compatible Record"
247 $ \(a :: CompatV1.Rec (CompatV0.Rec CompatV1.River)) -> roundtrip a
249 prop "Compatibility"
250 $ \a b -> testCompatibility a b
252 limitQC
253 $ prop "CustomDatatype"
254 $ \(x :: CustomDatatype) -> roundtrip x
256 limitQC
257 $ prop "[CustomDatatype]"
258 $ \(x :: [CustomDatatype]) -> roundtrip x
260 limitQC
261 $ prop "BinTree" $ \(x :: BinTree Int) -> roundtrip x
263 where
265 limitQC = modifyMaxSize (const 50)
267--------------------------------------------------------------------------------
268-- Main function
269--------------------------------------------------------------------------------
271moduleName :: String
272moduleName = "Data.Serialize." ++ CONF_NAME
274main :: IO ()
275main = hspec $ H.parallel $ describe moduleName testCases