packages feed

data-msgpack 0.0.8 → 0.0.9

raw patch · 7 files changed

+713/−21 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Data.MessagePack.Assoc: Assoc :: a -> Assoc a
- Data.MessagePack.Assoc: [unAssoc] :: Assoc a -> a
- Data.MessagePack.Assoc: instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (Data.MessagePack.Assoc.Assoc a)
- Data.MessagePack.Assoc: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.MessagePack.Assoc.Assoc a)
- Data.MessagePack.Assoc: instance GHC.Classes.Ord a => GHC.Classes.Ord (Data.MessagePack.Assoc.Assoc a)
- Data.MessagePack.Assoc: instance GHC.Read.Read a => GHC.Read.Read (Data.MessagePack.Assoc.Assoc a)
- Data.MessagePack.Assoc: instance GHC.Show.Show a => GHC.Show.Show (Data.MessagePack.Assoc.Assoc a)
- Data.MessagePack.Assoc: instance Test.QuickCheck.Arbitrary.Arbitrary a => Test.QuickCheck.Arbitrary.Arbitrary (Data.MessagePack.Assoc.Assoc a)
- Data.MessagePack.Assoc: newtype Assoc a
- Data.MessagePack.Class: class GMessagePack f
- Data.MessagePack.Class: class MessagePack a where toObject = genericToObject fromObject = genericFromObject
- Data.MessagePack.Class: fromObject :: (MessagePack a, Applicative m, Monad m, Generic a, GMessagePack (Rep a)) => Object -> m a
- Data.MessagePack.Class: gFromObject :: (GMessagePack f, Applicative m, Monad m) => Object -> m (f a)
- Data.MessagePack.Class: gToObject :: GMessagePack f => f a -> Object
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a, Data.MessagePack.Class.MessagePack b) => Data.MessagePack.Class.MessagePack (Data.MessagePack.Assoc.Assoc [(a, b)])
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a, Data.Vector.Unboxed.Base.Unbox a) => Data.MessagePack.Class.MessagePack (Data.Vector.Unboxed.Base.Vector a)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a, Foreign.Storable.Storable a) => Data.MessagePack.Class.MessagePack (Data.Vector.Storable.Vector a)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a1, Data.MessagePack.Class.MessagePack a2) => Data.MessagePack.Class.MessagePack (a1, a2)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a1, Data.MessagePack.Class.MessagePack a2, Data.MessagePack.Class.MessagePack a3) => Data.MessagePack.Class.MessagePack (a1, a2, a3)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a1, Data.MessagePack.Class.MessagePack a2, Data.MessagePack.Class.MessagePack a3, Data.MessagePack.Class.MessagePack a4) => Data.MessagePack.Class.MessagePack (a1, a2, a3, a4)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a1, Data.MessagePack.Class.MessagePack a2, Data.MessagePack.Class.MessagePack a3, Data.MessagePack.Class.MessagePack a4, Data.MessagePack.Class.MessagePack a5) => Data.MessagePack.Class.MessagePack (a1, a2, a3, a4, a5)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a1, Data.MessagePack.Class.MessagePack a2, Data.MessagePack.Class.MessagePack a3, Data.MessagePack.Class.MessagePack a4, Data.MessagePack.Class.MessagePack a5, Data.MessagePack.Class.MessagePack a6) => Data.MessagePack.Class.MessagePack (a1, a2, a3, a4, a5, a6)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a1, Data.MessagePack.Class.MessagePack a2, Data.MessagePack.Class.MessagePack a3, Data.MessagePack.Class.MessagePack a4, Data.MessagePack.Class.MessagePack a5, Data.MessagePack.Class.MessagePack a6, Data.MessagePack.Class.MessagePack a7) => Data.MessagePack.Class.MessagePack (a1, a2, a3, a4, a5, a6, a7)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a1, Data.MessagePack.Class.MessagePack a2, Data.MessagePack.Class.MessagePack a3, Data.MessagePack.Class.MessagePack a4, Data.MessagePack.Class.MessagePack a5, Data.MessagePack.Class.MessagePack a6, Data.MessagePack.Class.MessagePack a7, Data.MessagePack.Class.MessagePack a8) => Data.MessagePack.Class.MessagePack (a1, a2, a3, a4, a5, a6, a7, a8)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack a1, Data.MessagePack.Class.MessagePack a2, Data.MessagePack.Class.MessagePack a3, Data.MessagePack.Class.MessagePack a4, Data.MessagePack.Class.MessagePack a5, Data.MessagePack.Class.MessagePack a6, Data.MessagePack.Class.MessagePack a7, Data.MessagePack.Class.MessagePack a8, Data.MessagePack.Class.MessagePack a9) => Data.MessagePack.Class.MessagePack (a1, a2, a3, a4, a5, a6, a7, a8, a9)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack k, Data.MessagePack.Class.MessagePack v, Data.Hashable.Class.Hashable k, GHC.Classes.Eq k) => Data.MessagePack.Class.MessagePack (Data.HashMap.Base.HashMap k v)
- Data.MessagePack.Class: instance (Data.MessagePack.Class.MessagePack k, Data.MessagePack.Class.MessagePack v, GHC.Classes.Ord k) => Data.MessagePack.Class.MessagePack (Data.Map.Base.Map k v)
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack ()
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack Data.ByteString.Internal.ByteString
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack Data.ByteString.Lazy.Internal.ByteString
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack Data.MessagePack.Object.Object
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack Data.Text.Internal.Lazy.Text
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack Data.Text.Internal.Text
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Base.String
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Int.Int16
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Int.Int32
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Int.Int64
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Int.Int8
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Types.Bool
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Types.Double
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Types.Float
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Types.Int
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Types.Word
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Word.Word16
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Word.Word32
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Word.Word64
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack GHC.Word.Word8
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack a => Data.MessagePack.Class.MessagePack (Data.Vector.Vector a)
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack a => Data.MessagePack.Class.MessagePack [a]
- Data.MessagePack.Class: instance Data.MessagePack.Class.MessagePack v => Data.MessagePack.Class.MessagePack (Data.IntMap.Base.IntMap v)
- Data.MessagePack.Class: toObject :: (MessagePack a, Generic a, GMessagePack (Rep a)) => a -> Object
- Data.MessagePack.Generic: instance (Data.MessagePack.Class.GMessagePack a, Data.MessagePack.Generic.GProdPack b) => Data.MessagePack.Class.GMessagePack (a GHC.Generics.:*: b)
- Data.MessagePack.Generic: instance (Data.MessagePack.Class.GMessagePack a, Data.MessagePack.Generic.GProdPack b) => Data.MessagePack.Generic.GProdPack (a GHC.Generics.:*: b)
- Data.MessagePack.Generic: instance (Data.MessagePack.Generic.GSumPack a, Data.MessagePack.Generic.GSumPack b) => Data.MessagePack.Generic.GSumPack (a GHC.Generics.:+: b)
- Data.MessagePack.Generic: instance (Data.MessagePack.Generic.GSumPack a, Data.MessagePack.Generic.GSumPack b, Data.MessagePack.Generic.SumSize a, Data.MessagePack.Generic.SumSize b) => Data.MessagePack.Class.GMessagePack (a GHC.Generics.:+: b)
- Data.MessagePack.Generic: instance (Data.MessagePack.Generic.SumSize a, Data.MessagePack.Generic.SumSize b) => Data.MessagePack.Generic.SumSize (a GHC.Generics.:+: b)
- Data.MessagePack.Generic: instance Data.MessagePack.Class.GMessagePack GHC.Generics.U1
- Data.MessagePack.Generic: instance Data.MessagePack.Class.GMessagePack GHC.Generics.V1
- Data.MessagePack.Generic: instance Data.MessagePack.Class.GMessagePack a => Data.MessagePack.Class.GMessagePack (GHC.Generics.M1 t c a)
- Data.MessagePack.Generic: instance Data.MessagePack.Class.GMessagePack a => Data.MessagePack.Generic.GProdPack (GHC.Generics.M1 t c a)
- Data.MessagePack.Generic: instance Data.MessagePack.Class.GMessagePack a => Data.MessagePack.Generic.GSumPack (GHC.Generics.C1 c a)
- Data.MessagePack.Generic: instance Data.MessagePack.Class.MessagePack a => Data.MessagePack.Class.GMessagePack (GHC.Generics.K1 i a)
- Data.MessagePack.Generic: instance Data.MessagePack.Generic.GSumPack (GHC.Generics.C1 c GHC.Generics.U1)
- Data.MessagePack.Generic: instance Data.MessagePack.Generic.SumSize (GHC.Generics.C1 c a)
- Data.MessagePack.Get: getArray :: Get a -> Get [a]
- Data.MessagePack.Get: getBin :: Get ByteString
- Data.MessagePack.Get: getBool :: Get Bool
- Data.MessagePack.Get: getDouble :: Get Double
- Data.MessagePack.Get: getExt :: Get (Word8, ByteString)
- Data.MessagePack.Get: getFloat :: Get Float
- Data.MessagePack.Get: getInt :: Get Int64
- Data.MessagePack.Get: getMap :: Get a -> Get b -> Get [(a, b)]
- Data.MessagePack.Get: getNil :: Get ()
- Data.MessagePack.Get: getStr :: Get Text
- Data.MessagePack.Get: getWord :: Get Word64
- Data.MessagePack.Instances: instance (Data.MessagePack.Class.MessagePack a, Data.MessagePack.Class.MessagePack b) => Data.MessagePack.Class.MessagePack (Data.Either.Either a b)
- Data.MessagePack.Instances: instance Data.MessagePack.Class.MessagePack Data.Void.Void
- Data.MessagePack.Instances: instance Data.MessagePack.Class.MessagePack a => Data.MessagePack.Class.MessagePack (GHC.Base.Maybe a)
- Data.MessagePack.Object: ObjectArray :: ![Object] -> Object
- Data.MessagePack.Object: ObjectBin :: !ByteString -> Object
- Data.MessagePack.Object: ObjectBool :: !Bool -> Object
- Data.MessagePack.Object: ObjectDouble :: {-# UNPACK #-} !Double -> Object
- Data.MessagePack.Object: ObjectExt :: {-# UNPACK #-} !Word8 -> !ByteString -> Object
- Data.MessagePack.Object: ObjectFloat :: {-# UNPACK #-} !Float -> Object
- Data.MessagePack.Object: ObjectInt :: {-# UNPACK #-} !Int64 -> Object
- Data.MessagePack.Object: ObjectMap :: ![(Object, Object)] -> Object
- Data.MessagePack.Object: ObjectNil :: Object
- Data.MessagePack.Object: ObjectStr :: !Text -> Object
- Data.MessagePack.Object: ObjectWord :: {-# UNPACK #-} !Word64 -> Object
- Data.MessagePack.Object: data Object
- Data.MessagePack.Object: instance Control.DeepSeq.NFData Data.MessagePack.Object.Object
- Data.MessagePack.Object: instance Data.Binary.Class.Binary Data.MessagePack.Object.Object
- Data.MessagePack.Object: instance GHC.Classes.Eq Data.MessagePack.Object.Object
- Data.MessagePack.Object: instance GHC.Classes.Ord Data.MessagePack.Object.Object
- Data.MessagePack.Object: instance GHC.Generics.Generic Data.MessagePack.Object.Object
- Data.MessagePack.Object: instance GHC.Read.Read Data.MessagePack.Object.Object
- Data.MessagePack.Object: instance GHC.Show.Show Data.MessagePack.Object.Object
- Data.MessagePack.Object: instance Test.QuickCheck.Arbitrary.Arbitrary Data.ByteString.Internal.ByteString
- Data.MessagePack.Object: instance Test.QuickCheck.Arbitrary.Arbitrary Data.ByteString.Lazy.Internal.ByteString
- Data.MessagePack.Object: instance Test.QuickCheck.Arbitrary.Arbitrary Data.MessagePack.Object.Object
- Data.MessagePack.Object: instance Test.QuickCheck.Arbitrary.Arbitrary Data.Text.Internal.Lazy.Text
- Data.MessagePack.Object: instance Test.QuickCheck.Arbitrary.Arbitrary Data.Text.Internal.Text
- Data.MessagePack.Put: putArray :: (a -> Put) -> [a] -> Put
- Data.MessagePack.Put: putBin :: ByteString -> Put
- Data.MessagePack.Put: putBool :: Bool -> Put
- Data.MessagePack.Put: putDouble :: Double -> Put
- Data.MessagePack.Put: putExt :: Word8 -> ByteString -> Put
- Data.MessagePack.Put: putFloat :: Float -> Put
- Data.MessagePack.Put: putInt :: Int64 -> Put
- Data.MessagePack.Put: putMap :: (a -> Put) -> (b -> Put) -> [(a, b)] -> Put
- Data.MessagePack.Put: putNil :: Put
- Data.MessagePack.Put: putStr :: Text -> Put
- Data.MessagePack.Put: putWord :: Word64 -> Put
+ Data.MessagePack.Option: None :: Option a
+ Data.MessagePack.Option: Some :: a -> Option a
+ Data.MessagePack.Option: data Option a
+ Data.MessagePack.Option: instance Data.Data.Data a => Data.Data.Data (Data.MessagePack.Option.Option a)
+ Data.MessagePack.Option: instance Data.Foldable.Foldable Data.MessagePack.Option.Option
+ Data.MessagePack.Option: instance Data.MessagePack.Class.MessagePack a => Data.MessagePack.Class.MessagePack (Data.MessagePack.Option.Option a)
+ Data.MessagePack.Option: instance Data.Traversable.Traversable Data.MessagePack.Option.Option
+ Data.MessagePack.Option: instance GHC.Base.Alternative Data.MessagePack.Option.Option
+ Data.MessagePack.Option: instance GHC.Base.Applicative Data.MessagePack.Option.Option
+ Data.MessagePack.Option: instance GHC.Base.Functor Data.MessagePack.Option.Option
+ Data.MessagePack.Option: instance GHC.Base.Monad Data.MessagePack.Option.Option
+ Data.MessagePack.Option: instance GHC.Base.MonadPlus Data.MessagePack.Option.Option
+ Data.MessagePack.Option: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.MessagePack.Option.Option a)
+ Data.MessagePack.Option: instance GHC.Classes.Ord a => GHC.Classes.Ord (Data.MessagePack.Option.Option a)
+ Data.MessagePack.Option: instance GHC.Read.Read a => GHC.Read.Read (Data.MessagePack.Option.Option a)
+ Data.MessagePack.Option: instance GHC.Show.Show a => GHC.Show.Show (Data.MessagePack.Option.Option a)
+ Data.MessagePack.Option: instance Test.QuickCheck.Arbitrary.Arbitrary a => Test.QuickCheck.Arbitrary.Arbitrary (Data.MessagePack.Option.Option a)

Files

data-msgpack.cabal view
@@ -1,5 +1,5 @@ name:                 data-msgpack-version:              0.0.8+version:              0.0.9 synopsis:             A Haskell implementation of MessagePack homepage:             http://msgpack.org/ license:              BSD3@@ -18,10 +18,6 @@   since the original author is unreachable. This fork incorporates a number of   bugfixes and is actively being developed. -extra-source-files:-  bench/Data/MessagePack/IntBench.hs-  bench/Data/MessagePackBench.hs- source-repository head   type:             git   location:         https://github.com/TokTok/hs-msgpack.git@@ -35,6 +31,9 @@       -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@@ -42,7 +41,6 @@       Data.MessagePack.Instances       Data.MessagePack.Object       Data.MessagePack.Put-      Data.MessagePack.Result   build-depends:       base < 5     , QuickCheck@@ -76,6 +74,10 @@   default-language: Haskell2010   hs-source-dirs: test   main-is: testsuite.hs+  other-modules:+      Data.MessagePack.OptionSpec+      Data.MessagePack.ResultSpec+      Data.MessagePackSpec   ghc-options:       -Wall       -fno-warn-unused-imports@@ -97,6 +99,9 @@   default-language: Haskell2010   hs-source-dirs: bench   main-is: benchmark.hs+  other-modules:+      Data.MessagePack.IntBench+      Data.MessagePackBench   ghc-options:       -Wall       -fno-warn-unused-imports
src/Data/MessagePack.hs view
@@ -34,6 +34,7 @@ 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  
src/Data/MessagePack/Object.hs view
@@ -95,22 +95,10 @@     , ObjectWord   <$> arbitrary     , ObjectFloat  <$> arbitrary     , ObjectDouble <$> arbitrary-    , ObjectStr    <$> arbitrary-    , ObjectBin    <$> 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 <*> arbitrary+    , ObjectExt    <$> arbitrary <*> (S.pack <$> arbitrary)     ]     where negatives = Gen.choose (minBound, -1)--instance Arbitrary S.ByteString where-  arbitrary = S.pack <$> arbitrary--instance Arbitrary L.ByteString where-  arbitrary = L.pack <$> arbitrary--instance Arbitrary T.Text where-  arbitrary = T.pack <$> arbitrary--instance Arbitrary LT.Text where-  arbitrary = LT.pack <$> arbitrary
+ src/Data/MessagePack/Option.hs view
@@ -0,0 +1,62 @@+{-# 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+    ]
+ test/Data/MessagePack/OptionSpec.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE LambdaCase  #-}+{-# LANGUAGE Trustworthy #-}+module Data.MessagePack.OptionSpec where++import           Test.Hspec+import           Test.QuickCheck++import           Control.Applicative     (empty, pure, (<$>), (<*>), (<|>))+import           Control.Monad           (mplus, mzero)+import qualified Data.MessagePack.Option as O+++newtype F = F (Int -> O.Option Int)++instance Show F where+  show = const "<function>"++instance Arbitrary F where+  arbitrary = F <$> arbitrary+++-- | Checks that 'O.Option' satisfies the laws described in the 'Monad' and+-- 'Applicative' documentation.+--+-- Also see:+-- https://wiki.haskell.org/Monad_laws+-- https://hackage.haskell.org/package/base-4.9.0.0/docs/Prelude.html#t:Applicative+spec :: Spec+spec = do+  describe "Monad" $ do+    it "satisfies left identity" $+      property $ \a (F f) ->+        (return' a `bind'` f) `shouldBe` f a++    it "satisfies right identity" $+      property $ \m ->+        (m `bind'` return') `shouldBe` m++    it "satisfies associativity" $+      property $ \m (F f) (F g) ->+        ((m `bind'` f) `bind'` g) `shouldBe` (m `bind'` (\x -> f x `bind'` g))++    it "supports 'fail'" $+      fail' "nope" `shouldBe` O.None++  describe "Applicative" $ do+    it "satisfies identity" $+      property identity++    it "satisfies composition" $+      property $ \x y w -> do+        composition  O.None             O.None              w+        composition  O.None            (pure (y *)        ) w+        composition (pure (x *)      )  O.None              w+        composition (pure (x *)      ) (pure (y *)        ) w++    it "satisfies homomorphism" $+      property $ \x -> homomorphism (x *)++    it "satisfies interchange" $+      property $ \x y -> do+        interchange  O.None            y+        interchange (pure (x *)      ) y++  describe "Alternative" $ do+    it "chooses the left-most success" $ do+      O.Some "a" <|> O.Some "b" `shouldBe` O.Some "a"+      O.Some "a" <|> O.None     `shouldBe` O.Some "a"+      O.None     <|> O.Some "b" `shouldBe` O.Some "b"++    it "chooses the right-most failure" $+      O.None        <|> O.None        `shouldBe` (O.None :: O.Option ())++    describe "empty" $+      it "is a failure" $+        empty <|> O.Some "a" `shouldBe` O.Some "a"++  describe "MonadPlus" $ do+    it "chooses the left-most success" $ do+      O.Some "a" `mplus` O.Some "b" `shouldBe` O.Some "a"+      O.Some "a" `mplus` O.None     `shouldBe` O.Some "a"+      O.None     `mplus` O.Some "b" `shouldBe` O.Some "b"++    it "chooses the right-most failure" $+      O.None     `mplus` O.None        `shouldBe` (O.None :: O.Option ())++    describe "mzero" $+      it "is a failure" $+        mzero `mplus` O.Some "a" `shouldBe` O.Some "a"++  where+    --+    -- Aliases constrained to the Option monad. These also help avoid lint+    -- warnings about using monad laws.+    --++    return' :: Int -> O.Option Int+    return' = return++    bind' :: O.Option Int -> (Int -> O.Option Int) -> O.Option Int+    bind' = (>>=)++    fail' :: String -> O.Option Int+    fail' = fail++    pure' :: a -> O.Option a+    pure' = pure++    --+    -- Applicative laws.+    --++    identity :: O.Option Int -> Expectation+    identity v =+      (pure' id <*> v) `shouldBe` v++    composition :: O.Option (Int -> Int) -> O.Option (Int -> Int) -> O.Option Int -> Expectation+    composition u v w =+      (pure' (.) <*> u <*> v <*> w) `shouldBe` (u <*> (v <*> w))++    homomorphism :: (Int -> Int) -> Int -> Expectation+    homomorphism h x =+      (pure' h <*> pure' x) `shouldBe` pure' (h x)++    interchange :: O.Option (Int -> Int) -> Int -> Expectation+    interchange u y =+      (u <*> pure' y) `shouldBe` (pure' ($ y) <*> u)
+ test/Data/MessagePack/ResultSpec.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE LambdaCase  #-}+{-# LANGUAGE Trustworthy #-}+module Data.MessagePack.ResultSpec where++import           Test.Hspec+import           Test.QuickCheck++import           Control.Applicative     (empty, pure, (<$>), (<*>), (<|>))+import qualified Data.MessagePack.Result as R+++newtype F = F (Int -> R.Result Int)++instance Show F where+  show = const "<function>"++instance Arbitrary F where+  arbitrary = F <$> arbitrary+++-- | Checks that 'R.Result' satisfies the laws described in the 'Monad' and+-- 'Applicative' documentation.+--+-- Also see:+-- https://wiki.haskell.org/Monad_laws+-- https://hackage.haskell.org/package/base-4.9.0.0/docs/Prelude.html#t:Applicative+spec :: Spec+spec = do+  describe "Monad" $ do+    it "satisfies left identity" $+      property $ \a (F f) ->+        (return' a `bind'` f) `shouldBe` f a++    it "satisfies right identity" $+      property $ \m ->+        (m `bind'` return') `shouldBe` m++    it "satisfies associativity" $+      property $ \m (F f) (F g) ->+        ((m `bind'` f) `bind'` g) `shouldBe` (m `bind'` (\x -> f x `bind'` g))++    it "supports 'fail'" $+      fail' "nope" `shouldBe` R.Failure "nope"++  describe "Applicative" $ do+    it "satisfies identity" $+      property identity++    it "satisfies composition" $+      property $ \x y w -> do+        composition (R.Failure "nope") (R.Failure "no way") w+        composition (R.Failure "nope") (pure (y *)        ) w+        composition (pure (x *)      ) (R.Failure "no way") w+        composition (pure (x *)      ) (pure (y *)        ) w++    it "satisfies homomorphism" $+      property $ \x -> homomorphism (x *)++    it "satisfies interchange" $+      property $ \x y -> do+        interchange (R.Failure "nope") y+        interchange (pure (x *)      ) y++  describe "Alternative" $ do+    it "chooses the left-most success" $ do+      R.Success "a" <|> R.Success "b" `shouldBe` R.Success "a"+      R.Success "a" <|> R.Failure "b" `shouldBe` R.Success "a"+      R.Failure "a" <|> R.Success "b" `shouldBe` R.Success "b"++    it "chooses the right-most failure" $+      R.Failure "a" <|> R.Failure "b" `shouldBe` (R.Failure "b" :: R.Result ())++    describe "empty" $+      it "is a failure" $+        empty <|> R.Success "a" `shouldBe` R.Success "a"++  where+    --+    -- Aliases constrained to the Result monad. These also help avoid lint+    -- warnings about using monad laws.+    --++    return' :: Int -> R.Result Int+    return' = return++    bind' :: R.Result Int -> (Int -> R.Result Int) -> R.Result Int+    bind' = (>>=)++    fail' :: String -> R.Result Int+    fail' = fail++    pure' :: a -> R.Result a+    pure' = pure++    --+    -- Applicative laws.+    --++    identity :: R.Result Int -> Expectation+    identity v =+      (pure' id <*> v) `shouldBe` v++    composition :: R.Result (Int -> Int) -> R.Result (Int -> Int) -> R.Result Int -> Expectation+    composition u v w =+      (pure' (.) <*> u <*> v <*> w) `shouldBe` (u <*> (v <*> w))++    homomorphism :: (Int -> Int) -> Int -> Expectation+    homomorphism h x =+      (pure' h <*> pure' x) `shouldBe` pure' (h x)++    interchange :: R.Result (Int -> Int) -> Int -> Expectation+    interchange u y =+      (u <*> pure' y) `shouldBe` (pure' ($ y) <*> u)
+ test/Data/MessagePackSpec.hs view
@@ -0,0 +1,396 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy         #-}+module Data.MessagePackSpec where++import           Test.Hspec+import           Test.QuickCheck+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           Data.MessagePack+import qualified Data.MessagePack.Result    as R+++data Unit = Unit+  deriving (Eq, Show, Generic)++instance MessagePack Unit+++data TyConArgs = TyConArgs Int Int Int+  deriving (Eq, Show, Generic)++instance MessagePack TyConArgs+++data Record = Record+  { recordField1 :: Int+  , recordField2 :: Double+  , recordField3 :: String+  }+  deriving (Eq, Show, Generic)++instance MessagePack Record+++data Foo+  = Foo1+  | Foo2 Int+  | Foo3 Int+  | Foo4 Int+  | Foo5 Int+  | Foo6 { unFoo3 :: Int }+  | Foo7 (Maybe Foo)+  | Foo8 Int+  | Foo9 Int Int+  | Foo10 Int Int Int+  deriving (Eq, Show, Generic)++instance MessagePack Foo++instance Arbitrary Foo where+  arbitrary = Gen.oneof+    [ return Foo1+    , Foo2 <$> arbitrary+    , Foo3 <$> arbitrary+    , Foo4 <$> arbitrary+    , Foo5 <$> arbitrary+    , Foo6 <$> arbitrary+    , Foo7 <$> arbitrary+    , Foo8 <$> arbitrary+    , Foo9 <$> arbitrary <*> arbitrary+    , Foo10 <$> arbitrary <*> arbitrary <*> arbitrary+    ]+++instance (Hashable k, Ord k, Eq k, Arbitrary k, Arbitrary v)+    => Arbitrary (HashMap.HashMap k v) where+  arbitrary = HashMap.fromList . Map.assocs <$> arbitrary++instance Arbitrary a => Arbitrary (V.Vector a) where+  arbitrary = V.fromList <$> arbitrary++instance (Arbitrary a, VS.Storable a) => Arbitrary (VS.Vector a) where+  arbitrary = VS.fromList <$> arbitrary++instance (Arbitrary a, VU.Unbox a) => Arbitrary (VU.Vector a) where+  arbitrary = VU.fromList <$> arbitrary++instance Arbitrary S.ByteString where+  arbitrary = S.pack <$> arbitrary++instance Arbitrary L.ByteString where+  arbitrary = L.pack <$> arbitrary++instance Arbitrary LT.Text where+  arbitrary = LT.pack <$> arbitrary++mid :: MessagePack a => a -> a+mid = Maybe.fromJust . unpack . pack+++intMid :: Int64 -> Int64+intMid = mid+++coerce :: (MessagePack a, MessagePack b) => a -> Maybe b+coerce = unpack . pack+++checkMessage :: Show a => R.Result a -> Expectation+checkMessage (R.Success res) =+  expectationFailure $ "unexpected success: " ++ show res+checkMessage (R.Failure msg) =+  msg `shouldContain` "invalid encoding for "+++spec :: Spec+spec = do+  describe "unpack" $+    it "does not throw exceptions on arbitrary data" $+      property $ \bs ->+        case unpack bs of+          Just "" -> return () :: IO ()+          _       -> return () :: IO ()++  describe "Assoc" $ do+    it "supports read/show" $+      property $ \(a :: Assoc [(Int, Int)]) ->+        read (show a) `shouldBe` a++    it "inherits ordering from its contained type" $+      property $ \(a :: Assoc Int) b ->+        (unAssoc a < unAssoc b) `shouldBe` (a < b)++  describe "failures" $+    it "should contain the same start of the failure message for all types" $ do+      checkMessage (unpack (pack $ ObjectInt (-1)) :: R.Result Foo)+      checkMessage (unpack (pack [ObjectInt (-1), ObjectInt 0]) :: R.Result Foo)+      checkMessage (unpack (pack $ ObjectArray []) :: R.Result TyConArgs)+      checkMessage (unpack (pack [0 :: Int, 1, 2, 3]) :: R.Result TyConArgs)+      checkMessage (unpack (pack $ ObjectArray []) :: R.Result Record)+      checkMessage (unpack (pack [0 :: Int, 1, 2, 3]) :: R.Result Record)+      checkMessage (unpack (pack "") :: R.Result Unit)+      checkMessage (unpack (pack "") :: R.Result TyConArgs)+      checkMessage (unpack (pack "") :: R.Result Record)+      checkMessage (unpack (pack "") :: R.Result ())+      checkMessage (unpack (pack ()) :: R.Result Int)+      checkMessage (unpack (pack ()) :: R.Result Bool)+      checkMessage (unpack (pack ()) :: R.Result Float)+      checkMessage (unpack (pack ()) :: R.Result Double)+      checkMessage (unpack (pack ()) :: R.Result S.ByteString)+      checkMessage (unpack (pack ()) :: R.Result LT.Text)+      checkMessage (unpack (pack "") :: R.Result [String])+      checkMessage (unpack (pack ()) :: R.Result (V.Vector Int))+      checkMessage (unpack (pack ()) :: R.Result (VS.Vector Int))+      checkMessage (unpack (pack ()) :: R.Result (VU.Vector Int))+      checkMessage (unpack (pack "") :: R.Result (Assoc [(Int, Int)]))+      checkMessage (unpack (pack ()) :: R.Result (Int, Int))+      checkMessage (unpack (pack ()) :: R.Result (Int, Int, Int))+      checkMessage (unpack (pack ()) :: R.Result (Int, Int, Int, Int))+      checkMessage (unpack (pack ()) :: R.Result (Int, Int, Int, Int, Int))+      checkMessage (unpack (pack ()) :: R.Result (Int, Int, Int, Int, Int, Int))+      checkMessage (unpack (pack ()) :: R.Result (Int, Int, Int, Int, Int, Int, Int))+      checkMessage (unpack (pack ()) :: R.Result (Int, Int, Int, Int, Int, Int, Int, Int))+      checkMessage (unpack (pack ()) :: R.Result (Int, Int, Int, Int, Int, Int, Int, Int, Int))++  describe "type coercion" $ do+    it "bool<-int" $+      property $ \(a :: Int) -> coerce a `shouldBe` (Nothing :: Maybe Bool)++    it "int<-bool" $+      property $ \(a :: Bool) -> coerce a `shouldBe` (Nothing :: Maybe Int)++    it "float<-int" $+      property $ \(a :: Int) -> coerce a `shouldBe` Just (fromIntegral a :: Float)+    it "float<-double" $+      property $ \(a :: Double) -> coerce a `shouldBe` Just (realToFrac a :: Float)+    it "float<-string" $+      property $ \(a :: String) -> coerce a `shouldBe` (Nothing :: Maybe Float)++    it "double<-int" $+      property $ \(a :: Int) -> coerce a `shouldBe` Just (fromIntegral a :: Double)+    it "double<-float" $+      property $ \(a :: Float) -> coerce a `shouldBe` Just (realToFrac a :: Double)+    it "double<-string" $+      property $ \(a :: String) -> coerce a `shouldBe` (Nothing :: Maybe Double)++    it "bin<-string" $+      property $ \(a :: S.ByteString) -> coerce a `shouldBe` (Nothing :: Maybe String)++    it "string<-bin" $+      property $ \(a :: String) -> coerce a `shouldBe` (Nothing :: Maybe S.ByteString)++  describe "Identity Properties" $ do+    let sizes = [0xf, 0x10, 0x1f, 0x20, 0xff, 0x100, 0xffff, 0x10000]++    it "unit encoding" $+      Unit `shouldBe` mid Unit++    it "map encodings" $ do+      let rt n = let a = IntMap.fromList [(x, -x) | x <- [0..n]] in a `shouldBe` mid a+      mapM_ rt sizes++    it "list encodings" $ do+      let rt n = let a = replicate n "hello" in a `shouldBe` mid a+      mapM_ rt sizes++    it "vector encodings" $ do+      let rt n = let a = V.fromList [0..n] in a `shouldBe` mid a+      mapM_ rt sizes++    it "storable-vector encodings" $ do+      let rt n = let a = VS.fromList [0..n] in a `shouldBe` mid a+      mapM_ rt sizes++    it "unboxed-vector encodings" $ do+      let rt n = let a = VU.fromList [0..n] in a `shouldBe` mid a+      mapM_ rt sizes++    it "string encodings" $ do+      let rt n = let a = replicate n 'a' in a `shouldBe` mid a+      mapM_ rt sizes++    it "bytestring encodings" $ do+      let rt n = let a = S.pack $ replicate n 'a' in a `shouldBe` mid a+      mapM_ rt sizes++    it "ext encodings" $ do+      let rt n = let a = ObjectExt 0 $ S.pack $ replicate n 'a' in a `shouldBe` mid a+      mapM_ rt [0..20]+      mapM_ rt sizes++    it "int encodings" $ do+      (-0x7fffffffffffffff) `shouldBe` intMid (-0x7fffffffffffffff)+      (-0x80000000) `shouldBe` intMid (-0x80000000)+      (-0x7fffffff) `shouldBe` intMid (-0x7fffffff)+      (-0x8000) `shouldBe` intMid (-0x8000)+      (-0x7fff) `shouldBe` intMid (-0x7fff)+      (-1) `shouldBe` intMid (-1)+      0 `shouldBe` intMid 0+      1 `shouldBe` intMid 1+      0x7fff `shouldBe` intMid 0x7fff+      0x8000 `shouldBe` intMid 0x8000+      0x7fffffff `shouldBe` intMid 0x7fffffff+      0x80000000 `shouldBe` intMid 0x80000000+      0x7fffffffffffffff `shouldBe` intMid 0x7fffffffffffffff++    it "int"    $ property $ \(a :: Int   ) -> a `shouldBe` mid a+    it "int8"   $ property $ \(a :: Int8  ) -> a `shouldBe` mid a+    it "int16"  $ property $ \(a :: Int16 ) -> a `shouldBe` mid a+    it "int32"  $ property $ \(a :: Int32 ) -> a `shouldBe` mid a+    it "int64"  $ property $ \(a :: Int64 ) -> a `shouldBe` mid a+    it "word"   $ property $ \(a :: Word  ) -> a `shouldBe` mid a+    it "word8"  $ property $ \(a :: Word8 ) -> a `shouldBe` mid a+    it "word16" $ property $ \(a :: Word16) -> a `shouldBe` mid a+    it "word32" $ property $ \(a :: Word32) -> a `shouldBe` mid a+    it "word64" $ property $ \(a :: Word64) -> a `shouldBe` mid a++    it "ext" $+      property $ \(n, a) -> ObjectExt n a `shouldBe` mid (ObjectExt n a)+    it "nil" $+      property $ \(a :: ()) -> a `shouldBe` mid a+    it "bool" $+      property $ \(a :: Bool) -> a `shouldBe` mid a+    it "float" $+      property $ \(a :: Float) -> a `shouldBe` mid a+    it "double" $+      property $ \(a :: Double) -> a `shouldBe` mid a+    it "string" $+      property $ \(a :: String) -> a `shouldBe` mid a+    it "bytestring" $+      property $ \(a :: S.ByteString) -> a `shouldBe` mid a+    it "lazy-bytestring" $+      property $ \(a :: L.ByteString) -> a `shouldBe` mid a+    it "lazy-text" $+      property $ \(a :: LT.Text) -> a `shouldBe` mid a+    it "maybe int" $+      property $ \(a :: (Maybe Int)) -> a `shouldBe` mid a+    it "[int]" $+      property $ \(a :: [Int]) -> a `shouldBe` mid a+    it "vector int" $+      property $ \(a :: V.Vector Int) -> a `shouldBe` mid a+    it "storable-vector int" $+      property $ \(a :: VS.Vector Int) -> a `shouldBe` mid a+    it "unboxed-vector int" $+      property $ \(a :: VU.Vector Int) -> a `shouldBe` mid a+    it "[string]" $+      property $ \(a :: [String]) -> a `shouldBe` mid a+    it "(int, int)" $+      property $ \(a :: (Int, Int)) -> a `shouldBe` mid a+    it "(int, int, int)" $+      property $ \(a :: (Int, Int, Int)) -> a `shouldBe` mid a+    it "(int, int, int, int)" $+      property $ \(a :: (Int, Int, Int, Int)) -> a `shouldBe` mid a+    it "(int, int, int, int, int)" $+      property $ \(a :: (Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+    it "(int, int, int, int, int, int)" $+      property $ \(a :: (Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+    it "(int, int, int, int, int, int, int)" $+      property $ \(a :: (Int, Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+    it "(int, int, int, int, int, int, int, int)" $+      property $ \(a :: (Int, Int, Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+    it "(int, int, int, int, int, int, int, int, int)" $+      property $ \(a :: (Int, Int, Int, Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+    it "[(int, double)]" $+      property $ \(a :: [(Int, Double)]) -> a `shouldBe` mid a+    it "[(string, string)]" $+      property $ \(a :: [(String, String)]) -> a `shouldBe` mid a+    it "Assoc [(string, int)]" $+      property $ \(a :: Assoc [(String, Int)]) -> a `shouldBe` mid a+    it "Map String Int" $+      property $ \(a :: Map.Map String Int) -> a `shouldBe` mid a+    it "IntMap Int" $+      property $ \(a :: IntMap.IntMap Int) -> a `shouldBe` mid a+    it "HashMap String Int" $+      property $ \(a :: HashMap.HashMap String Int) -> a `shouldBe` mid a+    it "Option Int" $+      property $ \(a :: Option Int) -> a `shouldBe` mid a+    it "maybe int" $+      property $ \(a :: Maybe Int) -> a `shouldBe` mid a+    it "maybe nil" $+      property $ \(a :: Maybe ()) -> a `shouldBe` mid a+    it "maybe maybe int" $+      property $ \(a :: Maybe (Maybe Int)) -> a `shouldBe` mid a+    it "maybe bool" $+      property $ \(a :: Maybe Bool) -> a `shouldBe` mid a+    it "maybe double" $+      property $ \(a :: Maybe Double) -> a `shouldBe` mid a+    it "maybe string" $+      property $ \(a :: Maybe String) -> a `shouldBe` mid a+    it "maybe bytestring" $+      property $ \(a :: Maybe S.ByteString) -> a `shouldBe` mid a+    it "maybe lazy-bytestring" $+      property $ \(a :: Maybe L.ByteString) -> a `shouldBe` mid a+    it "maybe [int]" $+      property $ \(a :: Maybe [Int]) -> a `shouldBe` mid a+    it "maybe [string]" $+      property $ \(a :: Maybe [String]) -> a `shouldBe` mid a+    it "maybe (int, int)" $+      property $ \(a :: Maybe (Int, Int)) -> a `shouldBe` mid a+    it "maybe (int, int, int)" $+      property $ \(a :: Maybe (Int, Int, Int)) -> a `shouldBe` mid a+    it "maybe (int, int, int, int)" $+      property $ \(a :: Maybe (Int, Int, Int, Int)) -> a `shouldBe` mid a+    it "maybe (int, int, int, int, int)" $+      property $ \(a :: Maybe (Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+    it "maybe [(int, double)]" $+      property $ \(a :: Maybe [(Int, Double)]) -> a `shouldBe` mid a+    it "maybe [(string, string)]" $+      property $ \(a :: Maybe [(String, String)]) -> a `shouldBe` mid a+    it "maybe (Assoc [(string, int)])" $+      property $ \(a :: Maybe (Assoc [(String, Int)])) -> a `shouldBe` mid a+    it "either int float" $+      property $ \(a :: Either Int Float) -> a `shouldBe` mid a++    it "generics" $+      property $ \(a :: Foo) -> a `shouldBe` mid a+    it "arbitrary message" $+      property $ \(a :: Object) -> a `shouldBe` mid a++  describe "encoding validation" $ do+    it "word64 2^64-1" $+      pack (0xffffffffffffffff :: Word64) `shouldBe` L8.pack [0xCF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF]++    it "decodes empty array as ()" $+      unpack (pack ([] :: [Int])) `shouldBe` Just ()++  describe "show" $ do+    it "Foo" $ do+      show (toObject Foo1) `shouldBe` "ObjectWord 0"+      show (toObject $ Foo3 3) `shouldBe` "ObjectArray [ObjectWord 2,ObjectWord 3]"+      show (toObject $ Foo3 (-3)) `shouldBe` "ObjectArray [ObjectWord 2,ObjectInt (-3)]"+      show (toObject $ Foo9 3 5) `shouldBe` "ObjectArray [ObjectWord 8,ObjectArray [ObjectWord 3,ObjectWord 5]]"+      show (toObject $ Foo9 (-3) (-5)) `shouldBe` "ObjectArray [ObjectWord 8,ObjectArray [ObjectInt (-3),ObjectInt (-5)]]"+      show (toObject $ Foo10 3 5 7) `shouldBe` "ObjectArray [ObjectWord 9,ObjectArray [ObjectWord 3,ObjectWord 5,ObjectWord 7]]"+      show (toObject $ Foo10 (-3) (-5) 7) `shouldBe` "ObjectArray [ObjectWord 9,ObjectArray [ObjectInt (-3),ObjectInt (-5),ObjectWord 7]]"++    it "TyConArgs" $+      show (toObject $ TyConArgs 3 5 7) `shouldBe` "ObjectArray [ObjectWord 3,ObjectWord 5,ObjectWord 7]"++    it "Record" $+      show (toObject $ Record 3 5 "7") `shouldBe` "ObjectArray [ObjectWord 3,ObjectDouble 5.0,ObjectStr \"7\"]"++voidTest :: Void -> Object+voidTest = toObject