msgpack-types 0.2.1 → 0.3.0
raw patch · 4 files changed
+55/−70 lines, 4 files
Files
- msgpack-types.cabal +1/−1
- src/Data/MessagePack/Types/Class.hs +31/−30
- src/Data/MessagePack/Types/Object.hs +12/−29
- test/Data/MessagePack/Types/ClassSpec.hs +11/−10
msgpack-types.cabal view
@@ -1,5 +1,5 @@ name: msgpack-types-version: 0.2.1+version: 0.3.0 synopsis: A Haskell implementation of MessagePack. homepage: http://msgpack.org/ license: BSD3
src/Data/MessagePack/Types/Class.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------- -- |@@ -162,9 +163,9 @@ instance MessagePack () where toObject _ _ = ObjectNil fromObjectWith _ = \case- ObjectNil -> return ()- ObjectArray [] -> return ()- _ -> refute "invalid encoding for ()"+ ObjectNil -> return ()+ ObjectArray (V.toList -> []) -> return ()+ _ -> refute "invalid encoding for ()" instance MessagePack Bool where toObject _ = ObjectBool@@ -223,36 +224,36 @@ -- Instances for array-like data structures. instance MessagePack a => MessagePack [a] where- toObject cfg = ObjectArray . map (toObject cfg)+ toObject cfg = ObjectArray . V.fromList . map (toObject cfg) fromObjectWith cfg = \case- ObjectArray xs -> mapM (fromObjectWith cfg) xs- _ -> refute "invalid encoding for list"+ ObjectArray o -> mapM (fromObjectWith cfg) (V.toList o)+ _ -> refute "invalid encoding for list" instance MessagePack a => MessagePack (V.Vector a) where- toObject cfg = ObjectArray . map (toObject cfg) . V.toList+ toObject cfg = ObjectArray . V.map (toObject cfg) fromObjectWith cfg = \case- ObjectArray o -> V.fromList <$> mapM (fromObjectWith cfg) o+ ObjectArray o -> V.fromList <$> mapM (fromObjectWith cfg) (V.toList o) _ -> refute "invalid encoding for Vector" instance (MessagePack a, VU.Unbox a) => MessagePack (VU.Vector a) where- toObject cfg = ObjectArray . map (toObject cfg) . VU.toList+ toObject cfg = ObjectArray . V.map (toObject cfg) . V.fromList . VU.toList fromObjectWith cfg = \case- ObjectArray o -> VU.fromList <$> mapM (fromObjectWith cfg) o+ ObjectArray o -> VU.fromList . V.toList <$> V.mapM (fromObjectWith cfg) o _ -> refute "invalid encoding for Unboxed Vector" instance (MessagePack a, VS.Storable a) => MessagePack (VS.Vector a) where- toObject cfg = ObjectArray . map (toObject cfg) . VS.toList+ toObject cfg = ObjectArray . V.map (toObject cfg) . V.fromList . VS.toList fromObjectWith cfg = \case- ObjectArray o -> VS.fromList <$> mapM (fromObjectWith cfg) o+ ObjectArray o -> VS.fromList . V.toList <$> V.mapM (fromObjectWith cfg) o _ -> refute "invalid encoding for Storable Vector" -- Instances for map-like data structures. instance (MessagePack a, MessagePack b) => MessagePack (Assoc [(a, b)]) where- toObject cfg (Assoc xs) = ObjectMap $ map (toObject cfg *** toObject cfg) xs+ toObject cfg (Assoc xs) = ObjectMap . V.fromList $ map (toObject cfg *** toObject cfg) xs fromObjectWith cfg = \case ObjectMap xs ->- Assoc <$> mapM (\(k, v) -> (,) <$> fromObjectWith cfg k <*> fromObjectWith cfg v) xs+ Assoc <$> mapM (\(k, v) -> (,) <$> fromObjectWith cfg k <*> fromObjectWith cfg v) (V.toList xs) _ -> refute "invalid encoding for Assoc" instance (MessagePack k, MessagePack v, Ord k) => MessagePack (Map.Map k v) where@@ -271,41 +272,41 @@ -- Instances for various tuple arities. instance (MessagePack a1, MessagePack a2) => MessagePack (a1, a2) where- toObject cfg (a1, a2) = ObjectArray [toObject cfg a1, toObject cfg a2]- fromObjectWith cfg (ObjectArray [a1, a2]) = (,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2+ toObject cfg (a1, a2) = ObjectArray $ V.fromList [toObject cfg a1, toObject cfg a2]+ fromObjectWith cfg (ObjectArray (V.toList -> [a1, a2])) = (,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 fromObjectWith _ _ = refute "invalid encoding for tuple" instance (MessagePack a1, MessagePack a2, MessagePack a3) => MessagePack (a1, a2, a3) where- toObject cfg (a1, a2, a3) = ObjectArray [toObject cfg a1, toObject cfg a2, toObject cfg a3]- fromObjectWith cfg (ObjectArray [a1, a2, a3]) = (,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3+ toObject cfg (a1, a2, a3) = ObjectArray $ V.fromList [toObject cfg a1, toObject cfg a2, toObject cfg a3]+ fromObjectWith cfg (ObjectArray (V.toList -> [a1, a2, a3])) = (,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 fromObjectWith _ _ = refute "invalid encoding for tuple" instance (MessagePack a1, MessagePack a2, MessagePack a3, MessagePack a4) => MessagePack (a1, a2, a3, a4) where- toObject cfg (a1, a2, a3, a4) = ObjectArray [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4]- fromObjectWith cfg (ObjectArray [a1, a2, a3, a4]) = (,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4+ toObject cfg (a1, a2, a3, a4) = ObjectArray $ V.fromList [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4]+ fromObjectWith cfg (ObjectArray (V.toList -> [a1, a2, a3, a4])) = (,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 fromObjectWith _ _ = refute "invalid encoding for tuple" instance (MessagePack a1, MessagePack a2, MessagePack a3, MessagePack a4, MessagePack a5) => MessagePack (a1, a2, a3, a4, a5) where- toObject cfg (a1, a2, a3, a4, a5) = ObjectArray [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5]- fromObjectWith cfg (ObjectArray [a1, a2, a3, a4, a5]) = (,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5+ toObject cfg (a1, a2, a3, a4, a5) = ObjectArray $ V.fromList [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5]+ fromObjectWith cfg (ObjectArray (V.toList -> [a1, a2, a3, a4, a5])) = (,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 fromObjectWith _ _ = refute "invalid encoding for tuple" instance (MessagePack a1, MessagePack a2, MessagePack a3, MessagePack a4, MessagePack a5, MessagePack a6) => MessagePack (a1, a2, a3, a4, a5, a6) where- toObject cfg (a1, a2, a3, a4, a5, a6) = ObjectArray [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5, toObject cfg a6]- fromObjectWith cfg (ObjectArray [a1, a2, a3, a4, a5, a6]) = (,,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 <*> fromObjectWith cfg a6+ toObject cfg (a1, a2, a3, a4, a5, a6) = ObjectArray $ V.fromList [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5, toObject cfg a6]+ fromObjectWith cfg (ObjectArray (V.toList -> [a1, a2, a3, a4, a5, a6])) = (,,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 <*> fromObjectWith cfg a6 fromObjectWith _ _ = refute "invalid encoding for tuple" instance (MessagePack a1, MessagePack a2, MessagePack a3, MessagePack a4, MessagePack a5, MessagePack a6, MessagePack a7) => MessagePack (a1, a2, a3, a4, a5, a6, a7) where- toObject cfg (a1, a2, a3, a4, a5, a6, a7) = ObjectArray [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5, toObject cfg a6, toObject cfg a7]- fromObjectWith cfg (ObjectArray [a1, a2, a3, a4, a5, a6, a7]) = (,,,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 <*> fromObjectWith cfg a6 <*> fromObjectWith cfg a7+ toObject cfg (a1, a2, a3, a4, a5, a6, a7) = ObjectArray $ V.fromList [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5, toObject cfg a6, toObject cfg a7]+ fromObjectWith cfg (ObjectArray (V.toList -> [a1, a2, a3, a4, a5, a6, a7])) = (,,,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 <*> fromObjectWith cfg a6 <*> fromObjectWith cfg a7 fromObjectWith _ _ = refute "invalid encoding for tuple" instance (MessagePack a1, MessagePack a2, MessagePack a3, MessagePack a4, MessagePack a5, MessagePack a6, MessagePack a7, MessagePack a8) => MessagePack (a1, a2, a3, a4, a5, a6, a7, a8) where- toObject cfg (a1, a2, a3, a4, a5, a6, a7, a8) = ObjectArray [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5, toObject cfg a6, toObject cfg a7, toObject cfg a8]- fromObjectWith cfg (ObjectArray [a1, a2, a3, a4, a5, a6, a7, a8]) = (,,,,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 <*> fromObjectWith cfg a6 <*> fromObjectWith cfg a7 <*> fromObjectWith cfg a8+ toObject cfg (a1, a2, a3, a4, a5, a6, a7, a8) = ObjectArray $ V.fromList [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5, toObject cfg a6, toObject cfg a7, toObject cfg a8]+ fromObjectWith cfg (ObjectArray (V.toList -> [a1, a2, a3, a4, a5, a6, a7, a8])) = (,,,,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 <*> fromObjectWith cfg a6 <*> fromObjectWith cfg a7 <*> fromObjectWith cfg a8 fromObjectWith _ _ = refute "invalid encoding for tuple" instance (MessagePack a1, MessagePack a2, MessagePack a3, MessagePack a4, MessagePack a5, MessagePack a6, MessagePack a7, MessagePack a8, MessagePack a9) => MessagePack (a1, a2, a3, a4, a5, a6, a7, a8, a9) where- toObject cfg (a1, a2, a3, a4, a5, a6, a7, a8, a9) = ObjectArray [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5, toObject cfg a6, toObject cfg a7, toObject cfg a8, toObject cfg a9]- fromObjectWith cfg (ObjectArray [a1, a2, a3, a4, a5, a6, a7, a8, a9]) = (,,,,,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 <*> fromObjectWith cfg a6 <*> fromObjectWith cfg a7 <*> fromObjectWith cfg a8 <*> fromObjectWith cfg a9+ toObject cfg (a1, a2, a3, a4, a5, a6, a7, a8, a9) = ObjectArray $ V.fromList [toObject cfg a1, toObject cfg a2, toObject cfg a3, toObject cfg a4, toObject cfg a5, toObject cfg a6, toObject cfg a7, toObject cfg a8, toObject cfg a9]+ fromObjectWith cfg (ObjectArray (V.toList -> [a1, a2, a3, a4, a5, a6, a7, a8, a9])) = (,,,,,,,,) <$> fromObjectWith cfg a1 <*> fromObjectWith cfg a2 <*> fromObjectWith cfg a3 <*> fromObjectWith cfg a4 <*> fromObjectWith cfg a5 <*> fromObjectWith cfg a6 <*> fromObjectWith cfg a7 <*> fromObjectWith cfg a8 <*> fromObjectWith cfg a9 fromObjectWith _ _ = refute "invalid encoding for tuple"
src/Data/MessagePack/Types/Object.hs view
@@ -1,22 +1,21 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE Safe #-} {-# LANGUAGE StrictData #-}+{-# LANGUAGE Trustworthy #-} module Data.MessagePack.Types.Object ( Object (..) ) where -import Control.Applicative ((<$>), (<*>))-import Control.DeepSeq (NFData (..))-import qualified Data.ByteString as S-import Data.Int (Int64)-import qualified Data.Text as T-import Data.Typeable (Typeable)-import Data.Word (Word64, Word8)-import GHC.Generics (Generic)-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)-import qualified Test.QuickCheck.Gen as Gen+import Control.Applicative ((<$>), (<*>))+import Control.DeepSeq (NFData (..))+import qualified Data.ByteString as S+import Data.Int (Int64)+import qualified Data.Text as T+import Data.Typeable (Typeable)+import qualified Data.Vector as V+import Data.Word (Word64, Word8)+import GHC.Generics (Generic) -- | Object Representation of MessagePack data.@@ -37,9 +36,9 @@ -- ^ extending Raw type represents a UTF-8 string | ObjectBin S.ByteString -- ^ extending Raw type represents a byte array- | ObjectArray [Object]+ | ObjectArray (V.Vector Object) -- ^ represents a sequence of objects- | ObjectMap [(Object, Object)]+ | ObjectMap (V.Vector (Object, Object)) -- ^ represents key-value pairs of objects | ObjectExt {-# UNPACK #-} Word8 S.ByteString -- ^ represents a tuple of an integer and a byte array where@@ -47,19 +46,3 @@ deriving (Read, Show, Eq, Ord, Typeable, Generic) instance NFData Object--instance Arbitrary Object where- arbitrary = Gen.sized $ \n -> Gen.oneof- [ pure ObjectNil- , ObjectBool <$> arbitrary- , ObjectInt <$> negatives- , ObjectWord <$> arbitrary- , ObjectFloat <$> arbitrary- , ObjectDouble <$> arbitrary- , ObjectStr <$> (T.pack <$> arbitrary)- , ObjectBin <$> (S.pack <$> arbitrary)- , ObjectArray <$> Gen.resize (n `div` 2) arbitrary- , ObjectMap <$> Gen.resize (n `div` 4) arbitrary- , ObjectExt <$> arbitrary <*> (S.pack <$> arbitrary)- ]- where negatives = Gen.choose (minBound, -1)
test/Data/MessagePack/Types/ClassSpec.hs view
@@ -19,6 +19,7 @@ import Data.Int (Int16, Int32, Int64, Int8) import qualified Data.IntMap.Strict as IntMap import qualified Data.Map as Map+import Data.MessagePack.Arbitrary () import Data.MessagePack.Types (Assoc (..), MessagePack (..), Object (..), defaultConfig,@@ -126,23 +127,23 @@ it "produces msgpack values as expected" $ do toObject defaultConfig (SequenceTyCon 111 "hello" 2 3)- `shouldBe` ObjectArray+ `shouldBe` ObjectArray (V.fromList [ ObjectWord 0- , ObjectArray [ObjectWord 111, ObjectStr "hello", ObjectWord 2, ObjectWord 3]- ]+ , ObjectArray (V.fromList [ObjectWord 111, ObjectStr "hello", ObjectWord 2, ObjectWord 3])+ ]) toObject defaultConfig EnumTyCon `shouldBe` ObjectWord 1 toObject defaultConfig (RecordTyCon 222)- `shouldBe` ObjectArray [ObjectWord 2, ObjectWord 222]+ `shouldBe` ObjectArray (V.fromList [ObjectWord 2, ObjectWord 222]) describe "MessagePack" $ do it "handles wrong encodings correctly" $ do- (decode $ ObjectArray [ObjectWord 1, ObjectWord 222] :: Result MyType)+ (decode $ ObjectArray (V.fromList [ObjectWord 1, ObjectWord 222]) :: Result MyType) `shouldBe` Left ["invalid encoding for custom unit type"] (decode ObjectNil :: Result MyType) `shouldBe` Left ["invalid encoding for tuple"]- (decode $ ObjectArray [ObjectWord 99999] :: Result MyType)+ (decode $ ObjectArray (V.fromList [ObjectWord 99999]) :: Result MyType) `shouldBe` Left ["invalid encoding for tuple"]- (decode $ ObjectArray [] :: Result MyType)+ (decode $ ObjectArray V.empty :: Result MyType) `shouldBe` Left ["invalid encoding for tuple"] (decode ObjectNil :: Result Int64) `shouldBe` Left ["invalid encoding for integer type"]@@ -170,7 +171,7 @@ `shouldBe` Left ["invalid encoding for Assoc"] (decode ObjectNil :: Result Word64) `shouldBe` Left ["invalid encoding for integer type"]- (decode (ObjectArray [ObjectWord 0]) :: Result ())+ (decode (ObjectArray (V.fromList [ObjectWord 0])) :: Result ()) `shouldBe` Left ["invalid encoding for ()"] (decode ObjectNil :: Result (Int, Int)) `shouldBe` Left ["invalid encoding for tuple"]@@ -186,7 +187,7 @@ `shouldBe` Left ["invalid encoding for tuple"] (decode ObjectNil :: Result (Int, Int, Int, Int, Int, Int, Int, Int)) `shouldBe` Left ["invalid encoding for tuple"]- (decode $ ObjectArray [ObjectNil, ObjectNil] :: Result (Int, String))+ (decode $ ObjectArray (V.fromList [ObjectNil, ObjectNil]) :: Result (Int, String)) `shouldBe` Left ["invalid encoding for integer type", "invalid encoding for Text"] it "has a working Read/Show implementation" $ property $ \(x :: Object) ->@@ -195,7 +196,7 @@ it "can parse both nil and [] as ()" $ do (decode ObjectNil :: Result ()) `shouldBe` Right ()- (decode (ObjectArray []) :: Result ())+ (decode (ObjectArray V.empty) :: Result ()) `shouldBe` Right () it "can parse ints and doubles as floats" $ do