diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +2.1.3 +----- + +* Add [`UUID`](http://hackage.haskell.org/package/uuid-types/docs/Data-UUID-Types.html#t:UUID) instances (see [#81](https://github.com/GetShopTV/swagger2/pull/81)). +* Add [`TypeError`](https://hackage.haskell.org/package/base-4.9.0.0/docs/GHC-TypeLits.html#g:4) `ToSchema` and `ToParamSchema ByteString` instances (see [#78](https://github.com/GetShopTV/swagger2/pull/78)) +* Improve documentation for generic sum type instance derivation (see [#75](https://github.com/GetShopTV/swagger2/pull/75)) +* Compile warning free (see [#82](https://github.com/GetShopTV/swagger2/pull/82)) + 2.1.2.1 ------- diff --git a/src/Data/Swagger.hs b/src/Data/Swagger.hs --- a/src/Data/Swagger.hs +++ b/src/Data/Swagger.hs @@ -272,6 +272,28 @@ -- "{\"age\":28,\"name\":\"David\"}" -- >>> encode $ toSchema (Proxy :: Proxy Person) -- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}" +-- +-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a +-- schema for basic enums like +-- +-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic +-- >>> instance ToSchema SampleEnum +-- >>> instance ToJSON SampleEnum +-- +-- and for sum types that have constructors with values +-- +-- >>> data SampleSumType = ChoiceInt Int | ChoiceString String deriving Generic +-- >>> instance ToSchema SampleSumType +-- >>> instance ToJSON SampleSumType +-- +-- we can not derive a valid schema for a mix of the above. The following will result in a bad schema +-- +-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic +-- >>> instance ToSchema BadMixedType +-- >>> instance ToJSON BadMixedType +-- +-- This is due to the fact that @'ToJSON'@ encodes empty constructors with an empty list which can not be described in a swagger schema. +-- -- $manipulation -- Sometimes you have to work with an imported or generated @'Swagger'@. diff --git a/src/Data/Swagger/Internal.hs b/src/Data/Swagger/Internal.hs --- a/src/Data/Swagger/Internal.hs +++ b/src/Data/Swagger/Internal.hs @@ -458,7 +458,7 @@ swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix -swaggerTypeDataType :: Data (SwaggerType t) => SwaggerType t -> DataType +swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs swaggerCommonTypes :: [SwaggerType k] @@ -605,7 +605,7 @@ , _paramSchemaMultipleOf :: Maybe Scientific } deriving (Eq, Show, Generic, Typeable) -deriving instance (Typeable k, Data (SwaggerKindType k), Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k) +deriving instance (Typeable k, Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k) data Xml = Xml { -- | Replaces the name of the element/attribute used for the described schema property. diff --git a/src/Data/Swagger/Internal/AesonUtils.hs b/src/Data/Swagger/Internal/AesonUtils.hs --- a/src/Data/Swagger/Internal/AesonUtils.hs +++ b/src/Data/Swagger/Internal/AesonUtils.hs @@ -101,8 +101,7 @@ -- * possible to merge sub-object sopSwaggerGenericToJSON :: forall a xs. - ( Generic a - , HasDatatypeInfo a + ( HasDatatypeInfo a , HasSwaggerAesonOptions a , All2 ToJSON (Code a) , All2 Eq (Code a) @@ -190,8 +189,7 @@ sopSwaggerGenericParseJSON :: forall a xs. - ( Generic a - , HasDatatypeInfo a + ( HasDatatypeInfo a , HasSwaggerAesonOptions a , All2 FromJSON (Code a) , All2 Eq (Code a) @@ -270,8 +268,7 @@ sopSwaggerGenericToEncoding :: forall a xs. - ( Generic a - , HasDatatypeInfo a + ( HasDatatypeInfo a , HasSwaggerAesonOptions a , All2 ToJSON (Code a) , All2 Eq (Code a) diff --git a/src/Data/Swagger/Internal/ParamSchema.hs b/src/Data/Swagger/Internal/ParamSchema.hs --- a/src/Data/Swagger/Internal/ParamSchema.hs +++ b/src/Data/Swagger/Internal/ParamSchema.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -7,8 +8,16 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ >= 800 +-- Generic a is redundant in ToParamSchema a default imple +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +-- For TypeErrors +{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} +#endif #include "overlapping-compat.h" module Data.Swagger.Internal.ParamSchema where @@ -30,11 +39,19 @@ import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU import Data.Word +import Data.UUID.Types (UUID) import Data.Swagger.Internal import Data.Swagger.Lens import Data.Swagger.SchemaOptions +#if __GLASGOW_HASKELL__ < 800 +#else +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import GHC.TypeLits (TypeError, ErrorMessage(..)) +#endif + -- | Default schema for binary data (any sequence of octets). binaryParamSchema :: ParamSchema t binaryParamSchema = mempty @@ -188,6 +205,18 @@ instance ToParamSchema TL.Text where toParamSchema _ = toParamSchema (Proxy :: Proxy String) +#if __GLASGOW_HASKELL__ < 800 +#else +type family ToParamSchemaByteStringError bs where + ToParamSchemaByteStringError bs = TypeError + ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "." + :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead." + :$$: 'Text "Consider using byteParamSchema or binaryParamSchema templates." ) + +instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible" +instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible" +#endif + instance ToParamSchema All where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool) instance ToParamSchema Any where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool) instance ToParamSchema a => ToParamSchema (Sum a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a) @@ -220,6 +249,11 @@ toParamSchema _ = mempty & type_ .~ SwaggerString & enum_ ?~ ["_"] + +instance ToParamSchema UUID where + toParamSchema _ = mempty + & type_ .~ SwaggerString + & format ?~ "uuid" -- | A configurable generic @'ParamSchema'@ creator. -- diff --git a/src/Data/Swagger/Internal/Schema.hs b/src/Data/Swagger/Internal/Schema.hs --- a/src/Data/Swagger/Internal/Schema.hs +++ b/src/Data/Swagger/Internal/Schema.hs @@ -13,6 +13,13 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ >= 800 +-- Few generics related redundant constraints +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +-- For TypeErrors +{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} +#endif #include "overlapping-compat.h" module Data.Swagger.Internal.Schema where @@ -22,20 +29,16 @@ import Control.Lens import Data.Data.Lens (template) -import Control.Applicative import Control.Monad import Control.Monad.Writer import Data.Aeson -import qualified Data.Aeson.Types as Aeson import Data.Char import Data.Data (Data) import Data.Foldable (traverse_) -import Data.Function (on) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import "unordered-containers" Data.HashSet (HashSet) import qualified "unordered-containers" Data.HashSet as HashSet -import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Int import Data.IntSet (IntSet) @@ -53,6 +56,7 @@ import qualified Data.Vector.Unboxed as VU import Data.Word import GHC.Generics +import qualified Data.UUID.Types as UUID import Data.Swagger.Declare import Data.Swagger.Internal @@ -65,6 +69,13 @@ import Data.Swagger.Lens (name, schema) #endif +#if __GLASGOW_HASKELL__ < 800 +#else +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import GHC.TypeLits (TypeError, ErrorMessage(..)) +#endif + unnamed :: Schema -> NamedSchema unnamed schema = NamedSchema Nothing schema @@ -317,11 +328,11 @@ sketch js@(Bool _) = go js sketch js = go js & example ?~ js - go Null = mempty & type_ .~ SwaggerNull - go js@(Bool _) = mempty & type_ .~ SwaggerBoolean - go js@(String s) = mempty & type_ .~ SwaggerString - go js@(Number n) = mempty & type_ .~ SwaggerNumber - go js@(Array xs) = mempty + go Null = mempty & type_ .~ SwaggerNull + go (Bool _) = mempty & type_ .~ SwaggerBoolean + go (String _) = mempty & type_ .~ SwaggerString + go (Number _) = mempty & type_ .~ SwaggerNumber + go (Array xs) = mempty & type_ .~ SwaggerArray & items ?~ case ischema of Just s -> SwaggerItemsObject (Inline s) @@ -331,9 +342,9 @@ allSame = and ((zipWith (==)) ys (tail ys)) ischema = case ys of - (z:zs) | allSame -> Just z - _ -> Nothing - go js@(Object o) = mempty + (z:_) | allSame -> Just z + _ -> Nothing + go (Object o) = mempty & type_ .~ SwaggerObject & required .~ HashMap.keys o & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o) @@ -433,6 +444,11 @@ instance ToSchema () where declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema) +-- | For 'ToJSON' instance, see package. +instance ToSchema UUID.UUID where + declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p + & example ?~ toJSON (UUID.toText UUID.nil) + instance (ToSchema a, ToSchema b) => ToSchema (a, b) instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) @@ -475,6 +491,18 @@ instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema +#if __GLASGOW_HASKELL__ < 800 +#else +type family ToSchemaByteStringError bs where + ToSchemaByteStringError bs = TypeError + ( Text "Impossible to have an instance " :<>: ShowType (ToSchema bs) :<>: Text "." + :$$: Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead." + :$$: Text "Consider using byteSchema or binarySchema templates." ) + +instance ToSchemaByteStringError BS.ByteString => ToSchema BS.ByteString where declareNamedSchema = error "impossible" +instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where declareNamedSchema = error "impossible" +#endif + instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int)) -- | NOTE: This schema does not account for the uniqueness of keys. @@ -643,7 +671,7 @@ return $ Ref (Reference name) _ -> Inline <$> gdeclareSchema opts proxy -appendItem :: Referenced Schema -> Maybe (SwaggerItems SwaggerKindSchema) -> Maybe (SwaggerItems SwaggerKindSchema) +appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema) appendItem x Nothing = Just (SwaggerItemsArray [x]) appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x])) appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject" diff --git a/src/Data/Swagger/Internal/Schema/Validation.hs b/src/Data/Swagger/Internal/Schema/Validation.hs --- a/src/Data/Swagger/Internal/Schema/Validation.hs +++ b/src/Data/Swagger/Internal/Schema/Validation.hs @@ -22,7 +22,6 @@ import Control.Applicative import Control.Lens -import Control.Lens.TH import Control.Monad (when) import Data.Aeson hiding (Result) @@ -30,7 +29,6 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import qualified "unordered-containers" Data.HashSet as HashSet -import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Monoid import Data.Proxy @@ -61,11 +59,12 @@ -- For validation without patterns see @'validateToJSON'@. validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError] -validateToJSONWithPatternChecker checker x = case runValidation (validateWithSchema js) cfg schema of +validateToJSONWithPatternChecker checker x = + case runValidation (validateWithSchema js) cfg sch of Failed xs -> xs Passed _ -> mempty where - (defs, schema) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty + (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty js = toJSON x cfg = defaultConfig { configPatternChecker = checker @@ -95,7 +94,7 @@ instance Monad Result where return = pure Passed x >>= f = f x - Failed xs >>= f = Failed xs + Failed xs >>= _ = Failed xs -- | Validation configuration. data Config = Config @@ -140,7 +139,7 @@ instance Monad (Validation s) where return = pure - Validation x >>= f = Validation (\c s -> x c s >>= \x -> runValidation (f x) c s) + Validation x >>= f = Validation (\c s -> x c s >>= \y -> runValidation (f y) c s) (>>) = (*>) withConfig :: (Config -> Validation s a) -> Validation s a @@ -160,8 +159,8 @@ -- | Validate schema's property given a lens into that property -- and property checker. check :: Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s () -check l g = withSchema $ \schema -> - case schema ^. l of +check l g = withSchema $ \sch -> + case sch ^. l of Nothing -> valid Just x -> g x @@ -181,7 +180,7 @@ Just s -> f s validateWithSchemaRef :: Referenced Schema -> Value -> Validation s () -validateWithSchemaRef (Ref ref) js = withRef ref $ \schema -> sub schema (validateWithSchema js) +validateWithSchemaRef (Ref ref) js = withRef ref $ \sch -> sub sch (validateWithSchema js) validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js) -- | Validate JSON @'Value'@ with Swagger @'Schema'@. @@ -203,9 +202,9 @@ validateNumber n validateNumber :: Scientific -> Validation (ParamSchema t) () -validateNumber n = withConfig $ \cfg -> withSchema $ \schema -> do - let exMax = Just True == schema ^. exclusiveMaximum - exMin = Just True == schema ^. exclusiveMinimum +validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do + let exMax = Just True == sch ^. exclusiveMaximum + exMin = Just True == sch ^. exclusiveMinimum check maximum_ $ \m -> when (if exMax then (n >= m) else (n > m)) $ @@ -262,8 +261,8 @@ allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs)) validateObject :: HashMap Text Value -> Validation Schema () -validateObject o = withSchema $ \schema -> - case schema ^. discriminator of +validateObject o = withSchema $ \sch -> + case sch ^. discriminator of Just pname -> case fromJSON <$> HashMap.lookup pname o of Just (Success ref) -> validateWithSchemaRef ref (Object o) Just (Error msg) -> invalid ("failed to parse discriminator property " ++ show pname ++ ": " ++ show msg) @@ -282,17 +281,17 @@ where size = fromIntegral (HashMap.size o) - validateRequired = withSchema $ \schema -> traverse_ validateReq (schema ^. required) - validateReq name = - when (not (HashMap.member name o)) $ - invalid ("property " ++ show name ++ " is required, but not found in " ++ show (encode o)) + validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required) + validateReq n = + when (not (HashMap.member n o)) $ + invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o)) - validateProps = withSchema $ \schema -> do + validateProps = withSchema $ \sch -> do for_ (HashMap.toList o) $ \(k, v) -> case v of - Null | not (k `elem` (schema ^. required)) -> valid -- null is fine for non-required property + Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property _ -> - case InsOrdHashMap.lookup k (schema ^. properties) of + case InsOrdHashMap.lookup k (sch ^. properties) of Nothing -> check additionalProperties $ \s -> validateWithSchemaRef s v Just s -> validateWithSchemaRef s v @@ -303,8 +302,8 @@ invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value) validateSchemaType :: Value -> Validation Schema () -validateSchemaType value = withSchema $ \schema -> - case (schema ^. type_, value) of +validateSchemaType value = withSchema $ \sch -> + case (sch ^. type_, value) of (SwaggerNull, Null) -> valid (SwaggerBoolean, Bool _) -> valid (SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n) @@ -315,8 +314,8 @@ (t, _) -> invalid $ "expected JSON value of type " ++ show t validateParamSchemaType :: Value -> Validation (ParamSchema t) () -validateParamSchemaType value = withSchema $ \schema -> - case (schema ^. type_, value) of +validateParamSchemaType value = withSchema $ \sch -> + case (sch ^. type_, value) of (SwaggerBoolean, Bool _) -> valid (SwaggerInteger, Number n) -> validateInteger n (SwaggerNumber, Number n) -> validateNumber n diff --git a/src/Data/Swagger/Lens.hs b/src/Data/Swagger/Lens.hs --- a/src/Data/Swagger/Lens.hs +++ b/src/Data/Swagger/Lens.hs @@ -62,17 +62,21 @@ _SwaggerItemsArray :: Review (SwaggerItems 'SwaggerKindSchema) [Referenced Schema] _SwaggerItemsArray - = prism (\x -> SwaggerItemsArray x) $ \x -> case x of + = unto (\x -> SwaggerItemsArray x) +{- \x -> case x of SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p) SwaggerItemsObject o -> Left (SwaggerItemsObject o) SwaggerItemsArray a -> Right a +-} _SwaggerItemsObject :: Review (SwaggerItems 'SwaggerKindSchema) (Referenced Schema) _SwaggerItemsObject - = prism (\x -> SwaggerItemsObject x) $ \x -> case x of + = unto (\x -> SwaggerItemsObject x) +{- \x -> case x of SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p) SwaggerItemsObject o -> Right o SwaggerItemsArray a -> Left (SwaggerItemsArray a) +-} _SwaggerItemsPrimitive :: forall t p f. (Profunctor p, Bifunctor p, Functor f) => Optic' p f (SwaggerItems t) (Maybe (CollectionFormat t), ParamSchema t) _SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p) diff --git a/src/Data/Swagger/Operation.hs b/src/Data/Swagger/Operation.hs --- a/src/Data/Swagger/Operation.hs +++ b/src/Data/Swagger/Operation.hs @@ -30,23 +30,21 @@ declareResponse, ) where -import Control.Applicative -import Control.Arrow +import Prelude () +import Prelude.Compat + import Control.Lens import Data.Data.Lens -import qualified Data.HashMap.Strict as HashMap -import Data.List +import Data.List.Compat import Data.Maybe (mapMaybe) import Data.Monoid import qualified Data.Set as Set -import Data.Traversable import Data.Swagger.Declare import Data.Swagger.Internal import Data.Swagger.Lens import Data.Swagger.Schema -import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap -- $setup @@ -187,7 +185,7 @@ where (defs, new) = runDeclare dres mempty - combine (Just (Ref (Reference name))) = case swag ^. responses.at name of + combine (Just (Ref (Reference n))) = case swag ^. responses.at n of Just old -> f old new Nothing -> new -- response name can't be dereferenced, replacing with new response combine (Just (Inline old)) = f old new diff --git a/swagger2.cabal b/swagger2.cabal --- a/swagger2.cabal +++ b/swagger2.cabal @@ -1,5 +1,5 @@ name: swagger2 -version: 2.1.2.1 +version: 2.1.3 synopsis: Swagger 2.0 data model description: Please see README.md homepage: https://github.com/GetShopTV/swagger2 @@ -40,8 +40,9 @@ Data.Swagger.Internal.Utils Data.Swagger.Internal.AesonUtils build-depends: base >=4.7 && <4.10 - , base-compat >=0.6.0 && <0.10 - , aeson + , base-compat >=0.9.1 && <0.10 + , aeson >=0.11.2.1 + , bytestring , containers , hashable , generics-sop >=0.2 && <0.3 @@ -57,6 +58,7 @@ , transformers , unordered-containers , vector + , uuid-types >=1.0.2 && <1.1 default-language: Haskell2010 test-suite spec @@ -75,7 +77,7 @@ , insert-ordered-containers , HUnit , mtl - , QuickCheck + , QuickCheck >=2.8.2 , swagger2 , text , time diff --git a/test/Data/Swagger/ParamSchemaSpec.hs b/test/Data/Swagger/ParamSchemaSpec.hs --- a/test/Data/Swagger/ParamSchemaSpec.hs +++ b/test/Data/Swagger/ParamSchemaSpec.hs @@ -18,7 +18,7 @@ import Test.Hspec checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec -checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema (SwaggerKindNormal Param)) <=> js +checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js spec :: Spec spec = do diff --git a/test/Data/Swagger/Schema/ValidationSpec.hs b/test/Data/Swagger/Schema/ValidationSpec.hs --- a/test/Data/Swagger/Schema/ValidationSpec.hs +++ b/test/Data/Swagger/Schema/ValidationSpec.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PackageImports #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Swagger.Schema.ValidationSpec where import Control.Applicative @@ -8,29 +9,22 @@ import Data.Aeson.Types import Data.Int import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap -import Data.IntSet (IntSet) import Data.Hashable (Hashable) 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.Map (Map) -import qualified Data.Map as Map import Data.Proxy import Data.Time import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Set (Set) -import qualified Data.Set as Set import Data.Word import GHC.Generics import Data.Swagger -import Data.Swagger.Declare -import Data.Swagger.Schema.Validation -import SpecCommon import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck @@ -167,18 +161,6 @@ ] -- Arbitrary instances for common types - -#if MIN_VERSION_QuickCheck(2,8,2) -#else -instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where - arbitrary = Map.fromList <$> arbitrary - -instance Arbitrary a => Arbitrary (IntMap a) where - arbitrary = IntMap.fromList <$> arbitrary - -instance (Ord a, Arbitrary a) => Arbitrary (Set a) where - arbitrary = Set.fromList <$> arbitrary -#endif instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where arbitrary = HashMap.fromList <$> arbitrary diff --git a/test/Data/Swagger/SchemaSpec.hs b/test/Data/Swagger/SchemaSpec.hs --- a/test/Data/Swagger/SchemaSpec.hs +++ b/test/Data/Swagger/SchemaSpec.hs @@ -11,11 +11,9 @@ import Data.Aeson import Data.Aeson.QQ import Data.Char -import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Proxy import Data.Set (Set) -import qualified Data.Set as Set import qualified Data.Text as Text import GHC.Generics