{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures
           , TypeOperators
           , BangPatterns
           , KindSignatures
           , ScopedTypeVariables #-}

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif

-----------------------------------------------------------------------------
-- |
-- Module      : Data.Serialize
-- Copyright   : Lennart Kolmodin, Galois Inc. 2009
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Trevor Elliott <trevor@galois.com>
-- Stability   :
-- Portability :
--
-----------------------------------------------------------------------------

module Data.Serialize (

    -- * The Serialize class
      Serialize(..)

    -- $example

    -- * Serialize serialisation
    , encode, encodeLazy
    , decode, decodeLazy

    , expect
    , module Data.Serialize.Get
    , module Data.Serialize.Put
    , module Data.Serialize.IEEE754

    -- * Generic deriving
    , GSerializePut(..)
    , GSerializeGet(..)
    ) where

import Data.Serialize.Put
import Data.Serialize.Get
import Data.Serialize.IEEE754

import Control.Monad
import Data.Array.Unboxed
import Data.ByteString (ByteString)
import Data.Char    (chr,ord)
import Data.List    (unfoldr)
import Data.Word
import Foreign

-- And needed for the instances:
import qualified Data.ByteString       as B
import qualified Data.ByteString.Lazy  as L
import qualified Data.ByteString.Short as S
import qualified Data.Map              as Map
import qualified Data.Monoid           as M
import qualified Data.Set              as Set
import qualified Data.IntMap           as IntMap
import qualified Data.IntSet           as IntSet
import qualified Data.Ratio            as R
import qualified Data.Tree             as T
import qualified Data.Sequence         as Seq

import GHC.Generics

#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative ((*>),(<*>),(<$>),pure)
#endif

#if MIN_VERSION_base(4,8,0)
import Numeric.Natural
#endif

------------------------------------------------------------------------


-- | If your compiler has support for the @DeriveGeneric@ and
-- @DefaultSignatures@ language extensions (@ghc >= 7.2.1@), the 'put' and 'get'
-- methods will have default generic implementations.
--
-- To use this option, simply add a @deriving 'Generic'@ clause to your datatype
-- and declare a 'Serialize' instance for it without giving a definition for
-- 'put' and 'get'.
class Serialize t where
    -- | Encode a value in the Put monad.
    put :: Putter t
    -- | Decode a value in the Get monad
    get :: Get t

    default put :: (Generic t, GSerializePut (Rep t)) => Putter t
    put = forall (f :: * -> *) a. GSerializePut f => Putter (f a)
gPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

    default get :: (Generic t, GSerializeGet (Rep t)) => Get t
    get = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. GSerializeGet f => Get (f a)
gGet

------------------------------------------------------------------------
-- Wrappers to run the underlying monad

-- | Encode a value using binary serialization to a strict ByteString.
encode :: Serialize a => a -> ByteString
encode :: forall a. Serialize a => a -> ByteString
encode = Put -> ByteString
runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Serialize t => Putter t
put

-- | Encode a value using binary serialization to a lazy ByteString.
encodeLazy :: Serialize a => a -> L.ByteString
encodeLazy :: forall a. Serialize a => a -> ByteString
encodeLazy  = Put -> ByteString
runPutLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Serialize t => Putter t
put

-- | Decode a value from a strict ByteString, reconstructing the original
-- structure.
decode :: Serialize a => ByteString -> Either String a
decode :: forall a. Serialize a => ByteString -> Either String a
decode = forall a. Get a -> ByteString -> Either String a
runGet forall t. Serialize t => Get t
get

-- | Decode a value from a lazy ByteString, reconstructing the original
-- structure.
decodeLazy :: Serialize a => L.ByteString -> Either String a
decodeLazy :: forall a. Serialize a => ByteString -> Either String a
decodeLazy  = forall a. Get a -> ByteString -> Either String a
runGetLazy forall t. Serialize t => Get t
get


------------------------------------------------------------------------
-- Combinators

-- | Perform an action, failing if the read result does not match the argument
--   provided.
expect :: (Eq a, Serialize a) => a -> Get a
expect :: forall a. (Eq a, Serialize a) => a -> Get a
expect a
x = forall t. Serialize t => Get t
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
y -> if a
x forall a. Eq a => a -> a -> Bool
== a
y then forall (m :: * -> *) a. Monad m => a -> m a
return a
x else forall (m :: * -> *) a. MonadPlus m => m a
mzero


------------------------------------------------------------------------
-- Simple instances

-- The () type need never be written to disk: values of singleton type
-- can be reconstructed from the type alone
instance Serialize () where
    put :: Putter ()
put ()  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    get :: Get ()
get     = forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE boolToWord8 #-}
boolToWord8 :: Bool -> Word8
boolToWord8 :: Bool -> Word8
boolToWord8 Bool
False = Word8
0
boolToWord8 Bool
True = Word8
1

{-# INLINE boolFromWord8 #-}
boolFromWord8 :: Word8 -> Get Bool
boolFromWord8 :: Word8 -> Get Bool
boolFromWord8 Word8
0 = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
boolFromWord8 Word8
1 = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
boolFromWord8 Word8
w = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid Bool encoding " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
w)

{-# INLINE orderingToWord8 #-}
orderingToWord8 :: Ordering -> Word8
orderingToWord8 :: Ordering -> Word8
orderingToWord8 Ordering
LT = Word8
0
orderingToWord8 Ordering
EQ = Word8
1
orderingToWord8 Ordering
GT = Word8
2

{-# INLINE orderingFromWord8 #-}
orderingFromWord8 :: Word8 -> Get Ordering
orderingFromWord8 :: Word8 -> Get Ordering
orderingFromWord8 Word8
0 = forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
LT
orderingFromWord8 Word8
1 = forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ
orderingFromWord8 Word8
2 = forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
GT
orderingFromWord8 Word8
w = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid Ordering encoding " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
w)

-- Bools are encoded as a byte in the range 0 .. 1
instance Serialize Bool where
    put :: Putter Bool
put     = Putter Word8
putWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Word8
boolToWord8
    get :: Get Bool
get     = Word8 -> Get Bool
boolFromWord8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8

-- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2
instance Serialize Ordering where
    put :: Putter Ordering
put     = Putter Word8
putWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Word8
orderingToWord8
    get :: Get Ordering
get     = Word8 -> Get Ordering
orderingFromWord8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8

------------------------------------------------------------------------
-- Words and Ints

-- Words8s are written as bytes
instance Serialize Word8 where
    put :: Putter Word8
put     = Putter Word8
putWord8
    get :: Get Word8
get     = Get Word8
getWord8

-- Words16s are written as 2 bytes in big-endian (network) order
instance Serialize Word16 where
    put :: Putter Word16
put     = Putter Word16
putWord16be
    get :: Get Word16
get     = Get Word16
getWord16be

-- Words32s are written as 4 bytes in big-endian (network) order
instance Serialize Word32 where
    put :: Putter Word32
put     = Putter Word32
putWord32be
    get :: Get Word32
get     = Get Word32
getWord32be

-- Words64s are written as 8 bytes in big-endian (network) order
instance Serialize Word64 where
    put :: Putter Word64
put     = Putter Word64
putWord64be
    get :: Get Word64
get     = Get Word64
getWord64be

-- Int8s are written as a single byte.
instance Serialize Int8 where
    put :: Putter Int8
put     = Putter Int8
putInt8
    get :: Get Int8
get     = Get Int8
getInt8

-- Int16s are written as a 2 bytes in big endian format
instance Serialize Int16 where
    put :: Putter Int16
put     = Putter Int16
putInt16be
    get :: Get Int16
get     = Get Int16
getInt16be

-- Int32s are written as a 4 bytes in big endian format
instance Serialize Int32 where
    put :: Putter Int32
put     = Putter Int32
putInt32be
    get :: Get Int32
get     = Get Int32
getInt32be

-- Int64s are written as a 8 bytes in big endian format
instance Serialize Int64 where
    put :: Putter Int64
put     = Putter Int64
putInt64be
    get :: Get Int64
get     = Get Int64
getInt64be

------------------------------------------------------------------------

-- Words are are written as Word64s, that is, 8 bytes in big endian format
instance Serialize Word where
    put :: Putter Word
put Word
i   = forall t. Serialize t => Putter t
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i :: Word64)
    get :: Get Word
get     = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall t. Serialize t => Get t
get :: Get Word64)

