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 +11/−6
- src/Data/MessagePack.hs +1/−0
- src/Data/MessagePack/Object.hs +3/−15
- src/Data/MessagePack/Option.hs +62/−0
- test/Data/MessagePack/OptionSpec.hs +127/−0
- test/Data/MessagePack/ResultSpec.hs +113/−0
- test/Data/MessagePackSpec.hs +396/−0
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