msgpack-arbitrary 0.1.0 → 0.1.1

raw patch · 4 files changed

+88/−28 lines, 4 filesdep +quickcheck-instancesdep +timedep −vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: quickcheck-instances, time

Dependencies removed: vector

API changes (from Hackage documentation)

Files

• msgpack-arbitrary.cabal +5/−2
• src/Data/MessagePack/Arbitrary.hs +1/−26
• src/Test/MessagePack/Generate.hs +53/−0
• src/Test/QuickCheck/Instances/MessagePack.hs +29/−0

@@ -1,5 +1,5 @@ name:                 msgpack-arbitrary-version:              0.1.0+version:              0.1.1 synopsis:             A Haskell implementation of MessagePack. homepage:             http://msgpack.org/ license:              BSD3@@ -31,13 +31,16 @@       -fno-warn-unused-imports   exposed-modules:       Data.MessagePack.Arbitrary+      Test.MessagePack.Generate+      Test.QuickCheck.Instances.MessagePack   build-depends:       base                      < 5     , QuickCheck     , bytestring     , msgpack-types             >= 0.3 && < 0.4+    , quickcheck-instances     , text-    , vector+    , time  test-suite testsuite   type: exitcode-stdio-1.0

@@ -1,28 +1,3 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE StrictData  #-}-{-# LANGUAGE Trustworthy #-} module Data.MessagePack.Arbitrary () where -import qualified Data.ByteString           as S-import           Data.MessagePack.Types    (Object (..))-import qualified Data.Text                 as T-import qualified Data.Vector               as V-import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)-import qualified Test.QuickCheck.Gen       as Gen---instance Arbitrary Object where-    arbitrary = Gen.sized $ \n -> Gen.oneof-        [ pure ObjectNil-        , ObjectBool   <$> arbitrary-        , ObjectInt    <$> negatives-        , ObjectWord   <$> arbitrary-        , ObjectFloat  <$> arbitrary-        , ObjectDouble <$> arbitrary-        , ObjectStr    <$> (T.pack <$> arbitrary)-        , ObjectBin    <$> (S.pack <$> arbitrary)-        , ObjectArray  <$> (V.fromList <$> Gen.resize (n `div` 2) arbitrary)-        , ObjectMap    <$> (V.fromList <$> Gen.resize (n `div` 4) arbitrary)-        , ObjectExt    <$> arbitrary <*> (S.pack <$> arbitrary)-        ]-        where negatives = Gen.choose (minBound, -1)+import           Test.QuickCheck.Instances.MessagePack ()

@@ -0,0 +1,53 @@+module Test.MessagePack.Generate (generate) where++import           Control.Monad                    (when)+import qualified Data.ByteString.Lazy             as L+import           Data.Int                         (Int64)+import           Data.MessagePack.Arbitrary       ()+import           Data.MessagePack.Types           (Object (..))+import           Data.Time.Clock                  (diffUTCTime, getCurrentTime)+import           System.Environment               (getArgs)+import           System.IO                        (hPutStr, hPutStrLn, stderr)+import           Test.QuickCheck.Arbitrary        (arbitrary)+import qualified Test.QuickCheck.Gen              as Gen+import           Test.QuickCheck.Instances.Vector ()+import           Test.QuickCheck.Random           (mkQCGen)+++seed :: Int+seed = 33+++showBytes :: Int64 -> String+showBytes size+  | size > 10 * (1024 * 1024) = show (size `div` (1024 * 1024)) <> " MiB"+  | size > 10 * 1024 = show (size `div` 1024) <> " KiB"+  | otherwise = show size <> " B"+++showSpeed :: Int64 -> Double -> String+showSpeed size time =+    show (fromIntegral size / (1024 * 1024) / time) <> " MiB/s"+++generate :: (Object -> L.ByteString) -> IO ()+generate pack = do+    size:_ <- (++[30]) . map read <$> getArgs++    start <- getCurrentTime+    hPutStrLn stderr "Generating sample..."++    let sample@(ObjectArray array) = ObjectArray $ Gen.unGen (Gen.resize size arbitrary) (mkQCGen 0) seed+    when (sample == sample) $  -- force deep evaluation of the whole structure (kind of deepseq)+        hPutStr stderr $ "Generated msgpack array of length " <> show (length array)+    sampleTime <- getCurrentTime+    hPutStrLn stderr $ " in " <> show (diffUTCTime sampleTime start)++    let packed = pack sample+    hPutStr stderr $ "Message packed into " <> showBytes (L.length packed)+    packTime <- getCurrentTime+    hPutStrLn stderr $ " in " <> show (diffUTCTime packTime sampleTime)++    hPutStrLn stderr $ "Packing speed: " <> showSpeed (L.length packed) (realToFrac (diffUTCTime packTime sampleTime))++    L.putStr packed

@@ -0,0 +1,29 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE StrictData  #-}+{-# LANGUAGE Trustworthy #-}+module Test.QuickCheck.Instances.MessagePack () where++import qualified Data.ByteString                      as S+import           Data.MessagePack.Types               (Object (..))+import qualified Data.Text                            as T+import           Test.QuickCheck.Arbitrary            (Arbitrary, arbitrary)+import qualified Test.QuickCheck.Gen                  as Gen+import           Test.QuickCheck.Instances.ByteString ()+import           Test.QuickCheck.Instances.Vector     ()+++instance Arbitrary Object where+    arbitrary = Gen.sized $ \n -> Gen.oneof+        [ pure 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 <*> arbitrary+        ]+        where negatives = Gen.choose (minBound, -1)