git.iko.soy/typeable/openapi3
on master help sign in
Merge pull request #175 from GetShopTV/QuickCheck-2.12

Quick check 2.12

commit7a4cabfb51bb1f81ad91e705cbd217432eef542c authorOleg Grenrus <oleg.grenrus@iki.fi> dateSat 24 Nov 2018, 21:18 (8 years ago) parent6fc1496364a4bc
6 files changed+35−58
compare with master
unifiedsplit
.travis.yml+2−2 CHANGELOG.md+10 src/Data/Swagger/Internal.hs+17−3 stack.yaml+1 swagger2.cabal+5−8 test/Data/Aeson/QQ/Simple.hs−45
.travis.yml+2−2
@@ -32,9 +32,9 @@ before_cache:
3232
3333matrix:
3434 include:
35− - compiler: "ghc-8.6.1"
35+ - compiler: "ghc-8.6.2"
3636 # env: TEST=--disable-tests BENCH=--disable-benchmarks
37− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}}
37+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.2], sources: [hvr-ghc]}}
3838 - compiler: "ghc-8.4.4"
3939 # env: TEST=--disable-tests BENCH=--disable-benchmarks
4040 addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}}
CHANGELOG.md+10
@@ -1,3 +1,13 @@
1+2.3.1
2+-----
3+
4+- Add a quickcheck generator for aeson Values that match a swagger schema
5+ (see [#162](https://github.com/GetShopTV/swagger2/pull/162))
6+- Add `ToParamSchema` instance for `SetCookie`
7+ (see [#173](https://github.com/GetShopTV/swagger2/pull/173))
8+- Make nullary schemas valid
9+ (see [#168](https://github.com/GetShopTV/swagger2/pull/168))
10+
1112.3.0.1
212-------
313
src/Data/Swagger/Internal.hs+17−3
@@ -66,6 +66,7 @@ import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
6666#endif
6767
6868-- $setup
69+-- >>> :seti -XDataKinds
6970-- >>> import Data.Aeson
7071
7172-- | A list of definitions that can be used in references.
@@ -1067,7 +1068,8 @@ instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
10671068 toJSON (SwaggerItemsArray []) = object
10681069 [ "items" .= object []
10691070 , "maxItems" .= (0 :: Int)
1070− , "example" .= ([] :: [()]) ]
1071+ , "example" .= Array mempty
1072+ ]
10711073 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
10721074
10731075instance ToJSON Host where
@@ -1205,9 +1207,21 @@ instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
12051207 <$> o .:? "collectionFormat"
12061208 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
12071209
1210+-- |
1211+--
1212+-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1213+-- Just (SwaggerItemsArray [])
1214+--
1215+-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1216+-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1217+--
1218+-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1219+-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1220+--
12081221instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1209− parseJSON js | js == object [] = pure $ SwaggerItemsArray [] -- Nullary schema.
1210− parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
1222+ parseJSON js@(Object obj)
1223+ | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1224+ | otherwise = SwaggerItemsObject <$> parseJSON js
12111225 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
12121226 parseJSON _ = empty
12131227
stack.yaml+1
@@ -2,5 +2,6 @@ resolver: lts-12.10
22packages:
33- '.'
44extra-deps:
5+- aeson-1.4.2.0
56- base-compat-batteries-0.10.4
67- contravariant-1.5
swagger2.cabal+5−8
@@ -1,7 +1,6 @@
11cabal-version: >=1.10
22name: swagger2
3−version: 2.3.0.1
4−x-revision: 2
3+version: 2.3.1
54
65synopsis: Swagger 2.0 data model
76category: Web, Swagger
@@ -30,11 +29,11 @@ tested-with:
3029 || ==8.0.2
3130 || ==8.2.2
3231 || ==8.4.4
33− || ==8.6.1
32+ || ==8.6.2
3433
3534custom-setup
3635 setup-depends:
37− base, Cabal, cabal-doctest >=1.0.2 && <1.1
36+ base, Cabal, cabal-doctest >=1.0.6 && <1.1
3837
3938library
4039 hs-source-dirs: src
@@ -75,7 +74,7 @@ library
7574 -- other dependencies
7675 build-depends:
7776 base-compat-batteries >=0.10.4 && <0.11
78− , aeson >=1.3.1.1 && <1.5
77+ , aeson >=1.4.2.0 && <1.5
7978 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
8079 , cookie >=0.4.3 && <0.5
8180 , generics-sop >=0.3.2.0 && <0.5
@@ -89,7 +88,7 @@ library
8988 , unordered-containers >=0.2.9.0 && <0.3
9089 , uuid-types >=1.0.3 && <1.1
9190 , vector >=0.12.0.1 && <0.13
92− , QuickCheck >=2.10.1 && <2.12
91+ , QuickCheck >=2.10.1 && <2.13
9392
9493 default-language: Haskell2010
9594
@@ -137,8 +136,6 @@ test-suite spec
137136 Data.Swagger.SchemaSpec
138137 Data.Swagger.Schema.ValidationSpec
139138 Data.Swagger.Schema.GeneratorSpec
140−
141− Data.Aeson.QQ.Simple
142139 default-language: Haskell2010
143140
144141test-suite doctests
test/Data/Aeson/QQ/Simple.hsdeleted−45
@@ -1,45 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−-- | Like "Data.Aeson.QQ" but without interpolation.
3−module Data.Aeson.QQ.Simple where
4−
5−import Data.Aeson
6−import Data.ByteString.Lazy.UTF8 as UTF8
7−import qualified Data.HashMap.Strict as HM
8−import qualified Data.Text as T
9−import qualified Data.Vector as V
10−import Language.Haskell.TH
11−import Language.Haskell.TH.Quote
12−import Language.Haskell.TH.Syntax (Lift (..))
13−import Prelude ()
14−import Prelude.Compat
15−
16−aesonQQ :: QuasiQuoter
17−aesonQQ = QuasiQuoter
18− { quoteExp = aesonExp
19− , quotePat = const $ error "No quotePat defined for jsonQQ"
20− , quoteType = const $ error "No quoteType defined for jsonQQ"
21− , quoteDec = const $ error "No quoteDec defined for jsonQQ"
22− }
23−
24−aesonExp :: String -> ExpQ
25−aesonExp txt =
26− case eitherDecode $ UTF8.fromString txt of
27− Left err -> error $ "Error in aesonExp: " ++ show err
28− Right val -> liftValue val
29−
30−liftValue :: Value -> ExpQ
31−liftValue (String str) = [| String $(liftText str) |]
32−liftValue Null = [| Null |]
33−liftValue (Number n) = [| Number (fromRational $(return $ LitE $ RationalL (toRational n))) |]
34−liftValue (Bool b) = [| Bool b |]
35−liftValue (Array arr) = [| Array $ V.fromList $(ListE <$> traverse liftValue (V.toList arr)) |]
36−liftValue (Object obj) = [| object $jsList |]
37− where
38− jsList :: ExpQ
39− jsList = ListE <$> traverse objs2list (HM.toList obj)
40−
41− objs2list :: (T.Text, Value) -> ExpQ
42− objs2list (key, value) = [| ($(liftText key), $(liftValue value)) |]
43−
44−liftText :: T.Text -> ExpQ
45−liftText t = [| T.pack $(lift $ T.unpack t) |]