data-msgpack 0.0.10 → 0.0.11

raw patch · 14 files changed

+109/−743 lines, 14 filesdep +data-msgpack-typesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-msgpack-types

API changes (from Hackage documentation)

Files

• data-msgpack.cabal +3/−15
• src/Data/MessagePack.hs +17/−12
• src/Data/MessagePack/Assoc.hs +0/−35
• src/Data/MessagePack/Class.hs +0/−275
• src/Data/MessagePack/Generic.hs +0/−129
• src/Data/MessagePack/Get.hs +30/−13
• src/Data/MessagePack/Instances.hs +0/−14
• src/Data/MessagePack/Object.hs +0/−104
• src/Data/MessagePack/Option.hs +0/−62
• src/Data/MessagePack/Put.hs +32/−12
• src/Data/MessagePack/Result.hs +0/−47
• test/Data/MessagePack/OptionSpec.hs +4/−3
• test/Data/MessagePack/ResultSpec.hs +3/−2
• test/Data/MessagePackSpec.hs +20/−20

@@ -1,5 +1,5 @@ name:                 data-msgpack-version:              0.0.10+version:              0.0.11 synopsis:             A Haskell implementation of MessagePack homepage:             http://msgpack.org/ license:              BSD3@@ -31,29 +31,16 @@       -fno-warn-unused-imports   exposed-modules:       Data.MessagePack-      Data.MessagePack.Option-      Data.MessagePack.Result   other-modules:-      Data.MessagePack.Assoc-      Data.MessagePack.Class-      Data.MessagePack.Generic       Data.MessagePack.Get-      Data.MessagePack.Instances-      Data.MessagePack.Object       Data.MessagePack.Put   build-depends:       base < 5-    , QuickCheck     , binary >= 0.7.0.0     , bytestring-    , containers     , data-binary-ieee754-    , deepseq-    , hashable+    , data-msgpack-types >= 0.0.1 && < 0.1.0     , text-    , unordered-containers-    , vector-    , void  executable msgpack-parser   default-language: Haskell2010@@ -87,6 +74,7 @@     , bytestring     , containers     , data-msgpack+    , data-msgpack-types     , hashable     , hspec     , text

