messagepack (empty) → 0.1.0.0
raw patch · 5 files changed
+261/−0 lines, 5 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed
Dependencies added: QuickCheck, attoparsec, base, bytestring, cereal, containers, messagepack, test-framework, test-framework-quickcheck2, test-framework-th, text
Files
- Data/MessagePack.hs +138/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- messagepack.cabal +47/−0
- tests/Main.hs +54/−0
+ Data/MessagePack.hs view
@@ -0,0 +1,138 @@+module Data.MessagePack where++import Control.Applicative+import Control.Monad+import Data.Bits+import Data.Int+import Data.MessagePack.Spec+import Data.Serialize+import Data.Text (Text)+import Data.Text.Encoding+import qualified Data.ByteString as BS+import qualified Data.Map as M++data Object = ObjectInt Int+ | ObjectNil+ | ObjectBool Bool+ | ObjectFloat Float+ | ObjectDouble Double+ | ObjectString Text+ | ObjectBinary BS.ByteString+ | ObjectArray [Object]+ | ObjectMap (M.Map Object Object )+ deriving (Eq, Ord, Show)++instance Serialize Object where++ put (ObjectInt i)+ | i >= 0 && i <= 127 = putWord8 $ fromIntegral i+ | i >= -32 && i <= -1 = putWord8 $ fromIntegral i+ | i >= 0 && i < 0x100 = putWord8 uint8 >> putWord8 (fromIntegral i)+ | i >= 0 && i < 0x10000 = putWord8 uint16 >> putWord16be (fromIntegral i)+ | i >= 0 && i < 0x100000000 = putWord8 uint32 >> putWord32be (fromIntegral i)+ | i >= 0 = putWord8 uint64 >> putWord64be (fromIntegral i)+ | i >= -0x80 = putWord8 int8 >> putWord8 (fromIntegral i)+ | i >= -0x8000 = putWord8 int16 >> putWord16be (fromIntegral i)+ | i >= -0x80000000 = putWord8 int32 >> putWord32be (fromIntegral i)+ | otherwise = putWord8 int64 >> putWord64be (fromIntegral i)++ put ObjectNil = putWord8 nil++ put (ObjectBool b) = putWord8 $ if b then true else false++ put (ObjectFloat f) = putWord8 float32 >> putFloat32be f++ put (ObjectDouble d) = putWord8 float64 >> putFloat64be d++ put (ObjectString t) =+ header >> mapM_ put (BS.unpack bytes)+ where+ bytes = encodeUtf8 t+ size = BS.length bytes+ header+ | size <= 31 = putWord8 $ fixstr .|. fromIntegral size+ | size < 0x100 = putWord8 str8 >> putWord8 (fromIntegral size)+ | size < 0x10000 = putWord8 str16 >> putWord16be (fromIntegral size)+ | otherwise = putWord8 str32 >> putWord32be (fromIntegral size)++ put (ObjectBinary b) =+ header >> mapM_ put (BS.unpack b)+ where+ size = BS.length b+ header+ | size < 0x100 = putWord8 bin8 >> putWord8 (fromIntegral size)+ | size < 0x10000 = putWord8 bin16 >> putWord16be (fromIntegral size)+ | otherwise = putWord8 bin32 >> putWord32be (fromIntegral size)++ put (ObjectArray a) =+ buildArray >> mapM_ put a+ where+ size = length a+ buildArray+ | size <= 15 = putWord8 $ fixarray .|. fromIntegral size+ | size < 0x10000 = putWord8 array16 >> putWord16be (fromIntegral size)+ | otherwise = putWord8 array32 >> putWord32be (fromIntegral size)++ put (ObjectMap m) =+ buildMap >> mapM_ put (M.toList m)+ where+ size = M.size m+ buildMap+ | size <= 15 = putWord8 $ fixmap .|. fromIntegral size+ | size < 0x10000 = putWord8 map16 >> putWord16be (fromIntegral size)+ | otherwise = putWord8 map32 >> putWord32be (fromIntegral size)++ get =+ getWord8 >>= getObject+ where+ getObject k+ | k == nil = return ObjectNil+ | k == false = return $ ObjectBool False+ | k == true = return $ ObjectBool True++ | k == bin8 = do n <- fromIntegral <$> getWord8+ ObjectBinary <$> getBytes n+ | k == bin16 = do n <- fromIntegral <$> getWord16be+ ObjectBinary <$> getBytes n+ | k == bin32 = do n <- fromIntegral <$> getWord32be+ ObjectBinary <$> getBytes n++ | k == float32 = ObjectFloat <$> getFloat32be+ | k == float64 = ObjectDouble <$> getFloat64be++ | k .&. posFixintMask == posFixint = return $ ObjectInt $ fromIntegral k+ | k .&. negFixintMask == negFixint = return $ ObjectInt $ fromIntegral (fromIntegral k :: Int8)+ | k == uint8 = ObjectInt <$> fromIntegral <$> getWord8+ | k == uint16 = ObjectInt <$> fromIntegral <$> getWord16be+ | k == uint32 = ObjectInt <$> fromIntegral <$> getWord32be+ | k == uint64 = ObjectInt <$> fromIntegral <$> getWord64be+ | k == int8 = ObjectInt <$> fromIntegral <$> (get :: Get Int8)+ | k == int16 = ObjectInt <$> fromIntegral <$> (get :: Get Int16)+ | k == int32 = ObjectInt <$> fromIntegral <$> (get :: Get Int32)+ | k == int64 = ObjectInt <$> fromIntegral <$> (get :: Get Int64)++ | k .&. fixstrMask == fixstr = let n = fromIntegral $ k .&. complement fixstrMask+ in ObjectString <$> decodeUtf8 <$> getBytes n+ | k == str8 = do n <- fromIntegral <$> getWord8+ ObjectString <$> decodeUtf8 <$> getBytes n+ | k == str16 = do n <- fromIntegral <$> getWord16be+ ObjectString <$> decodeUtf8 <$> getBytes n+ | k == str32 = do n <- fromIntegral <$> getWord32be+ ObjectString <$> decodeUtf8 <$> getBytes n++ | k .&. fixarrayMask == fixarray = let n = fromIntegral $ k .&. complement fixarrayMask+ in ObjectArray <$> replicateM n get+ | k == array16 = do n <- fromIntegral <$> getWord16be+ ObjectArray <$> replicateM n get+ | k == array32 = do n <- fromIntegral <$> getWord32be+ ObjectArray <$> replicateM n get++ | k .&. fixmapMask == fixmap = let n = fromIntegral $ k .&. complement fixmapMask+ in ObjectMap <$> M.fromList <$> replicateM n get+ | k == map16 = do n <- fromIntegral <$> getWord16be+ ObjectMap <$> M.fromList <$> replicateM n get+ | k == map32 = do n <- fromIntegral <$> getWord32be+ ObjectMap <$> M.fromList <$> replicateM n get++ | otherwise = fail $ "mark byte not supported: " ++ show k+
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2014 Rodrigo Setti++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ messagepack.cabal view
@@ -0,0 +1,47 @@+name : messagepack+version : 0.1.0.0+synopsis : Serialize instance for Message Pack Object+description : Serialize instance for Message Pack Object+homepage : https://github.com/rodrigosetti/messagepack+license : MIT+license-file : LICENSE+author : Rodrigo Setti+stability : experimental+bug-reports : https://github.com/rodrigosetti/messagepack/issues+package-url : https://github.com/rodrigosetti/messagepack/archive/master.zip+maintainer : rodrigosetti@gmail.com+copyright : (c) 2014 Rodrigo Setti+category : Data+build-type : Simple+cabal-version : >=1.10++source-repository head+ type : git+ location : git@github.com:rodrigosetti/messagepack.git++library+ exposed-modules : Data.MessagePack+ default-language : Haskell2010+ build-depends : base == 4.*+ , attoparsec == 0.12.*+ , bytestring == 0.10.*+ , cereal == 0.4.*+ , containers == 0.5.*+ , text == 1.*++test-suite messagepack-tests+ type : exitcode-stdio-1.0+ hs-source-dirs : tests+ main-is : Main.hs+ default-language : Haskell2010+ build-depends : base == 4.*+ , QuickCheck == 2.*+ , bytestring == 0.10.*+ , cereal == 0.4.*+ , containers == 0.5.*+ , test-framework == 0.8.*+ , test-framework-quickcheck2 == 0.3.*+ , test-framework-th == 0.2.*+ , text == 1.*+ , messagepack+
+ tests/Main.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Control.Applicative+import Data.MessagePack+import Data.Serialize+import Test.Framework.Providers.QuickCheck2+import Test.Framework.TH+import Test.QuickCheck+import qualified Data.ByteString as BS+import qualified Data.Map as M+import qualified Data.Text as T++main :: IO ()+main = $(defaultMainGenerator)++instance Arbitrary Object where+ arbitrary = resize 6 $ oneof [ return ObjectNil+ , ObjectInt <$> arbitrary+ , ObjectBool <$> arbitrary+ , ObjectFloat <$> arbitrary+ , ObjectDouble <$> arbitrary+ , ObjectString <$> arbitrary+ , ObjectBinary <$> arbitrary+ , ObjectArray <$> arbitrary+ , ObjectMap <$> arbitrary ]++ shrink (ObjectString s) = map ObjectString $ shrink s+ shrink (ObjectBinary b) = map ObjectBinary $ shrink b+ shrink (ObjectArray a) = (map ObjectArray $ shrink a) ++ a+ shrink (ObjectMap m) = (map ObjectMap $ shrink m) ++ M.keys m ++ M.elems m+ shrink _ = []++instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where++ arbitrary = M.fromList <$> arbitrary++ shrink = map M.fromList . shrink . M.toList++instance Arbitrary BS.ByteString where++ arbitrary = BS.pack <$> arbitrary++ shrink = map BS.pack . shrink . BS.unpack++instance Arbitrary T.Text where++ arbitrary = T.pack <$> arbitrary++ shrink = map T.pack . shrink . T.unpack++prop_encodeDecodeIsIdentity :: Object -> Bool+prop_encodeDecodeIsIdentity o = either error (== o) $ decode $ encode o+