-- Ints are are written as Int64s, that is, 8 bytes in big endian format
instance Serialize Int where
    put :: Putter Int
put Int
i   = forall t. Serialize t => Putter t
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Int64)
    get :: Get Int
get     = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall t. Serialize t => Get t
get :: Get Int64)

------------------------------------------------------------------------
--
-- Portable, and pretty efficient, serialisation of Integer
--

-- Fixed-size type for a subset of Integer
type SmallInt = Int32

-- Integers are encoded in two ways: if they fit inside a SmallInt,
-- they're written as a byte tag, and that value.  If the Integer value
-- is too large to fit in a SmallInt, it is written as a byte array,
-- along with a sign and length field.

instance Serialize Integer where

    put :: Putter Integer
put Integer
n | Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
lo Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
hi = do
        Putter Word8
putWord8 Word8
0
        forall t. Serialize t => Putter t
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n :: SmallInt)  -- fast path
     where
        lo :: Integer
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: SmallInt) :: Integer
        hi :: Integer
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: SmallInt) :: Integer

    put Integer
n = do
        Putter Word8
putWord8 Word8
1
        forall t. Serialize t => Putter t
put Word8
sign
        let len :: Int
len = ((forall a. (Ord a, Integral a) => a -> Int
nrBits (forall a. Num a => a -> a
abs Integer
n) forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8)
        Putter Word64
putWord64be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Serialize t => Putter t
put (forall a. (Integral a, Bits a) => a -> [Word8]
unroll (forall a. Num a => a -> a
abs Integer
n))         -- unroll the bytes
     where
        sign :: Word8
sign = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
signum Integer
n) :: Word8

    get :: Get Integer
