{-# LANGUAGE CPP #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.Serializer
(
Serializer(..)
, buildBytes
, buildByteString
, buildLazyByteString
, BinarySerializer(..)
, CerealSerializer(..)
, word16H
, word32H
, word64H
, word
, wordL
, wordB
, wordH
, int8
, int16
, int16L
, int16B
, int16H
, int32
, int32L
, int32B
, int32H
, int64
, int64L
, int64B
, int64H
, int
, intL
, intB
, intH
, LittleEndianSerializer(..)
, BigEndianSerializer(..)
, serializeIn
, serializeH
, Serializable(..)
, putIn
, putL
, putB
, putH
, toBytes
, toByteString
, toLazyByteString
, SizedSerializable(..)
, RestSerializable(..)
) where
import GHC.Generics (Generic)
import Data.Typeable (Typeable)
import Data.Data (Data)
import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup, (<>))
import Data.Monoid (Monoid)
import Data.Endian (Endian(..), swapEndian)
import Data.Word
import Data.Int
import Data.Bits (shiftR)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as SBS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Builder as BB
import qualified Data.Binary.Put as B
import qualified Data.Serialize.Put as S
class (Semigroup s, Monoid s) ⇒ Serializer s where
{-# MINIMAL word8 #-}
endian ∷ Proxy s → Endian
#ifdef WORDS_BIGENDIAN
endian _ = BigEndian
#else
endian _ = LittleEndian
#endif
{-# INLINE endian #-}
word8 ∷ Word8 → s
word16 ∷ Word16 → s
word16 = putIn (endian (Proxy ∷ Proxy s))
{-# INLINE word16 #-}
word32 ∷ Word32 → s
word32 = putIn (endian (Proxy ∷ Proxy s))
{-# INLINE word32 #-}
word64 ∷ Word64 → s
word64 = putIn (endian (Proxy ∷ Proxy s))
{-# INLINE word64 #-}
word16L ∷ Word16 → s
word16L w = word8 (fromIntegral w)
<> word8 (fromIntegral (shiftR w 8))
{-# INLINE word16L #-}
word16B ∷ Word16 → s
word16B = word16L . swapEndian
{-# INLINE word16B #-}
word32L ∷ Word32 → s
word32L w = word8 (fromIntegral w)
<> word8 (fromIntegral (shiftR w 8))
<> word8 (fromIntegral (shiftR w 16))
<> word8 (fromIntegral (shiftR w 24))
{-# INLINE word32L #-}
word32B ∷ Word32 → s
word32B = word32L . swapEndian
{-# INLINE word32B #-}
word64L ∷ Word64 → s
word64L w = word8 (fromIntegral w)
<> word8 (fromIntegral (shiftR w 8))
<> word8 (fromIntegral (shiftR w 16))
<> word8 (fromIntegral (shiftR w 24))
<> word8 (fromIntegral (shiftR w 32))
<> word8 (fromIntegral (shiftR w 40))
<> word8 (fromIntegral (shiftR w 48))
<> word8 (fromIntegral (shiftR w 56))
{-# INLINE word64L #-}
word64B ∷ Word64 → s
word64B = word64L . swapEndian
{-# INLINE word64B #-}
byteString ∷ BS.ByteString → s
byteString = mconcat . fmap word8 . BS.unpack
{-# INLINE byteString #-}
shortByteString ∷ SBS.ShortByteString → s
shortByteString = mconcat . fmap word8 . SBS.unpack
{-# INLINE shortByteString #-}
lazyByteString ∷ LBS.ByteString → s
lazyByteString = mconcat . fmap byteString . LBS.toChunks
{-# INLINE lazyByteString #-}
builder ∷ BB.Builder → s
builder = lazyByteString . BB.toLazyByteString
{-# INLINE builder #-}
instance Serializer [Word8] where
word8 = pure
{-# INLINE word8 #-}
instance Serializer BB.Builder where
word8 = BB.word8
{-# INLINE word8 #-}
word16L = BB.word16LE
{-# INLINE word16L #-}
word16B = BB.word16BE
{-# INLINE word16B #-}
word32L = BB.word32LE
{-# INLINE word32L #-}
word32B = BB.word32BE
{-# INLINE word32B #-}
word64L = BB.word64LE
{-# INLINE word64L #-}
word64B = BB.word64BE
{-# INLINE word64B #-}
byteString = BB.byteString
{-# INLINE byteString #-}
shortByteString = BB.shortByteString
{-# INLINE shortByteString #-}
lazyByteString = BB.lazyByteString
{-# INLINE lazyByteString #-}
builder = id
{-# INLINE builder #-}
buildBytes ∷ BB.Builder → [Word8]
buildBytes = LBS.unpack . BB.toLazyByteString
buildByteString ∷ BB.Builder → BS.ByteString
buildByteString = LBS.toStrict . BB.toLazyByteString
{-# INLINE buildByteString #-}
buildLazyByteString ∷ BB.Builder → LBS.ByteString
buildLazyByteString = BB.toLazyByteString
{-# INLINE buildLazyByteString #-}
#if MIN_VERSION_base(4,9,0) && MIN_VERSION_binary(0,8,3)
instance Serializer B.Put where
word8 = B.putWord8
{-# INLINE word8 #-}
word16L = B.putWord16le
{-# INLINE word16L #-}
word16B = B.putWord16be
{-# INLINE word16B #-}
word32L = B.putWord32le
{-# INLINE word32L #-}
word32B = B.putWord32be
{-# INLINE word32B #-}
word64L = B.putWord64le
{-# INLINE word64L #-}
word64B = B.putWord64be
{-# INLINE word64B #-}
byteString = B.putByteString
{-# INLINE byteString #-}
shortByteString = B.putShortByteString
{-# INLINE shortByteString #-}
lazyByteString = B.putLazyByteString
{-# INLINE lazyByteString #-}
builder = B.putBuilder
{-# INLINE builder #-}
#endif
newtype BinarySerializer = BinarySerializer { binarySerializer ∷ B.Put }
deriving ( Typeable, Generic
#if MIN_VERSION_binary(0,8,3)
# if MIN_VERSION_base(4,9,0)
, Semigroup
# endif
, Monoid
#endif
)
#if !MIN_VERSION_base(4,9,0) || !MIN_VERSION_binary(0,8,3)
instance Semigroup BinarySerializer where
s₁ <> s₂ = BinarySerializer $ binarySerializer s₁ >> binarySerializer s₂
{-# INLINE (<>) #-}
#endif
#if !MIN_VERSION_binary(0,8,3)
instance Monoid BinarySerializer where
mempty = BinarySerializer $ return ()
{-# INLINE mempty #-}
mappend = (<>)
{-# INLINE mappend #-}
#endif
instance Serializer BinarySerializer where
word8 = BinarySerializer . B.putWord8
{-# INLINE word8 #-}
word16L = BinarySerializer . B.putWord16le
{-# INLINE word16L #-}
word16B = BinarySerializer . B.putWord16be
{-# INLINE word16B #-}
word32L = BinarySerializer . B.putWord32le
{-# INLINE word32L #-}
word32B = BinarySerializer . B.putWord32be
{-# INLINE word32B #-}
word64L = BinarySerializer . B.putWord64le
{-# INLINE word64L #-}
word64B = BinarySerializer . B.putWord64be
{-# INLINE word64B #-}
byteString = BinarySerializer . B.putByteString
{-# INLINE byteString #-}
#if MIN_VERSION_binary(0,8,1)
shortByteString = BinarySerializer . B.putShortByteString
{-# INLINE shortByteString #-}
#endif
lazyByteString = BinarySerializer . B.putLazyByteString
{-# INLINE lazyByteString #-}
#if MIN_VERSION_binary(0,8,3)
builder = BinarySerializer . B.putBuilder
{-# INLINE builder #-}
#endif
newtype CerealSerializer = CerealSerializer { cerealSerializer ∷ S.Put }
deriving ( Typeable, Generic
#if MIN_VERSION_cereal(0,5,3)
, Monoid
#endif
)
instance Semigroup CerealSerializer where
s₁ <> s₂ = CerealSerializer $ cerealSerializer s₁ >> cerealSerializer s₂
{-# INLINE (<>) #-}
#if !MIN_VERSION_cereal(0,5,3)
instance Monoid CerealSerializer where
mempty = CerealSerializer $ return ()
{-# INLINE mempty #-}
mappend = (<>)
{-# INLINE mappend #-}
#endif
instance Serializer CerealSerializer where
word8 = CerealSerializer . S.putWord8
{-# INLINE word8 #-}
word16L = CerealSerializer . S.putWord16le
{-# INLINE word16L #-}
word16B = CerealSerializer . S.putWord16be
{-# INLINE word16B #-}
word32L = CerealSerializer . S.putWord32le
{-# INLINE word32L #-}
word32B = CerealSerializer . S.putWord32be
{-# INLINE word32B #-}
word64L = CerealSerializer . S.putWord64le
{-# INLINE word64L #-}
word64B = CerealSerializer . S.putWord64be
{-# INLINE word64B #-}
byteString = CerealSerializer . S.putByteString
{-# INLINE byteString #-}
#if MIN_VERSION_cereal(0,5,0)
shortByteString = CerealSerializer . S.putShortByteString
{-# INLINE shortByteString #-}
#endif
lazyByteString = CerealSerializer . S.putLazyByteString
{-# INLINE lazyByteString #-}
#if MIN_VERSION_cereal(0,5,0)
builder = CerealSerializer . S.putBuilder
{-# INLINE builder #-}
#endif
word16H ∷ Serializer s ⇒ Word16 → s
#ifdef WORDS_BIGENDIAN
word16H = word16B
#else
word16H = word16L
#endif
{-# INLINE word16H #-}
word32H ∷ Serializer s ⇒ Word32 → s
#ifdef WORDS_BIGENDIAN
word32H = word32B
#else
word32H = word32L
#endif
{-# INLINE word32H #-}
word64H ∷ Serializer s ⇒ Word64 → s
#ifdef WORDS_BIGENDIAN
word64H = word64B
#else
word64H = word64L
#endif
{-# INLINE word64H #-}
word ∷ Serializer s ⇒ Word → s
#ifdef WORDS_BIGENDIAN
word = wordB
#else
word = wordL
#endif
{-# INLINE word #-}
wordL ∷ Serializer s ⇒ Word → s
#if WORD_SIZE_IN_BITS == 32
wordL = word32L . fromIntegral
#else
wordL = word64L . fromIntegral
#endif
{-# INLINE wordL #-}
wordB ∷ Serializer s ⇒ Word → s
#if WORD_SIZE_IN_BITS == 32
wordB = word32B . fromIntegral
#else
wordB = word64B . fromIntegral
#endif
{-# INLINE wordB #-}
wordH ∷ Serializer s ⇒ Word → s
#if WORD_SIZE_IN_BITS == 32
wordH = word32H . fromIntegral
#else
wordH = word64H . fromIntegral
#endif
{-# INLINE wordH #-}
int8 ∷ Serializer s ⇒ Int8 → s
int8 = word8 . fromIntegral
{-# INLINE int8 #-}
int16 ∷ Serializer s ⇒ Int16 → s
int16 = word16 . fromIntegral
{-# INLINE int16 #-}
int16L ∷ Serializer s ⇒ Int16 → s
int16L = word16L . fromIntegral
{-# INLINE int16L #-}
int16B ∷ Serializer s ⇒ Int16 → s
int16B = word16B . fromIntegral
{-# INLINE int16B #-}
int16H ∷ Serializer s ⇒ Int16 → s
#ifdef WORDS_BIGENDIAN
int16H = int16B
#else
int16H = int16L
#endif
{-# INLINE int16H #-}
int32 ∷ Serializer s ⇒ Int32 → s
int32 = word32 . fromIntegral
{-# INLINE int32 #-}
int32L ∷ Serializer s ⇒ Int32 → s
int32L = word32L . fromIntegral
{-# INLINE int32L #-}
int32B ∷ Serializer s ⇒ Int32 → s
int32B = word32B . fromIntegral
{-# INLINE int32B #-}
int32H ∷ Serializer s ⇒ Int32 → s
#ifdef WORDS_BIGENDIAN
int32H = int32B
#else
int32H = int32L
#endif
{-# INLINE int32H #-}
int64 ∷ Serializer s ⇒ Int64 → s
int64 = word64 . fromIntegral
{-# INLINE int64 #-}
int64L ∷ Serializer s ⇒ Int64 → s
int64L = word64L . fromIntegral
{-# INLINE int64L #-}
int64B ∷ Serializer s ⇒ Int64 → s
int64B = word64B . fromIntegral
{-# INLINE int64B #-}
int64H ∷ Serializer s ⇒ Int64 → s
#ifdef WORDS_BIGENDIAN
int64H = int64B
#else
int64H = int64L
#endif
{-# INLINE int64H #-}
int ∷ Serializer s ⇒ Int → s
#ifdef WORDS_BIGENDIAN
int = intB
#else
int = intL
#endif
{-# INLINE int #-}
intL ∷ Serializer s ⇒ Int → s
#if WORD_SIZE_IN_BITS == 32
intL = word32L . fromIntegral
#else
intL = word64L . fromIntegral
#endif
{-# INLINE intL #-}
intB ∷ Serializer s ⇒ Int64 → s
#if WORD_SIZE_IN_BITS == 32
intB = word32B . fromIntegral
#else
intB = word64B . fromIntegral
#endif
{-# INLINE intB #-}
intH ∷ Serializer s ⇒ Int → s
#if WORD_SIZE_IN_BITS == 32
intH = word32H . fromIntegral
#else
intH = word64H . fromIntegral
#endif
{-# INLINE intH #-}
newtype LittleEndianSerializer s = LittleEndianSerializer { serializeL ∷ s }
deriving (Typeable, Data, Generic,
Semigroup, Monoid)
instance Serializer s ⇒ Serializer (LittleEndianSerializer s) where
endian _ = LittleEndian
{-# INLINE endian #-}
word8 = LittleEndianSerializer . word8
{-# INLINE word8 #-}
word16 = LittleEndianSerializer . word16L
{-# INLINE word16 #-}
word32 = LittleEndianSerializer . word32L
{-# INLINE word32 #-}
word64 = LittleEndianSerializer . word64L
{-# INLINE word64 #-}
word16L = LittleEndianSerializer . word16L
{-# INLINE word16L #-}
word16B = LittleEndianSerializer . word16B
{-# INLINE word16B #-}
word32L = LittleEndianSerializer . word32L
{-# INLINE word32L #-}
word32B = LittleEndianSerializer . word32B
{-# INLINE word32B #-}
word64L = LittleEndianSerializer . word64L
{-# INLINE word64L #-}
word64B = LittleEndianSerializer . word64B
{-# INLINE word64B #-}
byteString = LittleEndianSerializer . byteString
{-# INLINE byteString #-}
shortByteString = LittleEndianSerializer . shortByteString
{-# INLINE shortByteString #-}
lazyByteString = LittleEndianSerializer . lazyByteString
{-# INLINE lazyByteString #-}
builder = LittleEndianSerializer . builder
{-# INLINE builder #-}
newtype BigEndianSerializer s = BigEndianSerializer { serializeB ∷ s }
deriving (Typeable, Data, Generic,
Semigroup, Monoid)
instance Serializer s ⇒ Serializer (BigEndianSerializer s) where
endian _ = BigEndian
{-# INLINE endian #-}
word8 = BigEndianSerializer . word8
{-# INLINE word8 #-}
word16 = BigEndianSerializer . word16B
{-# INLINE word16 #-}
word32 = BigEndianSerializer . word32B
{-# INLINE word32 #-}
word64 = BigEndianSerializer . word64B
{-# INLINE word64 #-}
word16L = BigEndianSerializer . word16L
{-# INLINE word16L #-}
word16B = BigEndianSerializer . word16B
{-# INLINE word16B #-}
word32L = BigEndianSerializer . word32L
{-# INLINE word32L #-}
word32B = BigEndianSerializer . word32B
{-# INLINE word32B #-}
word64L = BigEndianSerializer . word64L
{-# INLINE word64L #-}
word64B = BigEndianSerializer . word64B
{-# INLINE word64B #-}
byteString = BigEndianSerializer . byteString
{-# INLINE byteString #-}
shortByteString = BigEndianSerializer . shortByteString
{-# INLINE shortByteString #-}
lazyByteString = BigEndianSerializer . lazyByteString
{-# INLINE lazyByteString #-}
builder = BigEndianSerializer . builder
{-# INLINE builder #-}
serializeIn ∷ Serializer s ⇒ Endian → (∀ s' . (Serializer s') ⇒ s') → s
serializeIn LittleEndian = serializeL
serializeIn BigEndian = serializeB
{-# INLINE serializeIn #-}
serializeH ∷ Serializer s ⇒ (∀ s' . (Serializer s') ⇒ s') → s
#ifdef WORDS_BIGENDIAN
serializeH = serializeB
#else
serializeH = serializeL
#endif
{-# INLINE serializeH #-}
class Serializable α where
put ∷ Serializer s ⇒ α → s
instance Serializable Bool where
put False = word8 0
put True = word8 1
{-# INLINE put #-}
instance Serializable Word8 where
put = word8
{-# INLINE put #-}
instance Serializable Word16 where
put = word16
{-# INLINE put #-}
instance Serializable Word32 where
put = word32
{-# INLINE put #-}
instance Serializable Word64 where
put = word64
{-# INLINE put #-}
instance Serializable Word where
put = word
{-# INLINE put #-}
instance Serializable Int8 where
put = int8
{-# INLINE put #-}
instance Serializable Int16 where
put = word16 . fromIntegral
{-# INLINE put #-}
instance Serializable Int32 where
put = word32 . fromIntegral
{-# INLINE put #-}
instance Serializable Int64 where
put = word64 . fromIntegral
{-# INLINE put #-}
instance Serializable Int where
put = int
{-# INLINE put #-}
instance (Serializable α, Serializable β) ⇒ Serializable (α, β) where
put (a, b) = put a <> put b
{-# INLINE put #-}
instance Serializable α ⇒ Serializable (Maybe α) where
put Nothing = word8 0
put (Just a) = word8 1 <> put a
instance (Serializable α, Serializable β) ⇒ Serializable (Either α β) where
put (Left a) = word8 0 <> put a
put (Right b) = word8 1 <> put b
instance Serializable BS.ByteString where
put bs = int (BS.length bs) <> byteString bs
instance Serializable SBS.ShortByteString where
put bs = int (SBS.length bs) <> shortByteString bs
putIn ∷ (Serializer s, Serializable α) ⇒ Endian → α → s
putIn e a = serializeIn e (put a)
{-# INLINE putIn #-}
putL ∷ (Serializer s, Serializable α) ⇒ α → s
putL a = serializeL (put a)
{-# INLINE putL #-}
putB ∷ (Serializer s, Serializable α) ⇒ α → s
putB a = serializeB (put a)
{-# INLINE putB #-}
putH ∷ (Serializer s, Serializable α) ⇒ α → s
putH a = serializeH (put a)
{-# INLINE putH #-}
toBytes ∷ Serializable α ⇒ α → [Word8]
toBytes = buildBytes . put
{-# INLINE toBytes #-}
toByteString ∷ Serializable α ⇒ α → BS.ByteString
toByteString = buildByteString . put
{-# INLINE toByteString #-}
toLazyByteString ∷ Serializable α ⇒ α → LBS.ByteString
toLazyByteString = BB.toLazyByteString . put
{-# INLINE toLazyByteString #-}
class Serializable α ⇒ SizedSerializable α where
size ∷ Proxy α → Int
instance SizedSerializable Bool where
size _ = 1
{-# INLINE size #-}
instance SizedSerializable Word8 where
size _ = 1
{-# INLINE size #-}
instance SizedSerializable Word16 where
size _ = 2
{-# INLINE size #-}
instance SizedSerializable Word32 where
size _ = 4
{-# INLINE size #-}
instance SizedSerializable Word64 where
size _ = 8
{-# INLINE size #-}
instance SizedSerializable Word where
#if WORD_SIZE_IN_BITS == 32
size _ = 4
#else
size _ = 8
#endif
{-# INLINE size #-}
instance SizedSerializable Int8 where
size _ = 1
{-# INLINE size #-}
instance SizedSerializable Int16 where
size _ = 2
{-# INLINE size #-}
instance SizedSerializable Int32 where
size _ = 4
{-# INLINE size #-}
instance SizedSerializable Int64 where
size _ = 8
{-# INLINE size #-}
instance SizedSerializable Int where
#if WORD_SIZE_IN_BITS == 32
size _ = 4
#else
size _ = 8
#endif
{-# INLINE size #-}
instance (SizedSerializable α, SizedSerializable β)
⇒ SizedSerializable (α, β) where
size _ = size (Proxy ∷ Proxy α) + size (Proxy ∷ Proxy β)
{-# INLINE size #-}
class RestSerializable α where
putRest ∷ Serializer s ⇒ α → s
instance RestSerializable BS.ByteString where
putRest = byteString
{-# INLINE putRest #-}
instance RestSerializable SBS.ShortByteString where
putRest = shortByteString
{-# INLINE putRest #-}
instance RestSerializable LBS.ByteString where
putRest = lazyByteString
{-# INLINE putRest #-}
instance RestSerializable BB.Builder where
putRest = builder
{-# INLINE putRest #-}
instance Serializable α ⇒ RestSerializable [α] where
putRest = mconcat . fmap put
{-# INLINE putRest #-}
instance (Serializable α, RestSerializable β) ⇒ RestSerializable (α, β) where
putRest (a, b) = put a <> putRest b
{-# INLINE putRest #-}