{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
#if defined(__GLASGOW_HASKELL__)
# if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Trustworthy #-}
# endif
# if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE EmptyCase #-}
# endif
#endif
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013-2015
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
-- This module contains two main classes, each providing methods to
-- serialize and deserialize types. 'Serial' is the primary class,
-- to be used for the canonical way to serialize a specific
-- type. 'SerialEndian' is used to provide endian-specific methods
-- for serializing a type.
--------------------------------------------------------------------
module Data.Bytes.Serial
  (
  -- * Serialization
    Serial(..)
  -- * Specifying endianness
  , SerialEndian(..)
  -- * Higher-order
  -- $higher
  , Serial1(..)
  , serialize1, deserialize1
  , Serial2(..)
  , serialize2, deserialize2
  -- * Storable
  , store, restore
  -- * Generics
  -- $generics
  , GSerial(..)
  , GSerialEndian(..)
  , GSerial1(..)
  ) where

import Control.Applicative
import Control.Monad
import qualified Control.Monad.Fail as MonadFail
import qualified Data.Foldable as F
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Signed
import Data.Bytes.VarInt
import Data.ByteString.Internal
import Data.ByteString.Lazy as Lazy
import Data.ByteString as Strict
import Data.Int
import Data.Bits
import Data.Monoid as Monoid
import Data.Functor.Identity as Functor
import Data.Functor.Constant as Functor
import Data.Functor.Product  as Functor
import Data.Functor.Reverse  as Functor
import Data.Hashable (Hashable)
import qualified Data.HashMap.Lazy as HMap
import qualified Data.HashSet      as HSet
import qualified Data.List.NonEmpty as NEL
import Data.Time
import Data.Time.Clock.TAI
import qualified Data.IntMap as IMap
import qualified Data.IntSet as ISet
import qualified Data.Map as Map
import qualified Data.Scientific as Sci
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Text as SText
import Data.Text.Encoding as SText
import Data.Text.Lazy as LText
import Data.Text.Lazy.Encoding as LText
import Data.Version (Version(..))
import Data.Void
import Data.Word
import Data.Fixed
import Data.Ratio
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import GHC.Exts (Down(..))
import GHC.Generics
import System.IO.Unsafe
import Numeric.Natural

foreign import ccall floatToWord32 :: Float -> Word32
foreign import ccall word32ToFloat :: Word32 -> Float
foreign import ccall doubleToWord64 :: Double -> Word64
foreign import ccall word64ToDouble :: Word64 -> Double

-- $setup
-- >>> import Data.Bytes.Get
-- >>> import Data.Bytes.Put
-- >>> import Data.Bytes.VarInt
-- >>> import Data.Fixed
-- >>> import Data.Ratio (Ratio, (%))
-- >>> import Data.Time
-- >>> import Data.Time.Clock
-- >>> import Data.Time.Clock.TAI
-- >>> import Data.Word
-- >>> import Numeric.Natural

------------------------------------------------------------------------------
-- Endianness-Dependant Serialization
------------------------------------------------------------------------------

{-| Methods to serialize and deserialize type 'a' to a big and little endian
binary representations. Methods suffixed with "host" are automatically defined
to use equal the methods corresponding to the current machine's native
endianness, but they can be overridden.
-}
class SerialEndian a where
  serializeBE :: MonadPut m => a -> m ()
#ifndef HLINT
  default serializeBE :: (MonadPut m, GSerialEndian (Rep a), Generic a) => a -> m ()
  serializeBE = Rep a Any -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerialEndian f, MonadPut m) =>
f a -> m ()
gserializeBE (Rep a Any -> m ()) -> (a -> Rep a Any) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
#endif

  deserializeBE :: MonadGet m => m a
#ifndef HLINT
  default deserializeBE :: (MonadGet m, GSerialEndian (Rep a), Generic a) => m a
  deserializeBE = (Rep a Any -> a) -> m (Rep a Any) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to m (Rep a Any)
forall (f :: * -> *) (m :: * -> *) a.
(GSerialEndian f, MonadGet m) =>
m (f a)
gdeserializeBE
#endif

  serializeLE :: MonadPut m => a -> m ()
#ifndef HLINT
  default serializeLE :: (MonadPut m, GSerialEndian (Rep a), Generic a) => a -> m ()
  serializeLE = Rep a Any -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerialEndian f, MonadPut m) =>
f a -> m ()
gserializeLE (Rep a Any -> m ()) -> (a -> Rep a Any) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
#endif

  deserializeLE :: MonadGet m => m a
#ifndef HLINT
  default deserializeLE :: (MonadGet m, GSerialEndian (Rep a), Generic a) => m a
  deserializeLE = (Rep a Any -> a) -> m (Rep a Any) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to m (Rep a Any)
forall (f :: * -> *) (m :: * -> *) a.
(GSerialEndian f, MonadGet m) =>
m (f a)
gdeserializeLE
#endif

  serializeHost :: MonadPut m => a -> m ()
  deserializeHost :: MonadGet m => m a
#ifdef WORDS_BIGENDIAN
  serializeHost = serializeBE
  deserializeHost = deserializeBE
#else
  serializeHost = a -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeLE
  deserializeHost = m a
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeLE
#endif

instance SerialEndian Double where
  serializeBE :: Double -> m ()
serializeBE = Word64 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE (Word64 -> m ()) -> (Double -> Word64) -> Double -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord64
  deserializeBE :: m Double
deserializeBE = (Word64 -> Double) -> m Word64 -> m Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word64 -> Double
word64ToDouble m Word64
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

  serializeLE :: Double -> m ()
serializeLE = Word64 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeLE (Word64 -> m ()) -> (Double -> Word64) -> Double -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord64
  deserializeLE :: m Double
deserializeLE = (Word64 -> Double) -> m Word64 -> m Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word64 -> Double
word64ToDouble m Word64
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeLE

instance SerialEndian Float where
  serializeBE :: Float -> m ()
serializeBE = Word32 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE (Word32 -> m ()) -> (Float -> Word32) -> Float -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
floatToWord32
  deserializeBE :: m Float
deserializeBE = (Word32 -> Float) -> m Word32 -> m Float
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Float
word32ToFloat m Word32
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

  serializeLE :: Float -> m ()
serializeLE = Word32 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeLE (Word32 -> m ()) -> (Float -> Word32) -> Float -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
floatToWord32
  deserializeLE :: m Float
deserializeLE = (Word32 -> Float) -> m Word32 -> m Float
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Float
word32ToFloat m Word32
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeLE

instance SerialEndian Char where
  serializeBE :: Char -> m ()
serializeBE = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be (Word32 -> m ()) -> (Char -> Word32) -> Char -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (Char -> Int) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum
  deserializeBE :: m Char
deserializeBE = (Word32 -> Char) -> m Word32 -> m Char
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word32 -> Int) -> Word32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be

  serializeLE :: Char -> m ()
serializeLE = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Word32 -> m ()) -> (Char -> Word32) -> Char -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (Char -> Int) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum
  deserializeLE :: m Char
deserializeLE = (Word32 -> Char) -> m Word32 -> m Char
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word32 -> Int) -> Word32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le

instance SerialEndian Word64 where
  serializeBE :: Word64 -> m ()
serializeBE = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be
  deserializeBE :: m Word64
deserializeBE = m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be

  serializeLE :: Word64 -> m ()
serializeLE = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le
  deserializeLE :: m Word64
deserializeLE = m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le

instance SerialEndian Word32 where
  serializeBE :: Word32 -> m ()
serializeBE = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be
  deserializeBE :: m Word32
deserializeBE = m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be

  serializeLE :: Word32 -> m ()
