git.iko.soy/streamly
on master help sign in
Replace TH-derived Serialize instances with manual instances
0ed37ffAdithya Kumar
core/src/Streamly/Internal/Data/Serialize.hs+125−9
compare with master
unifiedsplit
@@ -19,12 +19,11 @@ module Streamly.Internal.Data.Serialize
19-- Imports
19-- Imports
20--------------------------------------------------------------------------------
20--------------------------------------------------------------------------------
21
21
22−import Data.Proxy (Proxy)
22+import Data.Proxy (Proxy(..))
23import Streamly.Internal.Data.Array (Array(..))
23import Streamly.Internal.Data.Array (Array(..))
24import Streamly.Internal.Data.Unbox (MutableByteArray(..))
24import Streamly.Internal.Data.Unbox (MutableByteArray(..))
25import GHC.Exts (Int(..), sizeofByteArray#, unsafeCoerce#)
25import GHC.Exts (Int(..), sizeofByteArray#, unsafeCoerce#)
26−
26+import GHC.Word (Word8)
27−import qualified Streamly.Internal.Data.Serialize.TH as Serialize
28
27
29#if __GLASGOW_HASKELL__ >= 900
28#if __GLASGOW_HASKELL__ >= 900
30import GHC.Num.Integer (Integer(..))
29import GHC.Num.Integer (Integer(..))
@@ -58,11 +57,92 @@ import Streamly.Internal.Data.Serialize.Type
58-- This is a problem for all types of derivations that depend on the order of
57-- This is a problem for all types of derivations that depend on the order of
59-- constructors, for example, Enum.
58-- constructors, for example, Enum.
60
59
60+-- Note on Windows build
61+-- =====================
62+--
63+-- On Windows, having template haskell splices here fail the build with the
64+-- following error:
65+--
66+-- @
67+-- addLibrarySearchPath: C:\... (Win32 error 3): The system cannot find the path specified.
68+-- @
69+--
70+-- The error might be irrelavant but having these splices triggers it. We should
71+-- either fix the problem or avoid the use to template haskell splices in this
72+-- file.
73+--
74+-- Similar issue: https://github.com/haskell/cabal/issues/4741
75+
61−$(Serialize.deriveSerialize ''Maybe)
76+-- $(Serialize.deriveSerialize ''Maybe)
77+instance Serialize a => Serialize (Maybe a) where
78+
79+ {-# INLINE size #-}
80+ size acc x =
81+ case x of
82+ Nothing -> (acc + 1)
83+ Just field0 -> (size (acc + 1)) field0
84+
85+ {-# INLINE deserialize #-}
86+ deserialize initialOffset arr endOffset = do
87+ (i0, tag) <- ((deserialize initialOffset) arr) endOffset
88+ case tag :: Word8 of
89+ 0 -> pure (i0, Nothing)
90+ 1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
91+ pure (i1, Just a0)
92+ _ -> error "Found invalid tag while peeking (Maybe a)"
93+
94+ {-# INLINE serialize #-}
95+ serialize initialOffset arr val =
96+ case val of
97+ Nothing -> do
98+ i0 <- ((serialize initialOffset) arr) (0 :: Word8)
99+ pure i0
100+ Just field0 -> do
101+ i0 <- ((serialize initialOffset) arr) (1 :: Word8)
102+ i1 <- ((serialize i0) arr) field0
103+ pure i1
104+
62−$(Serialize.deriveSerialize ''Either)
105+-- $(Serialize.deriveSerialize ''Either)
63−$(Serialize.deriveSerializeWith
106+instance (Serialize a, Serialize b) => Serialize (Either a b) where
64− Serialize.defaultConfig
107+
108+ {-# INLINE size #-}
109+ size acc x =
110+ case x of
111+ Left field0 -> (size (acc + 1)) field0
112+ Right field0 -> (size (acc + 1)) field0
113+
114+ {-# INLINE deserialize #-}
115+ deserialize initialOffset arr endOffset = do
116+ (i0, tag) <- ((deserialize initialOffset) arr) endOffset
117+ case tag :: Word8 of
118+ 0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
119+ pure (i1, Left a0)
120+ 1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
121+ pure (i1, Right a0)
122+ _ -> error "Found invalid tag while peeking (Either a b)"
123+
124+ {-# INLINE serialize #-}
125+ serialize initialOffset arr val =
126+ case val of
127+ Left field0 -> do
128+ i0 <- ((serialize initialOffset) arr) (0 :: Word8)
129+ i1 <- ((serialize i0) arr) field0
130+ pure i1
131+ Right field0 -> do
132+ i0 <- ((serialize initialOffset) arr) (1 :: Word8)
133+ i1 <- ((serialize i0) arr) field0
134+ pure i1
135+
65− [d|instance Serialize (Proxy a)|])
136+instance Serialize (Proxy a) where
137+
138+ {-# INLINE size #-}
139+ size acc _ = (acc + 1)
140+
141+ {-# INLINE deserialize #-}
142+ deserialize initialOffset _ _ = pure ((initialOffset + 1), Proxy)
143+
144+ {-# INLINE serialize #-}
145+ serialize initialOffset _ _ = pure (initialOffset + 1)
66
146
67--------------------------------------------------------------------------------
147--------------------------------------------------------------------------------
68-- Integer
148-- Integer
@@ -73,7 +153,43 @@ data LiftedInteger
73 | LIP (Array Word)
153 | LIP (Array Word)
74 | LIN (Array Word)
154 | LIN (Array Word)
75
155
76−$(Serialize.deriveSerialize ''LiftedInteger)
156+-- $(Serialize.deriveSerialize ''LiftedInteger)
157+instance Serialize LiftedInteger where
158+
159+ {-# INLINE size #-}
160+ size acc x =
161+ case x of
162+ LIS field0 -> (size (acc + 1)) field0
163+ LIP field0 -> (size (acc + 1)) field0
164+ LIN field0 -> (size (acc + 1)) field0
165+
166+ {-# INLINE deserialize #-}
167+ deserialize initialOffset arr endOffset = do
168+ (i0, tag) <- ((deserialize initialOffset) arr) endOffset
169+ case tag :: Word8 of
170+ 0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
171+ pure (i1, LIS a0)
172+ 1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
173+ pure (i1, LIP a0)
174+ 2 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
175+ pure (i1, LIN a0)
176+ _ -> error "Found invalid tag while peeking (LiftedInteger)"
177+
178+ {-# INLINE serialize #-}
179+ serialize initialOffset arr val =
180+ case val of
181+ LIS field0 -> do
182+ i0 <- ((serialize initialOffset) arr) (0 :: Word8)
183+ i1 <- ((serialize i0) arr) field0
184+ pure i1
185+ LIP field0 -> do
186+ i0 <- ((serialize initialOffset) arr) (1 :: Word8)
187+ i1 <- ((serialize i0) arr) field0
188+ pure i1
189+ LIN field0 -> do
190+ i0 <- ((serialize initialOffset) arr) (2 :: Word8)
191+ i1 <- ((serialize i0) arr) field0
192+ pure i1
77
193
78#if __GLASGOW_HASKELL__ >= 900
194#if __GLASGOW_HASKELL__ >= 900
79
195