get = do
        Word8
tag <- forall t. Serialize t => Get t
get :: Get Word8
        case Word8
tag of
            Word8
0 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall t. Serialize t => Get t
get :: Get SmallInt)
            Word8
_ -> do Word8
sign  <- forall t. Serialize t => Get t
get
                    [Word8]
bytes <- forall t. Serialize t => Get t
get
                    let v :: Integer
v = forall a. (Integral a, Bits a) => [Word8] -> a
roll [Word8]
bytes
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! if Word8
sign forall a. Eq a => a -> a -> Bool
== (Word8
1 :: Word8) then Integer
v else - Integer
v

--
-- Fold and unfold an Integer to and from a list of its bytes
--
unroll :: (Integral a, Bits a) => a -> [Word8]
unroll :: forall a. (Integral a, Bits a) => a -> [Word8]
unroll = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {b} {a}. (Integral b, Num a, Bits b) => b -> Maybe (a, b)
step
  where
    step :: b -> Maybe (a, b)
step b
0 = forall a. Maybe a
Nothing
    step b
i = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral b
i, b
i forall a. Bits a => a -> Int -> a
`shiftR` Int
8)

roll :: (Integral a, Bits a) => [Word8] -> a
roll :: forall a. (Integral a, Bits a) => [Word8] -> a
roll   = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}. (Bits a, Integral a, Num a) => a -> a -> a
unstep a
0
  where
    unstep :: a -> a -> a
unstep a
b a
a = a
a forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b

nrBits :: (Ord a, Integral a) => a -> Int
nrBits :: forall a. (Ord a, Integral a) => a -> Int
nrBits a
k =
    let expMax :: Int
expMax = forall a. (a -> Bool) -> (a -> a) -> a -> a
until (\Int
e -> a
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e forall a. Ord a => a -> a -> Bool
> a
k) (forall a. Num a => a -> a -> a
* Int
2) Int
1
        findNr :: Int -> Int -> Int
        findNr :: Int -> Int -> Int
findNr Int
lo Int
hi
            | Int
mid forall a. Eq a => a -> a -> Bool
== Int
lo    = Int
hi
            | a
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
mid forall a. Ord a => a -> a -> Bool
<= a
k = Int -> Int -> Int
findNr Int
mid Int
hi
            | Bool
otherwise    = Int -> Int -> Int
findNr Int
lo Int
mid
         where mid :: Int
mid = (Int
lo forall a. Num a => a -> a -> a
+ Int
hi) forall a. Integral a => a -> a -> a
`div` Int
2
    in Int -> Int -> Int
findNr (Int
expMax forall a. Integral a => a -> a -> a
`div` Int
2) Int
expMax

instance (Serialize a,Integral a) => Serialize (R.Ratio a) where
    put :: Putter (Ratio a)
put Ratio a
r = forall t. Serialize t => Putter t
put (forall a. Ratio a -> a
R.numerator Ratio a
r) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put (forall a. Ratio a -> a
R.denominator Ratio a
r)
    get :: Get (Ratio a)
get = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Integral a => a -> a -> Ratio a
(R.%) forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

#if MIN_VERSION_base(4,8,0)
-- Fixed-size type for a subset of Natural
type NaturalWord = Word64

instance Serialize Natural where
    {-# INLINE put #-}
    put :: Putter Natural
put Natural
n | Natural
n forall a. Ord a => a -> a -> Bool
<= Natural
hi = do
        Putter Word8
putWord8 Word8
0
        forall t. Serialize t => Putter t
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n :: NaturalWord)  -- fast path
     where
        hi :: Natural
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: NaturalWord) :: Natural

    put Natural
n = do
        Putter Word8
putWord8 Word8
1
        let len :: Int
