module Data.Serializer
(
Serializer(..)
, 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
, 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
endian ∷ Proxy s → Endian
#ifdef WORDS_BIGENDIAN
endian _ = BigEndian
#else
endian _ = LittleEndian
#endif
word8 ∷ Word8 → s
word16 ∷ Word16 → s
word16 = putIn (endian (Proxy ∷ Proxy s))
word32 ∷ Word32 → s
word32 = putIn (endian (Proxy ∷ Proxy s))
word64 ∷ Word64 → s
word64 = putIn (endian (Proxy ∷ Proxy s))
word16L ∷ Word16 → s
word16L w = word8 (fromIntegral w)
<> word8 (fromIntegral (shiftR w 8))
word16B ∷ Word16 → s
word16B = word16L . swapEndian
word32L ∷ Word32 → s
word32L w = word8 (fromIntegral w)
<> word8 (fromIntegral (shiftR w 8))
<> word8 (fromIntegral (shiftR w 16))
<> word8 (fromIntegral (shiftR w 24))
word32B ∷ Word32 → s
word32B = word32L . swapEndian
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))
word64B ∷ Word64 → s
word64B = word64L . swapEndian
byteString ∷ BS.ByteString → s
byteString = mconcat . fmap word8 . BS.unpack
shortByteString ∷ SBS.ShortByteString → s
shortByteString = mconcat . fmap word8 . SBS.unpack
lazyByteString ∷ LBS.ByteString → s
lazyByteString = mconcat . fmap byteString . LBS.toChunks
builder ∷ BB.Builder → s
builder = lazyByteString . BB.toLazyByteString
instance Serializer [Word8] where
word8 = pure
instance Serializer BB.Builder where
word8 = BB.word8
word16L = BB.word16LE
word16B = BB.word16BE
word32L = BB.word32LE
word32B = BB.word32BE
word64L = BB.word64LE
word64B = BB.word64BE
byteString = BB.byteString
shortByteString = BB.shortByteString
lazyByteString = BB.lazyByteString
builder = id
#if MIN_VERSION_base(4,9,0) && MIN_VERSION_binary(0,8,3)
instance Serializer B.Put where
word8 = B.putWord8
word16L = B.putWord16le
word16B = B.putWord16be
word32L = B.putWord32le
word32B = B.putWord32be
word64L = B.putWord64le
word64B = B.putWord64be
byteString = B.putByteString
shortByteString = B.putShortByteString
lazyByteString = B.putLazyByteString
builder = B.putBuilder
#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₂
#endif
#if !MIN_VERSION_binary(0,8,3)
instance Monoid BinarySerializer where
mempty = BinarySerializer $ return ()
mappend = (<>)
#endif
instance Serializer BinarySerializer where
word8 = BinarySerializer . B.putWord8
word16L = BinarySerializer . B.putWord16le
word16B = BinarySerializer . B.putWord16be
word32L = BinarySerializer . B.putWord32le
word32B = BinarySerializer . B.putWord32be
word64L = BinarySerializer . B.putWord64le
word64B = BinarySerializer . B.putWord64be
byteString = BinarySerializer . B.putByteString
#if MIN_VERSION_binary(0,8,1)
shortByteString = BinarySerializer . B.putShortByteString
#endif
lazyByteString = BinarySerializer . B.putLazyByteString
#if MIN_VERSION_binary(0,8,3)
builder = BinarySerializer . B.putBuilder
#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₂
#if !MIN_VERSION_cereal(0,5,3)
instance Monoid CerealSerializer where
mempty = CerealSerializer $ return ()
mappend = (<>)
#endif
instance Serializer CerealSerializer where
word8 = CerealSerializer . S.putWord8
word16L = CerealSerializer . S.putWord16le
word16B = CerealSerializer . S.putWord16be
word32L = CerealSerializer . S.putWord32le
word32B = CerealSerializer . S.putWord32be
word64L = CerealSerializer . S.putWord64le
word64B = CerealSerializer . S.putWord64be
byteString = CerealSerializer . S.putByteString
#if MIN_VERSION_cereal(0,5,0)
shortByteString = CerealSerializer . S.putShortByteString
#endif
lazyByteString = CerealSerializer . S.putLazyByteString
#if MIN_VERSION_cereal(0,5,0)
builder = CerealSerializer . S.putBuilder
#endif
word16H ∷ Serializer s ⇒ Word16 → s
#ifdef WORDS_BIGENDIAN
word16H = word16B
#else
word16H = word16L
#endif
word32H ∷ Serializer s ⇒ Word32 → s
#ifdef WORDS_BIGENDIAN
word32H = word32B
#else
word32H = word32L
#endif
word64H ∷ Serializer s ⇒ Word64 → s
#ifdef WORDS_BIGENDIAN
word64H = word64B
#else
word64H = word64L
#endif
word ∷ Serializer s ⇒ Word → s
#ifdef WORDS_BIGENDIAN
word = wordB
#else
word = wordL
#endif
wordL ∷ Serializer s ⇒ Word → s
#if WORD_SIZE_IN_BITS == 32
wordL = word32L . fromIntegral
#else
wordL = word64L . fromIntegral
#endif
wordB ∷ Serializer s ⇒ Word → s
#if WORD_SIZE_IN_BITS == 32
wordB = word32B . fromIntegral
#else
wordB = word64B . fromIntegral
#endif
wordH ∷ Serializer s ⇒ Word → s
#if WORD_SIZE_IN_BITS == 32
wordH = word32H . fromIntegral
#else
wordH = word64H . fromIntegral
#endif
int8 ∷ Serializer s ⇒ Int8 → s
int8 = word8 . fromIntegral
int16 ∷ Serializer s ⇒ Int16 → s
int16 = word16 . fromIntegral
int16L ∷ Serializer s ⇒ Int16 → s
int16L = word16L . fromIntegral
int16B ∷ Serializer s ⇒ Int16 → s
int16B = word16B . fromIntegral
int16H ∷ Serializer s ⇒ Int16 → s
#ifdef WORDS_BIGENDIAN
int16H = int16B
#else
int16H = int16L
#endif
int32 ∷ Serializer s ⇒ Int32 → s
int32 = word32 . fromIntegral
int32L ∷ Serializer s ⇒ Int32 → s
int32L = word32L . fromIntegral
int32B ∷ Serializer s ⇒ Int32 → s
int32B = word32B . fromIntegral
int32H ∷ Serializer s ⇒ Int32 → s
#ifdef WORDS_BIGENDIAN
int32H = int32B
#else
int32H = int32L
#endif
int64 ∷ Serializer s ⇒ Int64 → s
int64 = word64 . fromIntegral
int64L ∷ Serializer s ⇒ Int64 → s
int64L = word64L . fromIntegral
int64B ∷ Serializer s ⇒ Int64 → s
int64B = word64B . fromIntegral
int64H ∷ Serializer s ⇒ Int64 → s
#ifdef WORDS_BIGENDIAN
int64H = int64B
#else
int64H = int64L
#endif
int ∷ Serializer s ⇒ Int → s
#ifdef WORDS_BIGENDIAN
int = intB
#else
int = intL
#endif
intL ∷ Serializer s ⇒ Int → s
#if WORD_SIZE_IN_BITS == 32
intL = word32L . fromIntegral
#else
intL = word64L . fromIntegral
#endif
intB ∷ Serializer s ⇒ Int64 → s
#if WORD_SIZE_IN_BITS == 32
intB = word32B . fromIntegral
#else
intB = word64B . fromIntegral
#endif
intH ∷ Serializer s ⇒ Int → s
#if WORD_SIZE_IN_BITS == 32
intH = word32H . fromIntegral
#else
intH = word64H . fromIntegral
#endif
newtype LittleEndianSerializer s = LittleEndianSerializer { serializeL ∷ s }
deriving (Typeable, Data, Generic,
Semigroup, Monoid)
instance Serializer s ⇒ Serializer (LittleEndianSerializer s) where
endian _ = LittleEndian
word8 = LittleEndianSerializer . word8
word16 = LittleEndianSerializer . word16L
word32 = LittleEndianSerializer . word32L
word64 = LittleEndianSerializer . word64L
word16L = LittleEndianSerializer . word16L
word16B = LittleEndianSerializer . word16B
word32L = LittleEndianSerializer . word32L
word32B = LittleEndianSerializer . word32B
word64L = LittleEndianSerializer . word64L
word64B = LittleEndianSerializer . word64B
byteString = LittleEndianSerializer . byteString
shortByteString = LittleEndianSerializer . shortByteString
lazyByteString = LittleEndianSerializer . lazyByteString
builder = LittleEndianSerializer . builder
newtype BigEndianSerializer s = BigEndianSerializer { serializeB ∷ s }
deriving (Typeable, Data, Generic,
Semigroup, Monoid)
instance Serializer s ⇒ Serializer (BigEndianSerializer s) where
endian _ = BigEndian
word8 = BigEndianSerializer . word8
word16 = BigEndianSerializer . word16B
word32 = BigEndianSerializer . word32B
word64 = BigEndianSerializer . word64B
word16L = BigEndianSerializer . word16L
word16B = BigEndianSerializer . word16B
word32L = BigEndianSerializer . word32L
word32B = BigEndianSerializer . word32B
word64L = BigEndianSerializer . word64L
word64B = BigEndianSerializer . word64B
byteString = BigEndianSerializer . byteString
shortByteString = BigEndianSerializer . shortByteString
lazyByteString = BigEndianSerializer . lazyByteString
builder = BigEndianSerializer . builder
serializeIn ∷ Serializer s ⇒ Endian → (∀ s' . (Serializer s') ⇒ s') → s
serializeIn LittleEndian = serializeL
serializeIn BigEndian = serializeB
serializeH ∷ Serializer s ⇒ (∀ s' . (Serializer s') ⇒ s') → s
#ifdef WORDS_BIGENDIAN
serializeH = serializeB
#else
serializeH = serializeL
#endif
class Serializable α where
put ∷ Serializer s ⇒ α → s
instance Serializable Bool where
put False = word8 0
put True = word8 1
instance Serializable Word8 where
put = word8
instance Serializable Word16 where
put = word16
instance Serializable Word32 where
put = word32
instance Serializable Word64 where
put = word64
instance Serializable Word where
put = word
instance Serializable Int8 where
put = int8
instance Serializable Int16 where
put = word16 . fromIntegral
instance Serializable Int32 where
put = word32 . fromIntegral
instance Serializable Int64 where
put = word64 . fromIntegral
instance Serializable Int where
put = int
instance (Serializable α, Serializable β) ⇒ Serializable (α, β) where
put (a, b) = put a <> put b
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)
putL ∷ (Serializer s, Serializable α) ⇒ α → s
putL a = serializeL (put a)
putB ∷ (Serializer s, Serializable α) ⇒ α → s
putB a = serializeB (put a)
putH ∷ (Serializer s, Serializable α) ⇒ α → s
putH a = serializeH (put a)
class Serializable α ⇒ SizedSerializable α where
size ∷ Proxy α → Int
instance SizedSerializable Bool where
size _ = 1
instance SizedSerializable Word8 where
size _ = 1
instance SizedSerializable Word16 where
size _ = 2
instance SizedSerializable Word32 where
size _ = 4
instance SizedSerializable Word64 where
size _ = 8
instance SizedSerializable Word where
#if WORD_SIZE_IN_BITS == 32
size _ = 4
#else
size _ = 8
#endif
instance SizedSerializable Int8 where
size _ = 1
instance SizedSerializable Int16 where
size _ = 2
instance SizedSerializable Int32 where
size _ = 4
instance SizedSerializable Int64 where
size _ = 8
instance SizedSerializable Int where
#if WORD_SIZE_IN_BITS == 32
size _ = 4
#else
size _ = 8
#endif
instance (SizedSerializable α, SizedSerializable β)
⇒ SizedSerializable (α, β) where
size _ = size (Proxy ∷ Proxy α) + size (Proxy ∷ Proxy β)
class RestSerializable α where
putRest ∷ Serializer s ⇒ α → s
instance RestSerializable BS.ByteString where
putRest = byteString
instance RestSerializable SBS.ShortByteString where
putRest = shortByteString
instance RestSerializable LBS.ByteString where
putRest = lazyByteString
instance RestSerializable BB.Builder where
putRest = builder
instance Serializable α ⇒ RestSerializable [α] where
putRest = mconcat . fmap put
instance (Serializable α, RestSerializable β) ⇒ RestSerializable (α, β) where
putRest (a, b) = put a <> putRest b