1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleContexts  #-}
3{-# LANGUAGE CPP #-}
4{-# LANGUAGE DefaultSignatures
5           , TypeOperators
6           , BangPatterns
7           , KindSignatures
8           , ScopedTypeVariables #-}
9
10#ifndef MIN_VERSION_base
11#define MIN_VERSION_base(x,y,z) 1
12#endif
13
14-----------------------------------------------------------------------------
15-- |
16-- Module      : Data.Serialize
17-- Copyright   : Lennart Kolmodin, Galois Inc. 2009
18-- License     : BSD3-style (see LICENSE)
19--
20-- Maintainer  : Trevor Elliott <trevor@galois.com>
21-- Stability   :
22-- Portability :
23--
24-----------------------------------------------------------------------------
25
26module Data.Serialize (
27
28    -- * The Serialize class
29      Serialize(..)
30
31    -- $example
32
33    -- * Serialize serialisation
34    , encode, encodeLazy
35    , decode, decodeLazy
36
37    , expect
38    , module Data.Serialize.Get
39    , module Data.Serialize.Put
40    , module Data.Serialize.IEEE754
41
42    -- * Generic deriving
43    , GSerializePut(..)
44    , GSerializeGet(..)
45    ) where
46
47import Data.Serialize.Put
48import Data.Serialize.Get
49import Data.Serialize.IEEE754
50
51import Control.Monad
52import Data.Array.Unboxed
53import Data.ByteString (ByteString)
54import Data.Char    (chr,ord)
55import Data.List    (unfoldr)
56import Data.Word
57import Foreign
58
59-- And needed for the instances:
60import qualified Data.ByteString       as B
61import qualified Data.ByteString.Lazy  as L
62import qualified Data.ByteString.Short as S
63import qualified Data.Map              as Map
64import qualified Data.Monoid           as M
65import qualified Data.Set              as Set
66import qualified Data.IntMap           as IntMap
67import qualified Data.IntSet           as IntSet
68import qualified Data.Ratio            as R
69import qualified Data.Tree             as T
70import qualified Data.Sequence         as Seq
71
72import GHC.Generics
73
74#if !(MIN_VERSION_base(4,8,0))
75import Control.Applicative ((*>),(<*>),(<$>),pure)
76#endif
77
78#if MIN_VERSION_base(4,8,0)
79import Numeric.Natural
80#endif
81
82------------------------------------------------------------------------
83
84
85-- | If your compiler has support for the @DeriveGeneric@ and
86-- @DefaultSignatures@ language extensions (@ghc >= 7.2.1@), the 'put' and 'get'
87-- methods will have default generic implementations.
88--
89-- To use this option, simply add a @deriving 'Generic'@ clause to your datatype
90-- and declare a 'Serialize' instance for it without giving a definition for
91-- 'put' and 'get'.
92class Serialize t where
93    -- | Encode a value in the Put monad.
94    put :: Putter t
95    -- | Decode a value in the Get monad
96    get :: Get t
97
98    default put :: (Generic t, GSerializePut (Rep t)) => Putter t
99    put = gPut . from
100
101    default get :: (Generic t, GSerializeGet (Rep t)) => Get t
102    get = to <$> gGet
103
104------------------------------------------------------------------------
105-- Wrappers to run the underlying monad
106
107-- | Encode a value using binary serialization to a strict ByteString.
108encode :: Serialize a => a -> ByteString
109encode = runPut . put
110
111-- | Encode a value using binary serialization to a lazy ByteString.
112encodeLazy :: Serialize a => a -> L.ByteString
113encodeLazy  = runPutLazy . put
114
115-- | Decode a value from a strict ByteString, reconstructing the original
116-- structure.
117decode :: Serialize a => ByteString -> Either String a
118decode = runGet get
119
120-- | Decode a value from a lazy ByteString, reconstructing the original
121-- structure.
122decodeLazy :: Serialize a => L.ByteString -> Either String a
123decodeLazy  = runGetLazy get
124
125
126------------------------------------------------------------------------
127-- Combinators
128
129-- | Perform an action, failing if the read result does not match the argument
130--   provided.
131expect :: (Eq a, Serialize a) => a -> Get a
132expect x = get >>= \y -> if x == y then return x else mzero
133
134
135------------------------------------------------------------------------
136-- Simple instances
137
138-- The () type need never be written to disk: values of singleton type
139-- can be reconstructed from the type alone
140instance Serialize () where
141    put ()  = return ()
142    get     = return ()
143
144{-# INLINE boolToWord8 #-}
145boolToWord8 :: Bool -> Word8
146boolToWord8 False = 0
147boolToWord8 True = 1
148
149{-# INLINE boolFromWord8 #-}
150boolFromWord8 :: Word8 -> Get Bool
151boolFromWord8 0 = return False
152boolFromWord8 1 = return True
153boolFromWord8 w = fail ("Invalid Bool encoding " ++ show w)
154
155{-# INLINE orderingToWord8 #-}
156orderingToWord8 :: Ordering -> Word8
157orderingToWord8 LT = 0
158orderingToWord8 EQ = 1
159orderingToWord8 GT = 2
160
161{-# INLINE orderingFromWord8 #-}
162orderingFromWord8 :: Word8 -> Get Ordering
163orderingFromWord8 0 = return LT
164orderingFromWord8 1 = return EQ
165orderingFromWord8 2 = return GT
166orderingFromWord8 w = fail ("Invalid Ordering encoding " ++ show w)
167
168-- Bools are encoded as a byte in the range 0 .. 1
169instance Serialize Bool where
170    put     = putWord8 . boolToWord8
171    get     = boolFromWord8 =<< getWord8
172
173-- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2
174instance Serialize Ordering where
175    put     = putWord8 . orderingToWord8
176    get     = orderingFromWord8 =<< getWord8
177
178------------------------------------------------------------------------
179-- Words and Ints
180
181-- Words8s are written as bytes
182instance Serialize Word8 where
183    put     = putWord8
184    get     = getWord8
185
186-- Words16s are written as 2 bytes in big-endian (network) order
187instance Serialize Word16 where
188    put     = putWord16be
189    get     = getWord16be
190
191-- Words32s are written as 4 bytes in big-endian (network) order
192instance Serialize Word32 where
193    put     = putWord32be
194    get     = getWord32be
195
196-- Words64s are written as 8 bytes in big-endian (network) order
197instance Serialize Word64 where
198    put     = putWord64be
199    get     = getWord64be
200
201-- Int8s are written as a single byte.
202instance Serialize Int8 where
203    put     = putInt8
204    get     = getInt8
205
206-- Int16s are written as a 2 bytes in big endian format
207instance Serialize Int16 where
208    put     = putInt16be
209    get     = getInt16be
210
211-- Int32s are written as a 4 bytes in big endian format
212instance Serialize Int32 where
213    put     = putInt32be
214    get     = getInt32be
215
216-- Int64s are written as a 8 bytes in big endian format
217instance Serialize Int64 where
218    put     = putInt64be
219    get     = getInt64be
220
221------------------------------------------------------------------------
222
223-- Words are are written as Word64s, that is, 8 bytes in big endian format
224instance Serialize Word where
225    put i   = put (fromIntegral i :: Word64)
226    get     = liftM fromIntegral (get :: Get Word64)
227
228-- Ints are are written as Int64s, that is, 8 bytes in big endian format
229instance Serialize Int where
230    put i   = put (fromIntegral i :: Int64)
231    get     = liftM fromIntegral (get :: Get Int64)
232
233------------------------------------------------------------------------
234--
235-- Portable, and pretty efficient, serialisation of Integer
236--
237
238-- Fixed-size type for a subset of Integer
239type SmallInt = Int32
240
241-- Integers are encoded in two ways: if they fit inside a SmallInt,
242-- they're written as a byte tag, and that value.  If the Integer value
243-- is too large to fit in a SmallInt, it is written as a byte array,
244-- along with a sign and length field.
245
246instance Serialize Integer where
247
248    put n | n >= lo && n <= hi = do
249        putWord8 0
250        put (fromIntegral n :: SmallInt)  -- fast path
251     where
252        lo = fromIntegral (minBound :: SmallInt) :: Integer
253        hi = fromIntegral (maxBound :: SmallInt) :: Integer
254
255    put n = do
256        putWord8 1
257        put sign
258        let len = ((nrBits (abs n) + 7) `div` 8)
259        putWord64be (fromIntegral len)
260        mapM_ put (unroll (abs n))         -- unroll the bytes
261     where
262        sign = fromIntegral (signum n) :: Word8
263
264    get = do
265        tag <- get :: Get Word8
266        case tag of
267            0 -> liftM fromIntegral (get :: Get SmallInt)
268            _ -> do sign  <- get
269                    bytes <- get
270                    let v = roll bytes
271                    return $! if sign == (1 :: Word8) then v else - v
272
273--
274-- Fold and unfold an Integer to and from a list of its bytes
275--
276unroll :: (Integral a, Bits a) => a -> [Word8]
277unroll = unfoldr step
278  where
279    step 0 = Nothing
280    step i = Just (fromIntegral i, i `shiftR` 8)
281
282roll :: (Integral a, Bits a) => [Word8] -> a
283roll   = foldr unstep 0
284  where
285    unstep b a = a `shiftL` 8 .|. fromIntegral b
286
287nrBits :: (Ord a, Integral a) => a -> Int
288nrBits k =
289    let expMax = until (\e -> 2 ^ e > k) (* 2) 1
290        findNr :: Int -> Int -> Int
291        findNr lo hi
292            | mid == lo = hi
293            | 2 ^ mid <= k = findNr mid hi
294            | 2 ^ mid > k  = findNr lo mid
295         where mid = (lo + hi) `div` 2
296    in findNr (expMax `div` 2) expMax
297
298instance (Serialize a,Integral a) => Serialize (R.Ratio a) where
299    put r = put (R.numerator r) >> put (R.denominator r)
300    get = liftM2 (R.%) get get
301
302#if MIN_VERSION_base(4,8,0)
303-- Fixed-size type for a subset of Natural
304type NaturalWord = Word64
305
306instance Serialize Natural where
307    {-# INLINE put #-}
308    put n | n <= hi = do
309        putWord8 0
310        put (fromIntegral n :: NaturalWord)  -- fast path
311     where
312        hi = fromIntegral (maxBound :: NaturalWord) :: Natural
313
314    put n = do
315        putWord8 1
316        let len = ((nrBits (abs n) + 7) `div` 8)
317        putWord64be (fromIntegral len)
318        mapM_ put (unroll (abs n))         -- unroll the bytes
319
320    {-# INLINE get #-}
321    get = do
322        tag <- get :: Get Word8
323        case tag of
324            0 -> liftM fromIntegral (get :: Get NaturalWord)
325            _ -> do bytes <- get
326                    return $! roll bytes
327#endif
328
329------------------------------------------------------------------------
330
331-- Safely wrap `chr` to avoid exceptions.
332-- `chr` source: http://hackage.haskell.org/package/base-4.7.0.2/docs/src/GHC-Char.html#chr
333chrEither :: Int -> Either String Char
334chrEither i
335  | i <= 0x10FFFF = Right (chr i) -- Or: C# (chr# i#)
336  | otherwise =
337     Left ("bad argument: " ++ show i)
338
339-- Char is serialised as UTF-8
340instance Serialize Char where
341    put a | c <= 0x7f     = put (fromIntegral c :: Word8)
342          | c <= 0x7ff    = do put (0xc0 .|. y)
343                               put (0x80 .|. z)
344          | c <= 0xffff   = do put (0xe0 .|. x)
345                               put (0x80 .|. y)
346                               put (0x80 .|. z)
347          | c <= 0x10ffff = do put (0xf0 .|. w)
348                               put (0x80 .|. x)
349                               put (0x80 .|. y)
350                               put (0x80 .|. z)
351          | otherwise     = error "Not a valid Unicode code point"
352     where
353        c = ord a
354        z, y, x, w :: Word8
355        z = fromIntegral (c           .&. 0x3f)
356        y = fromIntegral (shiftR c 6  .&. 0x3f)
357        x = fromIntegral (shiftR c 12 .&. 0x3f)
358        w = fromIntegral (shiftR c 18 .&. 0x7)
359
360    get = do
361        let getByte = liftM (fromIntegral :: Word8 -> Int) get
362            shiftL6 = flip shiftL 6 :: Int -> Int
363        w <- getByte
364        r <- case () of
365                _ | w < 0x80  -> return w
366                  | w < 0xe0  -> do
367                                    x <- liftM (xor 0x80) getByte
368                                    return (x .|. shiftL6 (xor 0xc0 w))
369                  | w < 0xf0  -> do
370                                    x <- liftM (xor 0x80) getByte
371                                    y <- liftM (xor 0x80) getByte
372                                    return (y .|. shiftL6 (x .|. shiftL6
373                                            (xor 0xe0 w)))
374                  | otherwise -> do
375                                x <- liftM (xor 0x80) getByte
376                                y <- liftM (xor 0x80) getByte
377                                z <- liftM (xor 0x80) getByte
378                                return (z .|. shiftL6 (y .|. shiftL6
379                                        (x .|. shiftL6 (xor 0xf0 w))))
380        case chrEither r of
381            Right r' ->
382                return $! r'
383            Left err ->
384                fail err
385
386------------------------------------------------------------------------
387-- Instances for the first few tuples
388
389instance (Serialize a, Serialize b) => Serialize (a,b) where
390    put = putTwoOf put put
391    get = getTwoOf get get
392
393instance (Serialize a, Serialize b, Serialize c) => Serialize (a,b,c) where
394    put (a,b,c)         = put a >> put b >> put c
395    get                 = liftM3 (,,) get get get
396
397instance (Serialize a, Serialize b, Serialize c, Serialize d)
398        => Serialize (a,b,c,d) where
399    put (a,b,c,d)       = put a >> put b >> put c >> put d
400    get                 = liftM4 (,,,) get get get get
401
402instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e)
403        => Serialize (a,b,c,d,e) where
404    put (a,b,c,d,e)     = put a >> put b >> put c >> put d >> put e
405    get                 = liftM5 (,,,,) get get get get get
406
407--
408-- and now just recurse:
409--
410
411instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e
412         , Serialize f)
413        => Serialize (a,b,c,d,e,f) where
414    put (a,b,c,d,e,f)   = put (a,(b,c,d,e,f))
415    get                 = do (a,(b,c,d,e,f)) <- get ; return (a,b,c,d,e,f)
416
417instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e
418         , Serialize f, Serialize g)
419        => Serialize (a,b,c,d,e,f,g) where
420    put (a,b,c,d,e,f,g) = put (a,(b,c,d,e,f,g))
421    get                 = do (a,(b,c,d,e,f,g)) <- get ; return (a,b,c,d,e,f,g)
422
423instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e,
424          Serialize f, Serialize g, Serialize h)
425        => Serialize (a,b,c,d,e,f,g,h) where
426    put (a,b,c,d,e,f,g,h) = put (a,(b,c,d,e,f,g,h))
427    get                   = do (a,(b,c,d,e,f,g,h)) <- get
428                               return (a,b,c,d,e,f,g,h)
429
430instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e,
431          Serialize f, Serialize g, Serialize h, Serialize i)
432        => Serialize (a,b,c,d,e,f,g,h,i) where
433    put (a,b,c,d,e,f,g,h,i) = put (a,(b,c,d,e,f,g,h,i))
434    get                     = do (a,(b,c,d,e,f,g,h,i)) <- get
435                                 return (a,b,c,d,e,f,g,h,i)
436
437instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e,
438          Serialize f, Serialize g, Serialize h, Serialize i, Serialize j)
439        => Serialize (a,b,c,d,e,f,g,h,i,j) where
440    put (a,b,c,d,e,f,g,h,i,j) = put (a,(b,c,d,e,f,g,h,i,j))
441    get                       = do (a,(b,c,d,e,f,g,h,i,j)) <- get
442                                   return (a,b,c,d,e,f,g,h,i,j)
443
444------------------------------------------------------------------------
445-- Monoid newtype wrappers
446
447instance Serialize a => Serialize (M.Dual a) where
448    put = put . M.getDual
449    get = fmap M.Dual get
450
451instance Serialize M.All where
452    put = put . M.getAll
453    get = fmap M.All get
454
455instance Serialize M.Any where
456    put = put . M.getAny
457    get = fmap M.Any get
458
459instance Serialize a => Serialize (M.Sum a) where
460    put = put . M.getSum
461    get = fmap M.Sum get
462
463instance Serialize a => Serialize (M.Product a) where
464    put = put . M.getProduct
465    get = fmap M.Product get
466
467instance Serialize a => Serialize (M.First a) where
468    put = put . M.getFirst
469    get = fmap M.First get
470
471instance Serialize a => Serialize (M.Last a) where
472    put = put . M.getLast
473    get = fmap M.Last get
474
475------------------------------------------------------------------------
476-- Container types
477
478instance Serialize a => Serialize [a] where
479    put = putListOf put
480    get = getListOf get
481
482instance (Serialize a) => Serialize (Maybe a) where
483    put = putMaybeOf put
484    get = getMaybeOf get
485
486instance (Serialize a, Serialize b) => Serialize (Either a b) where
487    put = putEitherOf put put
488    get = getEitherOf get get
489
490------------------------------------------------------------------------
491-- ByteStrings (have specially efficient instances)
492
493instance Serialize B.ByteString where
494    put bs = do put (B.length bs :: Int)
495                putByteString bs
496    get    = get >>= getByteString
497
498instance Serialize L.ByteString where
499    put bs = do put (L.length bs :: Int64)
500                putLazyByteString bs
501    get    = get >>= getLazyByteString
502
503instance Serialize S.ShortByteString where
504    put sbs = do put (S.length sbs)
505                 putShortByteString sbs
506    get     = get >>= getShortByteString
507
508
509------------------------------------------------------------------------
510-- Maps and Sets
511
512instance (Ord a, Serialize a) => Serialize (Set.Set a) where
513    put = putSetOf put
514    get = getSetOf get
515
516instance (Ord k, Serialize k, Serialize e) => Serialize (Map.Map k e) where
517    put = putMapOf put put
518    get = getMapOf get get
519
520instance Serialize IntSet.IntSet where
521    put = putIntSetOf put
522    get = getIntSetOf get
523
524instance (Serialize e) => Serialize (IntMap.IntMap e) where
525    put = putIntMapOf put put
526    get = getIntMapOf get get
527
528------------------------------------------------------------------------
529-- Queues and Sequences
530
531instance (Serialize e) => Serialize (Seq.Seq e) where
532    put = putSeqOf put
533    get = getSeqOf get
534
535------------------------------------------------------------------------
536-- Floating point
537
538instance Serialize Double where
539    put = putFloat64be
540    get = getFloat64be
541
542instance Serialize Float where
543    put = putFloat32be
544    get = getFloat32be
545
546------------------------------------------------------------------------
547-- Trees
548
549instance (Serialize e) => Serialize (T.Tree e) where
550    put = putTreeOf put
551    get = getTreeOf get
552
553------------------------------------------------------------------------
554-- Arrays
555
556instance (Serialize i, Ix i, Serialize e) => Serialize (Array i e) where
557    put = putIArrayOf put put
558    get = getIArrayOf get get
559
560--
561-- The IArray UArray e constraint is non portable. Requires flexible instances
562--
563instance (Serialize i, Ix i, Serialize e, IArray UArray e)
564  => Serialize (UArray i e) where
565    put = putIArrayOf put put
566    get = getIArrayOf get get
567
568------------------------------------------------------------------------
569-- Generic Serialze
570
571class GSerializePut f where
572    gPut :: Putter (f a)
573
574class GSerializeGet f where
575    gGet :: Get (f a)
576
577instance GSerializePut a => GSerializePut (M1 i c a) where
578    gPut = gPut . unM1
579    {-# INLINE gPut #-}
580
581instance GSerializeGet a => GSerializeGet (M1 i c a) where
582    gGet = M1 <$> gGet
583    {-# INLINE gGet #-}
584
585instance Serialize a => GSerializePut (K1 i a) where
586    gPut = put . unK1
587    {-# INLINE gPut #-}
588
589instance Serialize a => GSerializeGet (K1 i a) where
590    gGet = K1 <$> get
591    {-# INLINE gGet #-}
592
593instance GSerializePut U1 where
594    gPut _ = pure ()
595    {-# INLINE gPut #-}
596
597instance GSerializeGet U1 where
598    gGet   = pure U1
599    {-# INLINE gGet #-}
600
601-- | Always fails to serialize
602instance GSerializePut V1 where
603    gPut v = v `seq` error "GSerializePut.V1"
604    {-# INLINE gPut #-}
605
606-- | Always fails to deserialize
607instance GSerializeGet V1 where
608    gGet   = fail "GSerializeGet.V1"
609    {-# INLINE gGet #-}
610
611instance (GSerializePut a, GSerializePut b) => GSerializePut (a :*: b) where
612    gPut (a :*: b) = gPut a *> gPut b
613    {-# INLINE gPut #-}
614
615instance (GSerializeGet a, GSerializeGet b) => GSerializeGet (a :*: b) where
616    gGet = (:*:) <$> gGet  <*> gGet
617    {-# INLINE gGet #-}
618
619-- The following GSerialize* instance for sums has support for serializing types
620-- with up to 2^64-1 constructors. It will use the minimal number of bytes
621-- needed to encode the constructor. For example when a type has 2^8
622-- constructors or less it will use a single byte to encode the constructor. If
623-- it has 2^16 constructors or less it will use two bytes, and so on till 2^64-1.
624
625#define GUARD(WORD) (size - 1) <= fromIntegral (maxBound :: WORD)
626#define PUTSUM(WORD) GUARD(WORD) = putSum (0 :: WORD) (fromIntegral size)
627#define GETSUM(WORD) GUARD(WORD) = (get :: Get WORD) >>= checkGetSum (fromIntegral size)
628
629instance ( PutSum        a, PutSum        b
630         , SumSize       a, SumSize       b) => GSerializePut (a :+: b) where
631    gPut | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64)
632         | otherwise = sizeError "encode" size
633      where
634        size = unTagged (sumSize :: Tagged (a :+: b) Word64)
635    {-# INLINE gPut #-}
636
637instance ( GetSum        a, GetSum        b
638         , SumSize       a, SumSize       b) => GSerializeGet (a :+: b) where
639    gGet | GETSUM(Word8) | GETSUM(Word16) | GETSUM(Word32) | GETSUM(Word64)
640         | otherwise = sizeError "decode" size
641      where
642        size = unTagged (sumSize :: Tagged (a :+: b) Word64)
643    {-# INLINE gGet #-}
644
645sizeError :: Show size => String -> size -> error
646sizeError s size = error $ "Can't " ++ s ++ " a type with " ++ show size ++ " constructors"
647
648------------------------------------------------------------------------
649
650class PutSum f where
651    putSum :: (Num word, Bits word, Serialize word) => word -> word -> Putter (f a)
652
653instance (PutSum a, PutSum b) => PutSum (a :+: b) where
654    putSum !code !size s = case s of
655                             L1 x -> putSum code           sizeL x
656                             R1 x -> putSum (code + sizeL) sizeR x
657        where
658#if MIN_VERSION_base(4,5,0)
659          sizeL = size `unsafeShiftR` 1
660#else
661          sizeL = size `shiftR` 1
662#endif
663          sizeR = size - sizeL
664    {-# INLINE putSum #-}
665
666instance GSerializePut a => PutSum (C1 c a) where
667    putSum !code _ x = put code *> gPut x
668    {-# INLINE putSum #-}
669
670------------------------------------------------------------------------
671
672checkGetSum :: (Ord word, Num word, Bits word, GetSum f)
673            => word -> word -> Get (f a)
674checkGetSum size code | code < size = getSum code size
675                      | otherwise   = fail "Unknown encoding for constructor"
676{-# INLINE checkGetSum #-}
677
678class GetSum f where
679    getSum :: (Ord word, Num word, Bits word) => word -> word -> Get (f a)
680
681instance (GetSum a, GetSum b) => GetSum (a :+: b) where
682    getSum !code !size | code < sizeL = L1 <$> getSum code           sizeL
683                       | otherwise    = R1 <$> getSum (code - sizeL) sizeR
684        where
685#if MIN_VERSION_base(4,5,0)
686          sizeL = size `unsafeShiftR` 1
687#else
688          sizeL = size `shiftR` 1
689#endif
690          sizeR = size - sizeL
691    {-# INLINE getSum #-}
692
693instance GSerializeGet a => GetSum (C1 c a) where
694    getSum _ _ = gGet
695    {-# INLINE getSum #-}
696
697------------------------------------------------------------------------
698
699class SumSize f where
700    sumSize :: Tagged f Word64
701
702newtype Tagged (s :: * -> *) b = Tagged {unTagged :: b}
703
704instance (SumSize a, SumSize b) => SumSize (a :+: b) where
705    sumSize = Tagged $ unTagged (sumSize :: Tagged a Word64) +
706                       unTagged (sumSize :: Tagged b Word64)
707
708instance SumSize (C1 c a) where
709    sumSize = Tagged 1
710