len = ((forall a. (Ord a, Integral a) => a -> Int
nrBits (forall a. Num a => a -> a
abs Natural
n) forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8)
        Putter Word64
putWord64be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Serialize t => Putter t
put (forall a. (Integral a, Bits a) => a -> [Word8]
unroll (forall a. Num a => a -> a
abs Natural
n))         -- unroll the bytes

    {-# INLINE get #-}
    get :: Get Natural
get = do
        Word8
tag <- forall t. Serialize t => Get t
get :: Get Word8
        case Word8
tag of
            Word8
0 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall t. Serialize t => Get t
get :: Get NaturalWord)
            Word8
_ -> do [Word8]
bytes <- forall t. Serialize t => Get t
get
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. (Integral a, Bits a) => [Word8] -> a
roll [Word8]
bytes
#endif

------------------------------------------------------------------------

-- Safely wrap `chr` to avoid exceptions.
-- `chr` source: http://hackage.haskell.org/package/base-4.7.0.2/docs/src/GHC-Char.html#chr
chrEither :: Int -> Either String Char
chrEither :: Int -> Either String Char
chrEither Int
i
  | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF = forall a b. b -> Either a b
Right (Int -> Char
chr Int
i) -- Or: C# (chr# i#)
  | Bool
otherwise =
     forall a b. a -> Either a b
Left (String
"bad argument: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i)

-- Char is serialised as UTF-8
instance Serialize Char where
    put :: Putter Char
put Char
a | Int
c forall a. Ord a => a -> a -> Bool
<= Int
0x7f     = forall t. Serialize t => Putter t
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c :: Word8)
          | Int
c forall a. Ord a => a -> a -> Bool
<= Int
0x7ff    = do forall t. Serialize t => Putter t
put (Word8
0xc0 forall a. Bits a => a -> a -> a
.|. Word8
y)
                               forall t. Serialize t => Putter t
put (Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
z)
          | Int
c forall a. Ord a => a -> a -> Bool
<= Int
0xffff   = do forall t. Serialize t => Putter t
put (Word8
0xe0 forall a. Bits a => a -> a -> a
.|. Word8
x)
                               forall t. Serialize t => Putter t
put (Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
y)
                               forall t. Serialize t => Putter t
put (Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
z)
          | Int
c forall a. Ord a => a -> a -> Bool
<= Int
0x10ffff = do forall t. Serialize t => Putter t
put (Word8
0xf0 forall a. Bits a => a -> a -> a
.|. Word8
w)
                               forall t. Serialize t => Putter t
put (Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
x)
                               forall t. Serialize t => Putter t
put (Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
y)
                               forall t. Serialize t => Putter t
put (Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
z)
          | Bool
otherwise     = forall a. HasCallStack => String -> a
error String
"Not a valid Unicode code point"
     where
        c :: Int
c = Char -> Int
ord Char
a
        z, y, x, w :: Word8
        z :: Word8
z = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c           forall a. Bits a => a -> a -> a
.&. Int
0x3f)
        y :: Word8
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int
c Int
6  forall a. Bits a => a -> a -> a
.&. Int
0x3f)
        x :: Word8
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int
c Int
12 forall a. Bits a => a -> a -> a
.&. Int
0x3f)
        w :: Word8
w = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int
c Int
18 forall a. Bits a => a -> a -> a
.&. Int
0x7)

    get :: Get Char
get = do
        let getByte :: Get Int
getByte = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Int) forall t. Serialize t => Get t
get
            shiftL6 :: Int -> Int
shiftL6 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
shiftL Int
6 :: Int -> Int
        Int
w <- Get Int
getByte
        Int
r <- case () of
                ()
_ | Int
w forall a. Ord a => a -> a -> Bool
< Int
0x80  -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
w
                  | Int
w forall a. Ord a => a -> a -> Bool
< Int
0xe0  -> do
                                    Int
x <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Bits a => a -> a -> a
xor Int
0x80) Get Int
getByte
                                    forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6 (forall a. Bits a => a -> a -> a
xor Int
0xc0 Int
w))
                  | Int
w forall a. Ord a => a -> a -> Bool
< Int
0xf0  -> do
                                    Int
x <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Bits a => a -> a -> a
xor Int
0x80) Get Int
getByte
                                    Int
y <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Bits a => a -> a -> a
xor Int
0x80) Get Int
getByte
                                    forall (m :: * -> *) a. Monad m => a -> m a
return (Int
y forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6 (Int
x forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6
                                            (forall a. Bits a => a -> a -> a
xor Int
0xe0 Int
w)))
                  | Bool
otherwise -> do
                                Int
x <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Bits a => a -> a -> a
xor Int
0x80) Get Int
getByte
                                Int
y <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Bits a => a -> a -> a
xor Int
0x80) Get Int
getByte
                                Int
z <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Bits a => a -> a -> a
xor Int
0x80) Get Int
getByte
                                forall (m :: * -> *) a. Monad m => a -> m a
return (Int
z forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6 (Int
y forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6
                                        (Int
x forall a. Bits a => a -> a -> a
.|. Int -> Int
shiftL6 (forall a. Bits a => a -> a -> a
xor Int
0xf0 Int
w))))
        case Int -> Either String Char
chrEither Int
r of
            Right Char
r' ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char
r'
            Left String
err ->
                forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err

------------------------------------------------------------------------
-- Instances for the first few tuples

instance (Serialize a, Serialize b) => Serialize (a,b) where
    put :: Putter (a, b)
put = forall a b. Putter a -> Putter b -> Putter (a, b)
putTwoOf forall t. Serialize t => Putter t
put forall t. Serialize t => Putter t
put
    get :: Get (a, b)
get = forall a b. Get a -> Get b -> Get (a, b)
getTwoOf forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

instance (Serialize a, Serialize b, Serialize c) => Serialize (a,b,c) where
    put :: Putter (a, b, c)
put (a
a,b
b,c
c)         = forall t. Serialize t => Putter t
put a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put c
c
    get :: Get (a, b, c)
get                 = forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

instance (Serialize a, Serialize b, Serialize c, Serialize d)
        => Serialize (a,b,c,d) where
    put :: Putter (a, b, c, d)