serializeLE = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le
  deserializeLE :: m Word32
deserializeLE = m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le

instance SerialEndian Word16 where
  serializeBE :: Word16 -> m ()
serializeBE = Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be
  deserializeBE :: m Word16
deserializeBE = m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be

  serializeLE :: Word16 -> m ()
serializeLE = Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16le
  deserializeLE :: m Word16
deserializeLE = m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16le

instance SerialEndian Int64 where
  serializeBE :: Int64 -> m ()
serializeBE = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Word64 -> m ()) -> (Int64 -> Word64) -> Int64 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  deserializeBE :: m Int64
deserializeBE = (Word64 -> Int64) -> m Word64 -> m Int64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be

  serializeLE :: Int64 -> m ()
serializeLE = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le (Word64 -> m ()) -> (Int64 -> Word64) -> Int64 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  deserializeLE :: m Int64
deserializeLE = (Word64 -> Int64) -> m Word64 -> m Int64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le

instance SerialEndian Int32 where
  serializeBE :: Int32 -> m ()
serializeBE = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be (Word32 -> m ()) -> (Int32 -> Word32) -> Int32 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  deserializeBE :: m Int32
deserializeBE = (Word32 -> Int32) -> m Word32 -> m Int32
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be

  serializeLE :: Int32 -> m ()
serializeLE = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Word32 -> m ()) -> (Int32 -> Word32) -> Int32 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  deserializeLE :: m Int32
deserializeLE = (Word32 -> Int32) -> m Word32 -> m Int32
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le

instance SerialEndian Int16 where
  serializeBE :: Int16 -> m ()
serializeBE = Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be (Word16 -> m ()) -> (Int16 -> Word16) -> Int16 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  deserializeBE :: m Int16
deserializeBE = (Word16 -> Int16) -> m Word16 -> m Int16
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be

  serializeLE :: Int16 -> m ()
serializeLE = Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16le (Word16 -> m ()) -> (Int16 -> Word16) -> Int16 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  deserializeLE :: m Int16
deserializeLE = (Word16 -> Int16) -> m Word16 -> m Int16
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16le

------------------------------------------------------------------------------
-- Serialization
------------------------------------------------------------------------------

{-| Methods to serialize and deserialize type 'a' to a binary representation

Instances provided here for fixed-with Integers and Words are big endian.
Instances for strict and lazy bytestrings store also the length of bytestring
big endian. Instances for Word and Int are host endian as they are
machine-specific types.
-}
class Serial a where
  serialize :: MonadPut m => a -> m ()
#ifndef HLINT
  default serialize :: (MonadPut m, GSerial (Rep a), Generic a) => a -> m ()
  serialize = Rep a Any -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadPut m) =>
f a -> m ()
gserialize (Rep a Any -> m ()) -> (a -> Rep a Any) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
#endif

  deserialize :: MonadGet m => m a
#ifndef HLINT
  default deserialize :: (MonadGet m, GSerial (Rep a), Generic a) => m a
  deserialize = (Rep a Any -> a) -> m (Rep a Any) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to m (Rep a Any)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadGet m) =>
m (f a)
gdeserialize
#endif

instance Serial Strict.ByteString where
  serialize :: ByteString -> m ()
serialize ByteString
bs = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
Strict.length ByteString
bs)) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
bs
  deserialize :: m ByteString
deserialize = do
    Word32
n <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
    Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)

instance Serial Lazy.ByteString where
  serialize :: ByteString -> m ()
serialize ByteString
bs = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
Lazy.length ByteString
bs)) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLazyByteString ByteString
bs
  deserialize :: m ByteString
deserialize = do
    Word64
n <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Int64 -> m ByteString
forall (m :: * -> *). MonadGet m => Int64 -> m ByteString
getLazyByteString (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)

instance Serial SText.Text where
  serialize :: Text -> m ()
serialize = ByteString -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ByteString -> m ()) -> (Text -> ByteString) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
SText.encodeUtf8
  deserialize :: m Text
deserialize = ByteString -> Text
SText.decodeUtf8 (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m ByteString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial LText.Text where
  serialize :: Text -> m ()
serialize = ByteString -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ByteString -> m ()) -> (Text -> ByteString) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
LText.encodeUtf8
  deserialize :: m Text
deserialize = ByteString -> Text
LText.decodeUtf8 (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m ByteString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial ()
instance Serial a => Serial [a]
instance Serial a => Serial (Maybe a)
instance (Serial a, Serial b) => Serial (Either a b)
instance (Serial a, Serial b) => Serial (a, b)
instance (Serial a, Serial b, Serial c) => Serial (a, b, c)
instance (Serial a, Serial b, Serial c, Serial d) => Serial (a, b, c, d)
instance (Serial a, Serial b, Serial c, Serial d, Serial e) => Serial (a, b, c, d, e)

instance Serial Bool

-- | serialize any 'Storable' in a host-specific format.
store :: (MonadPut m, Storable a) => a -> m ()
store :: a -> m ()
store a
a = ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
bs
  where bs :: ByteString
bs = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create (a -> Int
forall a. Storable a => a -> Int
sizeOf a
a) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
p -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) a
a

-- | deserialize any 'Storable' in a host-specific format.
restore :: forall m a. (MonadGet m, Storable a) => m a
restore :: m a
restore = do
  let required :: Int
required = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
#if MIN_VERSION_bytestring(0,11,0)
  let o = 0
  BS fp n
#else
  PS ForeignPtr Word8
fp Int
o Int
n
#endif
    <- Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
required
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
required) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
"restore: Required more bytes"
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
o

instance Serial Double where
  serialize :: Double -> m ()
serialize = Double -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Double
deserialize = m Double
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

instance Serial Float where
  serialize :: Float -> m ()
serialize = Float -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Float
deserialize = m Float
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

instance Serial Char where
  serialize :: Char -> m ()
serialize = Char -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Char
deserialize = m Char
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

 -- host endian
instance Serial Word where
  serialize :: Word -> m ()
serialize = Word -> m ()
forall (m :: * -> *). MonadPut m => Word -> m ()
putWordhost
  deserialize :: m Word
deserialize = m Word
forall (m :: * -> *). MonadGet m => m Word
getWordhost

instance Serial Word64 where
  serialize :: Word64 -> m ()
serialize = Word64 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Word64
deserialize = m Word64
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

instance Serial Word32 where
  serialize :: Word32 -> m ()
serialize = Word32 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Word32
deserialize = m Word32
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

instance Serial Word16 where
  serialize :: Word16 -> m ()
serialize = Word16 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Word16
deserialize = m Word16
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

instance Serial Word8 where
  serialize :: Word8 -> m ()
serialize = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8
  deserialize :: m Word8
deserialize = m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8

 -- host endian
instance Serial Int where
  serialize :: Int -> m ()
serialize = Word -> m ()
forall (m :: * -> *). MonadPut m => Word -> m ()
putWordhost (Word -> m ()) -> (Int -> Word) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  deserialize :: m Int
deserialize = (Word -> Int) -> m Word -> m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral m Word
forall (m :: * -> *). MonadGet m => m Word
getWordhost

instance Serial Int64 where
  serialize :: Int64 -> m ()
serialize = Int64 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Int64
deserialize = m Int64
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

instance Serial Int32 where
  serialize :: Int32 -> m ()
serialize = Int32 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Int32
deserialize = m Int32
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

instance Serial Int16 where
  serialize :: Int16 -> m ()
serialize = Int16 -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE
  deserialize :: m Int16
deserialize = m Int16
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

instance Serial Int8 where
  serialize :: Int8 -> m ()
