data-msgpack 0.0.5 → 0.0.6

raw patch · 6 files changed

+66/−23 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• data-msgpack.cabal +1/−1
• src/Data/MessagePack/Class.hs +26/−9
• src/Data/MessagePack/Generic.hs +2/−2
• src/Data/MessagePack/Get.hs +13/−7
• src/Data/MessagePack/Object.hs +9/−3
• src/Data/MessagePack/Put.hs +15/−1

@@ -1,5 +1,5 @@ name:                 data-msgpack-version:              0.0.5+version:              0.0.6 synopsis:             A Haskell implementation of MessagePack homepage:             http://msgpack.org/ license:              BSD3

@@ -81,22 +81,36 @@ fromInt :: Integral a => Int64 -> a fromInt = fromIntegral +toWord :: Integral a => a -> Word64+toWord = fromIntegral++fromWord :: Integral a => Word64 -> a+fromWord = fromIntegral+ instance MessagePack Int64 where-  toObject = ObjectInt+  toObject i+    | i < 0 = ObjectInt i+    | otherwise = ObjectWord $ toWord i   fromObject = \case-    ObjectInt n -> return n-    _           -> fail "invalid encoding for integer type"+    ObjectInt n  -> return n+    ObjectWord n -> return $ toInt n+    _            -> fail "invalid encoding for integer type" +instance MessagePack Word64 where+  toObject = ObjectWord+  fromObject = \case+    ObjectWord n -> return n+    _            -> fail "invalid encoding for integer type"+ instance MessagePack Int    where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o } instance MessagePack Int8   where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o } instance MessagePack Int16  where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o } instance MessagePack Int32  where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o } -instance MessagePack Word   where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o }-instance MessagePack Word8  where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o }-instance MessagePack Word16 where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o }-instance MessagePack Word32 where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o }-instance MessagePack Word64 where { toObject = toObject . toInt; fromObject o = fromInt <$> fromObject o }+instance MessagePack Word   where { toObject = toObject . toWord; fromObject o = fromWord <$> fromObject o }+instance MessagePack Word8  where { toObject = toObject . toWord; fromObject o = fromWord <$> fromObject o }+instance MessagePack Word16 where { toObject = toObject . toWord; fromObject o = fromWord <$> fromObject o }+instance MessagePack Word32 where { toObject = toObject . toWord; fromObject o = fromWord <$> fromObject o }   -- Core instances.@@ -106,8 +120,9 @@   fromObject = return  instance MessagePack () where-  toObject _ = ObjectArray []+  toObject _ = ObjectNil   fromObject = \case+    ObjectNil      -> return ()     ObjectArray [] -> return ()     _              -> fail "invalid encoding for ()" @@ -121,6 +136,7 @@   toObject = ObjectFloat   fromObject = \case     ObjectInt    n -> return $ fromIntegral n+    ObjectWord   n -> return $ fromIntegral n     ObjectFloat  f -> return f     ObjectDouble d -> return $ realToFrac d     _              -> fail "invalid encoding for Float"@@ -129,6 +145,7 @@   toObject = ObjectDouble   fromObject = \case     ObjectInt    n -> return $ fromIntegral n+    ObjectWord   n -> return $ fromIntegral n     ObjectFloat  f -> return $ realToFrac f     ObjectDouble d -> return d     _              -> fail "invalid encoding for Double"

@@ -37,8 +37,8 @@       size = unTagged (sumSize :: Tagged (a :+: b) Word64)    gFromObject = \case-    ObjectInt code -> checkSumFromObject0 size (fromIntegral code)-    o              -> fromObject o >>= uncurry (checkSumFromObject size)+    ObjectWord code -> checkSumFromObject0 size (fromIntegral code)+    o               -> fromObject o >>= uncurry (checkSumFromObject size)     where       size = unTagged (sumSize :: Tagged (a :+: b) Word64) 

