binary-generic (empty) → 0.1
raw patch · 5 files changed
+186/−0 lines, 5 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, data-binary-ieee754, syb, text
Files
- LICENSE +30/−0
- README +0/−0
- Setup.lhs +3/−0
- binary-generic.cabal +30/−0
- src/Data/Binary/Generic.hs +123/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) Lars Petersen++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 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.
+ README view
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ binary-generic.cabal view
@@ -0,0 +1,30 @@+name: binary-generic+version: 0.1+license: BSD3+license-file: LICENSE+author: Lars Petersen <info@lars-petersen.net>+maintainer: Lars Petersen <info@lars-petersen.net>+homepage: http://github.com/lpeterse/binary-generic+description: Instead of manual or semi-automated generation of+ instances of 'Data.Binary.Binary' you just derive + 'Data.Data' and the library automatically figures+ out how to (de-)serialize the type.+synopsis: Generic binary serialisation using binary and syb.+category: Data, Parsing+stability: experimental+build-type: Simple+cabal-version: >= 1.2+tested-with: GHC == 6.12.1+extra-source-files: README ++library+ build-depends: base >= 3 && < 5,+ binary, + data-binary-ieee754,+ bytestring,+ syb,+ text+ hs-source-dirs: src+ exposed-modules: Data.Binary.Generic+ ghc-options: -Wall+
+ src/Data/Binary/Generic.hs view
@@ -0,0 +1,123 @@+{-# OPTIONS -XNoMonomorphismRestriction #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Binary.Generic+-- Copyright : Lars Petersen+-- License : BSD3-style (see LICENSE)+-- +-- Maintainer : Lars Petersen <info@lars-petersen.net>+-- Stability : experimental+--+-- The following primitive datatypes are used as basecases and get serialized+-- according to their instances of @Data.Binary@:+-- +-- - 'Char'+-- +-- - 'Int'+-- +-- - 'Word'+-- +-- - 'Integer'+-- +-- - 'Int8'+-- +-- - 'Int16'+-- +-- - 'Int32'+-- +-- - 'Int64'+-- +-- - 'Word8'+-- +-- - 'Word16'+-- +-- - 'Word32'+-- +-- - 'Word64'+-- +-- - 'Data.ByteString.Lazy.ByteString'+-- +-- - 'Data.Text.Lazy.Text' encoded as Utf8+-- +-- 'Float' and 'Double' are serialized according to 'IEEE754'.+-- For any algebraic datatype just make it an instance of class @Data.Data@+-- by simply deriving 'Data' on definition or try stand-alone-deriving.+--+-----------------------------------------------------------------------------++module Data.Binary.Generic (+ + getGeneric+ , putGeneric++ ) where++import Data.Binary+import Data.Binary.IEEE754 (putFloat32be, getFloat32be, putFloat64be, getFloat64be)+import Data.ByteString.Lazy (ByteString) ++import Data.Data+import Data.Generics++import Data.Word ()+import Data.Int +import Data.Text.Lazy (Text) +import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)+++getGeneric :: (Data a) => Get a+getGeneric = generalCase + `extR` (get :: Get Char)+ `extR` (get :: Get Int)+ `extR` (get :: Get Word)+ `extR` (get :: Get Integer)+ `extR` (get :: Get Int8)+ `extR` (get :: Get Int16)+ `extR` (get :: Get Int32)+ `extR` (get :: Get Int64)+ `extR` (get :: Get Word8)+ `extR` (get :: Get Word16)+ `extR` (get :: Get Word32)+ `extR` (get :: Get Word64)+ `extR` (get :: Get ByteString)+ `extR` (getText :: Get Text)+ `extR` (getFloat32be :: Get Float)+ `extR` (getFloat64be :: Get Double)+ where+ getText = get >>= (return . decodeUtf8)+ fromIntegralM = return . fromIntegral+ myDataType = dataTypeOf ((undefined :: Get b -> b) generalCase)+ generalCase = let imax = maxConstrIndex myDataType+ index | imax == 1 = return 1 :: Get Int+ | imax <= 255 = (get :: Get Word8) >>= fromIntegralM+ | otherwise = (get :: Get Word16) >>= fromIntegralM+ in index >>= \i-> fromConstrM getGeneric (indexConstr myDataType i)++putGeneric :: (Data a) => a -> Put +putGeneric = generalCase + `extQ` (put :: Char -> Put)+ `extQ` (put :: Int -> Put) + `extQ` (put :: Word -> Put) + `extQ` (put :: Integer -> Put)+ `extQ` (put :: Int8 -> Put)+ `extQ` (put :: Int16 -> Put)+ `extQ` (put :: Int32 -> Put)+ `extQ` (put :: Int64 -> Put)+ `extQ` (put :: Word8 -> Put)+ `extQ` (put :: Word16 -> Put)+ `extQ` (put :: Word32 -> Put)+ `extQ` (put :: Word64 -> Put)+ `extQ` (put :: ByteString -> Put)+ `extQ` (put . encodeUtf8 :: Text -> Put)+ `extQ` (putFloat32be :: Float -> Put)+ `extQ` (putFloat64be :: Double -> Put)+ where+ generalCase t = let i = fromIntegral $ constrIndex (toConstr t)+ imax = maxConstrIndex (dataTypeOf t) + putIndex | imax == 1 = return ()+ | imax <= 255 = put (i :: Word8) >> return ()+ | otherwise = put (i :: Word16) >> return ()+ in foldl (>>) putIndex (gmapQ putGeneric t) + +