cleanup: Remove QuickCheck dependency.

TokTok · Feb 15, 2022 · 4557dee · 4557dee
1 parent 4d35f9c
commit 4557dee
Show file tree

Hide file tree

Showing 11 changed files with 108 additions and 107 deletions.
diff --git a/BUILD.bazel b/BUILD.bazel
@@ -8,12 +8,10 @@ project(license = "hs-msgpack")
 haskell_library(
     name = "hs-msgpack-types",
     srcs = glob(["src/**/*.*hs"]),
-    compiler_flags = ["-Wno-unused-imports"],
     src_strip_prefix = "src",
-    version = "0.3.1",
+    version = "0.3.2",
     visibility = ["//visibility:public"],
     deps = [
-        hazel_library("QuickCheck"),
         hazel_library("base"),
         hazel_library("bytestring"),
         hazel_library("containers"),
@@ -42,6 +40,7 @@ hspec_test(
         hazel_library("hashable"),
         hazel_library("hspec"),
         hazel_library("monad-validate"),
+        hazel_library("quickcheck-instances"),
         hazel_library("text"),
         hazel_library("unordered-containers"),
         hazel_library("vector"),

diff --git a/msgpack-types.cabal b/msgpack-types.cabal
@@ -1,5 +1,5 @@
 name:                 msgpack-types
-version:              0.3.1
+version:              0.3.2
 synopsis:             A Haskell implementation of MessagePack.
 homepage:             http://msgpack.org/
 license:              BSD3
@@ -30,6 +30,7 @@ library
       -Wall
       -fno-warn-unused-imports
   exposed-modules:
+      Data.MessagePack.Tags
       Data.MessagePack.Types
   other-modules:
       Data.MessagePack.Types.Assoc
@@ -39,7 +40,6 @@ library
       Data.MessagePack.Types.Object
   build-depends:
       base < 5
-    , QuickCheck
     , bytestring
     , containers
     , deepseq
@@ -56,9 +56,10 @@ test-suite testsuite
   hs-source-dirs: test
   main-is: testsuite.hs
   other-modules:
-      Data.MessagePack.Arbitrary
+      Data.MessagePack.TagsSpec
       Data.MessagePack.Types.AssocSpec
       Data.MessagePack.Types.ClassSpec
+      Test.QuickCheck.Instances.MessagePack
   ghc-options:
       -Wall
       -fno-warn-unused-imports
@@ -75,6 +76,7 @@ test-suite testsuite
     , hspec
     , monad-validate
     , msgpack-types
+    , quickcheck-instances
     , text
     , unordered-containers
     , vector
diff --git a/src/Data/MessagePack/Types/Assoc.hs b/src/Data/MessagePack/Types/Assoc.hs
@@ -21,17 +21,12 @@ module Data.MessagePack.Types.Assoc
     ( Assoc (..)
     ) where
 
-import           Control.Applicative       ((<$>))
-import           Control.DeepSeq           (NFData)
-import           Data.Typeable             (Typeable)
-import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import           Control.DeepSeq (NFData)
+import           Data.Typeable   (Typeable)
 
 -- 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
diff --git a/src/Data/MessagePack/Types/Class.hs b/src/Data/MessagePack/Types/Class.hs
@@ -30,7 +30,6 @@ module Data.MessagePack.Types.Class
     , defaultConfig
     ) where
 
-import           Control.Applicative                (Applicative, (<$>), (<*>))
 import           Control.Arrow                      ((***))
 import           Control.Monad.Validate             (MonadValidate (..))
 import qualified Data.ByteString                    as S
@@ -45,8 +44,8 @@ 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           Data.Word                          (Word16, Word32, Word64,
+                                                     Word8)
 import           GHC.Generics                       (Generic, Rep, from, to)
 
 import           Data.MessagePack.Types.Assoc       (Assoc (..))

diff --git a/src/Data/MessagePack/Types/Generic.hs b/src/Data/MessagePack/Types/Generic.hs
@@ -14,8 +14,6 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Data.MessagePack.Types.Generic () where
 
-import           Control.Applicative                (Applicative, (<$>), (<*>))
-import           Control.Monad                      ((>=>))
 import           Control.Monad.Trans.State.Strict   (StateT, evalStateT, get,
                                                      put)
 import           Control.Monad.Validate             (MonadValidate, refute)

diff --git a/src/Data/MessagePack/Types/Object.hs b/src/Data/MessagePack/Types/Object.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE StrictData         #-}
@@ -7,15 +6,14 @@ module Data.MessagePack.Types.Object
     ( Object (..)
     ) where
 
-import           Control.Applicative ((<$>), (<*>))
-import           Control.DeepSeq     (NFData (..))
-import qualified Data.ByteString     as S
-import           Data.Int            (Int64)
-import qualified Data.Text           as T
-import           Data.Typeable       (Typeable)
-import qualified Data.Vector         as V
-import           Data.Word           (Word64, Word8)
-import           GHC.Generics        (Generic)
+import           Control.DeepSeq (NFData (..))
+import qualified Data.ByteString as S
+import           Data.Int        (Int64)
+import qualified Data.Text       as T
+import           Data.Typeable   (Typeable)
+import qualified Data.Vector     as V
+import           Data.Word       (Word64, Word8)
+import           GHC.Generics    (Generic)
 
 
 -- | Object Representation of MessagePack data.

diff --git a/test/Data/MessagePack/Arbitrary.hs b/test/Data/MessagePack/Arbitrary.hs
diff --git a/test/Data/MessagePack/TagsSpec.hs b/test/Data/MessagePack/TagsSpec.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE LambdaCase #-}
+module Data.MessagePack.TagsSpec where
+
+import           Data.MessagePack.Tags
+import           Test.Hspec            (Spec, describe, it, shouldSatisfy)
+
+spec :: Spec
+spec =
+    describe "Assoc" $
+        it "has a working Read/Show implementation" $ do
+            (TAG_nil :: Int) `shouldSatisfy` \case
+                TAG_nil -> True
+                _       -> False
+            (TAG_nil :: Integer) `shouldSatisfy` \case
+                TAG_nil -> True
+                _       -> False
diff --git a/test/Data/MessagePack/Types/AssocSpec.hs b/test/Data/MessagePack/Types/AssocSpec.hs
@@ -2,9 +2,12 @@
 {-# LANGUAGE Trustworthy         #-}
 module Data.MessagePack.Types.AssocSpec where
 
-import           Data.MessagePack.Types (Assoc (..))
-import           Test.Hspec             (Spec, describe, it, shouldBe)
-import           Test.QuickCheck        (Arbitrary (..), property)
+import           Data.MessagePack.Types                (Assoc (..))
+import           Test.Hspec                            (Spec, describe, it,
+                                                        shouldBe)
+import           Test.QuickCheck                       (Arbitrary (..),
+                                                        property)
+import           Test.QuickCheck.Instances.MessagePack ()
 
 spec :: Spec
 spec =

diff --git a/test/Data/MessagePack/Types/ClassSpec.hs b/test/Data/MessagePack/Types/ClassSpec.hs
@@ -7,37 +7,40 @@
 {-# LANGUAGE Trustworthy         #-}
 module Data.MessagePack.Types.ClassSpec where
 
-import           Control.Applicative               (empty, pure, (<$>), (<*>),
-                                                    (<|>))
-import           Control.Monad                     (mplus, mzero)
-import           Control.Monad.Validate            (MonadValidate (..),
-                                                    runValidate)
-import qualified Data.ByteString                   as BS
-import qualified Data.ByteString.Lazy              as LBS
-import qualified Data.HashMap.Strict               as HashMap
-import           Data.Hashable                     (Hashable)
-import           Data.Int                          (Int16, Int32, Int64, Int8)
-import qualified Data.IntMap.Strict                as IntMap
-import qualified Data.Map                          as Map
-import           Data.MessagePack.Arbitrary        ()
-import           Data.MessagePack.Types            (Assoc (..),
-                                                    MessagePack (..),
-                                                    Object (..), defaultConfig,
-                                                    errorMessages)
-import qualified Data.Text                         as Text
-import qualified Data.Text.Lazy                    as LText
-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                      (Generic)
-import           Test.Hspec                        (Spec, describe, it,
-                                                    shouldBe, shouldSatisfy)
-import           Test.QuickCheck                   (Arbitrary (..),
-                                                    genericShrink, property,
-                                                    withMaxSuccess)
-import           Test.QuickCheck.Arbitrary.Generic (genericArbitrary)
+import           Control.Applicative                   (empty, pure, (<$>),
+                                                        (<*>), (<|>))
+import           Control.Monad                         (mplus, mzero)
+import           Control.Monad.Validate                (MonadValidate (..),
+                                                        runValidate)
+import qualified Data.ByteString                       as BS
+import qualified Data.ByteString.Lazy                  as LBS
+import qualified Data.HashMap.Strict                   as HashMap
+import           Data.Hashable                         (Hashable)
+import           Data.Int                              (Int16, Int32, Int64,
+                                                        Int8)
+import qualified Data.IntMap.Strict                    as IntMap
+import qualified Data.Map                              as Map
+import           Data.MessagePack.Types                (Assoc (..),
+                                                        MessagePack (..),
+                                                        Object (..),
+                                                        defaultConfig,
+                                                        errorMessages)
+import qualified Data.Text                             as Text
+import qualified Data.Text.Lazy                        as LText
+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                          (Generic)
+import           Test.Hspec                            (Spec, describe, it,
+                                                        shouldBe, shouldSatisfy)
+import           Test.QuickCheck                       (Arbitrary (..),
+                                                        genericShrink, property,
+                                                        withMaxSuccess)
+import           Test.QuickCheck.Arbitrary.Generic     (genericArbitrary)
+import           Test.QuickCheck.Instances             ()
+import           Test.QuickCheck.Instances.MessagePack ()
 
 data MyType
     = SequenceTyCon Int String Int Int
@@ -82,23 +85,6 @@ instance Arbitrary MyType where
     arbitrary = genericArbitrary
     shrink = genericShrink
 
-instance Arbitrary BS.ByteString where
-    arbitrary = BS.pack . take 10 <$> arbitrary
-instance Arbitrary LBS.ByteString where
-    arbitrary = LBS.pack . take 10 <$> arbitrary
-instance Arbitrary Text.Text where
-    arbitrary = Text.pack . take 10 <$> arbitrary
-instance Arbitrary LText.Text where
-    arbitrary = LText.pack . take 10 <$> 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 a, Hashable a, Eq a, Arbitrary b) => Arbitrary (HashMap.HashMap a b) where
-    arbitrary = HashMap.fromList <$> arbitrary
-
 
 type Result a = Either [String] a
 

diff --git a/test/Test/QuickCheck/Instances/MessagePack.hs b/test/Test/QuickCheck/Instances/MessagePack.hs
@@ -0,0 +1,33 @@
+{-# 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               (Assoc (..), 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)
+
+
+instance Arbitrary a => Arbitrary (Assoc a) where
+    arbitrary = Assoc <$> arbitrary