serialize = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> m ()) -> (Int8 -> Word8) -> Int8 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  deserialize :: m Int8
deserialize = (Word8 -> Int8) -> m Word8 -> m Int8
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8

instance Serial Sci.Scientific where
  serialize :: Scientific -> m ()
serialize Scientific
s = (Integer, Int) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Scientific -> Integer
Sci.coefficient Scientific
s, Scientific -> Int
Sci.base10Exponent Scientific
s)
  deserialize :: m Scientific
deserialize = (Integer -> Int -> Scientific) -> (Integer, Int) -> Scientific
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Int -> Scientific
Sci.scientific ((Integer, Int) -> Scientific) -> m (Integer, Int) -> m Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Integer, Int)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial Void where
  serialize :: Void -> m ()
serialize = Void -> m ()
forall a. Void -> a
absurd
  deserialize :: m Void
deserialize = String -> m Void
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
"I looked into the void."

instance Serial ISet.IntSet where
  serialize :: IntSet -> m ()
serialize = [Int] -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ([Int] -> m ()) -> (IntSet -> [Int]) -> IntSet -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
ISet.toAscList
  deserialize :: m IntSet
deserialize = [Int] -> IntSet
ISet.fromList ([Int] -> IntSet) -> m [Int] -> m IntSet
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m [Int]
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (Seq.Seq a) where
  serialize :: Seq a -> m ()
serialize = (a -> m ()) -> Seq a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserialize :: m (Seq a)
deserialize = m a -> m (Seq a)
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (NEL.NonEmpty a) where
  serialize :: NonEmpty a -> m ()
serialize = (a -> m ()) -> NonEmpty a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserialize :: m (NonEmpty a)
deserialize = m a -> m (NonEmpty a)
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance (Serial a, Ord a) => Serial (Set.Set a) where
  serialize :: Set a -> m ()
serialize = [a] -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ([a] -> m ()) -> (Set a -> [a]) -> Set a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toAscList
  deserialize :: m (Set a)
deserialize = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> m [a] -> m (Set a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m [a]
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial v => Serial (IMap.IntMap v) where
  serialize :: IntMap v -> m ()
serialize = (v -> m ()) -> IntMap v -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith v -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserialize :: m (IntMap v)
deserialize = m v -> m (IntMap v)
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m v
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance (Serial k, Serial v, Ord k) => Serial (Map.Map k v) where
  serialize :: Map k v -> m ()
serialize = (v -> m ()) -> Map k v -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith v -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserialize :: m (Map k v)
deserialize = m v -> m (Map k v)
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m v
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance (Serial k, Serial v, Hashable k, Eq k) => Serial (HMap.HashMap k v) where
  serialize :: HashMap k v -> m ()
serialize = (v -> m ()) -> HashMap k v -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith v -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserialize :: m (HashMap k v)
deserialize = m v -> m (HashMap k v)
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m v
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance (Serial v, Hashable v, Eq v) => Serial (HSet.HashSet v) where
  serialize :: HashSet v -> m ()
serialize = [v] -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ([v] -> m ()) -> (HashSet v -> [v]) -> HashSet v -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet v -> [v]
forall a. HashSet a -> [a]
HSet.toList
  deserialize :: m (HashSet v)
deserialize = [v] -> HashSet v
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HSet.fromList ([v] -> HashSet v) -> m [v] -> m (HashSet v)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m [v]
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

putVarInt :: (MonadPut m, Integral a, Bits a) => a -> m ()
putVarInt :: a -> m ()
putVarInt a
n
  | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x80 = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
  | Bool
otherwise = do
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Int
7
    a -> m ()
forall (m :: * -> *) a.
(MonadPut m, Integral a, Bits a) =>
a -> m ()
putVarInt (a -> m ()) -> a -> m ()
forall a b. (a -> b) -> a -> b
$ a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
n Int
7
{-# INLINE putVarInt #-}

getVarInt :: (MonadGet m, Num b, Bits b) => Word8 -> m b
getVarInt :: Word8 -> m b
getVarInt Word8
n
  | Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
n Int
7 = do
    VarInt b
m <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m (VarInt b)) -> m (VarInt b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> m (VarInt b)
forall (m :: * -> *) b. (MonadGet m, Num b, Bits b) => Word8 -> m b
getVarInt
    b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ b -> Int -> b
forall a. Bits a => a -> Int -> a
shiftL b
m Int
7 b -> b -> b
forall a. Bits a => a -> a -> a
.|. b -> Int -> b
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) Int
7
  | Bool
otherwise = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n
{-# INLINE getVarInt #-}


-- | Integer/Word types serialized to base-128 variable-width ints.
--
-- >>> import Data.Monoid (mconcat)
-- >>> import qualified Data.ByteString.Lazy as BSL
-- >>> mconcat $ BSL.toChunks $ runPutL $ serialize (97 :: Word64)
-- "\NUL\NUL\NUL\NUL\NUL\NUL\NULa"
-- >>> mconcat $ BSL.toChunks $ runPutL $ serialize (97 :: VarInt Word64)
-- "a"
instance (Bits n, Integral n, Bits (Unsigned n), Integral (Unsigned n)) => Serial (VarInt n) where
  serialize :: VarInt n -> m ()
serialize (VarInt n
n) = Unsigned n -> m ()
forall (m :: * -> *) a.
(MonadPut m, Integral a, Bits a) =>
a -> m ()
putVarInt (Unsigned n -> m ()) -> Unsigned n -> m ()
forall a b. (a -> b) -> a -> b
$ n -> Unsigned n
forall i. (Integral i, Num (Unsigned i)) => i -> Unsigned i
unsigned n
n
  {-# INLINE serialize #-}
  deserialize :: m (VarInt n)
deserialize = m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m (VarInt n)) -> m (VarInt n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> m (VarInt n)
forall (m :: * -> *) b. (MonadGet m, Num b, Bits b) => Word8 -> m b
getVarInt
  {-# INLINE deserialize #-}

-- |
-- >>> (runGetL deserialize $ runPutL $ serialize (1822304234^100::Integer))::Integer
-- 115368812579128172803867366576339947332796540054052185472042218522037227934707037623902492207671987696439966697503243972076991940820348847422930433939639982092916577692754723458548819441583937289395076910527534916776189405228720063994377687015476947534961767053653973945346259230972683338173842343243493433367681264359887291905132383269175086733345253389374961758293922003996035662362278340494093804835649459223465051596978792130073960666112508481814461273829244289795707398202762289955919352549768394583446336873179280924584333491364188425976869717125645749497258775598562132278030402205794994603544837805140410310712693778605743100915046769381631247123664460203591228745772887977959388457679427407639421147498028487544882346912935398848298806021505673449774474457435816552278997100556732447852816961683577731381792363312695347606768120122976105200574809419685234274705929886121600174028733812771637390342332436695318974693376
instance Serial Integer where
  serialize :: Integer -> m ()
serialize = VarInt Integer -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (VarInt Integer -> m ())
-> (Integer -> VarInt Integer) -> Integer -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> VarInt Integer
forall n. n -> VarInt n
VarInt
  deserialize :: m Integer
deserialize = VarInt Integer -> Integer
forall n. VarInt n -> n
unVarInt (VarInt Integer -> Integer) -> m (VarInt Integer) -> m Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (VarInt Integer)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> runGetL deserialize (runPutL (serialize (10^10::Natural))) :: Natural
-- 10000000000
instance Serial Natural where
  serialize :: Natural -> m ()
serialize = VarInt Integer -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (VarInt Integer -> m ())
-> (Natural -> VarInt Integer) -> Natural -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> VarInt Integer
forall n. n -> VarInt n
VarInt (Integer -> VarInt Integer)
-> (Natural -> Integer) -> Natural -> VarInt Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
  deserialize :: m Natural
deserialize = Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural)
-> (VarInt Integer -> Integer) -> VarInt Integer -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt Integer -> Integer
forall n. VarInt n -> n
unVarInt (VarInt Integer -> Natural) -> m (VarInt Integer) -> m Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (VarInt Integer)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> (runGetL deserialize $ runPutL $ serialize (1.82::Fixed E2))::Fixed E2
-- 1.82
instance HasResolution a => Serial (Fixed a) where
  serialize :: Fixed a -> m ()
serialize Fixed a
f =
      Integer -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Integer
i
    where
      i :: Integer
      i :: Integer
i = Fixed a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Fixed a -> Integer) -> (Fixed a -> Fixed a) -> Fixed a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
* Fixed a
r) (Fixed a -> Integer) -> Fixed a -> Integer
forall a b. (a -> b) -> a -> b
$ Fixed a
f
      r :: Fixed a
r = Integer -> Fixed a
forall a. Num a => Integer -> a
fromInteger (Integer -> Fixed a) -> Integer -> Fixed a
forall a b. (a -> b) -> a -> b
$ Fixed a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
f
  deserialize :: m (Fixed a)
deserialize =
    ((((Fixed a -> Fixed a -> Fixed a) -> Fixed a -> Fixed a -> Fixed a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fixed a -> Fixed a -> Fixed a
forall a. Fractional a => a -> a -> a
(/)) (Integer -> Fixed a
forall a. Num a => Integer -> a
fromInteger (Integer -> Fixed a) -> Integer -> Fixed a
forall a b. (a -> b) -> a -> b
$ Fixed a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution (Fixed a
forall a. HasCallStack => a
undefined::Fixed a))) (Fixed a -> Fixed a) -> (Integer -> Fixed a) -> Integer -> Fixed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Fixed a
forall a. Num a => Integer -> a
fromInteger) (Integer -> Fixed a) -> m Integer -> m (Fixed a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Integer
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> (runGetL deserialize $ runPutL $ serialize (1.82::DiffTime))::DiffTime
-- 1.82s
instance Serial DiffTime where
  serialize :: DiffTime -> m ()
serialize = Pico -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Pico -> m ()) -> (DiffTime -> Pico) -> DiffTime -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Rational -> Pico) -> (DiffTime -> Rational) -> DiffTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational::DiffTime -> Pico)
  deserialize :: m DiffTime
