module Data.Bytes.Serial
( Serial(..)
, GSerial(..)
, Serial1(..), serialize1, deserialize1
, GSerial1(..)
, Serial2(..), serialize2, deserialize2
) where
import Control.Monad
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Int
import Data.Word
import GHC.Generics
class Serial a where
serialize :: MonadPut m => a -> m ()
#ifndef HLINT
default serialize :: (MonadPut m, GSerial (Rep a), Generic a) => a -> m ()
serialize = gserialize . from
#endif
deserialize :: MonadGet m => m a
#ifndef HLINT
default deserialize :: (MonadGet m, Generic a, GSerial (Rep a)) => m a
deserialize = liftM to gdeserialize
#endif
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
instance Serial Char where
serialize = putWord32host . fromIntegral . fromEnum
deserialize = liftM (toEnum . fromIntegral) getWord32host
instance Serial Word where
serialize = putWordhost
deserialize = getWordhost
instance Serial Word64 where
serialize = putWord64host
deserialize = getWord64host
instance Serial Word32 where
serialize = putWord32host
deserialize = getWord32host
instance Serial Word16 where
serialize = putWord16host
deserialize = getWord16host
instance Serial Word8 where
serialize = putWord8
deserialize = getWord8
instance Serial Int where
serialize = putWordhost . fromIntegral
deserialize = liftM fromIntegral getWordhost
instance Serial Int64 where
serialize = putWord64host . fromIntegral
deserialize = liftM fromIntegral getWord64host
instance Serial Int32 where
serialize = putWord32host . fromIntegral
deserialize = liftM fromIntegral getWord32host
instance Serial Int16 where
serialize = putWord16host . fromIntegral
deserialize = liftM fromIntegral getWord16host
instance Serial Int8 where
serialize = putWord8 . fromIntegral
deserialize = liftM fromIntegral getWord8
class GSerial f where
gserialize :: MonadPut m => f a -> m ()
gdeserialize :: MonadGet m => m (f a)
instance GSerial U1 where
gserialize U1 = return ()
gdeserialize = return U1
instance GSerial V1 where
gserialize _ = fail "I looked into the void."
gdeserialize = fail "I looked into the void."
instance (GSerial f, GSerial g) => GSerial (f :*: g) where
gserialize (f :*: g) = do
gserialize f
gserialize g
gdeserialize = liftM2 (:*:) gdeserialize gdeserialize
instance (GSerial f, GSerial g) => GSerial (f :+: g) where
gserialize (L1 x) = putWord8 0 >> gserialize x
gserialize (R1 y) = putWord8 1 >> gserialize y
gdeserialize = getWord8 >>= \a -> case a of
0 -> liftM L1 gdeserialize
1 -> liftM R1 gdeserialize
_ -> fail "Missing case"
instance GSerial f => GSerial (M1 i c f) where
gserialize (M1 x) = gserialize x
gdeserialize = liftM M1 gdeserialize
instance Serial a => GSerial (K1 i a) where
gserialize (K1 x) = serialize x
gdeserialize = liftM K1 deserialize
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 f = gserializeWith f . 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 f = liftM to1 (gdeserializeWith f)
#endif
instance Serial1 [] where
serializeWith _ [] = putWord8 0
serializeWith f (x:xs) = putWord8 1 >> f x >> serializeWith f xs
deserializeWith m = getWord8 >>= \a -> case a of
0 -> return []
1 -> liftM2 (:) m (deserializeWith m)
_ -> error "[].deserializeWith: Missing case"
instance Serial1 Maybe where
serializeWith _ Nothing = putWord8 0
serializeWith f (Just a) = putWord8 1 >> f a
deserializeWith m = getWord8 >>= \a -> case a of
0 -> return Nothing
1 -> liftM Just m
_ -> error "Maybe.deserializeWith: Missing case"
instance Serial a => Serial1 (Either a) where
serializeWith = serializeWith2 serialize
deserializeWith = deserializeWith2 deserialize
instance Serial a => Serial1 ((,) a) where
serializeWith = serializeWith2 serialize
deserializeWith = deserializeWith2 deserialize
instance (Serial a, Serial b) => Serial1 ((,,) a b) where
serializeWith = serializeWith2 serialize
deserializeWith = deserializeWith2 deserialize
instance (Serial a, Serial b, Serial c) => Serial1 ((,,,) a b c) where
serializeWith = serializeWith2 serialize
deserializeWith = deserializeWith2 deserialize
instance (Serial a, Serial b, Serial c, Serial d) => Serial1 ((,,,,) a b c d) where
serializeWith = serializeWith2 serialize
deserializeWith = deserializeWith2 deserialize
serialize1 :: (MonadPut m, Serial1 f, Serial a) => f a -> m ()
serialize1 = serializeWith serialize
deserialize1 :: (MonadGet m, Serial1 f, Serial a) => m (f a)
deserialize1 = deserializeWith deserialize
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 f (Par1 a) = f a
gdeserializeWith m = liftM Par1 m
instance GSerial1 f => GSerial1 (Rec1 f) where
gserializeWith f (Rec1 fa) = gserializeWith f fa
gdeserializeWith m = liftM Rec1 (gdeserializeWith m)
instance GSerial1 U1 where
gserializeWith _ U1 = return ()
gdeserializeWith _ = return U1
instance GSerial1 V1 where
gserializeWith _ = fail "I looked into the void."
gdeserializeWith _ = fail "I looked into the void."
instance (GSerial1 f, GSerial1 g) => GSerial1 (f :*: g) where
gserializeWith f (a :*: b) = gserializeWith f a >> gserializeWith f b
gdeserializeWith m = liftM2 (:*:) (gdeserializeWith m) (gdeserializeWith m)
instance (GSerial1 f, GSerial1 g) => GSerial1 (f :+: g) where
gserializeWith f (L1 x) = putWord8 0 >> gserializeWith f x
gserializeWith f (R1 y) = putWord8 1 >> gserializeWith f y
gdeserializeWith m = getWord8 >>= \a -> case a of
0 -> liftM L1 (gdeserializeWith m)
1 -> liftM R1 (gdeserializeWith m)
_ -> fail "Missing case"
instance GSerial1 f => GSerial1 (M1 i c f) where
gserializeWith f (M1 x) = gserializeWith f x
gdeserializeWith = liftM M1 . gdeserializeWith
instance Serial a => GSerial1 (K1 i a) where
gserializeWith _ (K1 x) = serialize x
gdeserializeWith _ = liftM K1 deserialize
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 = serializeWith2 serialize serialize
deserialize2 :: (MonadGet m, Serial2 f, Serial a, Serial b) => m (f a b)
deserialize2 = deserializeWith2 deserialize deserialize
instance Serial2 Either where
serializeWith2 f _ (Left x) = putWord8 0 >> f x
serializeWith2 _ g (Right y) = putWord8 1 >> g y
deserializeWith2 m n = getWord8 >>= \a -> case a of
0 -> liftM Left m
1 -> liftM Right n
_ -> fail "Missing case"
instance Serial2 (,) where
serializeWith2 f g (a, b) = f a >> g b
deserializeWith2 m n = liftM2 (,) m n
instance Serial a => Serial2 ((,,) a) where
serializeWith2 f g (a, b, c) = serialize a >> f b >> g c
deserializeWith2 m n = liftM3 (,,) deserialize m n
instance (Serial a, Serial b) => Serial2 ((,,,) a b) where
serializeWith2 f g (a, b, c, d) = serialize a >> serialize b >> f c >> g d
deserializeWith2 m n = liftM4 (,,,) deserialize deserialize m n
instance (Serial a, Serial b, Serial c) => Serial2 ((,,,,) a b c) where
serializeWith2 f g (a, b, c, d, e) = serialize a >> serialize b >> serialize c >> f d >> g e
deserializeWith2 m n = liftM5 (,,,,) deserialize deserialize deserialize m n