git.iko.soy/streamly
on de89f36 help sign in
streamly/core/src/Streamly/Internal/Data/Serialize.hs
122 lines 4.0 kB history raw
1{-# LANGUAGE TemplateHaskell #-}
3-- This is required as all the instances in this module are orphan instances.
4{-# OPTIONS_GHC -fno-warn-orphans #-}
6-- |
7-- Module : Streamly.Internal.Data.Serialize
8-- Copyright : (c) 2023 Composewell Technologies
9-- License : BSD3-3-Clause
10-- Maintainer : streamly@composewell.com
11-- Portability : GHC
12--
14module Streamly.Internal.Data.Serialize
15 ( module Streamly.Internal.Data.Serialize.Type
16 ) where
18--------------------------------------------------------------------------------
19-- Imports
20--------------------------------------------------------------------------------
22import Data.Proxy (Proxy)
23import Streamly.Internal.Data.Array (Array(..))
24import Streamly.Internal.Data.Unbox (MutableByteArray(..))
25import GHC.Exts (Int(..), sizeofByteArray#, unsafeCoerce#)
27import qualified Streamly.Internal.Data.Serialize.TH as Serialize
29#if __GLASGOW_HASKELL__ >= 900
30import GHC.Num.Integer (Integer(..))
31#else
32import GHC.Integer.GMP.Internals (Integer(..), BigNat(..))
33#endif
35import Streamly.Internal.Data.Serialize.Type
37--------------------------------------------------------------------------------
38-- Common instances
39--------------------------------------------------------------------------------
41-- Note
42-- ====
43--
44-- Even a non-functional change such as changing the order of constructors will
45-- change the instance derivation.
46--
47-- This will not pose a problem if both, encode, and decode are done by the same
48-- version of the application. There *might* be a problem if version that
49-- encodes differs from the version that decodes.
50--
51-- We need to add some compatibility tests using different versions of
52-- dependencies.
53--
54-- Although such chages for the most basic types won't happen we need to detect
55-- if it ever happens.
56--
57-- Should we worry about these kind of changes and this kind of compatibility?
58-- This is a problem for all types of derivations that depend on the order of
59-- constructors, for example, Enum.
61$(Serialize.deriveSerialize ''Maybe)
62$(Serialize.deriveSerialize ''Either)
63$(Serialize.deriveSerializeWith
64 Serialize.defaultConfig
65 [d|instance Serialize (Proxy a)|])
67--------------------------------------------------------------------------------
68-- Integer
69--------------------------------------------------------------------------------
71data LiftedInteger
72 = LIS Int
73 | LIP (Array Word)
74 | LIN (Array Word)
76$(Serialize.deriveSerialize ''LiftedInteger)
78#if __GLASGOW_HASKELL__ >= 900
80{-# INLINE liftInteger #-}
81liftInteger :: Integer -> LiftedInteger
82liftInteger (IS x) = LIS (I# x)
83liftInteger (IP x) =
84 LIP (Array (MutableByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
85liftInteger (IN x) =
86 LIN (Array (MutableByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
88{-# INLINE unliftInteger #-}
89unliftInteger :: LiftedInteger -> Integer
90unliftInteger (LIS (I# x)) = IS x
91unliftInteger (LIP (Array (MutableByteArray x) _ _)) = IP (unsafeCoerce# x)
92unliftInteger (LIN (Array (MutableByteArray x) _ _)) = IN (unsafeCoerce# x)
94#else
96{-# INLINE liftInteger #-}
97liftInteger :: Integer -> LiftedInteger
98liftInteger (S# x) = LIS (I# x)
99liftInteger (Jp# (BN# x)) =
100 LIP (Array (MutableByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
101liftInteger (Jn# (BN# x)) =
102 LIN (Array (MutableByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
104{-# INLINE unliftInteger #-}
105unliftInteger :: LiftedInteger -> Integer
106unliftInteger (LIS (I# x)) = S# x
107unliftInteger (LIP (Array (MutableByteArray x) _ _)) =
108 Jp# (BN# (unsafeCoerce# x))
109unliftInteger (LIN (Array (MutableByteArray x) _ _)) =
110 Jn# (BN# (unsafeCoerce# x))
112#endif
114instance Serialize Integer where
115 {-# INLINE size #-}
116 size i a = size i (liftInteger a)
118 {-# INLINE deserialize #-}
119 deserialize off arr end = fmap unliftInteger <$> deserialize off arr end
121 {-# INLINE serialize #-}
122 serialize off arr val = serialize off arr (liftInteger val)