multirec-binary (empty) → 0.0.1

raw patch · 4 files changed

+144/−0 lines, 4 filesdep +basedep +binarydep +multirecsetup-changed

Dependencies added: base, binary, multirec

Files

• LICENSE +28/−0
• Setup.lhs +6/−0
• multirec-binary.cabal +17/−0
• src/Generics/MultiRec/Binary.hs +93/−0

@@ -0,0 +1,28 @@+Copyright (c) Sebastiaan Visser 2008++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.+

@@ -0,0 +1,6 @@+#! /usr/bin/env runhaskell++>import Distribution.Simple++>main = defaultMain+

@@ -0,0 +1,17 @@+Name:             multirec-binary+Version:          0.0.1+Description:      Generic Data.Binary instances using MultiRec.+Synopsis:         Generic Data.Binary instances using MultiRec.+Category:         Generics, Data+License:          BSD3+License-file:     LICENSE+Author:           Sebastiaan Visser+Maintainer:       sfvisser@cs.uu.nl+Cabal-Version:    >= 1.6+Build-Type:       Simple+Build-Depends:    base, multirec ==0.3.*, binary ==0.5.*++GHC-Options:      -Wall+HS-Source-Dirs:   src+Exposed-modules:  Generics.MultiRec.Binary+

@@ -0,0 +1,93 @@+{-# LANGUAGE+    FlexibleContexts+  , RankNTypes+  , GADTs+  , TypeOperators+  , MultiParamTypeClasses+  , FlexibleInstances+  , ScopedTypeVariables+ #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Generics.MultiRec.Binary+-- Copyright   :  (c) 2009 Sebastiaan Visser+-- License     :  BSD3+--+-- Maintainer  :  sfvisser@cs.uu.nl+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Generic Data.Binary instances.+--+--+-- You can use these generic functions to create a 'Data.Binary' instance. For+-- example, for the 'Expr' data type from the AST example from the MutliRec+-- distribution:+--+-- > import Data.Binary+-- > import Generics.MultiRec.Base+-- > import Generics.MultiRec.Binary+-- >+-- > instance Binary Expr where+-- >   put = gput AST+-- >   get = gget AST+--+-----------------------------------------------------------------------------++module Generics.MultiRec.Binary where++import Control.Applicative+import Control.Monad+import Data.Binary+import Generics.MultiRec.Base+import Generics.MultiRec.TEq++-- * Generic Data.Binary instances.++class HBinary phi f where+  hput :: (forall ix'.               phi ix' -> r ix' -> Put)         -> phi ix -> f r ix -> Put+  hget :: (forall ix'. El phi ix' => phi ix' ->          Get (r ix')) -> phi ix           -> Get (f r ix)++instance El phi xi => HBinary phi (I xi) where+  hput t _ (I x) = t proof x+  hget g _       = I <$> g proof++instance Binary a => HBinary phi (K a) where+  hput _ _ (K x) = put x+  hget _ _       = K <$> get++instance HBinary phi U where+  hput _ _ U = put ()+  hget _ _   = return U++instance (HBinary phi f, HBinary phi g) => HBinary phi (f :+: g) where+  hput t p (L x) = put True  >> hput t p x+  hput t p (R y) = put False >> hput t p y+  hget t p       = get >>= \v -> if v then L <$> hget t p else R <$> hget t p++instance (HBinary phi f, HBinary phi g) => HBinary phi (f :*: g) where+  hput t p (x :*: y) = hput t p x >> hput t p y+  hget t p           = (:*:) <$> hget t p <*> hget t p++instance (EqS phi, El phi ix, HBinary phi f) => HBinary phi (f :>: ix) where+  hput t p (Tag x) = hput t p x+  hget t p =+    case eqS (proof :: phi ix) p of+      Nothing -> error "decoding error"+      Just Refl -> Tag <$> hget t p++instance (Constructor c, HBinary phi f) => HBinary phi (C c f) where+  hput t p (C x) = hput t p x+  hget t p       = C <$> hget t p++-- | Generic binary 'Put'.++gput :: (Fam phi, HBinary phi (PF phi)) => phi ix -> ix -> Put+gput p = hput (\q -> gput q . unI0) p . from p++-- | Generic binary 'Get'.++gget :: (Fam phi, HBinary phi (PF phi)) => phi ix -> Get ix+gget p = to p <$> hget (fmap I0 . gget) p+