Permalink
Browse files

Serial, Binary and Serialize instances

  • Loading branch information...
1 parent f932cec commit 94b082719ae476889e11744e10202cdf46bc4392 @ekmett committed Mar 28, 2013
Showing with 66 additions and 1 deletion.
  1. +33 −1 src/Bound/Name.hs
  2. +33 −0 src/Bound/Scope.hs
View
@@ -42,13 +42,16 @@ import Bound.Scope
import Bound.Var
import Control.Applicative
import Control.Comonad
-import Control.Monad (liftM)
+import Control.Monad (liftM, liftM2)
import Data.Foldable
import Data.Traversable
import Data.Monoid
import Data.Bifunctor
import Data.Bifoldable
+import qualified Data.Binary as Binary
+import Data.Binary (Binary)
import Data.Bitraversable
+import Data.Bytes.Serial
#ifdef __GLASGOW_HASKELL__
import Data.Data
# if __GLASGOW_HASKELL__ >= 704
@@ -58,6 +61,8 @@ import GHC.Generics
import Data.Hashable
import Data.Hashable.Extras
import Data.Profunctor
+import qualified Data.Serialize as Serialize
+import Data.Serialize (Serialize)
import Prelude.Extras
-------------------------------------------------------------------------------
@@ -170,6 +175,33 @@ instance Ord2 Name where
instance Show2 Name where showsPrec2 = showsPrec
instance Read2 Name where readsPrec2 = readsPrec
+instance Serial2 Name where
+ serializeWith2 pb pf (Name b a) = pb b >> pf a
+ {-# INLINE serializeWith2 #-}
+
+ deserializeWith2 gb gf = liftM2 Name gb gf
+ {-# INLINE deserializeWith2 #-}
+
+instance Serial b => Serial1 (Name b) where
+ serializeWith = serializeWith2 serialize
+ {-# INLINE serializeWith #-}
+ deserializeWith = deserializeWith2 deserialize
+ {-# INLINE deserializeWith #-}
+
+instance (Serial b, Serial a) => Serial (Name b a) where
+ serialize = serializeWith2 serialize serialize
+ {-# INLINE serialize #-}
+ deserialize = deserializeWith2 deserialize deserialize
+ {-# INLINE deserialize #-}
+
+instance (Binary b, Binary a) => Binary (Name b a) where
+ put = serializeWith2 Binary.put Binary.put
+ get = deserializeWith2 Binary.get Binary.get
+
+instance (Serialize b, Serialize a) => Serialize (Name b a) where
+ put = serializeWith2 Serialize.put Serialize.put
+ get = deserializeWith2 Serialize.get Serialize.get
+
-------------------------------------------------------------------------------
-- Abstraction
-------------------------------------------------------------------------------
View
@@ -39,6 +39,8 @@ module Bound.Scope
, traverseScope
, mapMBound
, mapMScope
+ , serializeScope
+ , deserializeScope
) where
import Bound.Class
@@ -48,11 +50,18 @@ import Control.Monad hiding (mapM, mapM_)
import Control.Monad.Trans.Class
import Data.Bifunctor
import Data.Bifoldable
+import qualified Data.Binary as Binary
+import Data.Binary (Binary)
import Data.Bitraversable
+import Data.Bytes.Get
+import Data.Bytes.Put
+import Data.Bytes.Serial
import Data.Foldable
import Data.Hashable
import Data.Hashable.Extras
import Data.Monoid
+import qualified Data.Serialize as Serialize
+import Data.Serialize (Serialize)
import Data.Traversable
import Prelude.Extras
import Prelude hiding (foldr, mapM, mapM_)
@@ -346,3 +355,27 @@ mapMScope :: (Monad m, Traversable f) =>
(b -> m d) -> (a -> m c) -> Scope b f a -> m (Scope d f c)
mapMScope f g (Scope s) = liftM Scope (mapM (bimapM f (mapM g)) s)
{-# INLINE mapMScope #-}
+
+serializeScope :: (Serial1 f, MonadPut m) => (b -> m ()) -> (v -> m ()) -> Scope b f v -> m ()
+serializeScope pb pv (Scope body) = serializeWith (serializeWith2 pb $ serializeWith pv) body
+{-# INLINE serializeScope #-}
+
+deserializeScope :: (Serial1 f, MonadGet m) => m b -> m v -> m (Scope b f v)
+deserializeScope gb gv = liftM Scope $ deserializeWith (deserializeWith2 gb $ deserializeWith gv)
+{-# INLINE deserializeScope #-}
+
+instance (Serial b, Serial1 f) => Serial1 (Scope b f) where
+ serializeWith = serializeScope serialize
+ deserializeWith = deserializeScope deserialize
+
+instance (Serial b, Serial1 f, Serial a) => Serial (Scope b f a) where
+ serialize = serializeScope serialize serialize
+ deserialize = deserializeScope deserialize deserialize
+
+instance (Binary b, Serial1 f, Binary a) => Binary (Scope b f a) where
+ put = serializeScope Binary.put Binary.put
+ get = deserializeScope Binary.get Binary.get
+
+instance (Serialize b, Serial1 f, Serialize a) => Serialize (Scope b f a) where
+ put = serializeScope Serialize.put Serialize.put
+ get = deserializeScope Serialize.get Serialize.get

0 comments on commit 94b0827

Please sign in to comment.