msgpack 1.0.0 → 1.0.1.0
raw patch · 11 files changed
+237/−95 lines, 11 filesdep +asyncdep −blaze-builderdep ~QuickCheckdep ~basedep ~binarysetup-changednew-uploader
Dependencies added: async
Dependencies removed: blaze-builder
Dependency ranges changed: QuickCheck, base, binary, bytestring, containers, data-binary-ieee754, deepseq, hashable, mtl, tasty, tasty-quickcheck, text, vector
Files
- CHANGES.md +13/−0
- LICENSE +4/−2
- Setup.hs +2/−0
- Setup.lhs +0/−3
- msgpack.cabal +49/−24
- src/Data/MessagePack.hs +4/−7
- src/Data/MessagePack/Assoc.hs +1/−1
- src/Data/MessagePack/Get.hs +94/−21
- src/Data/MessagePack/Object.hs +21/−9
- src/Data/MessagePack/Put.hs +41/−28
- test/test.hs +8/−0
+ CHANGES.md view
@@ -0,0 +1,13 @@+## 1.0.1.0++- Fix incorrect MessagePack tag when encoding single-precision `Float`s+- Fix looping/hanging `MessagePack (Maybe a)` instance+- Add support for `binary-0.8` API+- Drop dependency on `blaze-builder`+- Add new operations+ - `getWord`, `getWord64`, `getInt64`+ - `putWord`, `putWord64`, `putInt64`+- Add `Read` instance for `Object` and `Assoc`+- Add `Generic` instance for `Object`+- Add `Object` instance `ShortByteString`+- Declare API `Trustworthy` for SafeHaskell
LICENSE view
@@ -1,4 +1,6 @@-Copyright (c) 2009-2010, Hideyuki Tanaka+Copyright (c) Hideyuki Tanaka 2009-2010+ (c) Herbert Valerio Riedel 2019+ All rights reserved. Redistribution and use in source and binary forms, with or without@@ -12,7 +14,7 @@ names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY Hideyuki Tanaka ''AS IS'' AND ANY+THIS SOFTWARE IS PROVIDED BY Hideyuki Tanaka 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 <copyright holder> BE LIABLE FOR ANY
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
msgpack.cabal view
@@ -1,24 +1,42 @@+cabal-version: 1.12 name: msgpack-version: 1.0.0+version: 1.0.1.0+ synopsis: A Haskell implementation of MessagePack-description: A Haskell implementation of MessagePack <http://msgpack.org/>+description:+ A Haskell implementation of the <http://msgpack.org/ MessagePack> data interchange format.+ MessagePack is a binary format which aims to be compact and supports encoding a superset of the <http://json.org/ JSON> data-model.+ .+ == Related Packages+ .+ A JSON adapter for the <https://hackage.haskell.org/package/aeson aeson> library is provided by the <https://hackage.haskell.org/package/msgpack-aeson msgpack-aeson> package.+ .+ The <http://hackage.haskell.org/package/msgpack-rpc msgpack-rpc> package provides an implementation of the MessagePack-RPC protocol.++ homepage: http://msgpack.org/+bug-reports: https://github.com/msgpack/msgpack-haskell/issues license: BSD3 license-file: LICENSE author: Hideyuki Tanaka-maintainer: Hideyuki Tanaka <tanaka.hideyuki@gmail.com>-copyright: Copyright (c) 2009-2015, Hideyuki Tanaka+maintainer: Herbert Valerio Riedel <hvr@gnu.org>+copyright: Copyright (c) Hideyuki Tanaka 2009-2015,+ (c) Herbert Valerio Riedel 2019+ category: Data-stability: Experimental-cabal-version: >= 1.10 build-type: Simple +extra-source-files: CHANGES.md+ source-repository head type: git- location: git://github.com/msgpack/msgpack-haskell.git+ location: http://github.com/msgpack/msgpack-haskell.git+ subdir: msgpack library default-language: Haskell2010+ other-extensions: LambdaCase, OverloadedLists+ default-extensions: Trustworthy hs-source-dirs: src exposed-modules: Data.MessagePack@@ -27,19 +45,23 @@ Data.MessagePack.Get Data.MessagePack.Put - build-depends: base ==4.*- , mtl >=2.2- , bytestring >=0.10- , text >=1.2- , containers >=0.5.5- , unordered-containers >=0.2.5- , hashable- , vector >=0.10- , blaze-builder >=0.4- , deepseq >=1.3- , binary >=0.7- , data-binary-ieee754+ build-depends: base >= 4.7 && < 4.13+ , mtl >= 2.1.3.1 && < 2.3+ , bytestring >= 0.10.4 && < 0.11+ , text >= 1.2 && < 1.3+ , containers >= 0.5.5 && < 0.7+ , unordered-containers >= 0.2.5 && < 0.3+ , hashable >= 1.1.2.4 && < 1.3+ , vector >= 0.10.11 && < 0.13+ , deepseq >= 1.3 && < 1.5+ , binary >= 0.7.1 && < 0.9+ , data-binary-ieee754 >= 0.4.4 && < 0.5 + ghc-options: -Wall++ if impl(ghc >= 7.10)+ ghc-options: -fno-warn-trustworthy-safe+ test-suite msgpack-tests type: exitcode-stdio-1.0 default-language: Haskell2010@@ -47,9 +69,12 @@ main-is: test.hs - build-depends: base+ build-depends: msgpack+ -- inherited constraints via `msgpack`+ , base , bytestring- , QuickCheck >=2.8- , tasty >=0.10- , tasty-quickcheck >=0.8- , msgpack+ -- test-specific dependencies+ , async == 2.2.*+ , tasty == 1.2.*+ , tasty-quickcheck == 0.10.*+ , QuickCheck == 2.12.*
src/Data/MessagePack.hs view
@@ -1,14 +1,12 @@ -------------------------------------------------------------------- -- | -- Module : Data.MessagePack--- Copyright : (c) Hideyuki Tanaka, 2009-2015+-- Copyright : © Hideyuki Tanaka 2009-2015+-- , © Herbert Valerio Riedel 2019 -- License : BSD3 ----- Maintainer: tanaka.hideyuki@gmail.com--- Stability : experimental--- Portability: portable+-- Simple interface to encode\/decode to\/from the [MessagePack](https://msgpack.org/) format. ----- Simple interface to pack and unpack MessagePack data. -- -------------------------------------------------------------------- @@ -18,14 +16,13 @@ -- * Re-export modules -- $reexports- -- module X, module Data.MessagePack.Assoc, module Data.MessagePack.Get, module Data.MessagePack.Object, module Data.MessagePack.Put, ) where -import Data.Binary+import Data.Binary (decode, encode) import qualified Data.ByteString.Lazy as L import Data.MessagePack.Assoc
src/Data/MessagePack/Assoc.hs view
@@ -26,4 +26,4 @@ -- (ie. you would want to write custom instances for each type using specialized mapM-like functions) newtype Assoc a = Assoc { unAssoc :: a }- deriving (Show, Eq, Ord, Typeable, NFData)+ deriving (Show, Read, Eq, Ord, Typeable, NFData)
src/Data/MessagePack/Get.hs view
@@ -3,27 +3,26 @@ -------------------------------------------------------------------- -- | -- Module : Data.MessagePack.Get--- Copyright : (c) Hideyuki Tanaka, 2009-2015+-- Copyright : © Hideyuki Tanaka 2009-2015+-- , © Herbert Valerio Riedel 2019 -- License : BSD3 ----- Maintainer: tanaka.hideyuki@gmail.com--- Stability : experimental--- Portability: portable------ MessagePack Deserializer using @Data.Binary@+-- MessagePack Deserializer using "Data.Binary" -- -------------------------------------------------------------------- module Data.MessagePack.Get(- getNil, getBool, getInt, getFloat, getDouble,+ getNil, getBool, getFloat, getDouble,+ getInt, getWord, getInt64, getWord64, getStr, getBin, getArray, getMap, getExt, ) where import Control.Applicative import Control.Monad import Data.Binary-import Data.Binary.Get-import Data.Binary.IEEE754+import Data.Binary.Get (getByteString, getWord16be, getWord32be,+ getWord64be)+import Data.Binary.IEEE754 (getFloat32be, getFloat64be) import Data.Bits import qualified Data.ByteString as S import Data.Int@@ -36,26 +35,99 @@ getBool :: Get Bool getBool =- False <$ tag 0xC2 <|>- True <$ tag 0xC3+ getWord8 >>= \case+ 0xC2 -> return False+ 0xC3 -> return True + _ -> empty++-- | Deserialize an integer into an 'Int'+--+-- __WARNING__: Currently this function silently wraps around integers to make them fit into an 'Int'. This will be changed in the next major version (i.e. @msgpack-1.1.0@). getInt :: Get Int getInt = getWord8 >>= \case- c | c .&. 0x80 == 0x00 ->- return $ fromIntegral c- | c .&. 0xE0 == 0xE0 ->- return $ fromIntegral (fromIntegral c :: Int8)+ 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 +-- | Deserialize an integer into a 'Word'+--+-- This operation will fail if the encoded integer doesn't fit into the value range of the 'Word' type.+--+-- @since 1.0.1.0+getWord :: Get Word+getWord+ | maxWord == maxBound = fromIntegral <$> getWord64+ | otherwise = do+ w <- getWord64+ if w <= maxWord+ then return (fromIntegral w)+ else empty+ where+ maxWord :: Word64+ maxWord = fromIntegral (maxBound :: Word)++-- | Deserialize an integer into an 'Int64'+--+-- This operation will fail if the encoded integer doesn't fit into the value range of the 'Int64' type.+--+-- @since 1.0.1.0+getInt64 :: Get Int64+getInt64 =+ 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 -> do+ x <- fromIntegral <$> getWord64be+ if x >= 0 then return x else empty++ 0xD0 -> fromIntegral <$> getInt8+ 0xD1 -> fromIntegral <$> getInt16be+ 0xD2 -> fromIntegral <$> getInt32be+ 0xD3 -> getInt64be++ _ -> empty++-- | Deserialize an integer into a 'Word'+--+-- This operation will fail if the encoded integer doesn't fit into the value range of the 'Word64' type.+--+-- @since 1.0.1.0+getWord64 :: Get Word64+getWord64 =+ 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 -> getWord64be++ 0xD0 -> do { x <- getInt8 ; if x >= 0 then return (fromIntegral x) else empty }+ 0xD1 -> do { x <- getInt16be ; if x >= 0 then return (fromIntegral x) else empty }+ 0xD2 -> do { x <- getInt32be ; if x >= 0 then return (fromIntegral x) else empty }+ 0xD3 -> do { x <- getInt64be ; if x >= 0 then return (fromIntegral x) else empty }++ _ -> empty++ getFloat :: Get Float getFloat = tag 0xCA >> getFloat32be @@ -73,7 +145,7 @@ _ -> empty bs <- getByteString len case T.decodeUtf8' bs of- Left _ -> empty+ Left _ -> empty Right v -> return v getBin :: Get S.ByteString@@ -119,6 +191,12 @@ _ -> empty (,) <$> getWord8 <*> getByteString len +tag :: Word8 -> Get ()+tag t = do+ b <- getWord8+ guard $ t == b++-- internal helpers for operations missing from older `binary` versions getInt8 :: Get Int8 getInt8 = fromIntegral <$> getWord8 @@ -130,8 +208,3 @@ getInt64be :: Get Int64 getInt64be = fromIntegral <$> getWord64be--tag :: Word8 -> Get ()-tag t = do- b <- getWord8- guard $ t == b
src/Data/MessagePack/Object.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE LambdaCase #-}@@ -8,13 +9,10 @@ -------------------------------------------------------------------- -- | -- Module : Data.MessagePack.Object--- Copyright : (c) Hideyuki Tanaka, 2009-2015+-- Copyright : © Hideyuki Tanaka 2009-2015+-- , © Herbert Valerio Riedel 2019 -- License : BSD3 ----- Maintainer: tanaka.hideyuki@gmail.com--- Stability : experimental--- Portability: portable--- -- MessagePack object definition -- --------------------------------------------------------------------@@ -33,7 +31,8 @@ import Data.Binary import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import Data.Hashable+import qualified Data.ByteString.Short as SBS+import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HashMap import qualified Data.IntMap.Strict as IntMap import qualified Data.Map as Map@@ -41,6 +40,7 @@ import qualified Data.Text.Lazy as LT import Data.Typeable import qualified Data.Vector as V+import GHC.Generics (Generic) import Data.MessagePack.Assoc import Data.MessagePack.Get@@ -71,7 +71,7 @@ | ObjectExt {-# UNPACK #-} !Word8 !S.ByteString -- ^ represents a tuple of an integer and a byte array where -- the integer represents type information and the byte array represents data.- deriving (Show, Eq, Ord, Typeable)+ deriving (Show, Read, Eq, Ord, Typeable, Generic) instance NFData Object where rnf obj = case obj of@@ -105,20 +105,24 @@ ObjectMap m -> putMap putObject putObject m ObjectExt b r -> putExt b r +-- | This 'Binary' instance encodes\/decodes to\/from MessagePack format instance Binary Object where get = getObject put = putObject +-- | Class for converting between MessagePack 'Object's and native Haskell types. class MessagePack a where toObject :: a -> Object fromObject :: Object -> Maybe a -- core instances +-- | The trivial identity 'MessagePack' instance instance MessagePack Object where toObject = id fromObject = Just +-- | Encodes as 'ObjectNil' instance MessagePack () where toObject _ = ObjectNil fromObject = \case@@ -182,6 +186,9 @@ -- nullable +-- | 'Maybe's are encoded as nullable types, i.e. 'Nothing' is encoded as @nil@.+--+-- __NOTE__: Encoding nested 'Maybe's or 'Maybe's enclosing types which encode to @nil@ (such as '()') will break round-tripping instance MessagePack a => MessagePack (Maybe a) where toObject = \case Just a -> toObject a@@ -189,7 +196,7 @@ fromObject = \case ObjectNil -> Just Nothing- obj -> fromObject obj+ obj -> Just <$> fromObject obj -- UTF8 string like @@ -197,6 +204,11 @@ toObject = ObjectBin . L.toStrict fromObject obj = L.fromStrict <$> fromObject obj +-- | @since 1.0.1.0+instance MessagePack SBS.ShortByteString where+ toObject = ObjectBin . SBS.fromShort+ fromObject obj = SBS.toShort <$> fromObject obj+ instance MessagePack T.Text where toObject = ObjectStr fromObject = \case@@ -236,7 +248,7 @@ instance (MessagePack a1, MessagePack a2) => MessagePack (a1, a2) where toObject (a1, a2) = ObjectArray [toObject a1, toObject a2] fromObject (ObjectArray [a1, a2]) = (,) <$> fromObject a1 <*> fromObject a2- fromObject _ = Nothing+ fromObject _ = Nothing instance (MessagePack a1, MessagePack a2, MessagePack a3) => MessagePack (a1, a2, a3) where toObject (a1, a2, a3) = ObjectArray [toObject a1, toObject a2, toObject a3]
src/Data/MessagePack/Put.hs view
@@ -1,27 +1,26 @@ -------------------------------------------------------------------- -- | -- Module : Data.MessagePack.Put--- Copyright : (c) Hideyuki Tanaka, 2009-2015+-- Copyright : © Hideyuki Tanaka 2009-2015+-- , © Herbert Valerio Riedel 2019 -- License : BSD3 ----- Maintainer: tanaka.hideyuki@gmail.com--- Stability : experimental--- Portability: portable------ MessagePack Serializer using @Data.Binary@+-- MessagePack Serializer using "Data.Binary". -- -------------------------------------------------------------------- module Data.MessagePack.Put (- putNil, putBool, putInt, putFloat, putDouble,+ putNil, putBool, putFloat, putDouble,+ putInt, putWord, putInt64, putWord64, putStr, putBin, putArray, putMap, putExt, ) where import Data.Binary-import Data.Binary.IEEE754+import Data.Binary.IEEE754 (putFloat32be, putFloat64be) import Data.Binary.Put import Data.Bits import qualified Data.ByteString as S+import Data.Int import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Vector as V@@ -36,29 +35,43 @@ putBool True = putWord8 0xC3 putInt :: Int -> Put-putInt n- | -32 <= n && n <= 127 =- putWord8 $ fromIntegral n- | 0 <= n && n < 0x100 =- putWord8 0xCC >> putWord8 (fromIntegral n)- | 0 <= n && n < 0x10000 =- putWord8 0xCD >> putWord16be (fromIntegral n)- | 0 <= n && n < 0x100000000 =- putWord8 0xCE >> putWord32be (fromIntegral n)- | 0 <= n =- putWord8 0xCF >> putWord64be (fromIntegral n)- | -0x80 <= n =- putWord8 0xD0 >> putWord8 (fromIntegral n)- | -0x8000 <= n =- putWord8 0xD1 >> putWord16be (fromIntegral n)- | -0x80000000 <= n =- putWord8 0xD2 >> putWord32be (fromIntegral n)- | otherwise =- putWord8 0xD3 >> putWord64be (fromIntegral n)+putInt n = putInt64 (fromIntegral n) +-- | @since 1.0.1.0+putWord :: Word -> Put+putWord n = putWord64 (fromIntegral n)++-- | @since 1.0.1.0+putInt64 :: Int64 -> Put+putInt64 n+ -- positive fixnum stores 7-bit positive integer+ -- negative fixnum stores 5-bit negative integer+ | -32 <= n && n <= 127 = putWord8 $ fromIntegral n++ -- unsigned int encoding+ | n >= 0 = putWord64 (fromIntegral n)++ -- signed int encoding+ | -0x80 <= n = putWord8 0xD0 >> putWord8 (fromIntegral n)+ | -0x8000 <= n = putWord8 0xD1 >> putWord16be (fromIntegral n)+ | -0x80000000 <= n = putWord8 0xD2 >> putWord32be (fromIntegral n)+ | otherwise = putWord8 0xD3 >> putWord64be (fromIntegral n)++-- | @since 1.0.1.0+putWord64 :: Word64 -> Put+putWord64 n+ -- positive fixnum stores 7-bit positive integer+ | n < 0x80 = putWord8 $ fromIntegral n++ -- unsigned int encoding+ | 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 (fromIntegral n)+ putFloat :: Float -> Put putFloat f = do- putWord8 0xCB+ putWord8 0xCA putFloat32be f putDouble :: Double -> Put
test/test.hs view
@@ -35,6 +35,8 @@ \(a :: ()) -> a == mid a , testProperty "bool" $ \(a :: Bool) -> a == mid a+ , testProperty "float" $+ \(a :: Float) -> a == mid a , testProperty "double" $ \(a :: Double) -> a == mid a , testProperty "string" $@@ -43,8 +45,12 @@ \(a :: S.ByteString) -> a == mid a , testProperty "lazy-bytestring" $ \(a :: L.ByteString) -> a == mid a+ , testProperty "maybe int" $+ \(a :: (Maybe Int)) -> a == mid a , testProperty "[int]" $ \(a :: [Int]) -> a == mid a+ , testProperty "[()]" $+ \(a :: [()]) -> a == mid a , testProperty "[string]" $ \(a :: [String]) -> a == mid a , testProperty "(int, int)" $@@ -61,4 +67,6 @@ \(a :: [(String, String)]) -> a == mid a , testProperty "Assoc [(string, int)]" $ \(a :: Assoc [(String, Int)]) -> a == mid a+ , testProperty "maybe (Int,Bool,String)" $+ \(a :: (Maybe ((),Maybe Int,Maybe Float,Maybe Bool,Maybe Double,Maybe String))) -> a == mid a ]