@@ -19,6 +19,7 @@   ( getNil   , getBool   , getInt+  , getWord   , getFloat   , getDouble   , getStr@@ -39,7 +40,7 @@ import           Data.Int            (Int16, Int32, Int64, Int8) import qualified Data.Text           as T import qualified Data.Text.Encoding  as T-import           Data.Word           (Word8)+import           Data.Word           (Word64, Word8)  getNil :: Get () getNil = tag 0xC0@@ -52,18 +53,23 @@ getInt :: Get Int64 getInt =   getWord8 >>= \case+    c | c .&. 0xE0 == 0xE0 ->+        return $ fromIntegral (fromIntegral c :: Int8)+    0xD0 -> fromIntegral <$> getInt8+    0xD1 -> fromIntegral <$> getInt16be+    0xD2 -> fromIntegral <$> getInt32be+    0xD3 -> fromIntegral <$> getInt64be+    _    -> empty++getWord :: Get Word64+getWord =+  getWord8 >>= \case     c | c .&. 0x80 == 0x00 ->         return $ fromIntegral c-      | c .&. 0xE0 == 0xE0 ->-        return $ fromIntegral (fromIntegral c :: Int8)     0xCC -> fromIntegral <$> getWord8     0xCD -> fromIntegral <$> getWord16be     0xCE -> fromIntegral <$> getWord32be     0xCF -> fromIntegral <$> getWord64be-    0xD0 -> fromIntegral <$> getInt8-    0xD1 -> fromIntegral <$> getInt16be-    0xD2 -> fromIntegral <$> getInt32be-    0xD3 -> fromIntegral <$> getInt64be     _    -> empty  getFloat :: Get Float

@@ -14,7 +14,7 @@ import qualified Data.Text                 as T import qualified Data.Text.Lazy            as LT import           Data.Typeable             (Typeable)-import           Data.Word                 (Word8)+import           Data.Word                 (Word64, Word8) import           GHC.Generics              (Generic) import           Prelude                   hiding (putStr) import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)@@ -31,7 +31,9 @@   | ObjectBool                  !Bool     -- ^ represents true or false   | ObjectInt    {-# UNPACK #-} !Int64-    -- ^ represents an integer+    -- ^ represents a negative integer+  | ObjectWord   {-# UNPACK #-} !Word64+    -- ^ represents a positive integer   | ObjectFloat  {-# UNPACK #-} !Float     -- ^ represents a floating point number   | ObjectDouble {-# UNPACK #-} !Double@@ -61,6 +63,7 @@       ObjectNil    <$  getNil   <|> ObjectBool   <$> getBool   <|> ObjectInt    <$> getInt+  <|> ObjectWord   <$> getWord   <|> ObjectFloat  <$> getFloat   <|> ObjectDouble <$> getDouble   <|> ObjectStr    <$> getStr@@ -74,6 +77,7 @@   ObjectNil      -> putNil   ObjectBool   b -> putBool b   ObjectInt    n -> putInt n+  ObjectWord   n -> putWord n   ObjectFloat  f -> putFloat f   ObjectDouble d -> putDouble d   ObjectStr    t -> putStr t@@ -87,7 +91,8 @@   arbitrary = Gen.sized $ \n -> Gen.oneof     [ return ObjectNil     , ObjectBool   <$> arbitrary-    , ObjectInt    <$> arbitrary+    , ObjectInt    <$> negatives+    , ObjectWord   <$> arbitrary     , ObjectFloat  <$> arbitrary     , ObjectDouble <$> arbitrary     , ObjectStr    <$> arbitrary@@ -96,6 +101,7 @@     , ObjectMap    <$> Gen.resize (n `div` 4) arbitrary     , ObjectExt    <$> arbitrary <*> arbitrary     ]+    where negatives = Gen.choose (minBound, -1)  instance Arbitrary S.ByteString where   arbitrary = S.pack <$> arbitrary

@@ -17,6 +17,7 @@   ( putNil   , putBool   , putInt+  , putWord   , putFloat   , putDouble   , putStr@@ -35,7 +36,7 @@ import           Data.Int            (Int64) import qualified Data.Text           as T import qualified Data.Text.Encoding  as T-import           Data.Word           (Word8)+import           Data.Word           (Word64, Word8)  import           Prelude             hiding (putStr) @@ -66,6 +67,19 @@     putWord8 0xD2 >> putWord32be  (fromIntegral n)   | otherwise =     putWord8 0xD3 >> putWord64be (fromIntegral n)++putWord :: Word64 -> Put+putWord n+  | n < 0x80 =+                     putWord8     (fromIntegral n)+  | n < 0x100 =+    putWord8 0xCC >> putWord8     (fromIntegral n)+  | n < 0x10000 =+    putWord8 0xCD >> putWord16be  (fromIntegral n)+  | n < 0x100000000 =+    putWord8 0xCE >> putWord32be  (fromIntegral n)+  | otherwise =+    putWord8 0xCF >> putWord64be  n  putFloat :: Float -> Put putFloat f = do