From a1dbad9b34282d914146caeb751c2a13b09f2e31 Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Tue, 7 Nov 2017 18:40:45 +0100 Subject: [PATCH 1/6] Add ToSchema NonEmpty instance for GHC 8. --- src/Data/Swagger/Internal/Schema.hs | 10 ++++++++++ test/Data/Swagger/Schema/ValidationSpec.hs | 2 ++ 2 files changed, 12 insertions(+) diff --git a/src/Data/Swagger/Internal/Schema.hs b/src/Data/Swagger/Internal/Schema.hs index b4db806..c4901a6 100644 --- a/src/Data/Swagger/Internal/Schema.hs +++ b/src/Data/Swagger/Internal/Schema.hs @@ -73,6 +73,7 @@ import Data.Swagger.Internal.TypeShape #else import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL +import Data.List.NonEmpty (NonEmpty) import GHC.TypeLits (TypeError, ErrorMessage(..)) #endif @@ -561,6 +562,15 @@ instance ToSchema a => ToSchema (Set a) where instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a)) +#if __GLASGOW_HASKELL__ < 800 +#else +instance ToSchema a => ToSchema (NonEmpty a) where + declareNamedSchema _ = do + schema <- declareSchema (Proxy :: Proxy [a]) + return $ unnamed $ schema + & minItems .~ Just 1 +#endif + instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema diff --git a/test/Data/Swagger/Schema/ValidationSpec.hs b/test/Data/Swagger/Schema/ValidationSpec.hs index c415561..3c7fe69 100644 --- a/test/Data/Swagger/Schema/ValidationSpec.hs +++ b/test/Data/Swagger/Schema/ValidationSpec.hs @@ -16,6 +16,7 @@ import "unordered-containers" Data.HashSet (HashSet) import qualified "unordered-containers" Data.HashSet as HashSet import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap +import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) import Data.Monoid (mempty) import Data.Proxy @@ -69,6 +70,7 @@ spec = do -- prop "(Maybe [Int])" $ shouldValidate (Proxy :: Proxy (Maybe [Int])) prop "(IntMap String)" $ shouldValidate (Proxy :: Proxy (IntMap String)) prop "(Set Bool)" $ shouldValidate (Proxy :: Proxy (Set Bool)) + prop "(NonEmpty Bool)" $ shouldValidate (Proxy :: Proxy (NonEmpty Bool)) prop "(HashSet Bool)" $ shouldValidate (Proxy :: Proxy (HashSet Bool)) prop "(Either Int String)" $ shouldValidate (Proxy :: Proxy (Either Int String)) prop "(Int, String)" $ shouldValidate (Proxy :: Proxy (Int, String)) From eda447edcb5d3e532bb57b4cf4f667d3a5c6b8aa Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Thu, 9 Nov 2017 09:42:15 +0100 Subject: [PATCH 2/6] (squash-me) support GHC 7.x --- src/Data/Swagger/Internal/Schema.hs | 5 +---- swagger2.cabal | 2 ++ 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Data/Swagger/Internal/Schema.hs b/src/Data/Swagger/Internal/Schema.hs index c4901a6..3339ea3 100644 --- a/src/Data/Swagger/Internal/Schema.hs +++ b/src/Data/Swagger/Internal/Schema.hs @@ -44,6 +44,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Int import Data.IntSet (IntSet) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) import Data.Proxy import Data.Scientific (Scientific) @@ -73,7 +74,6 @@ import Data.Swagger.Internal.TypeShape #else import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import Data.List.NonEmpty (NonEmpty) import GHC.TypeLits (TypeError, ErrorMessage(..)) #endif @@ -562,14 +562,11 @@ instance ToSchema a => ToSchema (Set a) where instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a)) -#if __GLASGOW_HASKELL__ < 800 -#else instance ToSchema a => ToSchema (NonEmpty a) where declareNamedSchema _ = do schema <- declareSchema (Proxy :: Proxy [a]) return $ unnamed $ schema & minItems .~ Just 1 -#endif instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema diff --git a/swagger2.cabal b/swagger2.cabal index d05d3dc..e297ca1 100644 --- a/swagger2.cabal +++ b/swagger2.cabal @@ -71,6 +71,8 @@ library , uuid-types >=1.0.2 && <1.1 if !impl(ghc >= 7.10) build-depends: nats >=1.1.1 && <1.2 + if !impl(ghc >= 8.0) + build-depends: semigroups >= 0.18.3 && <0.19 default-language: Haskell2010 test-suite spec From 361415bd10aac05c78b0389e6b9b4b8149ae6393 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Tue, 6 Mar 2018 18:04:08 -0700 Subject: [PATCH 3/6] Add semigroups build dep --- swagger2.cabal | 3 +++ 1 file changed, 3 insertions(+) diff --git a/swagger2.cabal b/swagger2.cabal index e297ca1..f27999a 100644 --- a/swagger2.cabal +++ b/swagger2.cabal @@ -98,6 +98,9 @@ test-suite spec , unordered-containers , vector , lens + if !impl(ghc >= 8.0) + build-depends: semigroups >= 0.18.3 && <0.19 + other-modules: SpecCommon Data.SwaggerSpec From 4ddca111c7c48e37d51ee45564eff7e09773d3d2 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Tue, 6 Mar 2018 18:38:00 -0700 Subject: [PATCH 4/6] Fix tests --- test/Data/Swagger/Schema/ValidationSpec.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/test/Data/Swagger/Schema/ValidationSpec.hs b/test/Data/Swagger/Schema/ValidationSpec.hs index 3c7fe69..0559027 100644 --- a/test/Data/Swagger/Schema/ValidationSpec.hs +++ b/test/Data/Swagger/Schema/ValidationSpec.hs @@ -16,7 +16,7 @@ import "unordered-containers" Data.HashSet (HashSet) import qualified "unordered-containers" Data.HashSet as HashSet import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.Map (Map) import Data.Monoid (mempty) import Data.Proxy @@ -262,3 +262,13 @@ instance Arbitrary ZonedTime where instance Arbitrary UTCTime where arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400)) + +#if MIN_VERSION_QuickCheck(2,10,0) +-- This instance was removed in QuickCheck 2.10 because of dependencies. +-- The instance is available in `quickcheck-instances` package, but that +-- introduces a ton of conflicts with the other instances here. + +instance Arbitrary a => Arbitrary (NonEmpty a) where + arbitrary = liftA2 (:|) arbitrary arbitrary + shrink (x :| xs) = mapMaybe nonEmpty (shrink (x:xs)) +#endif From edd2ed033eec44918ce1ac79333fbe0a25212702 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 7 Mar 2018 11:24:46 -0700 Subject: [PATCH 5/6] use quickcheck-instances --- swagger2.cabal | 3 ++- test/Data/Swagger/Schema/ValidationSpec.hs | 10 +++++++--- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/swagger2.cabal b/swagger2.cabal index f27999a..695fc29 100644 --- a/swagger2.cabal +++ b/swagger2.cabal @@ -92,6 +92,7 @@ test-suite spec , HUnit , mtl , QuickCheck >=2.8.2 + , quickcheck-instances , swagger2 , text , time @@ -99,7 +100,7 @@ test-suite spec , vector , lens if !impl(ghc >= 8.0) - build-depends: semigroups >= 0.18.3 && <0.19 + build-depends: semigroups other-modules: SpecCommon diff --git a/test/Data/Swagger/Schema/ValidationSpec.hs b/test/Data/Swagger/Schema/ValidationSpec.hs index 0559027..f4f7cb0 100644 --- a/test/Data/Swagger/Schema/ValidationSpec.hs +++ b/test/Data/Swagger/Schema/ValidationSpec.hs @@ -33,6 +33,7 @@ import Data.Swagger.Declare import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck +import Test.QuickCheck.Instances () shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool shouldValidate _ x = validateToJSON x == [] @@ -230,6 +231,10 @@ invalidButtonImagesToJSON = genericToJSON defaultOptions instance Arbitrary ButtonImages where arbitrary = ButtonImages <$> arbitrary +instance Eq ZonedTime where + ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y + +{- -- Arbitrary instances for common types instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where @@ -252,9 +257,6 @@ instance Arbitrary LocalTime where <$> 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 @@ -272,3 +274,5 @@ instance Arbitrary a => Arbitrary (NonEmpty a) where arbitrary = liftA2 (:|) arbitrary arbitrary shrink (x :| xs) = mapMaybe nonEmpty (shrink (x:xs)) #endif + +-} From 50106b3189489b948d59cbe2af81895884dcacc3 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 7 Mar 2018 16:03:40 -0700 Subject: [PATCH 6/6] Remove unused instance code --- test/Data/Swagger/Schema/ValidationSpec.hs | 43 ---------------------- 1 file changed, 43 deletions(-) diff --git a/test/Data/Swagger/Schema/ValidationSpec.hs b/test/Data/Swagger/Schema/ValidationSpec.hs index f4f7cb0..3696fab 100644 --- a/test/Data/Swagger/Schema/ValidationSpec.hs +++ b/test/Data/Swagger/Schema/ValidationSpec.hs @@ -233,46 +233,3 @@ instance Arbitrary ButtonImages where instance Eq ZonedTime where ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y - -{- --- Arbitrary instances for common types - -instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where - arbitrary = HashMap.fromList <$> arbitrary - -instance (Eq a, Hashable a, Arbitrary a) => Arbitrary (HashSet a) where - arbitrary = HashSet.fromList <$> arbitrary - -instance Arbitrary T.Text where - arbitrary = T.pack <$> arbitrary - -instance Arbitrary TL.Text where - arbitrary = TL.pack <$> arbitrary - -instance Arbitrary Day where - arbitrary = liftA3 fromGregorian (fmap ((+ 1) . abs) arbitrary) arbitrary arbitrary - -instance Arbitrary LocalTime where - arbitrary = LocalTime - <$> arbitrary - <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60)) - -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)) - -#if MIN_VERSION_QuickCheck(2,10,0) --- This instance was removed in QuickCheck 2.10 because of dependencies. --- The instance is available in `quickcheck-instances` package, but that --- introduces a ton of conflicts with the other instances here. - -instance Arbitrary a => Arbitrary (NonEmpty a) where - arbitrary = liftA2 (:|) arbitrary arbitrary - shrink (x :| xs) = mapMaybe nonEmpty (shrink (x:xs)) -#endif - --}