{-# 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 #-}