put (a
a,b
b,c
c,d
d)       = forall t. Serialize t => Putter t
put a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put c
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put d
d
    get :: Get (a, b, c, d)
get                 = forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e)
        => Serialize (a,b,c,d,e) where
    put :: Putter (a, b, c, d, e)
put (a
a,b
b,c
c,d
d,e
e)     = forall t. Serialize t => Putter t
put a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put c
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put d
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put e
e
    get :: Get (a, b, c, d, e)
get                 = forall (m :: * -> *) a1 a2 a3 a4 a5 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> a5 -> r)
-> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
liftM5 (,,,,) forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

--
-- and now just recurse:
--

instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e
         , Serialize f)
        => Serialize (a,b,c,d,e,f) where
    put :: Putter (a, b, c, d, e, f)
put (a
a,b
b,c
c,d
d,e
e,f
f)   = forall t. Serialize t => Putter t
put (a
a,(b
b,c
c,d
d,e
e,f
f))
    get :: Get (a, b, c, d, e, f)
get                 = do (a
a,(b
b,c
c,d
d,e
e,f
f)) <- forall t. Serialize t => Get t
get ; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
e,f
f)

instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e
         , Serialize f, Serialize g)
        => Serialize (a,b,c,d,e,f,g) where
    put :: Putter (a, b, c, d, e, f, g)
put (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = forall t. Serialize t => Putter t
put (a
a,(b
b,c
c,d
d,e
e,f
f,g
g))
    get :: Get (a, b, c, d, e, f, g)
get                 = do (a
a,(b
b,c
c,d
d,e
e,f
f,g
g)) <- forall t. Serialize t => Get t
get ; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
e,f
f,g
g)

instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e,
          Serialize f, Serialize g, Serialize h)
        => Serialize (a,b,c,d,e,f,g,h) where
    put :: Putter (a, b, c, d, e, f, g, h)
put (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = forall t. Serialize t => Putter t
put (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h))
    get :: Get (a, b, c, d, e, f, g, h)
get                   = do (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h)) <- forall t. Serialize t => Get t
get
                               forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h)

instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e,
          Serialize f, Serialize g, Serialize h, Serialize i)
        => Serialize (a,b,c,d,e,f,g,h,i) where
    put :: Putter (a, b, c, d, e, f, g, h, i)
put (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = forall t. Serialize t => Putter t
put (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i))
    get :: Get (a, b, c, d, e, f, g, h, i)
get                     = do (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i)) <- forall t. Serialize t => Get t
get
                                 forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i)

instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e,
          Serialize f, Serialize g, Serialize h, Serialize i, Serialize j)
        => Serialize (a,b,c,d,e,f,g,h,i,j) where
    put :: Putter (a, b, c, d, e, f, g, h, i, j)
put (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j) = forall t. Serialize t => Putter t
put (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j))
    get :: Get (a, b, c, d, e, f, g, h, i, j)
get                       = do (a
a,(b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j)) <- forall t. Serialize t => Get t
get
                                   forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j)

------------------------------------------------------------------------
-- Monoid newtype wrappers

instance Serialize a => Serialize (M.Dual a) where
    put :: Putter (Dual a)
