git.iko.soy/typeable/openapi3
on master help sign in
Backport to GHC7.8
29d2ec5Oleg Grenrus
.travis.yml+3
compare with master
unifiedsplit
@@ -13,6 +13,9 @@ before_cache:
13
13
14matrix:
14matrix:
15 include:
15 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]}}
16 - env: CABALVER=1.22 GHCVER=7.10.3
19 - env: CABALVER=1.22 GHCVER=7.10.3
17 compiler: ": #GHC 7.10.3"
20 compiler: ": #GHC 7.10.3"
18 addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5], sources: [hvr-ghc]}}
21 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 @@
4{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5module Data.Swagger.Declare where
5module Data.Swagger.Declare where
6
6
7+import Prelude ()
8+import Prelude.Compat
9+
7import Control.Monad
10import Control.Monad
8import Control.Monad.Trans
11import Control.Monad.Trans
9import Data.Functor.Identity
12import Data.Functor.Identity
@@ -24,14 +27,14 @@ import Data.Monoid
24newtype DeclareT d m a = DeclareT { runDeclareT :: d -> m (d, a) }
27newtype DeclareT d m a = DeclareT { runDeclareT :: d -> m (d, a) }
25 deriving (Functor)
28 deriving (Functor)
26
29
27−instance (Monad m, Monoid d) => Applicative (DeclareT d m) where
30+instance (Applicative m, Monad m, Monoid d) => Applicative (DeclareT d m) where
28 pure x = DeclareT (\_ -> pure (mempty, x))
31 pure x = DeclareT (\_ -> pure (mempty, x))
29 DeclareT df <*> DeclareT dx = DeclareT $ \d -> do
32 DeclareT df <*> DeclareT dx = DeclareT $ \d -> do
30 ~(d', f) <- df d
33 ~(d', f) <- df d
31 ~(d'', x) <- dx (d <> d')
34 ~(d'', x) <- dx (d <> d')
32 return (d' <> d'', f x)
35 return (d' <> d'', f x)
33
36
34−instance (Monad m, Monoid d) => Monad (DeclareT d m) where
37+instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where
35 return x = DeclareT (\_ -> pure (mempty, x))
38 return x = DeclareT (\_ -> pure (mempty, x))
36 DeclareT dx >>= f = DeclareT $ \d -> do
39 DeclareT dx >>= f = DeclareT $ \d -> do
37 ~(d', x) <- dx d
40 ~(d', x) <- dx d
@@ -39,7 +42,7 @@ instance (Monad m, Monoid d) => Monad (DeclareT d m) where
39 return (d' <> d'', y)
42 return (d' <> d'', y)
40
43
41instance Monoid d => MonadTrans (DeclareT d) where
44instance Monoid d => MonadTrans (DeclareT d) where
42− lift m = DeclareT (\_ -> (,) mempty <$> m)
45+ lift m = DeclareT (\_ -> (,) mempty `liftM` m)
43
46
44-- |
47-- |
45-- Definitions of @declare@ and @look@ must satisfy the following laws:
48-- Definitions of @declare@ and @look@ must satisfy the following laws:
@@ -58,13 +61,13 @@ instance Monoid d => MonadTrans (DeclareT d) where
58-- [/@look@ as left identity/]
61-- [/@look@ as left identity/]
59-- @'look' >> m == m@
62-- @'look' >> m == m@
60-- for every @m@
63-- 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
62 -- | @'declare' x@ is an action that produces the output @x@.
65 -- | @'declare' x@ is an action that produces the output @x@.
63 declare :: d -> m ()
66 declare :: d -> m ()
64 -- | @'look'@ is an action that returns all the output so far.
67 -- | @'look'@ is an action that returns all the output so far.
65 look :: m d
68 look :: m d
66
69
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
68 declare d = DeclareT (\_ -> return (d, ()))
71 declare d = DeclareT (\_ -> return (d, ()))
69 look = DeclareT (\d -> return (mempty, d))
72 look = DeclareT (\d -> return (mempty, d))
70
73
src/Data/Swagger/Internal.hs+22−15
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveTraversable #-}
4{-# LANGUAGE DeriveTraversable #-}
@@ -10,8 +11,12 @@
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE StandaloneDeriving #-}
12{-# LANGUAGE StandaloneDeriving #-}
12{-# LANGUAGE UndecidableInstances #-}
13{-# LANGUAGE UndecidableInstances #-}
14+#include "overlapping-compat.h"
13module Data.Swagger.Internal where
15module Data.Swagger.Internal where
14
16
17+import Prelude ()
18+import Prelude.Compat
19+
15import Control.Applicative
20import Control.Applicative
16import Control.Monad
21import Control.Monad
17import Data.Aeson
22import Data.Aeson
@@ -334,10 +339,11 @@ data SwaggerItems t where
334 SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
339 SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
335 SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema
340 SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema
336 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema
341 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema
342+ deriving (Typeable)
337
343
338deriving instance Eq (SwaggerItems t)
344deriving instance Eq (SwaggerItems t)
339deriving instance Show (SwaggerItems t)
345deriving instance Show (SwaggerItems t)
340−deriving instance Typeable (SwaggerItems t)
346+--deriving instance Typeable (SwaggerItems t)
341
347
342swaggerItemsPrimitiveConstr :: Constr
348swaggerItemsPrimitiveConstr :: Constr
343swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
349swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
@@ -345,7 +351,7 @@ swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimiti
345swaggerItemsDataType :: DataType
351swaggerItemsDataType :: DataType
346swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
352swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
347
353
348−instance {-# OVERLAPPABLE #-} Data t => Data (SwaggerItems t) where
354+instance OVERLAPPABLE_ Data t => Data (SwaggerItems t) where
349 gunfold k z c = case constrIndex c of
355 gunfold k z c = case constrIndex c of
350 1 -> k (k (z SwaggerItemsPrimitive))
356 1 -> k (k (z SwaggerItemsPrimitive))
351 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
357 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
@@ -363,10 +369,10 @@ data SwaggerType t where
363 SwaggerFile :: SwaggerType ParamOtherSchema
369 SwaggerFile :: SwaggerType ParamOtherSchema
364 SwaggerNull :: SwaggerType Schema
370 SwaggerNull :: SwaggerType Schema
365 SwaggerObject :: SwaggerType Schema
371 SwaggerObject :: SwaggerType Schema
372+ deriving (Typeable)
366
373
367deriving instance Eq (SwaggerType t)
374deriving instance Eq (SwaggerType t)
368deriving instance Show (SwaggerType t)
375deriving instance Show (SwaggerType t)
369−deriving instance Typeable (SwaggerType t)
370
376
371swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
377swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
372swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
378swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
@@ -387,17 +393,17 @@ swaggerTypeConstrs :: [Constr]
387swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])
393swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])
388 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
394 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
389
395
390−instance {-# OVERLAPPABLE #-} Typeable t => Data (SwaggerType t) where
396+instance OVERLAPPABLE_ Typeable t => Data (SwaggerType t) where
391 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
397 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
392 toConstr = swaggerTypeConstr
398 toConstr = swaggerTypeConstr
393 dataTypeOf = swaggerTypeDataType
399 dataTypeOf = swaggerTypeDataType
394
400
395−instance {-# OVERLAPPING #-} Data (SwaggerType ParamOtherSchema) where
401+instance OVERLAPPABLE_ Data (SwaggerType ParamOtherSchema) where
396 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
402 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
397 toConstr = swaggerTypeConstr
403 toConstr = swaggerTypeConstr
398 dataTypeOf = swaggerTypeDataType
404 dataTypeOf = swaggerTypeDataType
399
405
400−instance {-# OVERLAPPING #-} Data (SwaggerType Schema) where
406+instance OVERLAPPABLE_ Data (SwaggerType Schema) where
401 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
407 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
402 toConstr = swaggerTypeConstr
408 toConstr = swaggerTypeConstr
403 dataTypeOf = swaggerTypeDataType
409 dataTypeOf = swaggerTypeDataType
@@ -438,10 +444,10 @@ data CollectionFormat t where
438 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
444 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
439 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
445 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
440 CollectionMulti :: CollectionFormat ParamOtherSchema
446 CollectionMulti :: CollectionFormat ParamOtherSchema
447+ deriving (Typeable)
441
448
442deriving instance Eq (CollectionFormat t)
449deriving instance Eq (CollectionFormat t)
443deriving instance Show (CollectionFormat t)
450deriving instance Show (CollectionFormat t)
444−deriving instance Typeable (CollectionFormat t)
445
451
446collectionFormatConstr :: CollectionFormat t -> Constr
452collectionFormatConstr :: CollectionFormat t -> Constr
447collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
453collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
@@ -453,12 +459,12 @@ collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
453collectionCommonFormats :: [CollectionFormat t]
459collectionCommonFormats :: [CollectionFormat t]
454collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
460collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
455
461
456−instance {-# OVERLAPPABLE #-} Data t => Data (CollectionFormat t) where
462+instance OVERLAPPABLE_ Data t => Data (CollectionFormat t) where
457 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
463 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
458 toConstr = collectionFormatConstr
464 toConstr = collectionFormatConstr
459 dataTypeOf _ = collectionFormatDataType
465 dataTypeOf _ = collectionFormatDataType
460
466
461−deriving instance {-# OVERLAPPING #-} Data (CollectionFormat ParamOtherSchema)
467+deriving instance OVERLAPPABLE_ Data (CollectionFormat ParamOtherSchema)
462
468
463type ParamName = Text
469type ParamName = Text
464
470
@@ -788,7 +794,7 @@ instance SwaggerMonoid ParamLocation where
788 swaggerMempty = ParamQuery
794 swaggerMempty = ParamQuery
789 swaggerMappend _ y = y
795 swaggerMappend _ y = y
790
796
791−instance SwaggerMonoid (HashMap FilePath PathItem) where
797+instance OVERLAPPING_ SwaggerMonoid (HashMap FilePath PathItem) where
792 swaggerMempty = HashMap.empty
798 swaggerMempty = HashMap.empty
793 swaggerMappend = HashMap.unionWith mappend
799 swaggerMappend = HashMap.unionWith mappend
794
800
@@ -1051,12 +1057,12 @@ instance FromJSON Schema where
1051instance FromJSON Header where
1057instance FromJSON Header where
1052 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")
1058 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")
1053
1059
1054−instance {-# OVERLAPPABLE #-} (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where
1060+instance OVERLAPPABLE_ (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where
1055− parseJSON (Object o) = SwaggerItemsPrimitive
1061+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1056 <$> o .:? "collectionFormat"
1062 <$> o .:? "collectionFormat"
1057 <*> (o .: "items" >>= parseJSON)
1063 <*> (o .: "items" >>= parseJSON)
1058
1064
1059−instance {-# OVERLAPPING #-} FromJSON (SwaggerItems Schema) where
1065+instance OVERLAPPABLE_ FromJSON (SwaggerItems Schema) where
1060 parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
1066 parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
1061 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1067 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1062 parseJSON _ = empty
1068 parseJSON _ = empty
@@ -1128,6 +1134,7 @@ referencedParseJSON prefix js@(Object o) = do
1128 case Text.stripPrefix prefix s of
1134 case Text.stripPrefix prefix s of
1129 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1135 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1130 Just suffix -> pure (Reference suffix)
1136 Just suffix -> pure (Reference suffix)
1137+referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1131
1138
1132instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1139instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1133instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1140instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
@@ -1142,10 +1149,10 @@ instance FromJSON (SwaggerType Schema) where
1142instance FromJSON (SwaggerType ParamOtherSchema) where
1149instance FromJSON (SwaggerType ParamOtherSchema) where
1143 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1150 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1144
1151
1145−instance {-# OVERLAPPABLE #-} FromJSON (SwaggerType t) where
1152+instance OVERLAPPABLE_ FromJSON (SwaggerType t) where
1146 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1153 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1147
1154
1148−instance {-# OVERLAPPABLE #-} FromJSON (CollectionFormat t) where
1155+instance OVERLAPPABLE_ FromJSON (CollectionFormat t) where
1149 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1156 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1150
1157
1151instance FromJSON (CollectionFormat ParamOtherSchema) where
1158instance FromJSON (CollectionFormat ParamOtherSchema) where
src/Data/Swagger/Internal/ParamSchema.hs+3−1
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -8,6 +9,7 @@
8{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE TypeOperators #-}
10{-# LANGUAGE TypeOperators #-}
10{-# LANGUAGE TypeSynonymInstances #-}
11{-# LANGUAGE TypeSynonymInstances #-}
12+#include "overlapping-compat.h"
11module Data.Swagger.Internal.ParamSchema where
13module Data.Swagger.Internal.ParamSchema where
12
14
13import Control.Lens
15import Control.Lens
@@ -73,7 +75,7 @@ class ToParamSchema a where
73 default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamSchema t
75 default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamSchema t
74 toParamSchema = genericToParamSchema defaultSchemaOptions
76 toParamSchema = genericToParamSchema defaultSchemaOptions
75
77
76−instance {-# OVERLAPPING #-} ToParamSchema String where
78+instance OVERLAPPING_ ToParamSchema String where
77 toParamSchema _ = mempty & type_ .~ SwaggerString
79 toParamSchema _ = mempty & type_ .~ SwaggerString
78
80
79instance ToParamSchema Bool where
81instance ToParamSchema Bool where
src/Data/Swagger/Internal/Schema.hs+19−11
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -11,8 +12,12 @@
11{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE TypeSynonymInstances #-}
14{-# LANGUAGE TypeSynonymInstances #-}
15+#include "overlapping-compat.h"
14module Data.Swagger.Internal.Schema where
16module Data.Swagger.Internal.Schema where
15
17
18+import Prelude ()
19+import Prelude.Compat
20+
16import Control.Lens
21import Control.Lens
17import Data.Data.Lens (template)
22import Data.Data.Lens (template)
18
23
@@ -29,7 +34,6 @@ import Data.Int
29import Data.IntSet (IntSet)
34import Data.IntSet (IntSet)
30import Data.IntMap (IntMap)
35import Data.IntMap (IntMap)
31import Data.Map (Map)
36import Data.Map (Map)
32−import Data.Monoid
33import Data.Proxy
37import Data.Proxy
34import Data.Scientific (Scientific)
38import Data.Scientific (Scientific)
35import Data.Set (Set)
39import Data.Set (Set)
@@ -42,9 +46,13 @@ import GHC.Generics
42import Data.Swagger.Declare
46import Data.Swagger.Declare
43import Data.Swagger.Internal
47import Data.Swagger.Internal
44import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
48import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
45−import Data.Swagger.Lens
49+import Data.Swagger.Lens hiding (name, schema)
46import Data.Swagger.SchemaOptions
50import Data.Swagger.SchemaOptions
47
51
52+#ifdef __DOCTEST__
53+import Data.Swagger.Lens (name, schema)
54+#endif
55+
48unnamed :: Schema -> NamedSchema
56unnamed :: Schema -> NamedSchema
49unnamed schema = NamedSchema Nothing schema
57unnamed schema = NamedSchema Nothing schema
50
58
@@ -258,14 +266,14 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
258class GToSchema (f :: * -> *) where
266class GToSchema (f :: * -> *) where
259 gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
267 gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
260
268
261−instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
269+instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
262 declareNamedSchema _ = do
270 declareNamedSchema _ = do
263 ref <- declareSchemaRef (Proxy :: Proxy a)
271 ref <- declareSchemaRef (Proxy :: Proxy a)
264 return $ unnamed $ mempty
272 return $ unnamed $ mempty
265 & type_ .~ SwaggerArray
273 & type_ .~ SwaggerArray
266 & items ?~ SwaggerItemsObject ref
274 & items ?~ SwaggerItemsObject ref
267
275
268−instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
276+instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
269instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
277instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
270instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
278instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
271instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
279instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
@@ -434,10 +442,10 @@ instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
434 where
442 where
435 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
443 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
436
444
437−instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
445+instance OVERLAPPABLE_ GToSchema f => GToSchema (C1 c f) where
438 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
446 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
439
447
440−instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where
448+instance OVERLAPPING_ Constructor c => GToSchema (C1 c U1) where
441 gdeclareNamedSchema = gdeclareNamedSumSchema
449 gdeclareNamedSchema = gdeclareNamedSumSchema
442
450
443-- | Single field constructor.
451-- | Single field constructor.
@@ -498,17 +506,17 @@ withFieldSchema opts _ isRequiredField schema = do
498 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
506 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
499
507
500-- | Optional record fields.
508-- | 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
502 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
510 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
503
511
504-- | Record fields.
512-- | 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
506 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
514 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
507
515
508−instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where
516+instance OVERLAPPING_ ToSchema c => GToSchema (K1 i (Maybe c)) where
509 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
517 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
510
518
511−instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
519+instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
512 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
520 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
513
521
514instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
522instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
@@ -550,7 +558,7 @@ gsumConToSchema opts proxy schema = do
550 ref <- gdeclareSchemaRef opts proxy
558 ref <- gdeclareSchemaRef opts proxy
551 return $ gsumConToSchemaWith ref opts proxy schema
559 return $ gsumConToSchemaWith ref opts proxy schema
552
560
553−instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
561+instance OVERLAPPABLE_ (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
554 gsumToSchema opts proxy schema = do
562 gsumToSchema opts proxy schema = do
555 tell (All False)
563 tell (All False)
556 lift $ gsumConToSchema opts proxy schema
564 lift $ gsumConToSchema opts proxy schema
src/Data/Swagger/Internal/Utils.hs+4−1
@@ -6,6 +6,9 @@
6{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
7module Data.Swagger.Internal.Utils where
7module Data.Swagger.Internal.Utils where
8
8
9+import Prelude ()
10+import Prelude.Compat
11+
9import Control.Arrow (first)
12import Control.Arrow (first)
10import Control.Applicative
13import Control.Applicative
11import Control.Lens ((&), (%~))
14import Control.Lens ((&), (%~))
@@ -151,7 +154,7 @@ class SwaggerMonoid m where
151instance SwaggerMonoid [a]
154instance SwaggerMonoid [a]
152instance Ord k => SwaggerMonoid (Map k v)
155instance Ord k => SwaggerMonoid (Map k v)
153
156
154−instance {-# OVERLAPPABLE #-} (Eq k, Hashable k) => SwaggerMonoid (HashMap k v) where
157+instance (Eq k, Hashable k) => SwaggerMonoid (HashMap k v) where
155 swaggerMempty = mempty
158 swaggerMempty = mempty
156 swaggerMappend = HashMap.unionWith (\_old new -> new)
159 swaggerMappend = HashMap.unionWith (\_old new -> new)
157
160
src/Data/Swagger/Lens.hs+29−14
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE FunctionalDependencies #-}
@@ -7,6 +8,8 @@
7{-# LANGUAGE TemplateHaskell #-}
8{-# LANGUAGE TemplateHaskell #-}
8{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE UndecidableInstances #-}
10{-# LANGUAGE UndecidableInstances #-}
11+{-# OPTIONS_GHC -fno-warn-orphans #-}
12+#include "overlapping-compat.h"
10module Data.Swagger.Lens where
13module Data.Swagger.Lens where
11
14
12import Control.Lens
15import Control.Lens
@@ -93,58 +96,70 @@ instance HasDefault ParamOtherSchema (Maybe Value) where default_ = paramSchema.
93
96
94-- OVERLAPPABLE instances
97-- OVERLAPPABLE instances
95
98
99+instance
100+#if __GLASGOW_HASKELL__ >= 710
101+ OVERLAPPABLE_
102+#endif
96−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
103+ HasParamSchema s (ParamSchema t)
97 => HasFormat s (Maybe Format) where
104 => HasFormat s (Maybe Format) where
98 format = paramSchema.format
105 format = paramSchema.format
99
106
107+instance
108+#if __GLASGOW_HASKELL__ >= 710
109+ OVERLAPPABLE_
110+#endif
100−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
111+ HasParamSchema s (ParamSchema t)
101 => HasItems s (Maybe (SwaggerItems t)) where
112 => HasItems s (Maybe (SwaggerItems t)) where
102 items = paramSchema.items
113 items = paramSchema.items
103
114
115+instance
116+#if __GLASGOW_HASKELL__ >= 710
117+ OVERLAPPABLE_
118+#endif
104−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
119+ HasParamSchema s (ParamSchema t)
105 => HasMaximum s (Maybe Scientific) where
120 => HasMaximum s (Maybe Scientific) where
106 maximum_ = paramSchema.maximum_
121 maximum_ = paramSchema.maximum_
107
122
108−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
123+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
109 => HasExclusiveMaximum s (Maybe Bool) where
124 => HasExclusiveMaximum s (Maybe Bool) where
110 exclusiveMaximum = paramSchema.exclusiveMaximum
125 exclusiveMaximum = paramSchema.exclusiveMaximum
111
126
112−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
127+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
113 => HasMinimum s (Maybe Scientific) where
128 => HasMinimum s (Maybe Scientific) where
114 minimum_ = paramSchema.minimum_
129 minimum_ = paramSchema.minimum_
115
130
116−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
131+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
117 => HasExclusiveMinimum s (Maybe Bool) where
132 => HasExclusiveMinimum s (Maybe Bool) where
118 exclusiveMinimum = paramSchema.exclusiveMinimum
133 exclusiveMinimum = paramSchema.exclusiveMinimum
119
134
120−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
135+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
121 => HasMaxLength s (Maybe Integer) where
136 => HasMaxLength s (Maybe Integer) where
122 maxLength = paramSchema.maxLength
137 maxLength = paramSchema.maxLength
123
138
124−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
139+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
125 => HasMinLength s (Maybe Integer) where
140 => HasMinLength s (Maybe Integer) where
126 minLength = paramSchema.minLength
141 minLength = paramSchema.minLength
127
142
128−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
143+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
129 => HasPattern s (Maybe Text) where
144 => HasPattern s (Maybe Text) where
130 pattern = paramSchema.pattern
145 pattern = paramSchema.pattern
131
146
132−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
147+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
133 => HasMaxItems s (Maybe Integer) where
148 => HasMaxItems s (Maybe Integer) where
134 maxItems = paramSchema.maxItems
149 maxItems = paramSchema.maxItems
135
150
136−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
151+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
137 => HasMinItems s (Maybe Integer) where
152 => HasMinItems s (Maybe Integer) where
138 minItems = paramSchema.minItems
153 minItems = paramSchema.minItems
139
154
140−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
155+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
141 => HasUniqueItems s (Maybe Bool) where
156 => HasUniqueItems s (Maybe Bool) where
142 uniqueItems = paramSchema.uniqueItems
157 uniqueItems = paramSchema.uniqueItems
143
158
144−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
159+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
145 => HasEnum s (Maybe [Value]) where
160 => HasEnum s (Maybe [Value]) where
146 enum_ = paramSchema.enum_
161 enum_ = paramSchema.enum_
147
162
148−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
163+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
149 => HasMultipleOf s (Maybe Scientific) where
164 => HasMultipleOf s (Maybe Scientific) where
150 multipleOf = paramSchema.multipleOf
165 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 @@
1flags: {}
1flags: {}
2packages:
2packages:
3- '.'
3- '.'
4−extra-deps:
4+extra-deps: []
5−resolver: lts-3.12
5+resolver: lts-3.22
swagger2.cabal+8−3
@@ -15,11 +15,13 @@ extra-source-files:
15 README.md
15 README.md
16 , CHANGELOG.md
16 , CHANGELOG.md
17 , examples/*.hs
17 , examples/*.hs
18+ , include/overlapping-compat.h
18cabal-version: >=1.10
19cabal-version: >=1.10
19−tested-with: GHC==7.10.3
20+tested-with: GHC==7.8.4, GHC==7.10.3
20
21
21library
22library
22 hs-source-dirs: src
23 hs-source-dirs: src
24+ include-dirs: include
23 exposed-modules:
25 exposed-modules:
24 Data.Swagger
26 Data.Swagger
25 Data.Swagger.Declare
27 Data.Swagger.Declare
@@ -33,7 +35,8 @@ library
33 Data.Swagger.Internal.Schema
35 Data.Swagger.Internal.Schema
34 Data.Swagger.Internal.ParamSchema
36 Data.Swagger.Internal.ParamSchema
35 Data.Swagger.Internal.Utils
37 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
37 , aeson
40 , aeson
38 , containers
41 , containers
39 , hashable
42 , hashable
@@ -43,6 +46,7 @@ library
43 , text
46 , text
44 , template-haskell
47 , template-haskell
45 , time
48 , time
49+ , transformers
46 , unordered-containers
50 , unordered-containers
47 , lens
51 , lens
48 , scientific
52 , scientific
@@ -52,7 +56,8 @@ test-suite spec
52 type: exitcode-stdio-1.0
56 type: exitcode-stdio-1.0
53 hs-source-dirs: test
57 hs-source-dirs: test
54 main-is: Spec.hs
58 main-is: Spec.hs
55− build-depends: base == 4.*
59+ build-depends: base
60+ , base-compat
56 , swagger2
61 , swagger2
57 , hspec
62 , hspec
58 , HUnit
63 , HUnit
test/Data/Swagger/ParamSchemaSpec.hs+8−6
@@ -1,5 +1,4 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE DeriveAnyClass #-}
3{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE QuasiQuotes #-}
4{-# LANGUAGE QuasiQuotes #-}
@@ -9,7 +8,6 @@ import Data.Aeson
9import Data.Aeson.QQ
8import Data.Aeson.QQ
10import Data.Char
9import Data.Char
11import Data.Proxy
10import Data.Proxy
12−import Data.Set (Set)
13import GHC.Generics
11import GHC.Generics
14
12
15import Data.Swagger
13import Data.Swagger
@@ -37,7 +35,8 @@ main = hspec spec
37-- Unit type
35-- Unit type
38-- ========================================================================
36-- ========================================================================
39
37
40−data Unit = Unit deriving (Generic, ToParamSchema)
38+data Unit = Unit deriving (Generic)
39+instance ToParamSchema Unit
41
40
42unitSchemaJSON :: Value
41unitSchemaJSON :: Value
43unitSchemaJSON = [aesonQQ|
42unitSchemaJSON = [aesonQQ|
@@ -54,7 +53,8 @@ data Color
54 = Red
53 = Red
55 | Green
54 | Green
56 | Blue
55 | Blue
57− deriving (Generic, ToParamSchema)
56+ deriving (Generic)
57+instance ToParamSchema Color
58
58
59colorSchemaJSON :: Value
59colorSchemaJSON :: Value
60colorSchemaJSON = [aesonQQ|
60colorSchemaJSON = [aesonQQ|
@@ -87,7 +87,8 @@ statusSchemaJSON = [aesonQQ|
87-- ========================================================================
87-- ========================================================================
88
88
89newtype Email = Email { getEmail :: String }
89newtype Email = Email { getEmail :: String }
90− deriving (Generic, ToParamSchema)
90+ deriving (Generic)
91+instance ToParamSchema Email
91
92
92emailSchemaJSON :: Value
93emailSchemaJSON :: Value
93emailSchemaJSON = [aesonQQ|
94emailSchemaJSON = [aesonQQ|
@@ -101,7 +102,8 @@ emailSchemaJSON = [aesonQQ|
101-- ========================================================================
102-- ========================================================================
102
103
103newtype UserId = UserId Integer
104newtype UserId = UserId Integer
104− deriving (Generic, ToParamSchema)
105+ deriving (Generic)
106+instance ToParamSchema UserId
105
107
106userIdSchemaJSON :: Value
108userIdSchemaJSON :: Value
107userIdSchemaJSON = [aesonQQ|
109userIdSchemaJSON = [aesonQQ|
test/Data/Swagger/SchemaSpec.hs+36−20
@@ -1,10 +1,12 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE DeriveAnyClass #-}
3{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE QuasiQuotes #-}
4{-# LANGUAGE QuasiQuotes #-}
6module Data.Swagger.SchemaSpec where
5module Data.Swagger.SchemaSpec where
7
6
7+import Prelude ()
8+import Prelude.Compat
9+
8import Data.Aeson
10import Data.Aeson
9import Data.Aeson.QQ
11import Data.Aeson.QQ
10import Data.Char
12import Data.Char
@@ -12,7 +14,6 @@ import qualified Data.HashMap.Strict as HashMap
12import Data.Proxy
14import Data.Proxy
13import Data.Set (Set)
15import Data.Set (Set)
14import qualified Data.Set as Set
16import qualified Data.Set as Set
15−import Data.Text (Text)
16import qualified Data.Text as Text
17import qualified Data.Text as Text
17import GHC.Generics
18import GHC.Generics
18
19
@@ -41,14 +42,14 @@ checkInlinedSchema :: ToSchema a => Proxy a -> Value -> Spec
41checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
42checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
42
43
43checkInlinedSchemas :: ToSchema a => [String] -> Proxy a -> Value -> Spec
44checkInlinedSchemas :: 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
45 where
46 where
46− (defs, schema) = runDeclare (declareSchema proxy) mempty
47+ (defs, s) = runDeclare (declareSchema proxy) mempty
47
48
48checkInlinedRecSchema :: ToSchema a => Proxy a -> Value -> Spec
49checkInlinedRecSchema :: ToSchema a => Proxy a -> Value -> Spec
49−checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs schema <=> js
50+checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js
50 where
51 where
51− (defs, schema) = runDeclare (declareSchema proxy) mempty
52+ (defs, s) = runDeclare (declareSchema proxy) mempty
52
53
53spec :: Spec
54spec :: Spec
54spec = do
55spec = do
@@ -101,7 +102,9 @@ data Person = Person
101 { name :: String
102 { name :: String
102 , phone :: Integer
103 , phone :: Integer
103 , email :: Maybe String
104 , email :: Maybe String
104− } deriving (Generic, ToSchema)
105+ } deriving (Generic)
106+
107+instance ToSchema Person
105
108
106personSchemaJSON :: Value
109personSchemaJSON :: Value
107personSchemaJSON = [aesonQQ|
110personSchemaJSON = [aesonQQ|
@@ -121,7 +124,9 @@ personSchemaJSON = [aesonQQ|
121-- ISPair (non-record product data type)
124-- ISPair (non-record product data type)
122-- ========================================================================
125-- ========================================================================
123data ISPair = ISPair Integer String
126data ISPair = ISPair Integer String
124− deriving (Generic, ToSchema)
127+ deriving (Generic)
128+
129+instance ToSchema ISPair
125
130
126ispairSchemaJSON :: Value
131ispairSchemaJSON :: Value
127ispairSchemaJSON = [aesonQQ|
132ispairSchemaJSON = [aesonQQ|
@@ -168,7 +173,8 @@ data Color
168 = Red
173 = Red
169 | Green
174 | Green
170 | Blue
175 | Blue
171− deriving (Generic, ToSchema)
176+ deriving (Generic)
177+instance ToSchema Color
172
178
173colorSchemaJSON :: Value
179colorSchemaJSON :: Value
174colorSchemaJSON = [aesonQQ|
180colorSchemaJSON = [aesonQQ|
@@ -182,7 +188,8 @@ colorSchemaJSON = [aesonQQ|
182-- Shade (paramSchemaToNamedSchema)
188-- Shade (paramSchemaToNamedSchema)
183-- ========================================================================
189-- ========================================================================
184
190
185−data Shade = Dim | Bright deriving (Generic, ToParamSchema)
191+data Shade = Dim | Bright deriving (Generic)
192+instance ToParamSchema Shade
186
193
187instance ToSchema Shade where declareNamedSchema = pure . paramSchemaToNamedSchema defaultSchemaOptions
194instance ToSchema Shade where declareNamedSchema = pure . paramSchemaToNamedSchema defaultSchemaOptions
188
195
@@ -199,7 +206,8 @@ shadeSchemaJSON = [aesonQQ|
199-- ========================================================================
206-- ========================================================================
200
207
201newtype Paint = Paint { color :: Color }
208newtype Paint = Paint { color :: Color }
202− deriving (Generic, ToSchema)
209+ deriving (Generic)
210+instance ToSchema Paint
203
211
204paintSchemaJSON :: Value
212paintSchemaJSON :: Value
205paintSchemaJSON = [aesonQQ|
213paintSchemaJSON = [aesonQQ|
@@ -255,7 +263,8 @@ emailSchemaJSON = [aesonQQ|
255-- ========================================================================
263-- ========================================================================
256
264
257newtype UserId = UserId Integer
265newtype UserId = UserId Integer
258− deriving (Eq, Ord, Generic, ToSchema)
266+ deriving (Eq, Ord, Generic)
267+instance ToSchema UserId
259
268
260userIdSchemaJSON :: Value
269userIdSchemaJSON :: Value
261userIdSchemaJSON = [aesonQQ|
270userIdSchemaJSON = [aesonQQ|
@@ -269,7 +278,8 @@ userIdSchemaJSON = [aesonQQ|
269-- ========================================================================
278-- ========================================================================
270
279
271newtype UserGroup = UserGroup (Set UserId)
280newtype UserGroup = UserGroup (Set UserId)
272− deriving (Generic, ToSchema)
281+ deriving (Generic)
282+instance ToSchema UserGroup
273
283
274userGroupSchemaJSON :: Value
284userGroupSchemaJSON :: Value
275userGroupSchemaJSON = [aesonQQ|
285userGroupSchemaJSON = [aesonQQ|
@@ -286,7 +296,8 @@ userGroupSchemaJSON = [aesonQQ|
286
296
287newtype Player = Player
297newtype Player = Player
288 { position :: Point
298 { position :: Point
289− } deriving (Generic, ToSchema)
299+ } deriving (Generic)
300+instance ToSchema Player
290
301
291playerSchemaJSON :: Value
302playerSchemaJSON :: Value
292playerSchemaJSON = [aesonQQ|
303playerSchemaJSON = [aesonQQ|
@@ -345,10 +356,11 @@ newtype Inlined a = Inlined { getInlined :: a }
345instance ToSchema a => ToSchema (Inlined a) where
356instance ToSchema a => ToSchema (Inlined a) where
346 declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
357 declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
347 where
358 where
348− unname (NamedSchema _ schema) = NamedSchema Nothing schema
359+ unname (NamedSchema _ s) = NamedSchema Nothing s
349
360
350newtype Players = Players [Inlined Player]
361newtype Players = Players [Inlined Player]
351− deriving (Generic, ToSchema)
362+ deriving (Generic)
363+instance ToSchema Players
352
364
353playersSchemaJSON :: Value
365playersSchemaJSON :: Value
354playersSchemaJSON = [aesonQQ|
366playersSchemaJSON = [aesonQQ|
@@ -400,7 +412,8 @@ statusSchemaJSON = [aesonQQ|
400-- Unit type
412-- Unit type
401-- ========================================================================
413-- ========================================================================
402
414
403−data Unit = Unit deriving (Generic, ToSchema)
415+data Unit = Unit deriving (Generic)
416+instance ToSchema Unit
404
417
405unitSchemaJSON :: Value
418unitSchemaJSON :: Value
406unitSchemaJSON = [aesonQQ|
419unitSchemaJSON = [aesonQQ|
@@ -418,7 +431,8 @@ unitSchemaJSON = [aesonQQ|
418data Character
431data Character
419 = PC Player
432 = PC Player
420 | NPC { npcName :: String, npcPosition :: Point }
433 | NPC { npcName :: String, npcPosition :: Point }
421− deriving (Generic, ToSchema)
434+ deriving (Generic)
435+instance ToSchema Character
422
436
423characterSchemaJSON :: Value
437characterSchemaJSON :: Value
424characterSchemaJSON = [aesonQQ|
438characterSchemaJSON = [aesonQQ|
@@ -581,6 +595,8 @@ lightInlinedSchemaJSON = [aesonQQ|
581-- ResourceId (series of newtypes)
595-- ResourceId (series of newtypes)
582-- ========================================================================
596-- ========================================================================
583
597
584−newtype Id = Id String deriving (Generic, ToSchema)
598+newtype Id = Id String deriving (Generic)
599+instance ToSchema Id
585
600
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 @@
4{-# LANGUAGE QuasiQuotes #-}
4{-# LANGUAGE QuasiQuotes #-}
5module Data.SwaggerSpec where
5module Data.SwaggerSpec where
6
6
7+import Prelude ()
8+import Prelude.Compat
9+
7import Control.Lens
10import Control.Lens
8
11
9import Data.Aeson
12import Data.Aeson
@@ -843,8 +846,7 @@ petstoreExampleJSON = [aesonQQ|
843 },
846 },
844 "security":[
847 "security":[
845 {
848 {
846− "api_key":[
849+ "api_key": []
847− ]
848 }
850 }
849 ]
851 ]
850 },
852 },
@@ -1009,8 +1011,7 @@ petstoreExampleJSON = [aesonQQ|
1009 "produces":[
1011 "produces":[
1010 "application/json"
1012 "application/json"
1011 ],
1013 ],
1012− "parameters":[
1014+ "parameters": [],
1013− ],
1014 "responses":{
1015 "responses":{
1015 "200":{
1016 "200":{
1016 "description":"successful operation",
1017 "description":"successful operation",
@@ -1025,8 +1026,7 @@ petstoreExampleJSON = [aesonQQ|
1025 },
1026 },
1026 "security":[
1027 "security":[
1027 {
1028 {
1028− "api_key":[
1029+ "api_key": []
1029− ]
1030 }
1030 }
1031 ]
1031 ]
1032 }
1032 }
@@ -1298,8 +1298,7 @@ petstoreExampleJSON = [aesonQQ|
1298 "application/xml",
1298 "application/xml",
1299 "application/json"
1299 "application/json"
1300 ],
1300 ],
1301− "parameters":[
1301+ "parameters": [],
1302− ],
1303 "responses":{
1302 "responses":{
1304 "default":{
1303 "default":{
1305 "description":"successful operation"
1304 "description":"successful operation"
test/DocTest.hs+2−1
@@ -4,4 +4,5 @@ import System.FilePath.Glob (glob)
4import Test.DocTest (doctest)
4import Test.DocTest (doctest)
5
5
6main :: IO ()
6main :: IO ()
7−main = glob "src/**/*.hs" >>= doctest
7+main = glob "src/**/*.hs" >>= doctest'
8+ where doctest' files = doctest $ "-Iinclude/" : "-D__DOCTEST__" : files