deserialize = (Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> DiffTime) -> (Pico -> Rational) -> Pico -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Rational
forall a. Real a => a -> Rational
toRational::Pico -> DiffTime) (Pico -> DiffTime) -> m Pico -> m DiffTime
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Pico
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> (runGetL deserialize $ runPutL $ serialize (1.82::DiffTime))::DiffTime
-- 1.82s
instance Serial NominalDiffTime where
  serialize :: NominalDiffTime -> m ()
serialize = Pico -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Pico -> m ())
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Rational -> Pico)
-> (NominalDiffTime -> Rational) -> NominalDiffTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational::NominalDiffTime -> Pico)
  deserialize :: m NominalDiffTime
deserialize = (Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime)
-> (Pico -> Rational) -> Pico -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Rational
forall a. Real a => a -> Rational
toRational::Pico -> NominalDiffTime) (Pico -> NominalDiffTime) -> m Pico -> m NominalDiffTime
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Pico
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> (runGetL deserialize $ runPutL $ serialize (ModifiedJulianDay 1))::Day
-- 1858-11-18
instance Serial Day where
  serialize :: Day -> m ()
serialize = Integer -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Integer -> m ()) -> (Day -> Integer) -> Day -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer
toModifiedJulianDay
  deserialize :: m Day
deserialize = Integer -> Day
ModifiedJulianDay (Integer -> Day) -> m Integer -> m Day
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Integer
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> (runGetL deserialize $ runPutL $ serialize (read "2014-01-01 10:54:42.478031 UTC"::UTCTime))::UTCTime
-- 2014-01-01 10:54:42.478031 UTC
instance Serial UTCTime where
  serialize :: UTCTime -> m ()
serialize (UTCTime Day
d DiffTime
t) = (Day, DiffTime) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Day
d, DiffTime
t)
  deserialize :: m UTCTime
deserialize = m (Day, DiffTime)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m (Day, DiffTime) -> ((Day, DiffTime) -> m UTCTime) -> m UTCTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(Day
d, DiffTime
t) -> UTCTime -> m UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> m UTCTime) -> UTCTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
t)

-- |
-- >>> (runGetL deserialize $ runPutL $ serialize (addAbsoluteTime 18.2 taiEpoch))::AbsoluteTime
-- 1858-11-17 00:00:18.2 TAI
instance Serial AbsoluteTime where
  serialize :: AbsoluteTime -> m ()
serialize = DiffTime -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (DiffTime -> m ())
-> (AbsoluteTime -> DiffTime) -> AbsoluteTime -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((AbsoluteTime -> AbsoluteTime -> DiffTime)
-> AbsoluteTime -> AbsoluteTime -> DiffTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip AbsoluteTime -> AbsoluteTime -> DiffTime
diffAbsoluteTime) AbsoluteTime
taiEpoch)
  deserialize :: m AbsoluteTime
deserialize = (((DiffTime -> AbsoluteTime -> AbsoluteTime)
-> AbsoluteTime -> DiffTime -> AbsoluteTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DiffTime -> AbsoluteTime -> AbsoluteTime
addAbsoluteTime) AbsoluteTime
taiEpoch) (DiffTime -> AbsoluteTime) -> m DiffTime -> m AbsoluteTime
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m DiffTime
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> (runGetL deserialize $ runPutL $ serialize (5 % 11::Ratio Int))::Ratio Int
-- 5 % 11
instance (Serial a, Integral a) => Serial (Ratio a) where
  serialize :: Ratio a -> m ()
serialize Ratio a
r = (a, a) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r, Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)
  deserialize :: m (Ratio a)
deserialize = (\(a
n, a
d) -> a
n a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
d) ((a, a) -> Ratio a) -> m (a, a) -> m (Ratio a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (a, a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> getModJulianDate $ (runGetL deserialize $ runPutL $ serialize (ModJulianDate $ 5 % 11)::UniversalTime)
-- 5 % 11
instance Serial UniversalTime where
  serialize :: UniversalTime -> m ()
serialize = Rational -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Rational -> m ())
-> (UniversalTime -> Rational) -> UniversalTime -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniversalTime -> Rational
getModJulianDate
  deserialize :: m UniversalTime
deserialize = Rational -> UniversalTime
ModJulianDate (Rational -> UniversalTime) -> m Rational -> m UniversalTime
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Rational
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial TimeZone where
  serialize :: TimeZone -> m ()
serialize (TimeZone Int
m Bool
s String
n) = (Int, Bool, String) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Int
m, Bool
s, String
n)
  deserialize :: m TimeZone
deserialize = (\(Int
m, Bool
s, String
n) -> Int -> Bool -> String -> TimeZone
TimeZone Int
m Bool
s String
n) ((Int, Bool, String) -> TimeZone)
-> m (Int, Bool, String) -> m TimeZone
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Int, Bool, String)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial TimeOfDay where
  serialize :: TimeOfDay -> m ()
serialize (TimeOfDay Int
h Int
m Pico
s) = (Int, Int, Pico) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Int
h, Int
m, Pico
s)
  deserialize :: m TimeOfDay
