summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdwardKmett <>2013-03-28 09:40:34 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-03-28 09:40:34 (GMT)
commit5aeee1916f1fcf5a59285f9ee18c1bc4a4b247f1 (patch)
treebc147ab9da00c60fab9b7aa7f5be639ace45ae71
parent5f7c846c952deb6642b3c2d4613e789e7c675f00 (diff)
version 0.30.3
-rw-r--r--CHANGELOG.markdown4
-rw-r--r--bytes.cabal2
-rw-r--r--src/Data/Bytes/Serial.hs77
3 files changed, 82 insertions, 1 deletions
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
index f23a6d8..9af9fae 100644
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,7 @@
+0.3
+-----
+* Added `Serial2` and various missing `Serial1` instances.
+
0.2
---
* Added `Serial` and `Serial1`.
diff --git a/bytes.cabal b/bytes.cabal
index 1050eb5..bb1b735 100644
--- a/bytes.cabal
+++ b/bytes.cabal
@@ -1,6 +1,6 @@
name: bytes
category: Data, Serialization
-version: 0.2
+version: 0.3
license: BSD3
cabal-version: >= 1.8
license-file: LICENSE
diff --git a/src/Data/Bytes/Serial.hs b/src/Data/Bytes/Serial.hs
index 0a82ef3..4c66b03 100644
--- a/src/Data/Bytes/Serial.hs
+++ b/src/Data/Bytes/Serial.hs
@@ -25,6 +25,7 @@ module Data.Bytes.Serial
, GSerial(..)
, Serial1(..), serialize1, deserialize1
, GSerial1(..)
+ , Serial2(..), serialize2, deserialize2
) where
import Control.Monad
@@ -46,12 +47,18 @@ class Serial a where
#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
@@ -155,6 +162,36 @@ class Serial1 f where
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
{-# INLINE serialize1 #-}
@@ -209,3 +246,43 @@ instance GSerial1 f => GSerial1 (M1 i c f) where
instance Serial a => GSerial1 (K1 i a) where
gserializeWith _ (K1 x) = serialize x
gdeserializeWith _ = liftM K1 deserialize
+
+------------------------------------------------------------------------------
+-- Higher-Rank Serialization
+------------------------------------------------------------------------------
+
+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
+{-# INLINE serialize2 #-}
+
+deserialize2 :: (MonadGet m, Serial2 f, Serial a, Serial b) => m (f a b)
+deserialize2 = deserializeWith2 deserialize deserialize
+{-# INLINE deserialize2 #-}
+
+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