summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdwardKmett <>2013-09-09 18:09:28 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-09-09 18:09:28 (GMT)
commit434d02d8edf74ebe005f826ad7ac74dfbdff98ff (patch)
tree08ab1755cadbe69a47dbfe96172633dc3125dee9
parent7bce1813dd4a6acb8539d4d5b824723f17555cf8 (diff)
version 0.120.12.0.10.12
-rw-r--r--bytes.cabal2
-rw-r--r--src/Data/Bytes/Serial.hs242
2 files changed, 209 insertions, 35 deletions
diff --git a/bytes.cabal b/bytes.cabal
index dc125c2..f3f443b 100644
--- a/bytes.cabal
+++ b/bytes.cabal
@@ -1,6 +1,6 @@
name: bytes
category: Data, Serialization
-version: 0.11.5
+version: 0.12
license: BSD3
cabal-version: >= 1.8
license-file: LICENSE
diff --git a/src/Data/Bytes/Serial.hs b/src/Data/Bytes/Serial.hs
index aedcf8b..6a30bfb 100644
--- a/src/Data/Bytes/Serial.hs
+++ b/src/Data/Bytes/Serial.hs
@@ -18,20 +18,31 @@
-- Stability : experimental
-- Portability: non-portable
--
--- This module generalizes the @binary@ 'B.PutM' and @cereal@ 'S.PutM'
--- monads in an ad hoc fashion to permit code to be written that is
--- compatible across them.
---
--- Moreover, this class permits code to be written to be portable over
--- various monad transformers applied to these as base monads.
+-- 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
- ( Serial(..)
+ (
+ -- * Serialization
+ Serial(..)
+ -- * Specifying endianness
+ , SerialEndian(..)
+ -- * Higher-order
+ -- $higher
+ , Serial1(..)
+ , serialize1, deserialize1
+ , Serial2(..)
+ , serialize2, deserialize2
+ -- * Storable
+ , store, restore
+ -- * Generics
+ -- $generics
, GSerial(..)
- , Serial1(..), serialize1, deserialize1
+ , GSerialEndian(..)
, GSerial1(..)
- , Serial2(..), serialize2, deserialize2
- , store, restore
) where
import Control.Monad
@@ -59,10 +70,129 @@ import Foreign.Storable
import GHC.Generics
import System.IO.Unsafe
+foreign import ccall floatToWord32 :: Float -> Word32
+foreign import ccall word32ToFloat :: Word32 -> Float
+foreign import ccall doubleToWord64 :: Double -> Word64
+foreign import ccall word64ToDouble :: Word64 -> Double
+
+------------------------------------------------------------------------------
+-- 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 = gserializeBE . from
+#endif
+
+ deserializeBE :: MonadGet m => m a
+#ifndef HLINT
+ default deserializeBE :: (MonadGet m, GSerialEndian (Rep a), Generic a) => m a
+ deserializeBE = liftM to gdeserializeBE
+#endif
+
+ serializeLE :: MonadPut m => a -> m ()
+#ifndef HLINT
+ default serializeLE :: (MonadPut m, GSerialEndian (Rep a), Generic a) => a -> m ()
+ serializeLE = gserializeLE . from
+#endif
+
+ deserializeLE :: MonadGet m => m a
+#ifndef HLINT
+ default deserializeLE :: (MonadGet m, GSerialEndian (Rep a), Generic a) => m a
+ deserializeLE = liftM to gdeserializeLE
+#endif
+
+ serializeHost :: MonadPut m => a -> m ()
+ deserializeHost :: MonadGet m => m a
+#ifdef WORDS_BIGENDIAN
+ serializeHost = serializeBE
+ deserializeHost = deserializeBE
+#else
+ serializeHost = serializeLE
+ deserializeHost = deserializeLE
+#endif
+
+instance SerialEndian Double where
+ serializeBE = serializeBE . doubleToWord64
+ deserializeBE = liftM word64ToDouble deserializeBE
+
+ serializeLE = serializeLE . doubleToWord64
+ deserializeLE = liftM word64ToDouble deserializeLE
+
+instance SerialEndian Float where
+ serializeBE = serializeBE . floatToWord32
+ deserializeBE = liftM word32ToFloat deserializeBE
+
+ serializeLE = serializeLE . floatToWord32
+ deserializeLE = liftM word32ToFloat deserializeLE
+
+instance SerialEndian Char where
+ serializeBE = putWord32be . fromIntegral . fromEnum
+ deserializeBE = liftM (toEnum . fromIntegral) getWord32be
+
+ serializeLE = putWord32le . fromIntegral . fromEnum
+ deserializeLE = liftM (toEnum . fromIntegral) getWord32le
+
+instance SerialEndian Word64 where
+ serializeBE = putWord64be
+ deserializeBE = getWord64be
+
+ serializeLE = putWord64le
+ deserializeLE = getWord64le
+
+instance SerialEndian Word32 where
+ serializeBE = putWord32be
+ deserializeBE = getWord32be
+
+ serializeLE = putWord32le
+ deserializeLE = getWord32le
+
+instance SerialEndian Word16 where
+ serializeBE = putWord16be
+ deserializeBE = getWord16be
+
+ serializeLE = putWord16le
+ deserializeLE = getWord16le
+
+instance SerialEndian Int64 where
+ serializeBE = putWord64be . fromIntegral
+ deserializeBE = liftM fromIntegral getWord64be
+
+ serializeLE = putWord64le . fromIntegral
+ deserializeLE = liftM fromIntegral getWord64le
+
+instance SerialEndian Int32 where
+ serializeBE = putWord32be . fromIntegral
+ deserializeBE = liftM fromIntegral getWord32be
+
+ serializeLE = putWord32le . fromIntegral
+ deserializeLE = liftM fromIntegral getWord32le
+
+instance SerialEndian Int16 where
+ serializeBE = putWord16be . fromIntegral
+ deserializeBE = liftM fromIntegral getWord16be
+
+ serializeLE = putWord16le . fromIntegral
+ deserializeLE = liftM fromIntegral 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
@@ -72,7 +202,7 @@ class Serial a where
deserialize :: MonadGet m => m a
#ifndef HLINT
- default deserialize :: (MonadGet m, Generic a, GSerial (Rep a)) => m a
+ default deserialize :: (MonadGet m, GSerial (Rep a), Generic a) => m a
deserialize = liftM to gdeserialize
#endif
@@ -107,10 +237,12 @@ instance (Serial a, Serial b, Serial c, Serial d, Serial e) => Serial (a, b, c,
instance Serial Bool
+-- | serialize any 'Storable' in a host-specific format.
store :: (MonadPut m, Storable a) => a -> m ()
store a = putByteString bs
where bs = unsafePerformIO $ create (sizeOf a) $ \ p -> poke (castPtr p) a
+-- | deserialize any 'Storable' in a host-specific format.
restore :: forall m a. (MonadGet m, Storable a) => m a
restore = do
let required = sizeOf (undefined :: a)
@@ -118,58 +250,55 @@ restore = do
unless (n >= required) $ fail "restore: Required more bytes"
return $ unsafePerformIO $ withForeignPtr fp $ \p -> peekByteOff p o
-foreign import ccall floatToWord32 :: Float -> Word32
-foreign import ccall word32ToFloat :: Word32 -> Float
-foreign import ccall doubleToWord64 :: Double -> Word64
-foreign import ccall word64ToDouble :: Word64 -> Double
-
instance Serial Double where
- serialize = serialize . doubleToWord64
- deserialize = liftM word64ToDouble deserialize
+ serialize = serializeBE
+ deserialize = deserializeBE
instance Serial Float where
- serialize = serialize . floatToWord32
- deserialize = liftM word32ToFloat deserialize
+ serialize = serializeBE
+ deserialize = deserializeBE
instance Serial Char where
- serialize = putWord32be . fromIntegral . fromEnum
- deserialize = liftM (toEnum . fromIntegral) getWord32be
+ serialize = serializeBE
+ deserialize = deserializeBE
+ -- host endian
instance Serial Word where
serialize = putWordhost
deserialize = getWordhost
instance Serial Word64 where
- serialize = putWord64be
- deserialize = getWord64be
+ serialize = serializeBE
+ deserialize = deserializeBE
instance Serial Word32 where
- serialize = putWord32be
- deserialize = getWord32be
+ serialize = serializeBE
+ deserialize = deserializeBE
instance Serial Word16 where
- serialize = putWord16be
- deserialize = getWord16be
+ serialize = serializeBE
+ deserialize = deserializeBE
instance Serial Word8 where
serialize = putWord8
deserialize = getWord8
+ -- host endian
instance Serial Int where
serialize = putWordhost . fromIntegral
deserialize = liftM fromIntegral getWordhost
instance Serial Int64 where
- serialize = putWord64be . fromIntegral
- deserialize = liftM fromIntegral getWord64be
+ serialize = serializeBE
+ deserialize = deserializeBE
instance Serial Int32 where
- serialize = putWord32be . fromIntegral
- deserialize = liftM fromIntegral getWord32be
+ serialize = serializeBE
+ deserialize = deserializeBE
instance Serial Int16 where
- serialize = putWord16be . fromIntegral
- deserialize = liftM fromIntegral getWord16be
+ serialize = serializeBE
+ deserialize = deserializeBE
instance Serial Int8 where
serialize = putWord8 . fromIntegral
@@ -203,6 +332,11 @@ instance (Serial k, Serial v) => Serial (Map.Map k v) where
-- 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 ()
@@ -238,10 +372,50 @@ instance Serial a => GSerial (K1 i a) where
gserialize (K1 x) = serialize x
gdeserialize = liftM K1 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 = gserialize
+#endif
+
+ gdeserializeBE :: MonadGet m => m (f a)
+#ifndef HLINT
+ default gdeserializeBE :: (MonadGet m, GSerial f) => m (f a)
+ gdeserializeBE = gdeserialize
+#endif
+
+ gserializeLE :: MonadPut m => f a -> m ()
+#ifndef HLINT
+ default gserializeLE :: (MonadPut m, GSerial f) => f a -> m ()
+ gserializeLE = gserialize
+#endif
+
+ gdeserializeLE :: MonadGet m => m (f a)
+#ifndef HLINT
+ default gdeserializeLE :: (MonadGet m, GSerial f) => m (f a)
+ gdeserializeLE = gdeserialize
+#endif
+
+-- only difference between GSerialEndian and GSerial
+instance SerialEndian a => GSerialEndian (K1 i a) where
+ gserializeBE (K1 x) = serializeBE x
+ gdeserializeBE = liftM K1 deserializeBE
+
+ gserializeLE (K1 x) = serializeLE x
+ gdeserializeLE = liftM K1 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