mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Replace TH-derived Serialize instances with manual instances
This commit is contained in:
Adithya Kumar
parent
633bb185a8
commit
0ed37ff344
@ -19,12 +19,11 @@ module Streamly.Internal.Data.Serialize
|
||||
-- Imports
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Proxy (Proxy)
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Streamly.Internal.Data.Array (Array(..))
|
||||
import Streamly.Internal.Data.Unbox (MutableByteArray(..))
|
||||
import GHC.Exts (Int(..), sizeofByteArray#, unsafeCoerce#)
|
||||
|
||||
import qualified Streamly.Internal.Data.Serialize.TH as Serialize
|
||||
import GHC.Word (Word8)
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
import GHC.Num.Integer (Integer(..))
|
||||
@ -58,11 +57,92 @@ import Streamly.Internal.Data.Serialize.Type
|
||||
-- This is a problem for all types of derivations that depend on the order of
|
||||
-- constructors, for example, Enum.
|
||||
|
||||
$(Serialize.deriveSerialize ''Maybe)
|
||||
$(Serialize.deriveSerialize ''Either)
|
||||
$(Serialize.deriveSerializeWith
|
||||
Serialize.defaultConfig
|
||||
[d|instance Serialize (Proxy a)|])
|
||||
-- Note on Windows build
|
||||
-- =====================
|
||||
--
|
||||
-- On Windows, having template haskell splices here fail the build with the
|
||||
-- following error:
|
||||
--
|
||||
-- @
|
||||
-- addLibrarySearchPath: C:\... (Win32 error 3): The system cannot find the path specified.
|
||||
-- @
|
||||
--
|
||||
-- The error might be irrelavant but having these splices triggers it. We should
|
||||
-- either fix the problem or avoid the use to template haskell splices in this
|
||||
-- file.
|
||||
--
|
||||
-- Similar issue: https://github.com/haskell/cabal/issues/4741
|
||||
|
||||
-- $(Serialize.deriveSerialize ''Maybe)
|
||||
instance Serialize a => Serialize (Maybe a) where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
Nothing -> (acc + 1)
|
||||
Just field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> pure (i0, Nothing)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Just a0)
|
||||
_ -> error "Found invalid tag while peeking (Maybe a)"
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
Nothing -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
pure i0
|
||||
Just field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
-- $(Serialize.deriveSerialize ''Either)
|
||||
instance (Serialize a, Serialize b) => Serialize (Either a b) where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
Left field0 -> (size (acc + 1)) field0
|
||||
Right field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Left a0)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Right a0)
|
||||
_ -> error "Found invalid tag while peeking (Either a b)"
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
Left field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
Right field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
instance Serialize (Proxy a) where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc _ = (acc + 1)
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset _ _ = pure ((initialOffset + 1), Proxy)
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset _ _ = pure (initialOffset + 1)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Integer
|
||||
@ -73,7 +153,43 @@ data LiftedInteger
|
||||
| LIP (Array Word)
|
||||
| LIN (Array Word)
|
||||
|
||||
$(Serialize.deriveSerialize ''LiftedInteger)
|
||||
-- $(Serialize.deriveSerialize ''LiftedInteger)
|
||||
instance Serialize LiftedInteger where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
LIS field0 -> (size (acc + 1)) field0
|
||||
LIP field0 -> (size (acc + 1)) field0
|
||||
LIN field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIS a0)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIP a0)
|
||||
2 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIN a0)
|
||||
_ -> error "Found invalid tag while peeking (LiftedInteger)"
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
LIS field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
LIP field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
LIN field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (2 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user