deserialize = (\(Int
h, Int
m, Pico
s) -> Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s) ((Int, Int, Pico) -> TimeOfDay)
-> m (Int, Int, Pico) -> m TimeOfDay
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Int, Int, Pico)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial LocalTime where
  serialize :: LocalTime -> m ()
serialize (LocalTime Day
d TimeOfDay
t) = (Day, TimeOfDay) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Day
d, TimeOfDay
t)
  deserialize :: m LocalTime
deserialize = (\(Day
d, TimeOfDay
t) -> Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
t) ((Day, TimeOfDay) -> LocalTime)
-> m (Day, TimeOfDay) -> m LocalTime
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Day, TimeOfDay)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial ZonedTime where
  serialize :: ZonedTime -> m ()
serialize (ZonedTime LocalTime
l TimeZone
z) = (LocalTime, TimeZone) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (LocalTime
l, TimeZone
z)
  deserialize :: m ZonedTime
deserialize = (\(LocalTime
l, TimeZone
z) -> LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
l TimeZone
z) ((LocalTime, TimeZone) -> ZonedTime)
-> m (LocalTime, TimeZone) -> m ZonedTime
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (LocalTime, TimeZone)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- |
-- >>> runGetL deserialize $ runPutL $ serialize LT::Ordering
-- LT
-- >>> runGetL deserialize $ runPutL $ serialize EQ::Ordering
-- EQ
-- >>> runGetL deserialize $ runPutL $ serialize GT::Ordering
-- GT
instance Serial Ordering where
  serialize :: Ordering -> m ()
serialize = Int8 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Int8 -> m ()) -> (Ordering -> Int8) -> Ordering -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral::Int -> Int8) (Int -> Int8) -> (Ordering -> Int) -> Ordering -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Int
forall a. Enum a => a -> Int
fromEnum
  deserialize :: m Ordering
deserialize = (Int -> Ordering
forall a. Enum a => Int -> a
toEnum (Int -> Ordering) -> (Int8 -> Int) -> Int8 -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral::Int8 -> Int)) (Int8 -> Ordering) -> m Int8 -> m Ordering
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Int8
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (Down a) where
    serialize :: Down a -> m ()
serialize (Down a
a) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
a
    deserialize :: m (Down a)