@@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -------------------------------------------------------------------- -- | -- Module    : Data.MessagePack@@ -23,19 +24,15 @@   , module X   ) where -import           Control.Applicative        (Applicative)-import           Control.Monad              ((>=>))-import           Data.Binary                (decodeOrFail, encode)-import qualified Data.ByteString.Lazy       as L+import           Control.Applicative    (Applicative, (<|>))+import           Control.Monad          ((>=>))+import           Data.Binary            (Binary (..), decodeOrFail, encode)+import qualified Data.ByteString.Lazy   as L+import           Prelude                hiding (putStr) -import           Data.MessagePack.Assoc     as X-import           Data.MessagePack.Class     as X-import           Data.MessagePack.Generic   ()-import           Data.MessagePack.Get       as X-import           Data.MessagePack.Instances as X-import           Data.MessagePack.Object    as X-import           Data.MessagePack.Option    as X-import           Data.MessagePack.Put       as X+import           Data.MessagePack.Get   as X+import           Data.MessagePack.Put   as X+import           Data.MessagePack.Types as X   -- | Pack a Haskell value to MessagePack binary.@@ -50,3 +47,11 @@   where     eitherToM (Left  (_, _, msg)) = fail msg     eitherToM (Right (_, _, res)) = return res+++instance Binary Object where+  get = getObject+  {-# INLINE get #-}++  put = putObject+  {-# INLINE put #-}

@@ -1,35 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE Trustworthy                #-}------------------------------------------------------------------------- |--- Module    : Data.MessagePack.Assoc--- Copyright : (c) Daiki Handa, 2010-2011--- License   : BSD3------ Maintainer:  tanaka.hideyuki@gmail.com--- Stability :  experimental--- Portability: portable------ MessagePack map labeling type--------------------------------------------------------------------------module Data.MessagePack.Assoc-  ( Assoc (..)-  ) where--import           Control.Applicative       ((<$>))-import           Control.DeepSeq           (NFData)-import           Data.Typeable             (Typeable)-import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)---- not defined for general Functor for performance reason.--- (ie. you would want to write custom instances for each type using specialized mapM-like functions)-newtype Assoc a-  = Assoc { unAssoc :: a }-  deriving (Show, Read, Eq, Ord, Typeable, NFData)--instance Arbitrary a => Arbitrary (Assoc a) where-  arbitrary = Assoc <$> arbitrary

@@ -1,275 +0,0 @@-{-# LANGUAGE DefaultSignatures    #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE IncoherentInstances  #-}-{-# LANGUAGE LambdaCase           #-}-{-# LANGUAGE Trustworthy          #-}-{-# LANGUAGE TypeSynonymInstances #-}------------------------------------------------------------------------- |--- Module    : Data.MessagePack.Object--- Copyright : (c) Hideyuki Tanaka, 2009-2015--- License   : BSD3------ Maintainer:  tanaka.hideyuki@gmail.com--- Stability :  experimental--- Portability: portable------ MessagePack object definition--------------------------------------------------------------------------module Data.MessagePack.Class-  ( MessagePack (..)-  , GMessagePack (..)-  ) where--import           Control.Applicative     (Applicative, (<$>), (<*>))-import           Control.Arrow           ((***))-import qualified Data.ByteString         as S-import qualified Data.ByteString.Lazy    as L-import           Data.Hashable           (Hashable)-import qualified Data.HashMap.Strict     as HashMap-import           Data.Int                (Int16, Int32, Int64, Int8)-import qualified Data.IntMap.Strict      as IntMap-import qualified Data.Map                as Map-import qualified Data.Text               as T-import qualified Data.Text.Lazy          as LT-import qualified Data.Vector             as V-import qualified Data.Vector.Storable    as VS-import qualified Data.Vector.Unboxed     as VU-import           Data.Word               (Word, Word16, Word32, Word64, Word8)-import           GHC.Generics--import           Data.MessagePack.Assoc-import           Data.MessagePack.Object----- Generic serialisation.--class GMessagePack f where-  gToObject   :: f a -> Object-  gFromObject :: (Applicative m, Monad m) => Object -> m (f a)---class MessagePack a where-  toObject   :: a -> Object-  fromObject :: (Applicative m, Monad m) => Object -> m a--  default toObject :: (Generic a, GMessagePack (Rep a))-                   => a -> Object-  toObject = genericToObject-  default fromObject :: ( Applicative m, Monad m-                        , Generic a, GMessagePack (Rep a))-                     => Object -> m a-  fromObject = genericFromObject---genericToObject :: (Generic a, GMessagePack (Rep a))-                => a -> Object-genericToObject = gToObject . from--genericFromObject :: ( Applicative m, Monad m-                     , Generic a, GMessagePack (Rep a))-                  => Object -> m a-genericFromObject x = to <$> gFromObject x----- Instances for integral types (Int etc.).--toInt :: Integral a => a -> Int64-toInt = fromIntegral--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 i-    | i < 0 = ObjectInt i-    | otherwise = ObjectWord $ toWord i-  fromObject = \case-    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 . 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.--instance MessagePack Object where-  toObject = id-  fromObject = return--instance MessagePack () where-  toObject _ = ObjectNil-  fromObject = \case-    ObjectNil      -> return ()-    ObjectArray [] -> return ()-    _              -> fail "invalid encoding for ()"--instance MessagePack Bool where-  toObject = ObjectBool-  fromObject = \case-    ObjectBool b -> return b-    _            -> fail "invalid encoding for Bool"--instance MessagePack Float where-  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"--instance MessagePack Double where-  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"---- Because of overlapping instance, this must be above [a].--- IncoherentInstances and TypeSynonymInstances are required for this to work.-instance MessagePack String where-  toObject = toObject . T.pack-  fromObject obj = T.unpack <$> fromObject obj----- Instances for binary and UTF-8 encoded string.--instance MessagePack S.ByteString where-  toObject = ObjectBin-  fromObject = \case-    ObjectBin r -> return r-    _           -> fail "invalid encoding for ByteString"--instance MessagePack L.ByteString where-  toObject = ObjectBin . L.toStrict-  fromObject obj = L.fromStrict <$> fromObject obj--instance MessagePack T.Text where-  toObject = ObjectStr-  fromObject = \case-    ObjectStr s -> return s-    _           -> fail "invalid encoding for Text"--instance MessagePack LT.Text where-  toObject = toObject . LT.toStrict-  fromObject obj = LT.fromStrict <$> fromObject obj----- Instances for array-like data structures.--instance MessagePack a => MessagePack [a] where-  toObject = ObjectArray . map toObject-  fromObject = \case-    ObjectArray xs -> mapM fromObject xs-    _              -> fail "invalid encoding for list"--instance MessagePack a => MessagePack (V.Vector a) where-  toObject = ObjectArray . map toObject . V.toList-  fromObject = \case-    ObjectArray o -> V.fromList <$> mapM fromObject o-    _             -> fail "invalid encoding for Vector"--instance (MessagePack a, VU.Unbox a) => MessagePack (VU.Vector a) where-  toObject = ObjectArray . map toObject . VU.toList-  fromObject = \case-    ObjectArray o -> VU.fromList <$> mapM fromObject o-    _             -> fail "invalid encoding for Unboxed Vector"--instance (MessagePack a, VS.Storable a) => MessagePack (VS.Vector a) where-  toObject = ObjectArray . map toObject . VS.toList-  fromObject = \case-    ObjectArray o -> VS.fromList <$> mapM fromObject o-    _             -> fail "invalid encoding for Storable Vector"---- Instances for map-like data structures.--instance (MessagePack a, MessagePack b) => MessagePack (Assoc [(a, b)]) where-  toObject (Assoc xs) = ObjectMap $ map (toObject *** toObject) xs-  fromObject = \case-    ObjectMap xs ->-      Assoc <$> mapM (\(k, v) -> (,) <$> fromObject k <*> fromObject v) xs-    _ ->-      fail "invalid encoding for Assoc"--instance (MessagePack k, MessagePack v, Ord k) => MessagePack (Map.Map k v) where-  toObject = toObject . Assoc . Map.toList-  fromObject obj = Map.fromList . unAssoc <$> fromObject obj--instance MessagePack v => MessagePack (IntMap.IntMap v) where-  toObject = toObject . Assoc . IntMap.toList-  fromObject obj = IntMap.fromList . unAssoc <$> fromObject obj--instance (MessagePack k, MessagePack v, Hashable k, Eq k) => MessagePack (HashMap.HashMap k v) where-  toObject = toObject . Assoc . HashMap.toList-  fromObject obj = HashMap.fromList . unAssoc <$> fromObject obj----- Instances for various tuple arities.--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 _                      = fail "invalid encoding for tuple"--instance (MessagePack a1, MessagePack a2, MessagePack a3) => MessagePack (a1, a2, a3) where-  toObject (a1, a2, a3) = ObjectArray [toObject a1, toObject a2, toObject a3]-  fromObject (ObjectArray [a1, a2, a3]) = (,,) <$> fromObject a1 <*> fromObject a2 <*> fromObject a3-  fromObject _ = fail "invalid encoding for tuple"--instance (MessagePack a1, MessagePack a2, MessagePack a3, MessagePack a4) => MessagePack (a1, a2, a3, a4) where-  toObject (a1, a2, a3, a4) = ObjectArray [toObject a1, toObject a2, toObject a3, toObject a4]-  fromObject (ObjectArray [a1, a2, a3, a4]) = (,,,) <$> fromObject a1 <*> fromObject a2 <*> fromObject a3 <*> fromObject a4-  fromObject _ = fail "invalid encoding for tuple"--instance (MessagePack a1, MessagePack a2, MessagePack a3, MessagePack a4, MessagePack a5) => MessagePack (a1, a2, a3, a4, a5) where-  toObject (a1, a2, a3, a4, a5) = ObjectArray [toObject a1, toObject a2, toObject a3, toObject a4, toObject a5]-  fromObject (ObjectArray [a1, a2, a3, a4, a5]) = (,,,,) <$> fromObject a1 <*> fromObject a2 <*> fromObject a3 <*> fromObject a4 <*> fromObject a5-  fromObject _ = fail "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 (a1, a2, a3, a4, a5, a6) = ObjectArray [toObject a1, toObject a2, toObject a3, toObject a4, toObject a5, toObject a6]-  fromObject (ObjectArray [a1, a2, a3, a4, a5, a6]) = (,,,,,) <$> fromObject a1 <*> fromObject a2 <*> fromObject a3 <*> fromObject a4 <*> fromObject a5 <*> fromObject a6-  fromObject _ = fail "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 (a1, a2, a3, a4, a5, a6, a7) = ObjectArray [toObject a1, toObject a2, toObject a3, toObject a4, toObject a5, toObject a6, toObject a7]-  fromObject (ObjectArray [a1, a2, a3, a4, a5, a6, a7]) = (,,,,,,) <$> fromObject a1 <*> fromObject a2 <*> fromObject a3 <*> fromObject a4 <*> fromObject a5 <*> fromObject a6 <*> fromObject a7-  fromObject _ = fail "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 (a1, a2, a3, a4, a5, a6, a7, a8) = ObjectArray [toObject a1, toObject a2, toObject a3, toObject a4, toObject a5, toObject a6, toObject a7, toObject a8]-  fromObject (ObjectArray [a1, a2, a3, a4, a5, a6, a7, a8]) = (,,,,,,,) <$> fromObject a1 <*> fromObject a2 <*> fromObject a3 <*> fromObject a4 <*> fromObject a5 <*> fromObject a6 <*> fromObject a7 <*> fromObject a8-  fromObject _ = fail "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 (a1, a2, a3, a4, a5, a6, a7, a8, a9) = ObjectArray [toObject a1, toObject a2, toObject a3, toObject a4, toObject a5, toObject a6, toObject a7, toObject a8, toObject a9]-  fromObject (ObjectArray [a1, a2, a3, a4, a5, a6, a7, a8, a9]) = (,,,,,,,,) <$> fromObject a1 <*> fromObject a2 <*> fromObject a3 <*> fromObject a4 <*> fromObject a5 <*> fromObject a6 <*> fromObject a7 <*> fromObject a8 <*> fromObject a9-  fromObject _ = fail "invalid encoding for tuple"

@@ -1,129 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE IncoherentInstances #-}-{-# LANGUAGE KindSignatures      #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE Safe                #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators       #-}-module Data.MessagePack.Generic () where--import           Control.Applicative     (Applicative, (<$>), (<*>))-import           Control.Monad           ((>=>))-import           Data.Bits               (shiftR)-import           Data.Word               (Word64)-import           GHC.Generics--import           Data.MessagePack.Class-import           Data.MessagePack.Object (Object (..))--instance GMessagePack V1 where-  gToObject = undefined-  gFromObject = fail "can't instantiate void type"--instance GMessagePack U1 where-  gToObject U1 = ObjectNil-  gFromObject ObjectNil = return U1-  gFromObject _         = fail "invalid encoding for custom unit type"--instance (GMessagePack a, GProdPack b) => GMessagePack (a :*: b) where-  gToObject = toObject . prodToObject-  gFromObject = fromObject >=> prodFromObject--instance (GSumPack a, GSumPack b, SumSize a, SumSize b) => GMessagePack (a :+: b) where-  gToObject = sumToObject 0 size-    where-      size = unTagged (sumSize :: Tagged (a :+: b) Word64)--  gFromObject = \case-    ObjectWord code -> checkSumFromObject0 size (fromIntegral code)-    o               -> fromObject o >>= uncurry (checkSumFromObject size)-    where-      size = unTagged (sumSize :: Tagged (a :+: b) Word64)--instance GMessagePack a => GMessagePack (M1 t c a) where-  gToObject (M1 x) = gToObject x-  gFromObject x = M1 <$> gFromObject x--instance MessagePack a => GMessagePack (K1 i a) where-  gToObject (K1 x) = toObject x-  gFromObject o = K1 <$> fromObject o----- Product type packing.--class GProdPack f where-  prodToObject :: f a -> [Object]-  prodFromObject :: (Applicative m, Monad m) => [Object] -> m (f a)---instance (GMessagePack a, GProdPack b) => GProdPack (a :*: b) where-  prodToObject (a :*: b) = gToObject a : prodToObject b-  prodFromObject (a:b) = (:*:) <$> gFromObject a <*> prodFromObject b-  prodFromObject _     = fail "invalid encoding for product type"--instance GMessagePack a => GProdPack (M1 t c a) where-  prodToObject (M1 x) = [gToObject x]-  prodFromObject [x] = M1 <$> gFromObject x-  prodFromObject _   = fail "invalid encoding for product type"----- Sum type packing.--checkSumFromObject0 :: (Applicative m, Monad m) => (GSumPack f) => Word64 -> Word64 -> m (f a)-checkSumFromObject0 size code-  | code < size = sumFromObject code size ObjectNil-  | otherwise   = fail "invalid encoding for sum type"---checkSumFromObject :: (Applicative m, Monad m) => (GSumPack f) => Word64 -> Word64 -> Object -> m (f a)-checkSumFromObject size code x-  | code < size = sumFromObject code size x-  | otherwise   = fail "invalid encoding for sum type"---class GSumPack f where-  sumToObject :: Word64 -> Word64 -> f a -> Object-  sumFromObject :: (Applicative m, Monad m) => Word64 -> Word64 -> Object -> m (f a)---instance (GSumPack a, GSumPack b) => GSumPack (a :+: b) where-  sumToObject code size = \case-    L1 x -> sumToObject code           sizeL x-    R1 x -> sumToObject (code + sizeL) sizeR x-    where-      sizeL = size `shiftR` 1-      sizeR = size - sizeL--  sumFromObject code size x-    | code < sizeL = L1 <$> sumFromObject code           sizeL x-    | otherwise    = R1 <$> sumFromObject (code - sizeL) sizeR x-    where-      sizeL = size `shiftR` 1-      sizeR = size - sizeL---instance GSumPack (C1 c U1) where-  sumToObject code _ _ = toObject code-  sumFromObject _ _ = gFromObject---instance GMessagePack a => GSumPack (C1 c a) where-  sumToObject code _ x = toObject (code, gToObject x)-  sumFromObject _ _ = gFromObject----- Sum size.--class SumSize f where-  sumSize :: Tagged f Word64--newtype Tagged (s :: * -> *) b = Tagged { unTagged :: b }--instance (SumSize a, SumSize b) => SumSize (a :+: b) where-  sumSize = Tagged $ unTagged (sumSize :: Tagged a Word64) +-                     unTagged (sumSize :: Tagged b Word64)--instance SumSize (C1 c a) where-  sumSize = Tagged 1

@@ -16,7 +16,8 @@ --------------------------------------------------------------------  module Data.MessagePack.Get-  ( getNil+  ( getObject+  , getNil   , getBool   , getInt   , getWord@@ -29,18 +30,34 @@   , getExt   ) where -import           Control.Applicative (empty, (<$), (<$>), (<*>), (<|>))-import           Control.Monad       (guard, replicateM)-import           Data.Binary         (Get)-import           Data.Binary.Get     (getByteString, getWord16be, getWord32be,-                                      getWord64be, getWord8)-import           Data.Binary.IEEE754 (getFloat32be, getFloat64be)-import           Data.Bits           ((.&.))-import qualified Data.ByteString     as S-import           Data.Int            (Int16, Int32, Int64, Int8)-import qualified Data.Text           as T-import qualified Data.Text.Encoding  as T-import           Data.Word           (Word64, Word8)+import           Control.Applicative    (empty, (<$), (<$>), (<*>), (<|>))+import           Control.Monad          (guard, replicateM)+import           Data.Binary            (Get)+import           Data.Binary.Get        (getByteString, getWord16be,+                                         getWord32be, getWord64be, getWord8)+import           Data.Binary.IEEE754    (getFloat32be, getFloat64be)+import           Data.Bits              ((.&.))+import qualified Data.ByteString        as S+import           Data.Int               (Int16, Int32, Int64, Int8)+import qualified Data.Text              as T+import qualified Data.Text.Encoding     as T+import           Data.Word              (Word64, Word8)++import           Data.MessagePack.Types (Object (..))++getObject :: Get Object+getObject =+      ObjectNil    <$  getNil+  <|> ObjectBool   <$> getBool+  <|> ObjectInt    <$> getInt+  <|> ObjectWord   <$> getWord+  <|> ObjectFloat  <$> getFloat+  <|> ObjectDouble <$> getDouble+  <|> ObjectStr    <$> getStr+  <|> ObjectBin    <$> getBin+  <|> ObjectArray  <$> getArray getObject+  <|> ObjectMap    <$> getMap getObject getObject+  <|> uncurry ObjectExt <$> getExt  getNil :: Get () getNil = tag 0xC0

@@ -1,14 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Data.MessagePack.Instances () where--import           Data.Void                (Void)--import           Data.MessagePack.Class   (MessagePack)-import           Data.MessagePack.Generic ()---instance MessagePack a => MessagePack (Maybe a)--instance (MessagePack a, MessagePack b) => MessagePack (Either a b)--instance MessagePack Void

@@ -1,104 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE LambdaCase         #-}-{-# LANGUAGE Safe               #-}-module Data.MessagePack.Object (Object (..)) where--import           Control.Applicative       ((<$), (<$>), (<*>), (<|>))-import           Control.DeepSeq           (NFData (..))-import           Data.Binary               (Binary (get, put), Get, Put)-import qualified Data.ByteString           as S-import qualified Data.ByteString.Lazy      as L-import           Data.Int                  (Int64)-import qualified Data.Text                 as T-import qualified Data.Text.Lazy            as LT-import           Data.Typeable             (Typeable)-import           Data.Word                 (Word64, Word8)-import           GHC.Generics              (Generic)-import           Prelude                   hiding (putStr)-import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)-import qualified Test.QuickCheck.Gen       as Gen--import           Data.MessagePack.Get-import           Data.MessagePack.Put----- | Object Representation of MessagePack data.-data Object-  = ObjectNil-    -- ^ represents nil-  | ObjectBool                  !Bool-    -- ^ represents true or false-  | ObjectInt    {-# UNPACK #-} !Int64-    -- ^ represents a negative integer-  | ObjectWord   {-# UNPACK #-} !Word64-    -- ^ represents a positive integer-  | ObjectFloat  {-# UNPACK #-} !Float-    -- ^ represents a floating point number-  | ObjectDouble {-# UNPACK #-} !Double-    -- ^ represents a floating point number-  | ObjectStr                   !T.Text-    -- ^ extending Raw type represents a UTF-8 string-  | ObjectBin                   !S.ByteString-    -- ^ extending Raw type represents a byte array-  | ObjectArray                 ![Object]-    -- ^ represents a sequence of objects-  | ObjectMap                   ![(Object, Object)]-    -- ^ represents key-value pairs of objects-  | 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 (Read, Show, Eq, Ord, Typeable, Generic)--instance NFData Object--instance Binary Object where-  get = getObject-  put = putObject---getObject :: Get Object-getObject =-      ObjectNil    <$  getNil-  <|> ObjectBool   <$> getBool-  <|> ObjectInt    <$> getInt-  <|> ObjectWord   <$> getWord-  <|> ObjectFloat  <$> getFloat-  <|> ObjectDouble <$> getDouble-  <|> ObjectStr    <$> getStr-  <|> ObjectBin    <$> getBin-  <|> ObjectArray  <$> getArray getObject-  <|> ObjectMap    <$> getMap getObject getObject-  <|> uncurry ObjectExt <$> getExt--putObject :: Object -> Put-putObject = \case-  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-  ObjectBin    b -> putBin b-  ObjectArray  a -> putArray putObject a-  ObjectMap    m -> putMap putObject putObject m-  ObjectExt  b r -> putExt b r---instance Arbitrary Object where-  arbitrary = Gen.sized $ \n -> Gen.oneof-    [ return 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)

@@ -1,62 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable     #-}-{-# LANGUAGE DeriveFunctor      #-}-{-# LANGUAGE DeriveTraversable  #-}-module Data.MessagePack.Option-  ( Option (..)-  ) where--import           Control.Applicative       (Alternative (..), Applicative (..),-                                            (<$>))-import           Control.Monad             (Monad (..), MonadPlus (..))-import           Data.Data                 (Data)-import           Data.Foldable             (Foldable)-import           Data.Traversable          (Traversable)-import           Data.Typeable             (Typeable)-import           Test.QuickCheck.Arbitrary (Arbitrary (..))-import qualified Test.QuickCheck.Gen       as Gen--import           Data.MessagePack.Class    (MessagePack (..))-import           Data.MessagePack.Object   (Object (..))---data Option a-  = None-  | Some a-  deriving (Eq, Ord, Show, Read, Foldable, Functor, Traversable, Data, Typeable)--instance Applicative Option where-  pure = Some--  Some f <*> m = fmap f m-  None   <*> _ = None--instance Monad Option where-  return = Some-  fail _ = None--  None   >>= _ = None-  Some x >>= f = f x--instance Alternative Option where-  empty = None--  None <|> x = x-  x    <|> _ = x--instance MonadPlus Option where-  mzero = empty-  mplus = (<|>)--instance MessagePack a => MessagePack (Option a) where-  toObject None = ObjectNil-  toObject (Some a) = toObject a--  fromObject ObjectNil = return None-  fromObject x = Some <$> fromObject x--instance Arbitrary a => Arbitrary (Option a) where-  arbitrary = Gen.oneof-    [ pure None-    , Some <$> arbitrary-    ]

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase  #-} {-# LANGUAGE Trustworthy #-} -------------------------------------------------------------------- -- |@@ -14,7 +15,8 @@ --------------------------------------------------------------------  module Data.MessagePack.Put-  ( putNil+  ( putObject+  , putNil   , putBool   , putInt   , putWord@@ -27,18 +29,36 @@   , putExt   ) where -import           Data.Binary         (Put)-import           Data.Binary.IEEE754 (putFloat32be, putFloat64be)-import           Data.Binary.Put     (putByteString, putWord16be, putWord32be,-                                      putWord64be, putWord8, putWord8)-import           Data.Bits           ((.|.))-import qualified Data.ByteString     as S-import           Data.Int            (Int64)-import qualified Data.Text           as T-import qualified Data.Text.Encoding  as T-import           Data.Word           (Word64, Word8)+import           Data.Binary            (Put)+import           Data.Binary.IEEE754    (putFloat32be, putFloat64be)+import           Data.Binary.Put        (putByteString, putWord16be,+                                         putWord32be, putWord64be, putWord8,+                                         putWord8)+import           Data.Bits              ((.|.))+import qualified Data.ByteString        as S+import           Data.Int               (Int64)+import qualified Data.Text              as T+import qualified Data.Text.Encoding     as T+import           Data.Word              (Word64, Word8) -import           Prelude             hiding (putStr)+import           Prelude                hiding (putStr)++import           Data.MessagePack.Types (Object (..))+++putObject :: Object -> Put+putObject = \case+  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+  ObjectBin    b -> putBin b+  ObjectArray  a -> putArray putObject a+  ObjectMap    m -> putMap putObject putObject m+  ObjectExt  b r -> putExt b r  putNil :: Put putNil = putWord8 0xC0

@@ -1,47 +0,0 @@-{-# LANGUAGE DeriveFoldable    #-}-{-# LANGUAGE DeriveFunctor     #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE Safe              #-}-module Data.MessagePack.Result where--import           Control.Applicative       (Alternative (..), Applicative (..),-                                            (<$>), (<*>))-import           Data.Foldable             (Foldable)-import           Data.Traversable          (Traversable)-import           Test.QuickCheck.Arbitrary (Arbitrary (..))-import qualified Test.QuickCheck.Gen       as Gen---data Result a-  = Success a-  | Failure String-  deriving (Read, Show, Eq, Functor, Traversable, Foldable)---instance Applicative Result where-  pure = Success--  Success f   <*> x = fmap f x-  Failure msg <*> _ = Failure msg---instance Alternative Result where-  empty = Failure "empty alternative"--  s@Success {} <|> _ = s-  _            <|> r = r---instance Monad Result where-  return = pure-  fail = Failure--  Success x   >>= f = f x-  Failure msg >>= _ = Failure msg---instance Arbitrary a => Arbitrary (Result a) where-  arbitrary = Gen.oneof-    [ Success <$> arbitrary-    , Failure <$> arbitrary-    ]

@@ -5,9 +5,10 @@ import           Test.Hspec import           Test.QuickCheck -import           Control.Applicative     (empty, pure, (<$>), (<*>), (<|>))-import           Control.Monad           (mplus, mzero)-import qualified Data.MessagePack.Option as O+import           Control.Applicative           (empty, pure, (<$>), (<*>),+                                                (<|>))+import           Control.Monad                 (mplus, mzero)+import qualified Data.MessagePack.Types.Option as O   newtype F = F (Int -> O.Option Int)

@@ -5,8 +5,9 @@ import           Test.Hspec import           Test.QuickCheck -import           Control.Applicative     (empty, pure, (<$>), (<*>), (<|>))-import qualified Data.MessagePack.Result as R+import           Control.Applicative           (empty, pure, (<$>), (<*>),+                                                (<|>))+import qualified Data.MessagePack.Types.Result as R   newtype F = F (Int -> R.Result Int)

@@ -7,29 +7,29 @@  import           Test.Hspec import           Test.QuickCheck-import qualified Test.QuickCheck.Gen        as Gen+import qualified Test.QuickCheck.Gen           as Gen -import           Control.Applicative        ((<$>), (<*>))-import qualified Data.ByteString.Char8      as S-import qualified Data.ByteString.Lazy       as L8-import qualified Data.ByteString.Lazy.Char8 as L-import           Data.Hashable              (Hashable)-import qualified Data.HashMap.Strict        as HashMap-import           Data.Int                   (Int16, Int32, Int64, Int8)-import qualified Data.IntMap                as IntMap-import qualified Data.Map                   as Map-import qualified Data.Maybe                 as Maybe-import qualified Data.Text.Lazy             as LT-import qualified Data.Vector                as V-import qualified Data.Vector.Storable       as VS-import qualified Data.Vector.Unboxed        as VU-import           Data.Void                  (Void)-import           Data.Word                  (Word, Word16, Word32, Word64,-                                             Word8)-import           GHC.Generics               (Generic)+import           Control.Applicative           ((<$>), (<*>))+import qualified Data.ByteString.Char8         as S+import qualified Data.ByteString.Lazy          as L8+import qualified Data.ByteString.Lazy.Char8    as L+import           Data.Hashable                 (Hashable)+import qualified Data.HashMap.Strict           as HashMap+import           Data.Int                      (Int16, Int32, Int64, Int8)+import qualified Data.IntMap                   as IntMap+import qualified Data.Map                      as Map+import qualified Data.Maybe                    as Maybe+import qualified Data.Text.Lazy                as LT+import qualified Data.Vector                   as V+import qualified Data.Vector.Storable          as VS+import qualified Data.Vector.Unboxed           as VU+import           Data.Void                     (Void)+import           Data.Word                     (Word, Word16, Word32, Word64,+                                                Word8)+import           GHC.Generics                  (Generic)  import           Data.MessagePack-import qualified Data.MessagePack.Result    as R+import qualified Data.MessagePack.Types.Result as R   data Unit = Unit