Use quickcheck-instances and newer QuickCheck, less own orphan instances

fizruk · Sep 23, 2016 · eb65b71 · eb65b71
1 parent e8c7d07
commit eb65b71
Show file tree

Hide file tree

Showing 6 changed files with 30 additions and 44 deletions.
diff --git a/http-api-data.cabal b/http-api-data.cabal
@@ -59,7 +59,8 @@ test-suite spec
                    , hspec >= 1.3
                    , base >= 4 && < 5
                    , bytestring
-                   , QuickCheck
+                   , QuickCheck >=2.9
+                   , quickcheck-instances >= 0.3.12
                    , unordered-containers
                    , http-api-data
                    , text

diff --git a/stack-ghc-7.10.yaml b/stack-ghc-7.10.yaml
@@ -7,5 +7,6 @@ flags:
   http-api-data:
     use-text-show: false
 
-extra-deps: []
+extra-deps:
+- QuickCheck-2.9.2
 extra-package-dbs: []
diff --git a/stack-ghc-7.8.yaml b/stack-ghc-7.8.yaml
@@ -20,4 +20,6 @@ extra-deps:
 - base-orphans-0.5.4
 - generic-deriving-1.9.0
 - doctest-0.11.0
+- QuickCheck-2.9.2
+- quickcheck-instances-0.3.12
 extra-package-dbs: []
diff --git a/stack.yaml b/stack.yaml
@@ -7,5 +7,6 @@ flags:
   http-api-data:
     use-text-show: false
 
-extra-deps: []
+extra-deps:
+- QuickCheck-2.9.2
 extra-package-dbs: []
diff --git a/test/Web/Internal/HttpApiDataSpec.hs b/test/Web/Internal/HttpApiDataSpec.hs
@@ -62,10 +62,10 @@ spec = do
     checkUrlPiece  (Proxy :: Proxy T.Text)    "Text.Strict"
     checkUrlPiece  (Proxy :: Proxy L.Text)    "Text.Lazy"
     checkUrlPiece  (Proxy :: Proxy Day)       "Day"
-    checkUrlPiece  (Proxy :: Proxy LocalTime) "LocalTime"
-    checkUrlPiece  (Proxy :: Proxy ZonedTime) "ZonedTime"
-    checkUrlPiece  (Proxy :: Proxy UTCTime)   "UTCTime"
-    checkUrlPiece  (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"
+    checkUrlPiece' localTimeGen               "LocalTime"
+    checkUrlPiece' zonedTimeGen               "ZonedTime"
+    checkUrlPiece' utcTimeGen                 "UTCTime"
+    checkUrlPiece' nominalDiffTimeGen         "NominalDiffTime"
     checkUrlPiece  (Proxy :: Proxy Version)   "Version"
     checkUrlPiece' uuidGen                    "UUID"
 
@@ -90,3 +90,20 @@ spec = do
 
 uuidGen :: Gen UUID.UUID
 uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+-- TODO: this generators don't generate full range items
+localTimeGen :: Gen LocalTime
+localTimeGen = LocalTime
+    <$> arbitrary
+    <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))
+
+zonedTimeGen :: Gen ZonedTime
+zonedTimeGen = ZonedTime
+    <$> localTimeGen -- Note: not arbitrary!
+    <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
+
+utcTimeGen :: Gen UTCTime
+utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
+
+nominalDiffTimeGen :: Gen NominalDiffTime
+nominalDiffTimeGen = fromInteger <$> arbitrary
diff --git a/test/Web/Internal/TestInstances.hs b/test/Web/Internal/TestInstances.hs
@@ -9,58 +9,22 @@ module Web.Internal.TestInstances
    ) where
 
 import           Control.Applicative
-import qualified Data.ByteString.Lazy.Char8 as BSL
 import           Data.Char
 import qualified Data.HashMap.Strict  as HashMap
 import qualified Data.Text            as T
-import qualified Data.Text.Lazy       as L
 import           Data.Time
-import           Data.Version
 import           GHC.Exts             (fromList)
 import           GHC.Generics
 
 import Test.QuickCheck
+import Test.QuickCheck.Instances ()
 
 import Web.Internal.FormUrlEncoded
 import Web.Internal.HttpApiData
 
-instance Arbitrary T.Text where
-  arbitrary = T.pack <$> arbitrary
-
-instance Arbitrary L.Text where
-  arbitrary = L.pack <$> arbitrary
-
-instance Arbitrary BSL.ByteString where
-  arbitrary = BSL.pack <$> arbitrary
-
-instance Arbitrary Day where
-  arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary
-
-instance Arbitrary LocalTime where
-  arbitrary = LocalTime
-    <$> arbitrary
-    <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))
-
 instance Eq ZonedTime where
   ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y
 
-instance Arbitrary ZonedTime where
-  arbitrary = ZonedTime
-    <$> arbitrary
-    <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
-
-instance Arbitrary UTCTime where
-  arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
-
-instance Arbitrary NominalDiffTime where
-  arbitrary = fromInteger <$> arbitrary
-
-instance Arbitrary Version where
-  arbitrary = (version . map abs) <$> nonempty
-    where
-      version branch = Version branch []
-      nonempty = liftA2 (:) arbitrary arbitrary
-
 instance Arbitrary Form where
   arbitrary = fromList <$> arbitrary