put = forall t. Serialize t => Putter t
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
M.getDual
    get :: Get (Dual a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Dual a
M.Dual forall t. Serialize t => Get t
get

instance Serialize M.All where
    put :: Putter All
put = forall t. Serialize t => Putter t
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. All -> Bool
M.getAll
    get :: Get All
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> All
M.All forall t. Serialize t => Get t
get

instance Serialize M.Any where
    put :: Putter Any
put = forall t. Serialize t => Putter t
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Bool
M.getAny
    get :: Get Any
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Any
M.Any forall t. Serialize t => Get t
get

instance Serialize a => Serialize (M.Sum a) where
    put :: Putter (Sum a)
put = forall t. Serialize t => Putter t
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Sum a -> a
M.getSum
    get :: Get (Sum a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Sum a
M.Sum forall t. Serialize t => Get t
get

instance Serialize a => Serialize (M.Product a) where
    put :: Putter (Product a)
put = forall t. Serialize t => Putter t
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Product a -> a
M.getProduct
    get :: Get (Product a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Product a
M.Product forall t. Serialize t => Get t
get

instance Serialize a => Serialize (M.First a) where
    put :: Putter (First a)
put = forall t. Serialize t => Putter t
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. First a -> Maybe a
M.getFirst
    get :: Get (First a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> First a
M.First forall t. Serialize t => Get t
get

instance Serialize a => Serialize (M.Last a) where
    put :: Putter (Last a)
put = forall t. Serialize t => Putter t
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Last a -> Maybe a
M.getLast
    get :: Get (Last a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Last a
M.Last forall t. Serialize t => Get t
get

------------------------------------------------------------------------
-- Container types

instance Serialize a => Serialize [a] where
    put :: Putter [a]
put = forall a. Putter a -> Putter [a]
putListOf forall t. Serialize t => Putter t
put
    get :: Get [a]
get = forall a. Get a -> Get [a]
getListOf forall t. Serialize t => Get t
get

instance (Serialize a) => Serialize (Maybe a) where
    put :: Putter (Maybe a)
put = forall a. Putter a -> Putter (Maybe a)
putMaybeOf forall t. Serialize t => Putter t
put
    get :: Get (Maybe a)
get = forall a. Get a -> Get (Maybe a)
getMaybeOf forall t. Serialize t => Get t
get

instance (Serialize a, Serialize b) => Serialize (Either a b) where
    put :: Putter (Either a b)
put = forall a b. Putter a -> Putter b -> Putter (Either a b)
putEitherOf forall t. Serialize t => Putter t
put forall t. Serialize t => Putter t
put
    get :: Get (Either a b)
get = forall a b. Get a -> Get b -> Get (Either a b)
getEitherOf forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

------------------------------------------------------------------------
-- ByteStrings (have specially efficient instances)

instance Serialize B.ByteString where
    put :: Putter ByteString
put ByteString
bs = do forall t. Serialize t => Putter t
put (ByteString -> Int
B.length ByteString
bs :: Int)
                Putter ByteString
putByteString ByteString
bs
    get :: Get ByteString
get    = forall t. Serialize t => Get t
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString

instance Serialize L.ByteString where
    put :: Putter ByteString
put ByteString
bs = do forall t. Serialize t => Putter t
put (ByteString -> Int64
L.length ByteString
bs :: Int64)
                Putter ByteString
putLazyByteString ByteString
bs
    get :: Get ByteString
get    = forall t. Serialize t => Get t
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64 -> Get ByteString
getLazyByteString

instance Serialize S.ShortByteString where
    put :: Putter ShortByteString
put ShortByteString
sbs = do forall t. Serialize t => Putter t
put (ShortByteString -> Int
S.length ShortByteString
sbs)
                 Putter ShortByteString
putShortByteString ShortByteString
sbs
    get :: Get ShortByteString
get     = forall t. Serialize t => Get t
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ShortByteString
getShortByteString


------------------------------------------------------------------------
-- Maps and Sets

instance (Ord a, Serialize a) => Serialize (Set.Set a) where
    put :: Putter (Set a)
put = forall a. Putter a -> Putter (Set a)
putSetOf forall t. Serialize t => Putter t
put
    get :: Get (Set a)
get = forall a. Ord a => Get a -> Get (Set a)
getSetOf forall t. Serialize t => Get t
get

instance (Ord k, Serialize k, Serialize e) => Serialize (Map.Map k e) where
    put :: Putter (Map k e)
put = forall k a. Putter k -> Putter a -> Putter (Map k a)
putMapOf forall t. Serialize t => Putter t
put forall t. Serialize t => Putter t
put
    get :: Get (Map k e)
get = forall k a. Ord k => Get k -> Get a -> Get (Map k a)
getMapOf forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

instance Serialize IntSet.IntSet where
    put :: Putter IntSet
put = Putter Int -> Putter IntSet
putIntSetOf forall t. Serialize t => Putter t
put
    get :: Get IntSet
get = Get Int -> Get IntSet
getIntSetOf forall t. Serialize t => Get t
get

instance (Serialize e) => Serialize (IntMap.IntMap e) where
    put :: Putter (IntMap e)
put = forall a. Putter Int -> Putter a -> Putter (IntMap a)
putIntMapOf forall t. Serialize t => Putter t
put forall t. Serialize t => Putter t
put
    get :: Get (IntMap e)
get = forall a. Get Int -> Get a -> Get (IntMap a)
getIntMapOf forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

------------------------------------------------------------------------
-- Queues and Sequences

instance (Serialize e) => Serialize (Seq.Seq e) where
    put :: Putter (Seq e)
put = forall a. Putter a -> Putter (Seq a)
putSeqOf forall t. Serialize t => Putter t
put
    get :: Get (Seq e)
get = forall a. Get a -> Get (Seq a)
getSeqOf forall t. Serialize t => Get t
get

------------------------------------------------------------------------
-- Floating point

instance Serialize Double where
    put :: Putter Double
put = Putter Double
putFloat64be
    get :: Get Double
get = Get Double
getFloat64be

instance Serialize Float where
    put :: Putter Float
put = Putter Float
putFloat32be
    get :: Get Float
get = Get Float
getFloat32be

------------------------------------------------------------------------
-- Trees

instance (Serialize e) => Serialize (T.Tree e) where
    put :: Putter (Tree e)
put = forall a. Putter a -> Putter (Tree a)
putTreeOf forall t. Serialize t => Putter t
put
    get :: Get (Tree e)
get = forall a. Get a -> Get (Tree a)
getTreeOf forall t. Serialize t => Get t
get

------------------------------------------------------------------------
-- Arrays

instance (Serialize i, Ix i, Serialize e) => Serialize (Array i e) where
    put :: Putter (Array i e)
put = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
Putter i -> Putter e -> Putter (a i e)
putIArrayOf forall t. Serialize t => Putter t
put forall t. Serialize t => Putter t
put
    get :: Get (Array i e)
get = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
Get i -> Get e -> Get (a i e)
getIArrayOf forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

--
-- The IArray UArray e constraint is non portable. Requires flexible instances
--
instance (Serialize i, Ix i, Serialize e, IArray UArray e)
  => Serialize (UArray i e) where
    put :: Putter (UArray i e)
put = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
Putter i -> Putter e -> Putter (a i e)
putIArrayOf forall t. Serialize t => Putter t
put forall t. Serialize t => Putter t
put
    get :: Get (UArray i e)
get = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
Get i -> Get e -> Get (a i e)
getIArrayOf forall t. Serialize t => Get t
get forall t. Serialize t => Get t
get

------------------------------------------------------------------------
-- Generic Serialze

class GSerializePut f where
    gPut :: Putter (f a)

class GSerializeGet f where
    gGet :: Get (f a)

instance GSerializePut a => GSerializePut (M1 i c a) where
    gPut :: forall a. Putter (M1 i c a a)
gPut = forall (f :: * -> *) a. GSerializePut f => Putter (f a)
gPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    {-# INLINE gPut #-}

instance GSerializeGet a => GSerializeGet (M1 i c a) where
    gGet :: forall a. Get (M1 i c a a)
gGet = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. GSerializeGet f => Get (f a)
gGet
    {-# INLINE gGet #-}

instance Serialize a => GSerializePut (K1 i a) where
    gPut :: forall a. Putter (K1 i a a)
gPut = forall t. Serialize t => Putter t
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1
    {-# INLINE gPut #-}

instance Serialize a => GSerializeGet (K1 i a) where
    gGet :: forall a. Get (K1 i a a)
gGet = forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
get
    {-# INLINE gGet #-}

instance GSerializePut U1 where
    gPut :: forall a. Putter (U1 a)
gPut U1 a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    {-# INLINE gPut #-}

instance GSerializeGet U1 where
    gGet :: forall a. Get (U1 a)
gGet   = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
U1
    {-# INLINE gGet #-}

-- | Always fails to serialize
instance GSerializePut V1 where
    gPut :: forall a. Putter (V1 a)
gPut V1 a
v = V1 a
v seq :: forall a b. a -> b -> b
`seq` forall a. HasCallStack => String -> a
error String
"GSerializePut.V1"
    {-# INLINE gPut #-}

-- | Always fails to deserialize
instance GSerializeGet V1 where
    gGet :: forall a. Get (V1 a)
gGet   = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"GSerializeGet.V1"
    {-# INLINE gGet #-}

instance (GSerializePut a, GSerializePut b) => GSerializePut (a :*: b) where
    gPut :: forall a. Putter ((:*:) a b a)
gPut (a a
a :*: b a
b) = forall (f :: * -> *) a. GSerializePut f => Putter (f a)
gPut a a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. GSerializePut f => Putter (f a)
gPut b a
b
    {-# INLINE gPut #-}

instance (GSerializeGet a, GSerializeGet b) => GSerializeGet (a :*: b) where
    gGet :: forall a. Get ((:*:) a b a)
gGet = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. GSerializeGet f => Get (f a)
gGet  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. GSerializeGet f => Get (f a)
gGet
    {-# INLINE gGet #-}

-- The following GSerialize* instance for sums has support for serializing types
-- with up to 2^64-1 constructors. It will use the minimal number of bytes
-- needed to encode the constructor. For example when a type has 2^8
-- constructors or less it will use a single byte to encode the constructor. If
-- it has 2^16 constructors or less it will use two bytes, and so on till 2^64-1.

#define GUARD(WORD) (size - 1) <= fromIntegral (maxBound :: WORD)
#define PUTSUM(WORD) GUARD(WORD) = putSum (0 :: WORD) (fromIntegral size)
#define GETSUM(WORD) GUARD(WORD) = (get :: Get WORD) >>= checkGetSum (fromIntegral size)

instance ( PutSum        a, PutSum        b
         , SumSize       a, SumSize       b) => GSerializePut (a :+: b) where
    gPut :: forall a. Putter ((:+:) a b a)
gPut | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64)
         | Bool
otherwise = forall size error. Show size => String -> size -> error
sizeError String
"encode" Word64
size
      where
        size :: Word64
size = forall (s :: * -> *) b. Tagged s b -> b
unTagged (forall (f :: * -> *). SumSize f => Tagged f Word64
sumSize :: Tagged (a :+: b) Word64)
    {-# INLINE gPut #-}

instance ( GetSum        a, GetSum        b
         , SumSize       a, SumSize       b) => GSerializeGet (a :+: b) where
    gGet :: forall a. Get ((:+:) a b a)
gGet | GETSUM(Word8) | GETSUM(Word16) | GETSUM(Word32) | GETSUM(Word64)
         | Bool
otherwise = forall size error. Show size => String -> size -> error
sizeError String
"decode" Word64
size
      where
        size :: Word64
size = forall (s :: * -> *) b. Tagged s b -> b
unTagged (forall (f :: * -> *). SumSize f => Tagged f Word64
sumSize :: Tagged (a :+: b) Word64)
    {-# INLINE gGet #-}

sizeError :: Show size => String -> size -> error
sizeError :: forall size error. Show size => String -> size -> error
sizeError String
s size
size = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Can't " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
" a type with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show size
size forall a. [a] -> [a] -> [a]
++ String
" constructors"

------------------------------------------------------------------------

class PutSum f where
    putSum :: (Num word, Bits word, Serialize word) => word -> word -> Putter (f a)

instance (PutSum a, PutSum b) => PutSum (a :+: b) where
    putSum :: forall word a.
(Num word, Bits word, Serialize word) =>
word -> word -> Putter ((:+:) a b a)
putSum !word
code !word
size (:+:) a b a
s = case (:+:) a b a
s of
                             L1 a a
x -> forall (f :: * -> *) word a.
(PutSum f, Num word, Bits word, Serialize word) =>
word -> word -> Putter (f a)
putSum word
code           word
sizeL a a
x
                             R1 b a
x -> forall (f :: * -> *) word a.
(PutSum f, Num word, Bits word, Serialize word) =>
word -> word -> Putter (f a)
putSum (word
code forall a. Num a => a -> a -> a
+ word
sizeL) word
sizeR b a
x
        where
#if MIN_VERSION_base(4,5,0)
          sizeL :: word
sizeL = word
size forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
#else
          sizeL = size `shiftR` 1
#endif
          sizeR :: word
sizeR = word
size forall a. Num a => a -> a -> a
- word
sizeL
    {-# INLINE putSum #-}

instance GSerializePut a => PutSum (C1 c a) where
    putSum :: forall word a.
(Num word, Bits word, Serialize word) =>
word -> word -> Putter (C1 c a a)
putSum !word
code word
_ C1 c a a
x = forall t. Serialize t => Putter t
put word
code forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. GSerializePut f => Putter (f a)
gPut C1 c a a
x
    {-# INLINE putSum #-}

------------------------------------------------------------------------

checkGetSum :: (Ord word, Num word, Bits word, GetSum f)
            => word -> word -> Get (f a)
checkGetSum :: forall word (f :: * -> *) a.
(Ord word, Num word, Bits word, GetSum f) =>
word -> word -> Get (f a)
checkGetSum word
size word
code | word
code forall a. Ord a => a -> a -> Bool
< word
size = forall (f :: * -> *) word a.
(GetSum f, Ord word, Num word, Bits word) =>
word -> word -> Get (f a)
getSum word
code word
size
                      | Bool
otherwise   = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown encoding for constructor"
{-# INLINE checkGetSum #-}

class GetSum f where
    getSum :: (Ord word, Num word, Bits word) => word -> word -> Get (f a)

instance (GetSum a, GetSum b) => GetSum (a :+: b) where
    getSum :: forall word a.
(Ord word, Num word, Bits word) =>
word -> word -> Get ((:+:) a b a)
getSum !word
code !word
size | word
code forall a. Ord a => a -> a -> Bool
< word
sizeL = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) word a.
(GetSum f, Ord word, Num word, Bits word) =>
word -> word -> Get (f a)
getSum word
code           word
sizeL
                       | Bool
otherwise    = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) word a.
(GetSum f, Ord word, Num word, Bits word) =>
word -> word -> Get (f a)
getSum (word
code forall a. Num a => a -> a -> a
- word
sizeL) word
sizeR
        where
#if MIN_VERSION_base(4,5,0)
          sizeL :: word
sizeL = word
size forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
#else
          sizeL = size `shiftR` 1
#endif
          sizeR :: word
sizeR = word
size forall a. Num a => a -> a -> a
- word
sizeL
    {-# INLINE getSum #-}

instance GSerializeGet a => GetSum (C1 c a) where
    getSum :: forall word a.
(Ord word, Num word, Bits word) =>
word -> word -> Get (C1 c a a)
getSum word
_ word
_ = forall (f :: * -> *) a. GSerializeGet f => Get (f a)
gGet
    {-# INLINE getSum #-}

------------------------------------------------------------------------

class SumSize f where
    sumSize :: Tagged f Word64

newtype Tagged (s :: * -> *) b = Tagged {forall (s :: * -> *) b. Tagged s b -> b
unTagged :: b}

instance (SumSize a, SumSize b) => SumSize (a :+: b) where
    sumSize :: Tagged (a :+: b) Word64
sumSize = forall (s :: * -> *) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b. Tagged s b -> b
unTagged (forall (f :: * -> *). SumSize f => Tagged f Word64
sumSize :: Tagged a Word64) forall a. Num a => a -> a -> a
+
                       forall (s :: * -> *) b. Tagged s b -> b
unTagged (forall (f :: * -> *). SumSize f => Tagged f Word64
sumSize :: Tagged b Word64)

instance SumSize (C1 c a) where
    sumSize :: Tagged (C1 c a) Word64
sumSize = forall (s :: * -> *) b. b -> Tagged s b
Tagged Word64
1