29d2ec5 · typeable/swagger2

git.iko.soy/typeable/swagger2

Backport to GHC7.8

commit29d2ec5fb51027a7a717ff0dc0df09e3b370c669 authorOleg Grenrus <oleg.grenrus@iki.fi> dateSun 31 Jan 2016, 12:56 (11 years ago) parent74f1aad

15 files changed+164−87

compare with master

unifiedsplit

.travis.yml+3 include/overlapping-compat.h+8 src/Data/Swagger/Declare.hs+8−5 src/Data/Swagger/Internal.hs+22−15 src/Data/Swagger/Internal/ParamSchema.hs+3−1 src/Data/Swagger/Internal/Schema.hs+19−11 src/Data/Swagger/Internal/Utils.hs+4−1 src/Data/Swagger/Lens.hs+29−14 stack-lts-2.yaml+5 stack.yaml+2−2 swagger2.cabal+8−3 test/Data/Swagger/ParamSchemaSpec.hs+8−6 test/Data/Swagger/SchemaSpec.hs+36−20 test/Data/SwaggerSpec.hs+7−8 test/DocTest.hs+2−1

.travis.yml+3

@@ -13,6 +13,9 @@ before_cache:

1313

1414matrix:

1515 include:

16+ - env: CABALVER=1.18 GHCVER=7.8.4

17+ compiler: ": #GHC 7.8.4"

18+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5], sources: [hvr-ghc]}}

1619 - env: CABALVER=1.22 GHCVER=7.10.3

1720 compiler: ": #GHC 7.10.3"

1821 addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5], sources: [hvr-ghc]}}

include/overlapping-compat.hnew file+8

@@ -0,0 +1,8 @@

1+#if __GLASGOW_HASKELL__ >= 710

2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}

3+#define OVERLAPPING_ {-# OVERLAPPING #-}

4+#else