deserialize = a -> Down a
forall a. a -> Down a
Down (a -> Down a) -> m a -> m (Down a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial Version where
    serialize :: Version -> m ()
serialize (Version [Int]
vb [String]
ts) = ([VarInt Int], [String]) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ((Int -> VarInt Int) -> [Int] -> [VarInt Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> VarInt Int
forall n. n -> VarInt n
VarInt [Int]
vb, [String]
ts)
    deserialize :: m Version
deserialize = do ([VarInt Int]
vb,[String]
ts) <- m ([VarInt Int], [String])
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
                     Version -> m Version
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> m Version) -> Version -> m Version
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> Version
Version ((VarInt Int -> Int) -> [VarInt Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VarInt Int -> Int
forall n. VarInt n -> n
unVarInt [VarInt Int]
vb) [String]
ts

instance Serial a => Serial (ZipList a) where
    serialize :: ZipList a -> m ()
serialize = [a] -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ([a] -> m ()) -> (ZipList a -> [a]) -> ZipList a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipList a -> [a]
forall a. ZipList a -> [a]
getZipList
    deserialize :: m (ZipList a)
deserialize = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList ([a] -> ZipList a) -> m [a] -> m (ZipList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [a]
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (Identity a) where
    serialize :: Identity a -> m ()
serialize = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (a -> m ()) -> (Identity a -> a) -> Identity a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity
    deserialize :: m (Identity a)
deserialize = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> m a -> m (Identity a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (Constant a b) where
    serialize :: Constant a b -> m ()
serialize = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (a -> m ()) -> (Constant a b -> a) -> Constant a b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constant a b -> a
forall a k (b :: k). Constant a b -> a
getConstant
    deserialize :: m (Constant a b)
deserialize = a -> Constant a b
forall k a (b :: k). a -> Constant a b
Constant (a -> Constant a b) -> m a -> m (Constant a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance (Serial (f a), Serial (g a)) => Serial (Functor.Product f g a) where
    serialize :: Product f g a -> m ()
serialize (Pair f a
f g a
g) = (f a, g a) -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (f a
f, g a
g)
    deserialize :: m (Product f g a)
deserialize = (f a -> g a -> Product f g a) -> (f a, g a) -> Product f g a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((f a, g a) -> Product f g a) -> m (f a, g a) -> m (Product f g a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (f a, g a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial (f a) => Serial (Reverse f a) where
    serialize :: Reverse f a -> m ()
serialize = f a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (f a -> m ()) -> (Reverse f a -> f a) -> Reverse f a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reverse f a -> f a
forall k (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
    deserialize :: m (Reverse f a)
deserialize = f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f a -> Reverse f a) -> m (f a) -> m (Reverse f a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (f a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

------------------------------------------------------------------------------
-- Serialization for newtypes from 'Data.Monoid'
------------------------------------------------------------------------------

instance Serial a => Serial (Dual a) where
    serialize :: Dual a -> m ()
serialize = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (a -> m ()) -> (Dual a -> a) -> Dual a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual a -> a
forall a. Dual a -> a
getDual
    deserialize :: m (Dual a)
deserialize = a -> Dual a
forall a. a -> Dual a
Dual (a -> Dual a) -> m a -> m (Dual a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial All where
    serialize :: All -> m ()
serialize = Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Bool -> m ()) -> (All -> Bool) -> All -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. All -> Bool
getAll
    deserialize :: m All
deserialize = Bool -> All
All (Bool -> All) -> m Bool -> m All
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial Any where
    serialize :: Any -> m ()
serialize = Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Bool -> m ()) -> (Any -> Bool) -> Any -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Bool
getAny
    deserialize :: m Any
deserialize = Bool -> Any
Any (Bool -> Any) -> m Bool -> m Any
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (Sum a) where
    serialize :: Sum a -> m ()
serialize = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (a -> m ()) -> (Sum a -> a) -> Sum a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum a -> a
forall a. Sum a -> a
getSum
    deserialize :: m (Sum a)
deserialize = a -> Sum a
forall a. a -> Sum a
Sum (a -> Sum a) -> m a -> m (Sum a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (Monoid.Product a) where
    serialize :: Product a -> m ()
serialize = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (a -> m ()) -> (Product a -> a) -> Product a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product a -> a
forall a. Product a -> a
getProduct
    deserialize :: m (Product a)
deserialize = a -> Product a
forall a. a -> Product a
Product (a -> Product a) -> m a -> m (Product a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (First a) where
    serialize :: First a -> m ()
serialize = Maybe a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Maybe a -> m ()) -> (First a -> Maybe a) -> First a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First a -> Maybe a
forall a. First a -> Maybe a
getFirst
    deserialize :: m (First a)
deserialize = Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> m (Maybe a) -> m (First a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Maybe a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => Serial (Last a) where
    serialize :: Last a -> m ()
serialize = Maybe a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Maybe a -> m ()) -> (Last a -> Maybe a) -> Last a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last a -> Maybe a
forall a. Last a -> Maybe a
getLast
    deserialize :: m (Last a)
deserialize = Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a) -> m (Maybe a) -> m (Last a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Maybe a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize



------------------------------------------------------------------------------
-- Generic Serialization
------------------------------------------------------------------------------

-- $generics
--
-- You probably will never need to care that these exist except they
-- provide us with default definitions for 'Serial' and 'SerialEndian'

-- | Used internally to provide generic serialization
class GSerial f where
  gserialize :: MonadPut m => f a -> m ()
  gdeserialize :: MonadGet m => m (f a)

instance GSerial U1 where
  gserialize :: U1 a -> m ()
gserialize U1 a
U1 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  gdeserialize :: m (U1 a)
gdeserialize = U1 a -> m (U1 a)
forall (m :: * -> *) a. Monad m => a -> m a
return U1 a
forall k (p :: k). U1 p
U1

instance GSerial V1 where
  gserialize :: V1 a -> m ()
gserialize V1 a
x =
#if __GLASGOW_HASKELL__ >= 708
    case V1 a
x of {}
#else
    x `seq` error "I looked into the void."
#endif
  gdeserialize :: m (V1 a)
gdeserialize = String -> m (V1 a)
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
"I looked into the void."

instance (GSerial f, GSerial g) => GSerial (f :*: g) where
  gserialize :: (:*:) f g a -> m ()
gserialize (f a
f :*: g a
g) = do
    f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadPut m) =>
f a -> m ()
gserialize f a
f
    g a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadPut m) =>
f a -> m ()
gserialize g a
g
  gdeserialize :: m ((:*:) f g a)
gdeserialize = (f a -> g a -> (:*:) f g a)
-> m (f a) -> m (g a) -> m ((:*:) f g a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadGet m) =>
m (f a)
gdeserialize m (g a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadGet m) =>
m (f a)
gdeserialize

instance (GSerial f, GSerial g) => GSerial (f :+: g) where
  gserialize :: (:+:) f g a -> m ()
gserialize (L1 f a
x) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadPut m) =>
f a -> m ()
gserialize f a
x
  gserialize (R1 g a
y) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> g a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadPut m) =>
f a -> m ()
gserialize g a
y
  gdeserialize :: m ((:+:) f g a)
gdeserialize = m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m ((:+:) f g a)) -> m ((:+:) f g a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
a -> case Word8
a of
    Word8
0 -> (f a -> (:+:) f g a) -> m (f a) -> m ((:+:) f g a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadGet m) =>
m (f a)
gdeserialize
    Word8
1 -> (g a -> (:+:) f g a) -> m (g a) -> m ((:+:) f g a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 m (g a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadGet m) =>
m (f a)
gdeserialize
    Word8
_ -> String -> m ((:+:) f g a)
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
"Missing case"

instance GSerial f => GSerial (M1 i c f) where
  gserialize :: M1 i c f a -> m ()
gserialize (M1 f a
x) = f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadPut m) =>
f a -> m ()
gserialize f a
x
  gdeserialize :: m (M1 i c f a)
gdeserialize = (f a -> M1 i c f a) -> m (f a) -> m (M1 i c f a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadGet m) =>
m (f a)
gdeserialize

instance Serial a => GSerial (K1 i a) where
  gserialize :: K1 i a a -> m ()
gserialize (K1 a
x) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
x
  gdeserialize :: m (K1 i a a)
gdeserialize = (a -> K1 i a a) -> m a -> m (K1 i a a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize


-- | Used internally to provide generic big-endian serialization
class GSerialEndian f where
  gserializeBE :: MonadPut m => f a -> m ()
#ifndef HLINT
  default gserializeBE :: (MonadPut m, GSerial f) => f a -> m ()
  gserializeBE = f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadPut m) =>
f a -> m ()
gserialize
#endif

  gdeserializeBE :: MonadGet m => m (f a)
#ifndef HLINT
  default gdeserializeBE :: (MonadGet m, GSerial f) => m (f a)
  gdeserializeBE = m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadGet m) =>
m (f a)
gdeserialize
#endif

  gserializeLE :: MonadPut m => f a -> m ()
#ifndef HLINT
  default gserializeLE :: (MonadPut m, GSerial f) => f a -> m ()
  gserializeLE = f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadPut m) =>
f a -> m ()
gserialize
#endif

  gdeserializeLE :: MonadGet m => m (f a)
#ifndef HLINT
  default gdeserializeLE :: (MonadGet m, GSerial f) => m (f a)
  gdeserializeLE = m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial f, MonadGet m) =>
m (f a)
gdeserialize
#endif

-- only difference between GSerialEndian and GSerial
instance SerialEndian a => GSerialEndian (K1 i a) where
  gserializeBE :: K1 i a a -> m ()
gserializeBE (K1 a
x) = a -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeBE a
x
  gdeserializeBE :: m (K1 i a a)
gdeserializeBE = (a -> K1 i a a) -> m a -> m (K1 i a a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 m a
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeBE

  gserializeLE :: K1 i a a -> m ()
gserializeLE (K1 a
x) = a -> m ()
forall a (m :: * -> *). (SerialEndian a, MonadPut m) => a -> m ()
serializeLE a
x
  gdeserializeLE :: m (K1 i a a)
gdeserializeLE = (a -> K1 i a a) -> m a -> m (K1 i a a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 m a
forall a (m :: * -> *). (SerialEndian a, MonadGet m) => m a
deserializeLE

------------------------------------------------------------------------------
-- Higher-Rank Serialization
------------------------------------------------------------------------------

-- $higher
--
-- These classes provide us with the ability to serialize containers that need
-- polymorphic recursion.

class Serial1 f where
  serializeWith :: MonadPut m => (a -> m ()) -> f a -> m ()
#ifndef HLINT
  default serializeWith :: (MonadPut m, GSerial1 (Rep1 f), Generic1 f) => (a -> m ()) -> f a -> m ()
  serializeWith a -> m ()
f = (a -> m ()) -> Rep1 f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
gserializeWith a -> m ()
f (Rep1 f a -> m ()) -> (f a -> Rep1 f a) -> f a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1
#endif

  deserializeWith :: MonadGet m => m a -> m (f a)
#ifndef HLINT
  default deserializeWith :: (MonadGet m, GSerial1 (Rep1 f), Generic1 f) => m a -> m (f a)
  deserializeWith m a
f = (Rep1 f a -> f a) -> m (Rep1 f a) -> m (f a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (m a -> m (Rep1 f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadGet m) =>
m a -> m (f a)
gdeserializeWith m a
f)
#endif

instance Serial1 [] where
  serializeWith :: (a -> m ()) -> [a] -> m ()
serializeWith a -> m ()
_ [] = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0
  serializeWith a -> m ()
f (a
x:[a]
xs) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> m ()) -> [a] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith a -> m ()
f [a]
xs
  deserializeWith :: m a -> m [a]
deserializeWith m a
m = m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
a -> case Word8
a of
    Word8
0 -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Word8
1 -> (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) m a
m (m a -> m [a]
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m a
m)
    Word8
_ -> String -> m [a]
forall a. HasCallStack => String -> a
error String
"[].deserializeWith: Missing case"
instance Serial1 Maybe where
  serializeWith :: (a -> m ()) -> Maybe a -> m ()
serializeWith a -> m ()
_ Maybe a
Nothing = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0
  serializeWith a -> m ()
f (Just a
a) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
a
  deserializeWith :: m a -> m (Maybe a)
deserializeWith m a
m = m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
a -> case Word8
a of
    Word8
0 -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Word8
1 -> (a -> Maybe a) -> m a -> m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just m a
m
    Word8
_ -> String -> m (Maybe a)
forall a. HasCallStack => String -> a
error String
"Maybe.deserializeWith: Missing case"
instance Serial a => Serial1 (Either a) where
  serializeWith :: (a -> m ()) -> Either a a -> m ()
serializeWith = (a -> m ()) -> (a -> m ()) -> Either a a -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserializeWith :: m a -> m (Either a a)
deserializeWith = m a -> m a -> m (Either a a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Serial a => Serial1 ((,) a) where
  serializeWith :: (a -> m ()) -> (a, a) -> m ()
serializeWith = (a -> m ()) -> (a -> m ()) -> (a, a) -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserializeWith :: m a -> m (a, a)
deserializeWith = m a -> m a -> m (a, a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance (Serial a, Serial b) => Serial1 ((,,) a b) where
  serializeWith :: (a -> m ()) -> (a, b, a) -> m ()
serializeWith = (b -> m ()) -> (a -> m ()) -> (a, b, a) -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 b -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserializeWith :: m a -> m (a, b, a)
deserializeWith = m b -> m a -> m (a, b, a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m b
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance (Serial a, Serial b, Serial c) => Serial1 ((,,,) a b c) where
  serializeWith :: (a -> m ()) -> (a, b, c, a) -> m ()
serializeWith = (c -> m ()) -> (a -> m ()) -> (a, b, c, a) -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 c -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserializeWith :: m a -> m (a, b, c, a)
deserializeWith = m c -> m a -> m (a, b, c, a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m c
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance (Serial a, Serial b, Serial c, Serial d) => Serial1 ((,,,,) a b c d) where
  serializeWith :: (a -> m ()) -> (a, b, c, d, a) -> m ()
serializeWith = (d -> m ()) -> (a -> m ()) -> (a, b, c, d, a) -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 d -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  deserializeWith :: m a -> m (a, b, c, d, a)
deserializeWith = m d -> m a -> m (a, b, c, d, a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m d
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial1 Seq.Seq where
  serializeWith :: (a -> m ()) -> Seq a -> m ()
serializeWith a -> m ()
pv = (a -> m ()) -> [a] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith a -> m ()
pv ([a] -> m ()) -> (Seq a -> [a]) -> Seq a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  deserializeWith :: m a -> m (Seq a)
deserializeWith m a
gv = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> m [a] -> m (Seq a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a -> m [a]
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m a
gv

instance Serial1 NEL.NonEmpty where
  serializeWith :: (a -> m ()) -> NonEmpty a -> m ()
serializeWith a -> m ()
pv = (a -> m ()) -> [a] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith a -> m ()
pv ([a] -> m ()) -> (NonEmpty a -> [a]) -> NonEmpty a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  deserializeWith :: m a -> m (NonEmpty a)
deserializeWith m a
gv = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NEL.fromList ([a] -> NonEmpty a) -> m [a] -> m (NonEmpty a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a -> m [a]
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m a
gv

{-
instance Serial1 Set.Set where
  serializeWith pv = serializeWith pv . Set.toAscList
  deserializeWith gv = Set.fromList `liftM` deserializeWith gv
-}

instance Serial1 IMap.IntMap where
  serializeWith :: (a -> m ()) -> IntMap a -> m ()
serializeWith a -> m ()
pv = ((Int, a) -> m ()) -> [(Int, a)] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith ((Int -> m ()) -> (a -> m ()) -> (Int, a) -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a -> m ()
pv)
                   ([(Int, a)] -> m ())
-> (IntMap a -> [(Int, a)]) -> IntMap a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IMap.toAscList
  deserializeWith :: m a -> m (IntMap a)
deserializeWith m a
gv = [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IMap.fromList
               ([(Int, a)] -> IntMap a) -> m [(Int, a)] -> m (IntMap a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Int, a) -> m [(Int, a)]
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith (m Int -> m a -> m (Int, a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m Int
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m a
gv)

instance (Ord k, Serial k) => Serial1 (Map.Map k) where
  -- serializeWith = serializeWith2 serialize
  -- deserializeWith = deserializeWith2 deserialize
  serializeWith :: (a -> m ()) -> Map k a -> m ()
serializeWith a -> m ()
pv = ((k, a) -> m ()) -> [(k, a)] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith ((k -> m ()) -> (a -> m ()) -> (k, a) -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 k -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a -> m ()
pv)
                   ([(k, a)] -> m ()) -> (Map k a -> [(k, a)]) -> Map k a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
  deserializeWith :: m a -> m (Map k a)
deserializeWith m a
gv = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
               ([(k, a)] -> Map k a) -> m [(k, a)] -> m (Map k a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (k, a) -> m [(k, a)]
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith (m k -> m a -> m (k, a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m k
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m a
gv)

instance (Hashable k, Eq k, Serial k) => Serial1 (HMap.HashMap k) where
  serializeWith :: (a -> m ()) -> HashMap k a -> m ()
serializeWith a -> m ()
pv = ((k, a) -> m ()) -> [(k, a)] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith ((k -> m ()) -> (a -> m ()) -> (k, a) -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 k -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a -> m ()
pv)
                   ([(k, a)] -> m ())
-> (HashMap k a -> [(k, a)]) -> HashMap k a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k a -> [(k, a)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList
  deserializeWith :: m a -> m (HashMap k a)
deserializeWith m a
gv = [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList
               ([(k, a)] -> HashMap k a) -> m [(k, a)] -> m (HashMap k a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (k, a) -> m [(k, a)]
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith (m k -> m a -> m (k, a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m k
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m a
gv)

serialize1 :: (MonadPut m, Serial1 f, Serial a) => f a -> m ()
serialize1 :: f a -> m ()
serialize1 = (a -> m ()) -> f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
{-# INLINE serialize1 #-}

deserialize1 :: (MonadGet m, Serial1 f, Serial a) => m (f a)
deserialize1 :: m (f a)
deserialize1 = m a -> m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
{-# INLINE deserialize1 #-}

------------------------------------------------------------------------------
-- Higher-Rank Generic Serialization
------------------------------------------------------------------------------

-- | Used internally to provide generic serialization
class GSerial1 f where
  gserializeWith :: MonadPut m => (a -> m ()) -> f a -> m ()
  gdeserializeWith :: MonadGet m => m a -> m (f a)

instance GSerial1 Par1 where
  gserializeWith :: (a -> m ()) -> Par1 a -> m ()
gserializeWith a -> m ()
f (Par1 a
a) = a -> m ()
f a
a
  gdeserializeWith :: m a -> m (Par1 a)
gdeserializeWith m a
m = (a -> Par1 a) -> m a -> m (Par1 a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Par1 a
forall p. p -> Par1 p
Par1 m a
m

instance Serial1 f => GSerial1 (Rec1 f) where
  gserializeWith :: (a -> m ()) -> Rec1 f a -> m ()
gserializeWith a -> m ()
f (Rec1 f a
fa) = (a -> m ()) -> f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith a -> m ()
f f a
fa
  gdeserializeWith :: m a -> m (Rec1 f a)
gdeserializeWith m a
m = (f a -> Rec1 f a) -> m (f a) -> m (Rec1 f a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (m a -> m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m a
m)

-- instance (Serial1 f, GSerial1 g) => GSerial1 (f :.: g) where

instance GSerial1 U1 where
  gserializeWith :: (a -> m ()) -> U1 a -> m ()
gserializeWith a -> m ()
_ U1 a
U1 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  gdeserializeWith :: m a -> m (U1 a)
gdeserializeWith m a
_  = U1 a -> m (U1 a)
forall (m :: * -> *) a. Monad m => a -> m a
return U1 a
forall k (p :: k). U1 p
U1

instance GSerial1 V1 where
  gserializeWith :: (a -> m ()) -> V1 a -> m ()
gserializeWith a -> m ()
_ V1 a
x =
#if __GLASGOW_HASKELL__ >= 708
    case V1 a
x of {}
#else
    x `seq` error "I looked into the void."
#endif
  gdeserializeWith :: m a -> m (V1 a)
gdeserializeWith m a
_ = String -> m (V1 a)
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
"I looked into the void."

instance (GSerial1 f, GSerial1 g) => GSerial1 (f :*: g) where
  gserializeWith :: (a -> m ()) -> (:*:) f g a -> m ()
gserializeWith a -> m ()
f (f a
a :*: g a
b) = (a -> m ()) -> f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
gserializeWith a -> m ()
f f a
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> m ()) -> g a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
gserializeWith a -> m ()
f g a
b
  gdeserializeWith :: m a -> m ((:*:) f g a)
gdeserializeWith m a
m = (f a -> g a -> (:*:) f g a)
-> m (f a) -> m (g a) -> m ((:*:) f g a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (m a -> m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadGet m) =>
m a -> m (f a)
gdeserializeWith m a
m) (m a -> m (g a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadGet m) =>
m a -> m (f a)
gdeserializeWith m a
m)

instance (GSerial1 f, GSerial1 g) => GSerial1 (f :+: g) where
  gserializeWith :: (a -> m ()) -> (:+:) f g a -> m ()
gserializeWith a -> m ()
f (L1 f a
x) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> m ()) -> f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
gserializeWith a -> m ()
f f a
x
  gserializeWith a -> m ()
f (R1 g a
y) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> m ()) -> g a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
gserializeWith a -> m ()
f g a
y
  gdeserializeWith :: m a -> m ((:+:) f g a)
gdeserializeWith m a
m = m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m ((:+:) f g a)) -> m ((:+:) f g a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
a -> case Word8
a of
    Word8
0 -> (f a -> (:+:) f g a) -> m (f a) -> m ((:+:) f g a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (m a -> m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadGet m) =>
m a -> m (f a)
gdeserializeWith m a
m)
    Word8
1 -> (g a -> (:+:) f g a) -> m (g a) -> m ((:+:) f g a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (m a -> m (g a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadGet m) =>
m a -> m (f a)
gdeserializeWith m a
m)
    Word8
_ -> String -> m ((:+:) f g a)
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
"Missing case"

instance (Serial1 f, GSerial1 g) => GSerial1 (f :.: g) where
  gserializeWith :: (a -> m ()) -> (:.:) f g a -> m ()
gserializeWith a -> m ()
f (Comp1 f (g a)
m) = (g a -> m ()) -> f (g a) -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith ((a -> m ()) -> g a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
gserializeWith a -> m ()
f) f (g a)
m
  gdeserializeWith :: m a -> m ((:.:) f g a)
gdeserializeWith m a
m = f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g a) -> (:.:) f g a) -> m (f (g a)) -> m ((:.:) f g a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (g a) -> m (f (g a))
forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith (m a -> m (g a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadGet m) =>
m a -> m (f a)
gdeserializeWith m a
m)

instance GSerial1 f => GSerial1 (M1 i c f) where
  gserializeWith :: (a -> m ()) -> M1 i c f a -> m ()
gserializeWith a -> m ()
f (M1 f a
x) = (a -> m ()) -> f a -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
gserializeWith a -> m ()
f f a
x
  gdeserializeWith :: m a -> m (M1 i c f a)
gdeserializeWith = (f a -> M1 i c f a) -> m (f a) -> m (M1 i c f a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (m (f a) -> m (M1 i c f a))
-> (m a -> m (f a)) -> m a -> m (M1 i c f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GSerial1 f, MonadGet m) =>
m a -> m (f a)
gdeserializeWith

instance Serial a => GSerial1 (K1 i a) where
  gserializeWith :: (a -> m ()) -> K1 i a a -> m ()
gserializeWith a -> m ()
_ (K1 a
x) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
x
  gdeserializeWith :: m a -> m (K1 i a a)
gdeserializeWith m a
_ = (a -> K1 i a a) -> m a -> m (K1 i a a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

------------------------------------------------------------------------------
-- Higher-Rank Serialization
------------------------------------------------------------------------------

class Serial2 f where
  serializeWith2 :: MonadPut m => (a -> m ()) -> (b -> m ()) -> f a b -> m ()
  deserializeWith2 :: MonadGet m => m a -> m b ->  m (f a b)

serialize2 :: (MonadPut m, Serial2 f, Serial a, Serial b) => f a b -> m ()
serialize2 :: f a b -> m ()
serialize2 = (a -> m ()) -> (b -> m ()) -> f a b -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize b -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
{-# INLINE serialize2 #-}

deserialize2 :: (MonadGet m, Serial2 f, Serial a, Serial b) => m (f a b)
deserialize2 :: m (f a b)
deserialize2 = m a -> m b -> m (f a b)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m b
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
{-# INLINE deserialize2 #-}

instance Serial2 Either where
  serializeWith2 :: (a -> m ()) -> (b -> m ()) -> Either a b -> m ()
serializeWith2 a -> m ()
f b -> m ()
_ (Left a
x)  = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
x
  serializeWith2 a -> m ()
_ b -> m ()
g (Right b
y) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
g b
y
  deserializeWith2 :: m a -> m b -> m (Either a b)
deserializeWith2 m a
m m b
n = m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m (Either a b)) -> m (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
a -> case Word8
a of
    Word8
0 -> (a -> Either a b) -> m a -> m (Either a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either a b
forall a b. a -> Either a b
Left m a
m
    Word8
1 -> (b -> Either a b) -> m b -> m (Either a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Either a b
forall a b. b -> Either a b
Right m b
n
    Word8
_ -> String -> m (Either a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
"Missing case"

instance Serial2 (,) where
  serializeWith2 :: (a -> m ()) -> (b -> m ()) -> (a, b) -> m ()
serializeWith2 a -> m ()
f b -> m ()
g (a
a, b
b) = a -> m ()
f a
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
g b
b
  deserializeWith2 :: m a -> m b -> m (a, b)
deserializeWith2 m a
m m b
n = (a -> b -> (a, b)) -> m a -> m b -> m (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) m a
m m b
n

instance Serial a => Serial2 ((,,) a) where
  serializeWith2 :: (a -> m ()) -> (b -> m ()) -> (a, a, b) -> m ()
serializeWith2 a -> m ()
f b -> m ()
g (a
a, a
b, b
c) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
b m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
g b
c
  deserializeWith2 :: m a -> m b -> m (a, a, b)
deserializeWith2 m a
m m b
n = (a -> a -> b -> (a, a, b)) -> m a -> m a -> m b -> m (a, a, b)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m a
m m b
n

instance (Serial a, Serial b) => Serial2 ((,,,) a b) where
  serializeWith2 :: (a -> m ()) -> (b -> m ()) -> (a, b, a, b) -> m ()
serializeWith2 a -> m ()
f b -> m ()
g (a
a, b
b, a
c, b
d) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize b
b m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
c m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
g b
d
  deserializeWith2 :: m a -> m b -> m (a, b, a, b)
deserializeWith2 m a
m m b
n = (a -> b -> a -> b -> (a, b, a, b))
-> m a -> m b -> m a -> m b -> m (a, b, a, b)
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 (,,,) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m b
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m a
m m b
n

instance (Serial a, Serial b, Serial c) => Serial2 ((,,,,) a b c) where
  serializeWith2 :: (a -> m ()) -> (b -> m ()) -> (a, b, c, a, b) -> m ()
serializeWith2 a -> m ()
f b -> m ()
g (a
a, b
b, c
c, a
d, b
e) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize b
b m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize c
c m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
d m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
g b
e
  deserializeWith2 :: m a -> m b -> m (a, b, c, a, b)
deserializeWith2 m a
m m b
n = (a -> b -> c -> a -> b -> (a, b, c, a, b))
-> m a -> m b -> m c -> m a -> m b -> m (a, b, c, a, b)
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 (,,,,) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m b
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m c
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m a
m m b
n