5+{-# LANGUAGE OverlappingInstances #-}

6+#define OVERLAPPABLE_

7+#define OVERLAPPING_

8+#endif

src/Data/Swagger/Declare.hs+8−5

@@ -4,6 +4,9 @@

44{-# LANGUAGE MultiParamTypeClasses #-}

55module Data.Swagger.Declare where

7+import Prelude ()

8+import Prelude.Compat

710import Control.Monad

811import Control.Monad.Trans

912import Data.Functor.Identity

@@ -24,14 +27,14 @@ import Data.Monoid

2427newtype DeclareT d m a = DeclareT { runDeclareT :: d -> m (d, a) }

2528 deriving (Functor)

2629

27−instance (Monad m, Monoid d) => Applicative (DeclareT d m) where

30+instance (Applicative m, Monad m, Monoid d) => Applicative (DeclareT d m) where

2831 pure x = DeclareT (\_ -> pure (mempty, x))

2932 DeclareT df <*> DeclareT dx = DeclareT $ \d -> do

3033 ~(d', f) <- df d

3134 ~(d'', x) <- dx (d <> d')

3235 return (d' <> d'', f x)

3336

34−instance (Monad m, Monoid d) => Monad (DeclareT d m) where

37+instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where

3538 return x = DeclareT (\_ -> pure (mempty, x))

3639 DeclareT dx >>= f = DeclareT $ \d -> do

3740 ~(d', x) <- dx d

@@ -39,7 +42,7 @@ instance (Monad m, Monoid d) => Monad (DeclareT d m) where

3942 return (d' <> d'', y)

4043

4144instance Monoid d => MonadTrans (DeclareT d) where

42− lift m = DeclareT (\_ -> (,) mempty <$> m)

45+ lift m = DeclareT (\_ -> (,) mempty `liftM` m)

4346

4447-- |

4548-- Definitions of @declare@ and @look@ must satisfy the following laws:

@@ -58,13 +61,13 @@ instance Monoid d => MonadTrans (DeclareT d) where

5861-- [/@look@ as left identity/]

5962-- @'look' >> m == m@

6063-- for every @m@

61−class Monad m => MonadDeclare d m | m -> d where

64+class (Applicative m, Monad m) => MonadDeclare d m | m -> d where

6265 -- | @'declare' x@ is an action that produces the output @x@.

6366 declare :: d -> m ()

6467 -- | @'look'@ is an action that returns all the output so far.

6568 look :: m d

6669

67−instance (Monad m, Monoid d) => MonadDeclare d (DeclareT d m) where

70+instance (Applicative m, Monad m, Monoid d) => MonadDeclare d (DeclareT d m) where

6871 declare d = DeclareT (\_ -> return (d, ()))

6972 look = DeclareT (\d -> return (mempty, d))

7073

src/Data/Swagger/Internal.hs+22−15

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DeriveDataTypeable #-}

23{-# LANGUAGE DeriveGeneric #-}

34{-# LANGUAGE DeriveTraversable #-}

@@ -10,8 +11,12 @@

1011{-# LANGUAGE ScopedTypeVariables #-}

1112{-# LANGUAGE StandaloneDeriving #-}

1213{-# LANGUAGE UndecidableInstances #-}

14+#include "overlapping-compat.h"

1315module Data.Swagger.Internal where

1416

17+import Prelude ()

18+import Prelude.Compat

19+

1520import Control.Applicative

1621import Control.Monad

1722import Data.Aeson

@@ -334,10 +339,11 @@ data SwaggerItems t where

334339 SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t

335340 SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema

336341 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema

342+ deriving (Typeable)

337343

338344deriving instance Eq (SwaggerItems t)

339345deriving instance Show (SwaggerItems t)

340−deriving instance Typeable (SwaggerItems t)

346+--deriving instance Typeable (SwaggerItems t)

341347

342348swaggerItemsPrimitiveConstr :: Constr

343349swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix

@@ -345,7 +351,7 @@ swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimiti

345351swaggerItemsDataType :: DataType

346352swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]

347353

348−instance {-# OVERLAPPABLE #-} Data t => Data (SwaggerItems t) where

354+instance OVERLAPPABLE_ Data t => Data (SwaggerItems t) where

349355 gunfold k z c = case constrIndex c of

350356 1 -> k (k (z SwaggerItemsPrimitive))

351357 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."

@@ -363,10 +369,10 @@ data SwaggerType t where

363369 SwaggerFile :: SwaggerType ParamOtherSchema

364370 SwaggerNull :: SwaggerType Schema

365371 SwaggerObject :: SwaggerType Schema

372+ deriving (Typeable)

366373

367374deriving instance Eq (SwaggerType t)

368375deriving instance Show (SwaggerType t)

369−deriving instance Typeable (SwaggerType t)

370376

371377swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr

372378swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix

@@ -387,17 +393,17 @@ swaggerTypeConstrs :: [Constr]

387393swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])

388394 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]

389395

390−instance {-# OVERLAPPABLE #-} Typeable t => Data (SwaggerType t) where

396+instance OVERLAPPABLE_ Typeable t => Data (SwaggerType t) where

391397 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes

392398 toConstr = swaggerTypeConstr

393399 dataTypeOf = swaggerTypeDataType

394400

395−instance {-# OVERLAPPING #-} Data (SwaggerType ParamOtherSchema) where

401+instance OVERLAPPABLE_ Data (SwaggerType ParamOtherSchema) where

396402 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes

397403 toConstr = swaggerTypeConstr

398404 dataTypeOf = swaggerTypeDataType

399405

400−instance {-# OVERLAPPING #-} Data (SwaggerType Schema) where

406+instance OVERLAPPABLE_ Data (SwaggerType Schema) where

401407 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes

402408 toConstr = swaggerTypeConstr

403409 dataTypeOf = swaggerTypeDataType

@@ -438,10 +444,10 @@ data CollectionFormat t where

438444 -- instead of multiple values for a single instance @foo=bar&foo=baz@.

439445 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.

440446 CollectionMulti :: CollectionFormat ParamOtherSchema

447+ deriving (Typeable)

441448

442449deriving instance Eq (CollectionFormat t)

443450deriving instance Show (CollectionFormat t)

444−deriving instance Typeable (CollectionFormat t)

445451

446452collectionFormatConstr :: CollectionFormat t -> Constr

447453collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix

@@ -453,12 +459,12 @@ collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $

453459collectionCommonFormats :: [CollectionFormat t]

454460collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]

455461

456−instance {-# OVERLAPPABLE #-} Data t => Data (CollectionFormat t) where

462+instance OVERLAPPABLE_ Data t => Data (CollectionFormat t) where

457463 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats

458464 toConstr = collectionFormatConstr

459465 dataTypeOf _ = collectionFormatDataType

460466

461−deriving instance {-# OVERLAPPING #-} Data (CollectionFormat ParamOtherSchema)

467+deriving instance OVERLAPPABLE_ Data (CollectionFormat ParamOtherSchema)

462468

463469type ParamName = Text

464470

@@ -788,7 +794,7 @@ instance SwaggerMonoid ParamLocation where

788794 swaggerMempty = ParamQuery

789795 swaggerMappend _ y = y

790796

791−instance SwaggerMonoid (HashMap FilePath PathItem) where

797+instance OVERLAPPING_ SwaggerMonoid (HashMap FilePath PathItem) where

792798 swaggerMempty = HashMap.empty

793799 swaggerMappend = HashMap.unionWith mappend

794800

@@ -1051,12 +1057,12 @@ instance FromJSON Schema where

10511057instance FromJSON Header where

10521058 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")

10531059

1054−instance {-# OVERLAPPABLE #-} (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where

1055− parseJSON (Object o) = SwaggerItemsPrimitive

1060+instance OVERLAPPABLE_ (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where

1061+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive

10561062 <$> o .:? "collectionFormat"

10571063 <*> (o .: "items" >>= parseJSON)

10581064

1059−instance {-# OVERLAPPING #-} FromJSON (SwaggerItems Schema) where

1065+instance OVERLAPPABLE_ FromJSON (SwaggerItems Schema) where

10601066 parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js

10611067 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js

10621068 parseJSON _ = empty

@@ -1128,6 +1134,7 @@ referencedParseJSON prefix js@(Object o) = do

11281134 case Text.stripPrefix prefix s of

11291135 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s

11301136 Just suffix -> pure (Reference suffix)

1137+referencedParseJSON _ _ = fail "referenceParseJSON: not an object"

11311138

11321139instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"

11331140instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"

@@ -1142,10 +1149,10 @@ instance FromJSON (SwaggerType Schema) where

11421149instance FromJSON (SwaggerType ParamOtherSchema) where

11431150 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]

11441151

1145−instance {-# OVERLAPPABLE #-} FromJSON (SwaggerType t) where

1152+instance OVERLAPPABLE_ FromJSON (SwaggerType t) where

11461153 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]

11471154

1148−instance {-# OVERLAPPABLE #-} FromJSON (CollectionFormat t) where

1155+instance OVERLAPPABLE_ FromJSON (CollectionFormat t) where

11491156 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]

11501157

11511158instance FromJSON (CollectionFormat ParamOtherSchema) where

src/Data/Swagger/Internal/ParamSchema.hs+3−1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DefaultSignatures #-}

23{-# LANGUAGE FlexibleContexts #-}

34{-# LANGUAGE FlexibleInstances #-}

@@ -8,6 +9,7 @@

89{-# LANGUAGE ScopedTypeVariables #-}

910{-# LANGUAGE TypeOperators #-}

1011{-# LANGUAGE TypeSynonymInstances #-}

12+#include "overlapping-compat.h"

1113module Data.Swagger.Internal.ParamSchema where

1214

1315import Control.Lens

@@ -73,7 +75,7 @@ class ToParamSchema a where

7375 default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamSchema t

7476 toParamSchema = genericToParamSchema defaultSchemaOptions

7577

76−instance {-# OVERLAPPING #-} ToParamSchema String where

78+instance OVERLAPPING_ ToParamSchema String where

7779 toParamSchema _ = mempty & type_ .~ SwaggerString

7880

7981instance ToParamSchema Bool where

src/Data/Swagger/Internal/Schema.hs+19−11

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DefaultSignatures #-}

23{-# LANGUAGE FlexibleContexts #-}

34{-# LANGUAGE FlexibleInstances #-}

@@ -11,8 +12,12 @@

1112{-# LANGUAGE TypeFamilies #-}

1213{-# LANGUAGE TypeOperators #-}

1314{-# LANGUAGE TypeSynonymInstances #-}

15+#include "overlapping-compat.h"

1416module Data.Swagger.Internal.Schema where

1517

18+import Prelude ()

19+import Prelude.Compat

20+

1621import Control.Lens

1722import Data.Data.Lens (template)

1823

@@ -29,7 +34,6 @@ import Data.Int

2934import Data.IntSet (IntSet)

3035import Data.IntMap (IntMap)

3136import Data.Map (Map)

32−import Data.Monoid

3337import Data.Proxy

3438import Data.Scientific (Scientific)

3539import Data.Set (Set)

@@ -42,9 +46,13 @@ import GHC.Generics

4246import Data.Swagger.Declare

4347import Data.Swagger.Internal

4448import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))

45−import Data.Swagger.Lens

49+import Data.Swagger.Lens hiding (name, schema)

4650import Data.Swagger.SchemaOptions

4751

52+#ifdef __DOCTEST__

53+import Data.Swagger.Lens (name, schema)

54+#endif

55+

4856unnamed :: Schema -> NamedSchema

4957unnamed schema = NamedSchema Nothing schema

5058

@@ -258,14 +266,14 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

258266class GToSchema (f :: * -> *) where

259267 gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

260268

261−instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where

269+instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where

262270 declareNamedSchema _ = do

263271 ref <- declareSchemaRef (Proxy :: Proxy a)

264272 return $ unnamed $ mempty

265273 & type_ .~ SwaggerArray

266274 & items ?~ SwaggerItemsObject ref

267275

268−instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema

276+instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema

269277instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema

270278instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema

271279instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema

@@ -434,10 +442,10 @@ instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where

434442 where

435443 name = gdatatypeSchemaName opts (Proxy :: Proxy d)

436444

437−instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where

445+instance OVERLAPPABLE_ GToSchema f => GToSchema (C1 c f) where

438446 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)

439447

440−instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where

448+instance OVERLAPPING_ Constructor c => GToSchema (C1 c U1) where

441449 gdeclareNamedSchema = gdeclareNamedSumSchema

442450

443451-- | Single field constructor.

@@ -498,17 +506,17 @@ withFieldSchema opts _ isRequiredField schema = do

498506 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))

499507

500508-- | Optional record fields.

501−instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where

509+instance OVERLAPPING_ (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where

502510 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False

503511

504512-- | Record fields.

505−instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where

513+instance OVERLAPPABLE_ (Selector s, GToSchema f) => GToSchema (S1 s f) where

506514 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True

507515

508−instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where

516+instance OVERLAPPING_ ToSchema c => GToSchema (K1 i (Maybe c)) where

509517 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)

510518

511−instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where

519+instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where

512520 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)

513521

514522instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where

@@ -550,7 +558,7 @@ gsumConToSchema opts proxy schema = do

550558 ref <- gdeclareSchemaRef opts proxy

551559 return $ gsumConToSchemaWith ref opts proxy schema

552560

553−instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where

561+instance OVERLAPPABLE_ (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where

554562 gsumToSchema opts proxy schema = do

555563 tell (All False)

556564 lift $ gsumConToSchema opts proxy schema

src/Data/Swagger/Internal/Utils.hs+4−1

@@ -6,6 +6,9 @@

66{-# LANGUAGE TypeOperators #-}

77module Data.Swagger.Internal.Utils where

9+import Prelude ()

10+import Prelude.Compat

11+

912import Control.Arrow (first)

1013import Control.Applicative

1114import Control.Lens ((&), (%~))

@@ -151,7 +154,7 @@ class SwaggerMonoid m where

151154instance SwaggerMonoid [a]

152155instance Ord k => SwaggerMonoid (Map k v)

153156

154−instance {-# OVERLAPPABLE #-} (Eq k, Hashable k) => SwaggerMonoid (HashMap k v) where

157+instance (Eq k, Hashable k) => SwaggerMonoid (HashMap k v) where

155158 swaggerMempty = mempty

156159 swaggerMappend = HashMap.unionWith (\_old new -> new)

157160

src/Data/Swagger/Lens.hs+29−14

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE FlexibleContexts #-}

23{-# LANGUAGE FlexibleInstances #-}

34{-# LANGUAGE FunctionalDependencies #-}

@@ -7,6 +8,8 @@

78{-# LANGUAGE TemplateHaskell #-}

89{-# LANGUAGE TypeFamilies #-}

910{-# LANGUAGE UndecidableInstances #-}

11+{-# OPTIONS_GHC -fno-warn-orphans #-}

12+#include "overlapping-compat.h"

1013module Data.Swagger.Lens where

1114

1215import Control.Lens

@@ -93,58 +96,70 @@ instance HasDefault ParamOtherSchema (Maybe Value) where default_ = paramSchema.

9396

9497-- OVERLAPPABLE instances

9598

96−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

99+instance

100+#if __GLASGOW_HASKELL__ >= 710

101+ OVERLAPPABLE_

102+#endif

103+ HasParamSchema s (ParamSchema t)

97104 => HasFormat s (Maybe Format) where

98105 format = paramSchema.format

99106

100−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

107+instance

108+#if __GLASGOW_HASKELL__ >= 710

109+ OVERLAPPABLE_

110+#endif

111+ HasParamSchema s (ParamSchema t)

101112 => HasItems s (Maybe (SwaggerItems t)) where

102113 items = paramSchema.items

103114

104−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

115+instance

116+#if __GLASGOW_HASKELL__ >= 710

117+ OVERLAPPABLE_

118+#endif

119+ HasParamSchema s (ParamSchema t)

105120 => HasMaximum s (Maybe Scientific) where

106121 maximum_ = paramSchema.maximum_

107122

108−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

123+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

109124 => HasExclusiveMaximum s (Maybe Bool) where

110125 exclusiveMaximum = paramSchema.exclusiveMaximum

111126

112−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

127+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

113128 => HasMinimum s (Maybe Scientific) where

114129 minimum_ = paramSchema.minimum_

115130

116−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

131+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

117132 => HasExclusiveMinimum s (Maybe Bool) where

118133 exclusiveMinimum = paramSchema.exclusiveMinimum

119134

120−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

135+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

121136 => HasMaxLength s (Maybe Integer) where

122137 maxLength = paramSchema.maxLength

123138

124−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

139+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

125140 => HasMinLength s (Maybe Integer) where

126141 minLength = paramSchema.minLength

127142

128−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

143+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

129144 => HasPattern s (Maybe Text) where

130145 pattern = paramSchema.pattern

131146

132−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

147+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

133148 => HasMaxItems s (Maybe Integer) where

134149 maxItems = paramSchema.maxItems

135150

136−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

151+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

137152 => HasMinItems s (Maybe Integer) where

138153 minItems = paramSchema.minItems

139154

140−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

155+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

141156 => HasUniqueItems s (Maybe Bool) where

142157 uniqueItems = paramSchema.uniqueItems

143158

144−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

159+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

145160 => HasEnum s (Maybe [Value]) where

146161 enum_ = paramSchema.enum_

147162

148−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

163+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)

149164 => HasMultipleOf s (Maybe Scientific) where

150165 multipleOf = paramSchema.multipleOf

stack-lts-2.yamlnew file+5

@@ -0,0 +1,5 @@

1+flags: {}

2+packages:

3+- '.'

4+extra-deps: []

5+resolver: lts-2.22

stack.yaml+2−2

@@ -1,5 +1,5 @@

11flags: {}

22packages:

33- '.'

4−extra-deps:

5−resolver: lts-3.12

4+extra-deps: []

5+resolver: lts-3.22

swagger2.cabal+8−3

@@ -15,11 +15,13 @@ extra-source-files:

1515 README.md

1616 , CHANGELOG.md

1717 , examples/*.hs

18+ , include/overlapping-compat.h

1819cabal-version: >=1.10

19−tested-with: GHC==7.10.3

20+tested-with: GHC==7.8.4, GHC==7.10.3

2021

2122library

2223 hs-source-dirs: src

24+ include-dirs: include

2325 exposed-modules:

2426 Data.Swagger

2527 Data.Swagger.Declare

@@ -33,7 +35,8 @@ library

3335 Data.Swagger.Internal.Schema

3436 Data.Swagger.Internal.ParamSchema

3537 Data.Swagger.Internal.Utils

36− build-depends: base >=4.8 && <4.10

38+ build-depends: base >=4.7 && <4.10

39+ , base-compat >=0.6.0 && <0.10

3740 , aeson

3841 , containers

3942 , hashable

@@ -43,6 +46,7 @@ library

4346 , text

4447 , template-haskell

4548 , time

49+ , transformers

4650 , unordered-containers

4751 , lens

4852 , scientific

@@ -52,7 +56,8 @@ test-suite spec

5256 type: exitcode-stdio-1.0

5357 hs-source-dirs: test

5458 main-is: Spec.hs

55− build-depends: base == 4.*

59+ build-depends: base

60+ , base-compat

5661 , swagger2

5762 , hspec

5863 , HUnit

test/Data/Swagger/ParamSchemaSpec.hs+8−6

@@ -1,5 +1,4 @@

11{-# LANGUAGE DeriveGeneric #-}

2−{-# LANGUAGE DeriveAnyClass #-}

32{-# LANGUAGE ScopedTypeVariables #-}

43{-# LANGUAGE TemplateHaskell #-}

54{-# LANGUAGE QuasiQuotes #-}

@@ -9,7 +8,6 @@ import Data.Aeson

98import Data.Aeson.QQ

109import Data.Char

1110import Data.Proxy

12−import Data.Set (Set)

1311import GHC.Generics

1412

1513import Data.Swagger

@@ -37,7 +35,8 @@ main = hspec spec

3735-- Unit type

3836-- ========================================================================

3937

40−data Unit = Unit deriving (Generic, ToParamSchema)

38+data Unit = Unit deriving (Generic)

39+instance ToParamSchema Unit

4140

4241unitSchemaJSON :: Value

4342unitSchemaJSON = [aesonQQ|

@@ -54,7 +53,8 @@ data Color

5453 = Red

5554 | Green

5655 | Blue

57− deriving (Generic, ToParamSchema)

56+ deriving (Generic)

57+instance ToParamSchema Color

5858

5959colorSchemaJSON :: Value

6060colorSchemaJSON = [aesonQQ|

@@ -87,7 +87,8 @@ statusSchemaJSON = [aesonQQ|

8787-- ========================================================================

8888

8989newtype Email = Email { getEmail :: String }

90− deriving (Generic, ToParamSchema)

90+ deriving (Generic)

91+instance ToParamSchema Email

9192

9293emailSchemaJSON :: Value

9394emailSchemaJSON = [aesonQQ|

@@ -101,7 +102,8 @@ emailSchemaJSON = [aesonQQ|

101102-- ========================================================================

102103

103104newtype UserId = UserId Integer

104− deriving (Generic, ToParamSchema)

105+ deriving (Generic)

106+instance ToParamSchema UserId

105107

106108userIdSchemaJSON :: Value

107109userIdSchemaJSON = [aesonQQ|

test/Data/Swagger/SchemaSpec.hs+36−20

@@ -1,10 +1,12 @@

11{-# LANGUAGE DeriveGeneric #-}

2−{-# LANGUAGE DeriveAnyClass #-}

32{-# LANGUAGE ScopedTypeVariables #-}

43{-# LANGUAGE TemplateHaskell #-}

54{-# LANGUAGE QuasiQuotes #-}

65module Data.Swagger.SchemaSpec where

7+import Prelude ()

8+import Prelude.Compat

810import Data.Aeson

911import Data.Aeson.QQ

1012import Data.Char

@@ -12,7 +14,6 @@ import qualified Data.HashMap.Strict as HashMap

1214import Data.Proxy

1315import Data.Set (Set)

1416import qualified Data.Set as Set

15−import Data.Text (Text)

1617import qualified Data.Text as Text

1718import GHC.Generics

1819

@@ -41,14 +42,14 @@ checkInlinedSchema :: ToSchema a => Proxy a -> Value -> Spec

4142checkInlinedSchema proxy js = toInlinedSchema proxy <=> js

4243

4344checkInlinedSchemas :: ToSchema a => [String] -> Proxy a -> Value -> Spec

44−checkInlinedSchemas names proxy js = inlineSchemas (map Text.pack names) defs schema <=> js

45+checkInlinedSchemas names proxy js = inlineSchemas (map Text.pack names) defs s <=> js

4546 where

46− (defs, schema) = runDeclare (declareSchema proxy) mempty

47+ (defs, s) = runDeclare (declareSchema proxy) mempty

4748

4849checkInlinedRecSchema :: ToSchema a => Proxy a -> Value -> Spec

49−checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs schema <=> js

50+checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js

5051 where

51− (defs, schema) = runDeclare (declareSchema proxy) mempty

52+ (defs, s) = runDeclare (declareSchema proxy) mempty

5253

5354spec :: Spec

5455spec = do

@@ -101,7 +102,9 @@ data Person = Person

101102 { name :: String

102103 , phone :: Integer

103104 , email :: Maybe String

104− } deriving (Generic, ToSchema)

105+ } deriving (Generic)

106+

107+instance ToSchema Person

105108

106109personSchemaJSON :: Value

107110personSchemaJSON = [aesonQQ|

@@ -121,7 +124,9 @@ personSchemaJSON = [aesonQQ|

121124-- ISPair (non-record product data type)

122125-- ========================================================================

123126data ISPair = ISPair Integer String

124− deriving (Generic, ToSchema)

127+ deriving (Generic)

128+

129+instance ToSchema ISPair

125130

126131ispairSchemaJSON :: Value

127132ispairSchemaJSON = [aesonQQ|

@@ -168,7 +173,8 @@ data Color

168173 = Red

169174 | Green

170175 | Blue

171− deriving (Generic, ToSchema)

176+ deriving (Generic)

177+instance ToSchema Color

172178

173179colorSchemaJSON :: Value

174180colorSchemaJSON = [aesonQQ|

@@ -182,7 +188,8 @@ colorSchemaJSON = [aesonQQ|

182188-- Shade (paramSchemaToNamedSchema)

183189-- ========================================================================

184190

185−data Shade = Dim | Bright deriving (Generic, ToParamSchema)

191+data Shade = Dim | Bright deriving (Generic)

192+instance ToParamSchema Shade

186193

187194instance ToSchema Shade where declareNamedSchema = pure . paramSchemaToNamedSchema defaultSchemaOptions

188195

@@ -199,7 +206,8 @@ shadeSchemaJSON = [aesonQQ|

199206-- ========================================================================

200207

201208newtype Paint = Paint { color :: Color }

202− deriving (Generic, ToSchema)

209+ deriving (Generic)

210+instance ToSchema Paint

203211

204212paintSchemaJSON :: Value

205213paintSchemaJSON = [aesonQQ|

@@ -255,7 +263,8 @@ emailSchemaJSON = [aesonQQ|

255263-- ========================================================================

256264

257265newtype UserId = UserId Integer

258− deriving (Eq, Ord, Generic, ToSchema)

266+ deriving (Eq, Ord, Generic)

267+instance ToSchema UserId

259268

260269userIdSchemaJSON :: Value

261270userIdSchemaJSON = [aesonQQ|

@@ -269,7 +278,8 @@ userIdSchemaJSON = [aesonQQ|

269278-- ========================================================================

270279

271280newtype UserGroup = UserGroup (Set UserId)

272− deriving (Generic, ToSchema)

281+ deriving (Generic)

282+instance ToSchema UserGroup

273283

274284userGroupSchemaJSON :: Value

275285userGroupSchemaJSON = [aesonQQ|

@@ -286,7 +296,8 @@ userGroupSchemaJSON = [aesonQQ|

286296

287297newtype Player = Player

288298 { position :: Point

289− } deriving (Generic, ToSchema)

299+ } deriving (Generic)

300+instance ToSchema Player

290301

291302playerSchemaJSON :: Value

292303playerSchemaJSON = [aesonQQ|

@@ -345,10 +356,11 @@ newtype Inlined a = Inlined { getInlined :: a }

345356instance ToSchema a => ToSchema (Inlined a) where

346357 declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)

347358 where

348− unname (NamedSchema _ schema) = NamedSchema Nothing schema

359+ unname (NamedSchema _ s) = NamedSchema Nothing s

349360

350361newtype Players = Players [Inlined Player]

351− deriving (Generic, ToSchema)

362+ deriving (Generic)

363+instance ToSchema Players

352364

353365playersSchemaJSON :: Value

354366playersSchemaJSON = [aesonQQ|

@@ -400,7 +412,8 @@ statusSchemaJSON = [aesonQQ|

400412-- Unit type

401413-- ========================================================================

402414

403−data Unit = Unit deriving (Generic, ToSchema)

415+data Unit = Unit deriving (Generic)

416+instance ToSchema Unit

404417

405418unitSchemaJSON :: Value

406419unitSchemaJSON = [aesonQQ|

@@ -418,7 +431,8 @@ unitSchemaJSON = [aesonQQ|

418431data Character

419432 = PC Player

420433 | NPC { npcName :: String, npcPosition :: Point }

421− deriving (Generic, ToSchema)

434+ deriving (Generic)

435+instance ToSchema Character

422436

423437characterSchemaJSON :: Value

424438characterSchemaJSON = [aesonQQ|

@@ -581,6 +595,8 @@ lightInlinedSchemaJSON = [aesonQQ|

581595-- ResourceId (series of newtypes)

582596-- ========================================================================

583597

584−newtype Id = Id String deriving (Generic, ToSchema)

598+newtype Id = Id String deriving (Generic)

599+instance ToSchema Id

585600

586−newtype ResourceId = ResourceId Id deriving (Generic, ToSchema)

601+newtype ResourceId = ResourceId Id deriving (Generic)

602+instance ToSchema ResourceId

test/Data/SwaggerSpec.hs+7−8

@@ -4,6 +4,9 @@

44{-# LANGUAGE QuasiQuotes #-}

55module Data.SwaggerSpec where

7+import Prelude ()

8+import Prelude.Compat

710import Control.Lens

811

912import Data.Aeson

@@ -843,8 +846,7 @@ petstoreExampleJSON = [aesonQQ|

843846 },

844847 "security":[

845848 {

846− "api_key":[

847− ]

849+ "api_key": []

848850 }

849851 ]

850852 },

@@ -1009,8 +1011,7 @@ petstoreExampleJSON = [aesonQQ|

10091011 "produces":[

10101012 "application/json"

10111013 ],

1012− "parameters":[

1013− ],

1014+ "parameters": [],

10141015 "responses":{

10151016 "200":{

10161017 "description":"successful operation",

@@ -1025,8 +1026,7 @@ petstoreExampleJSON = [aesonQQ|

10251026 },

10261027 "security":[

10271028 {

1028− "api_key":[

1029− ]

1029+ "api_key": []

10301030 }

10311031 ]

10321032 }

@@ -1298,8 +1298,7 @@ petstoreExampleJSON = [aesonQQ|

12981298 "application/xml",

12991299 "application/json"

13001300 ],

1301− "parameters":[

1302− ],

1301+ "parameters": [],

13031302 "responses":{

13041303 "default":{

13051304 "description":"successful operation"

test/DocTest.hs+2−1

@@ -4,4 +4,5 @@ import System.FilePath.Glob (glob)

44import Test.DocTest (doctest)

66main :: IO ()

7−main = glob "src/**/*.hs" >>= doctest

7+main = glob "src/**/*.hs" >>= doctest'

8+ where doctest' files = doctest $ "-Iinclude/" : "-D__DOCTEST__" : files