git.iko.soy/typeable/openapi3
on fcbe2f0 help sign in
340d86f
swap
0 ahead, 25 behind
.github/workflows/haskell-ci.yml+30−96
since splitsnapshots
unifiedsplit
@@ -8,117 +8,67 @@
8#
8#
9# For more information, see https://github.com/haskell-CI/haskell-ci
9# For more information, see https://github.com/haskell-CI/haskell-ci
10#
10#
11−# version: 0.14.3
11+# version: 0.12
12#
12#
13−# REGENDATA ("0.14.3",["github","cabal.project"])
13+# REGENDATA ("0.12",["github","cabal.project"])
14#
14#
15name: Haskell-CI
15name: Haskell-CI
16on:
16on:
17− push:
17+ - push
18− branches:
19− - master
20− pull_request:
18+ - pull_request
21− branches:
22− - master
23jobs:
19jobs:
24 linux:
20 linux:
25 name: Haskell-CI - Linux - ${{ matrix.compiler }}
21 name: Haskell-CI - Linux - ${{ matrix.compiler }}
26 runs-on: ubuntu-18.04
22 runs-on: ubuntu-18.04
27− timeout-minutes:
28− 60
29 container:
23 container:
30− image: buildpack-deps:focal
24+ image: buildpack-deps:bionic
31 continue-on-error: ${{ matrix.allow-failure }}
25 continue-on-error: ${{ matrix.allow-failure }}
32 strategy:
26 strategy:
33 matrix:
27 matrix:
34 include:
28 include:
35− - compiler: ghc-9.2.2
29+ - compiler: ghc-9.0.1
36− compilerKind: ghc
37− compilerVersion: 9.2.2
38− setup-method: ghcup
39 allow-failure: true
30 allow-failure: true
40− - compiler: ghc-9.0.2
31+ - compiler: ghc-8.10.4
41− compilerKind: ghc
42− compilerVersion: 9.0.2
43− setup-method: ghcup
44− allow-failure: false
45− - compiler: ghc-8.10.7
46− compilerKind: ghc
47− compilerVersion: 8.10.7
48− setup-method: ghcup
49 allow-failure: false
32 allow-failure: false
50 - compiler: ghc-8.8.4
33 - compiler: ghc-8.8.4
51− compilerKind: ghc
52− compilerVersion: 8.8.4
53− setup-method: hvr-ppa
54 allow-failure: false
34 allow-failure: false
55 - compiler: ghc-8.6.5
35 - compiler: ghc-8.6.5
56− compilerKind: ghc
57− compilerVersion: 8.6.5
58− setup-method: hvr-ppa
59 allow-failure: false
36 allow-failure: false
60 - compiler: ghc-8.4.4
37 - compiler: ghc-8.4.4
61− compilerKind: ghc
62− compilerVersion: 8.4.4
63− setup-method: hvr-ppa
64 allow-failure: false
38 allow-failure: false
65 fail-fast: false
39 fail-fast: false
66 steps:
40 steps:
67 - name: apt
41 - name: apt
68 run: |
42 run: |
69 apt-get update
43 apt-get update
70− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
44+ apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
71− if [ "${{ matrix.setup-method }}" = ghcup ]; then
72− mkdir -p "$HOME/.ghcup/bin"
73− curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
74− chmod a+x "$HOME/.ghcup/bin/ghcup"
75− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
76− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
77− else
78− apt-add-repository -y 'ppa:hvr/ghc'
45+ apt-add-repository -y 'ppa:hvr/ghc'
79− apt-get update
46+ apt-get update
80− apt-get install -y "$HCNAME"
47+ apt-get install -y $CC cabal-install-3.4
81− mkdir -p "$HOME/.ghcup/bin"
82− curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
83− chmod a+x "$HOME/.ghcup/bin/ghcup"
84− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
85− fi
86 env:
48 env:
87− HCKIND: ${{ matrix.compilerKind }}
88− HCNAME: ${{ matrix.compiler }}
49+ CC: ${{ matrix.compiler }}
89− HCVER: ${{ matrix.compilerVersion }}
90 - name: Set PATH and environment variables
50 - name: Set PATH and environment variables
91 run: |
51 run: |
92 echo "$HOME/.cabal/bin" >> $GITHUB_PATH
52 echo "$HOME/.cabal/bin" >> $GITHUB_PATH
93− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
53+ echo "LANG=C.UTF-8" >> $GITHUB_ENV
94− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
54+ echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV
95− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
55+ echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV
96− HCDIR=/opt/$HCKIND/$HCVER
56+ HCDIR=$(echo "/opt/$CC" | sed 's/-/\//')
97− if [ "${{ matrix.setup-method }}" = ghcup ]; then
57+ HCNAME=ghc
98− HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
58+ HC=$HCDIR/bin/$HCNAME
99− echo "HC=$HC" >> "$GITHUB_ENV"
59+ echo "HC=$HC" >> $GITHUB_ENV
100− echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
60+ echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV
101− echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
61+ echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV
102− echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
103− else
104− HC=$HCDIR/bin/$HCKIND
105− echo "HC=$HC" >> "$GITHUB_ENV"
106− echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
107− echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
108− echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
62+ echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
109− fi
110−
111 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
63 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
112− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
64+ echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
113− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
65+ echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
114− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
66+ echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
115− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
67+ echo "HEADHACKAGE=false" >> $GITHUB_ENV
116− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
68+ echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV
117− echo "GHCJSARITH=0" >> "$GITHUB_ENV"
69+ echo "GHCJSARITH=0" >> $GITHUB_ENV
118 env:
70 env:
119− HCKIND: ${{ matrix.compilerKind }}
120− HCNAME: ${{ matrix.compiler }}
71+ CC: ${{ matrix.compiler }}
121− HCVER: ${{ matrix.compilerVersion }}
122 - name: env
72 - name: env
123 run: |
73 run: |
124 env
74 env
@@ -141,10 +91,6 @@ jobs:
141 repository hackage.haskell.org
91 repository hackage.haskell.org
142 url: http://hackage.haskell.org/
92 url: http://hackage.haskell.org/
143 EOF
93 EOF
144− cat >> $CABAL_CONFIG <<EOF
145− program-default-options
146− ghc-options: $GHCJOBS +RTS -M3G -RTS
147− EOF
148 cat $CABAL_CONFIG
94 cat $CABAL_CONFIG
149 - name: versions
95 - name: versions
150 run: |
96 run: |
@@ -183,8 +129,7 @@ jobs:
183 - name: generate cabal.project
129 - name: generate cabal.project
184 run: |
130 run: |
185 PKGDIR_openapi3="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/openapi3-[0-9.]*')"
131 PKGDIR_openapi3="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/openapi3-[0-9.]*')"
186− echo "PKGDIR_openapi3=${PKGDIR_openapi3}" >> "$GITHUB_ENV"
132+ echo "PKGDIR_openapi3=${PKGDIR_openapi3}" >> $GITHUB_ENV
187− rm -f cabal.project cabal.project.local
188 touch cabal.project
133 touch cabal.project
189 touch cabal.project.local
134 touch cabal.project.local
190 echo "packages: ${PKGDIR_openapi3}" >> cabal.project
135 echo "packages: ${PKGDIR_openapi3}" >> cabal.project
@@ -230,14 +175,3 @@ jobs:
230 run: |
175 run: |
231 rm -f cabal.project.local
176 rm -f cabal.project.local
232 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
177 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
233− - name: prepare for constraint sets
234− run: |
235− rm -f cabal.project.local
236− - name: constraint set aeson-2
237− run: |
238− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' --dependencies-only -j2 all
239− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' all
240− - name: constraint set aeson-1
241− run: |
242− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' --dependencies-only -j2 all ; fi
243− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' all ; fi
CHANGELOG.md−18
@@ -1,24 +1,6 @@
1Unreleased
1Unreleased
2----------
2----------
3
3
4−3.2.2
5−-----
6−
7−- Fix bug with infinite recursion in GToSchema [#37](https://github.com/biocad/openapi3/pull/37).
8−
9−3.2.1
10−-----
11−
12−- Support aeson-2.0.3.
13−- Support GHC-9.2 (doctests still fail).
14−
15−3.2.0
16−-----
17−
18−- Support aeson-2 [#34](https://github.com/biocad/openapi3/pull/34).
19−- Use `SecurityDefinitions` type for `_componentsSecuritySchemes`
20− [#32](https://github.com/biocad/openapi3/pull/32).
21−
223.1.0
43.1.0
23-----
5-----
24
6
cabal.haskell-cideleted−11
@@ -1,11 +0,0 @@
1−branches: master
2−
3−distribution: focal
4−allow-failures: >=9.2
5−
6−constraint-set aeson-1
7− constraints: aeson <2.0
8− ghc: <9.2
9−
10−constraint-set aeson-2
11− constraints: aeson >=2.0
openapi3.cabal+13−16
@@ -1,6 +1,6 @@
1cabal-version: >=1.10
1cabal-version: >=1.10
2name: openapi3
2name: openapi3
3−version: 3.2.2
3+version: 3.1.0
4
4
5synopsis: OpenAPI 3.0 data model
5synopsis: OpenAPI 3.0 data model
6category: Web, Swagger, OpenApi
6category: Web, Swagger, OpenApi
@@ -26,9 +26,8 @@ tested-with:
26 GHC ==8.4.4
26 GHC ==8.4.4
27 || ==8.6.5
27 || ==8.6.5
28 || ==8.8.4
28 || ==8.8.4
29− || ==8.10.7
29+ || ==8.10.4
30− || ==9.0.2
30+ || ==9.0.1
31− || ==9.2.2
32
31
33custom-setup
32custom-setup
34 setup-depends:
33 setup-depends:
@@ -57,25 +56,23 @@ library
57 Data.OpenApi.Internal.AesonUtils
56 Data.OpenApi.Internal.AesonUtils
58 Data.OpenApi.Internal.TypeShape
57 Data.OpenApi.Internal.TypeShape
59
58
60− Data.OpenApi.Aeson.Compat
61−
62 -- GHC boot libraries
59 -- GHC boot libraries
63 build-depends:
60 build-depends:
64− base >=4.11.1.0 && <4.17
61+ base >=4.11.1.0 && <4.16
65− , bytestring >=0.10.8.2 && <0.12
62+ , bytestring >=0.10.8.2 && <0.11
66 , containers >=0.5.11.0 && <0.7
63 , containers >=0.5.11.0 && <0.7
67− , template-haskell >=2.13.0.0 && <2.19
64+ , template-haskell >=2.13.0.0 && <2.18
68− , time >=1.8.0.2 && <1.14
65+ , time >=1.8.0.2 && <1.10
69 , transformers >=0.5.5.0 && <0.6
66 , transformers >=0.5.5.0 && <0.6
70
67
71 build-depends:
68 build-depends:
72 mtl >=2.2.2 && <2.3
69 mtl >=2.2.2 && <2.3
73− , text >=1.2.3.1 && <2.1
70+ , text >=1.2.3.1 && <1.3
74
71
75 -- other dependencies
72 -- other dependencies
76 build-depends:
73 build-depends:
77− base-compat-batteries >=0.11.1 && <0.13
74+ base-compat-batteries >=0.11.1 && <0.12
78− , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1
75+ , aeson >=1.4.2.0 && <1.6
79 , aeson-pretty >=0.8.7 && <0.9
76 , aeson-pretty >=0.8.7 && <0.9
80 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
77 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
81 , cookie >=0.4.3 && <0.5
78 , cookie >=0.4.3 && <0.5
@@ -83,7 +80,7 @@ library
83 , hashable >=1.2.7.0 && <1.5
80 , hashable >=1.2.7.0 && <1.5
84 , http-media >=0.8.0.0 && <0.9
81 , http-media >=0.8.0.0 && <0.9
85 , insert-ordered-containers >=0.2.3 && <0.3
82 , insert-ordered-containers >=0.2.3 && <0.3
86− , lens >=4.16.1 && <5.2
83+ , lens >=4.16.1 && <5.1
87 , network >=2.6.3.5 && <3.2
84 , network >=2.6.3.5 && <3.2
88 , optics-core >=0.2 && <0.5
85 , optics-core >=0.2 && <0.5
89 , optics-th >=0.2 && <0.5
86 , optics-th >=0.2 && <0.5
@@ -122,14 +119,14 @@ test-suite spec
122
119
123 -- test-suite only dependencies
120 -- test-suite only dependencies
124 build-depends:
121 build-depends:
125− hspec >=2.5.5 && <2.10
122+ hspec >=2.5.5 && <2.9
126 , HUnit >=1.6.0.0 && <1.7
123 , HUnit >=1.6.0.0 && <1.7
127 , quickcheck-instances >=0.3.19 && <0.14
124 , quickcheck-instances >=0.3.19 && <0.14
128 , utf8-string >=1.0.1.1 && <1.1
125 , utf8-string >=1.0.1.1 && <1.1
129
126
130 -- https://github.com/haskell/cabal/issues/3708
127 -- https://github.com/haskell/cabal/issues/3708
131 build-tool-depends:
128 build-tool-depends:
132− hspec-discover:hspec-discover >=2.5.5 && <2.10
129+ hspec-discover:hspec-discover >=2.5.5 && <2.9
133
130
134 other-modules:
131 other-modules:
135 SpecCommon
132 SpecCommon
src/Data/OpenApi/Aeson/Compat.hsdeleted−76
@@ -1,76 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−module Data.OpenApi.Aeson.Compat where
4−
5−#if MIN_VERSION_aeson(2,0,0)
6−import Data.Aeson (Key)
7−import qualified Data.Aeson.Key as Key
8−import qualified Data.Aeson.KeyMap as KeyMap
9−#else
10−import qualified Data.HashMap.Strict as HM
11−#endif
12−import Data.Bifunctor (first)
13−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
14−import qualified Data.Text as T
15−
16−#if MIN_VERSION_aeson(2,0,0)
17−deleteKey :: Key -> KeyMap.KeyMap v -> KeyMap.KeyMap v
18−deleteKey = KeyMap.delete
19−
20−objectToList :: KeyMap.KeyMap v -> [(Key, v)]
21−objectToList = KeyMap.toList
22−
23−objectKeys :: KeyMap.KeyMap v -> [T.Text]
24−objectKeys = map Key.toText . KeyMap.keys
25−
26−stringToKey :: String -> Key
27−stringToKey = Key.fromString
28−
29−keyToString :: Key -> String
30−keyToString = Key.toString
31−
32−keyToText :: Key -> T.Text
33−keyToText = Key.toText
34−
35−toInsOrdHashMap :: KeyMap.KeyMap v -> InsOrdHashMap.InsOrdHashMap T.Text v
36−toInsOrdHashMap = InsOrdHashMap.fromList . fmap (first Key.toText) . KeyMap.toList
37−
38−fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> KeyMap.KeyMap v
39−fromInsOrdHashMap = KeyMap.fromList . fmap (first Key.fromText) . InsOrdHashMap.toList
40−
41−lookupKey :: T.Text -> KeyMap.KeyMap v -> Maybe v
42−lookupKey = KeyMap.lookup . Key.fromText
43−
44−hasKey :: T.Text -> KeyMap.KeyMap a -> Bool
45−hasKey = KeyMap.member . Key.fromText
46−#else
47−deleteKey :: T.Text -> HM.HashMap T.Text v -> HM.HashMap T.Text v
48−deleteKey = HM.delete
49−
50−objectToList :: HM.HashMap T.Text v -> [(T.Text, v)]
51−objectToList = HM.toList
52−
53−objectKeys :: HM.HashMap T.Text v -> [T.Text]
54−objectKeys = HM.keys
55−
56−stringToKey :: String -> T.Text
57−stringToKey = T.pack
58−
59−keyToString :: T.Text -> String
60−keyToString = T.unpack
61−
62−keyToText :: T.Text -> T.Text
63−keyToText = id
64−
65−toInsOrdHashMap :: HM.HashMap T.Text v -> InsOrdHashMap.InsOrdHashMap T.Text v
66−toInsOrdHashMap = InsOrdHashMap.fromHashMap
67−
68−fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> HM.HashMap T.Text v
69−fromInsOrdHashMap = InsOrdHashMap.toHashMap
70−
71−lookupKey :: T.Text -> HM.HashMap T.Text v -> Maybe v
72−lookupKey = HM.lookup
73−
74−hasKey :: T.Text -> HM.HashMap T.Text a -> Bool
75−hasKey = HM.member
76−#endif
src/Data/OpenApi/Internal.hs+15−18
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
@@ -22,9 +21,6 @@ import Prelude.Compat
22import Control.Applicative
21import Control.Applicative
23import Control.Lens ((&), (.~), (?~))
22import Control.Lens ((&), (.~), (?~))
24import Data.Aeson hiding (Encoding)
23import Data.Aeson hiding (Encoding)
25−#if MIN_VERSION_aeson(2,0,0)
26−import qualified Data.Aeson.KeyMap as KeyMap
27−#endif
28import qualified Data.Aeson.Types as JSON
24import qualified Data.Aeson.Types as JSON
29import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
25import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
30 constrIndex, mkConstr, mkDataType)
26 constrIndex, mkConstr, mkDataType)
@@ -49,13 +45,17 @@ import Text.Read (readMaybe)
49import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
45import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
50import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
46import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51
47
52−import Data.OpenApi.Aeson.Compat (deleteKey)
53−import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAesonOptions (..),
54− mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,
55− sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,
56− sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)
57−import Data.OpenApi.Internal.Utils
58import Generics.SOP.TH (deriveGeneric)
48import Generics.SOP.TH (deriveGeneric)
49+import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToJSON
50+ ,sopSwaggerGenericToJSONWithOpts
51+ ,sopSwaggerGenericParseJSON
52+ ,HasSwaggerAesonOptions(..)
53+ ,AesonDefaultValue(..)
54+ ,mkSwaggerAesonOptions
55+ ,saoAdditionalPairs
56+ ,saoSubObject)
57+import Data.OpenApi.Internal.Utils
58+import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToEncoding)
59
59
60-- $setup
60-- $setup
61-- >>> :seti -XDataKinds
61-- >>> :seti -XDataKinds
@@ -196,7 +196,7 @@ data Components = Components
196 , _componentsExamples :: Definitions Example
196 , _componentsExamples :: Definitions Example
197 , _componentsRequestBodies :: Definitions RequestBody
197 , _componentsRequestBodies :: Definitions RequestBody
198 , _componentsHeaders :: Definitions Header
198 , _componentsHeaders :: Definitions Header
199− , _componentsSecuritySchemes :: SecurityDefinitions
199+ , _componentsSecuritySchemes :: Definitions SecurityScheme
200 , _componentsLinks :: Definitions Link
200 , _componentsLinks :: Definitions Link
201 , _componentsCallbacks :: Definitions Callback
201 , _componentsCallbacks :: Definitions Callback
202 } deriving (Eq, Show, Generic, Data, Typeable)
202 } deriving (Eq, Show, Generic, Data, Typeable)
@@ -337,7 +337,7 @@ data RequestBody = RequestBody
337 -- | The content of the request body.
337 -- | The content of the request body.
338 -- The key is a media type or media type range and the value describes it.
338 -- The key is a media type or media type range and the value describes it.
339 -- For requests that match multiple keys, only the most specific key is applicable.
339 -- For requests that match multiple keys, only the most specific key is applicable.
340− -- e.g. @text/plain@ overrides @text/\*@
340+ -- e.g. @text/plain@ overrides @text/*@
341 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
341 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
342
342
343 -- | Determines if the request body is required in the request.
343 -- | Determines if the request body is required in the request.
@@ -394,7 +394,7 @@ data Encoding = Encoding
394 -- for other primitive types – @text/plain@; for object - @application/json@;
394 -- for other primitive types – @text/plain@; for object - @application/json@;
395 -- for array – the default is defined based on the inner type.
395 -- for array – the default is defined based on the inner type.
396 -- The value can be a specific media type (e.g. @application/json@),
396 -- The value can be a specific media type (e.g. @application/json@),
397− -- a wildcard media type (e.g. @image/\*@), or a comma-separated list of the two types.
397+ -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
398 _encodingContentType :: Maybe MediaType
398 _encodingContentType :: Maybe MediaType
399
399
400 -- | A map allowing additional information to be provided as headers,
400 -- | A map allowing additional information to be provided as headers,
@@ -734,7 +734,7 @@ data Response = Response
734 -- | A map containing descriptions of potential response payloads.
734 -- | A map containing descriptions of potential response payloads.
735 -- The key is a media type or media type range and the value describes it.
735 -- The key is a media type or media type range and the value describes it.
736 -- For responses that match multiple keys, only the most specific key is applicable.
736 -- For responses that match multiple keys, only the most specific key is applicable.
737− -- e.g. @text/plain@ overrides @text/\*@.
737+ -- e.g. @text/plain@ overrides @text/*@.
738 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
738 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
739
739
740 -- | Maps a header name to its definition.
740 -- | Maps a header name to its definition.
@@ -1125,7 +1125,6 @@ instance SwaggerMonoid Response
1125instance SwaggerMonoid ExternalDocs
1125instance SwaggerMonoid ExternalDocs
1126instance SwaggerMonoid Operation
1126instance SwaggerMonoid Operation
1127instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1127instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1128−instance SwaggerMonoid SecurityDefinitions
1129
1128
1130instance SwaggerMonoid MimeList
1129instance SwaggerMonoid MimeList
1131deriving instance SwaggerMonoid URL
1130deriving instance SwaggerMonoid URL
@@ -1492,7 +1491,7 @@ instance FromJSON Param where
1492instance FromJSON Responses where
1491instance FromJSON Responses where
1493 parseJSON (Object o) = Responses
1492 parseJSON (Object o) = Responses
1494 <$> o .:? "default"
1493 <$> o .:? "default"
1495− <*> parseJSON (Object (deleteKey "default" o))
1494+ <*> parseJSON (Object (HashMap.delete "default" o))
1496 parseJSON _ = empty
1495 parseJSON _ = empty
1497
1496
1498instance FromJSON Example where
1497instance FromJSON Example where
@@ -1615,5 +1614,3 @@ instance AesonDefaultValue MimeList where defaultValue = Just mempty
1615instance AesonDefaultValue Info
1614instance AesonDefaultValue Info
1616instance AesonDefaultValue ParamLocation
1615instance AesonDefaultValue ParamLocation
1617instance AesonDefaultValue Link
1616instance AesonDefaultValue Link
1618−instance AesonDefaultValue SecurityDefinitions where
1619− defaultValue = Just mempty
src/Data/OpenApi/Internal/AesonUtils.hs+10−11
@@ -36,19 +36,18 @@ import Data.Text (Text)
36import Generics.SOP
36import Generics.SOP
37
37
38import qualified Data.Text as T
38import qualified Data.Text as T
39+import qualified Data.HashMap.Strict as HM
39import qualified Data.Set as Set
40import qualified Data.Set as Set
40import qualified Data.HashMap.Strict.InsOrd as InsOrd
41import qualified Data.HashMap.Strict.InsOrd as InsOrd
41import qualified Data.HashSet.InsOrd as InsOrdHS
42import qualified Data.HashSet.InsOrd as InsOrdHS
42
43
43−import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
44−
45-------------------------------------------------------------------------------
44-------------------------------------------------------------------------------
46-- SwaggerAesonOptions
45-- SwaggerAesonOptions
47-------------------------------------------------------------------------------
46-------------------------------------------------------------------------------
48
47
49data SwaggerAesonOptions = SwaggerAesonOptions
48data SwaggerAesonOptions = SwaggerAesonOptions
50 { _saoPrefix :: String
49 { _saoPrefix :: String
51− , _saoAdditionalPairs :: [Pair]
50+ , _saoAdditionalPairs :: [(Text, Value)]
52 , _saoSubObject :: Maybe String
51 , _saoSubObject :: Maybe String
53 }
52 }
54
53
@@ -155,14 +154,14 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
155 go Nil Nil Nil = []
154 go Nil Nil Nil = []
156 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
155 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
157 | Just name' == sub = case json of
156 | Just name' == sub = case json of
158− Object m -> objectToList m ++ rest
157+ Object m -> HM.toList m ++ rest
159 Null -> rest
158 Null -> rest
160 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
159 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
161 -- If default value: omit it.
160 -- If default value: omit it.
162 | Just x == def =
161 | Just x == def =
163 rest
162 rest
164 | otherwise =
163 | otherwise =
165− (stringToKey name', json) : rest
164+ (T.pack name', json) : rest
166 where
165 where
167 json = toJSON x
166 json = toJSON x
168 name' = fieldNameModifier name
167 name' = fieldNameModifier name
@@ -196,11 +195,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
196 proxy = Proxy :: Proxy a
195 proxy = Proxy :: Proxy a
197 opts = swaggerAesonOptions proxy
196 opts = swaggerAesonOptions proxy
198
197
199− parseAdditionalField :: Object -> Pair -> Parser ()
198+ parseAdditionalField :: Object -> (Text, Value) -> Parser ()
200 parseAdditionalField obj (k, v) = do
199 parseAdditionalField obj (k, v) = do
201 v' <- obj .: k
200 v' <- obj .: k
202 unless (v == v') $ fail $
201 unless (v == v') $ fail $
203− "Additonal field don't match for key " ++ keyToString k
202+ "Additonal field don't match for key " ++ T.unpack k
204 ++ ": " ++ show v
203 ++ ": " ++ show v
205 ++ " /= " ++ show v'
204 ++ " /= " ++ show v'
206
205
@@ -231,8 +230,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
231 -- Note: we might strip fields of outer structure.
230 -- Note: we might strip fields of outer structure.
232 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
231 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
233 | otherwise = case def of
232 | otherwise = case def of
234− Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
233+ Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest
235− Nothing -> cons <$> obj .: stringToKey name' <*> rest
234+ Nothing -> cons <$> obj .: T.pack name' <*> rest
236 where
235 where
237 cons h t = I h :* t
236 cons h t = I h :* t
238 name' = fieldNameModifier name
237 name' = fieldNameModifier name
@@ -295,14 +294,14 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
295 go Nil Nil Nil = mempty
294 go Nil Nil Nil = mempty
296 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
295 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
297 | Just name' == sub = case toJSON x of
296 | Just name' == sub = case toJSON x of
298− Object m -> pairsToSeries (objectToList m) <> rest
297+ Object m -> pairsToSeries (HM.toList m) <> rest
299 Null -> rest
298 Null -> rest
300 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
299 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
301 -- If default value: omit it.
300 -- If default value: omit it.
302 | Just x == def =
301 | Just x == def =
303 rest
302 rest
304 | otherwise =
303 | otherwise =
305− (stringToKey name' .= x) <> rest
304+ (T.pack name' .= x) <> rest
306 where
305 where
307 name' = fieldNameModifier name
306 name' = fieldNameModifier name
308 rest = go xs names defs
307 rest = go xs names defs
src/Data/OpenApi/Internal/Schema.hs+17−21
@@ -64,14 +64,13 @@ import GHC.Generics
64import qualified Data.UUID.Types as UUID
64import qualified Data.UUID.Types as UUID
65import Type.Reflection (Typeable, typeRep)
65import Type.Reflection (Typeable, typeRep)
66
66
67−import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)
68−import Data.OpenApi.Declare
67+import Data.OpenApi.Declare
69−import Data.OpenApi.Internal
68+import Data.OpenApi.Internal
70−import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
69+import Data.OpenApi.Internal.ParamSchema (ToParamSchema(..))
71−import Data.OpenApi.Internal.TypeShape
72−import Data.OpenApi.Lens hiding (name, schema)
70+import Data.OpenApi.Lens hiding (name, schema)
73−import qualified Data.OpenApi.Lens as Swagger
71+import qualified Data.OpenApi.Lens as Swagger
74−import Data.OpenApi.SchemaOptions
72+import Data.OpenApi.SchemaOptions
73+import Data.OpenApi.Internal.TypeShape
75
74
76import qualified Data.ByteString as BS
75import qualified Data.ByteString as BS
77import qualified Data.ByteString.Lazy.Char8 as BSL
76import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -406,8 +405,8 @@ sketchSchema = sketch . toJSON
406 _ -> Nothing
405 _ -> Nothing
407 go (Object o) = mempty
406 go (Object o) = mempty
408 & type_ ?~ OpenApiObject
407 & type_ ?~ OpenApiObject
409− & required .~ sort (objectKeys o)
408+ & required .~ sort (HashMap.keys o)
410− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
409+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
411
410
412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
411-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
413-- Produced schema uses as much constraints as possible.
412-- Produced schema uses as much constraints as possible.
@@ -571,12 +570,12 @@ sketchStrictSchema = go . toJSON
571 go js@(Object o) = mempty
570 go js@(Object o) = mempty
572 & type_ ?~ OpenApiObject
571 & type_ ?~ OpenApiObject
573 & required .~ sort names
572 & required .~ sort names
574− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
573+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
575 & maxProperties ?~ fromIntegral (length names)
574 & maxProperties ?~ fromIntegral (length names)
576 & minProperties ?~ fromIntegral (length names)
575 & minProperties ?~ fromIntegral (length names)
577 & enum_ ?~ [js]
576 & enum_ ?~ [js]
578 where
577 where
579− names = objectKeys o
578+ names = HashMap.keys o
580
579
581class GToSchema (f :: * -> *) where
580class GToSchema (f :: * -> *) where
582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
581 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -811,13 +810,13 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
810 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
811 => Proxy (map key value) -> Declare (Definitions Schema) Schema
813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
812declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
814− ToJSONKeyText getKey _ -> objectSchema getKey
813+ ToJSONKeyText keyToText _ -> objectSchema keyToText
815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
814 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
816 where
815 where
817− objectSchema getKey = do
816+ objectSchema keyToText = do
818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
817 valueRef <- declareSchemaRef (Proxy :: Proxy value)
819 let allKeys = [minBound..maxBound :: key]
818 let allKeys = [minBound..maxBound :: key]
820− mkPair k = (keyToText $ getKey k, valueRef)
819+ mkPair k = (keyToText k, valueRef)
821 return $ mempty
820 return $ mempty
822 & type_ ?~ OpenApiObject
821 & type_ ?~ OpenApiObject
823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
822 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
@@ -945,13 +944,10 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
945 case schema ^. items of
944 case schema ^. items of
946 Just (OpenApiItemsArray [_]) -> fieldSchema
945 Just (OpenApiItemsArray [_]) -> fieldSchema
947 _ -> do
946 _ -> do
948− -- We have to run recordSchema instead of just using its defs,
947+ declare defs
949− -- since those can be recursive and will lead to infinite loop,
950− -- see https://github.com/biocad/openapi3/pull/37
951− NamedSchema _ schema' <- recordSchema
952− return (unnamed schema')
948+ return (unnamed schema)
953 where
949 where
954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty
950+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
951 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
952 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
957
953
src/Data/OpenApi/Internal/Schema/Validation.hs+11−23
@@ -1,5 +1,4 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE CPP #-}
3{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveFunctor #-}
5{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -32,14 +31,10 @@ import Control.Lens hiding (allOf)
32import Control.Monad (forM, forM_, when)
31import Control.Monad (forM, forM_, when)
33
32
34import Data.Aeson hiding (Result)
33import Data.Aeson hiding (Result)
35−#if MIN_VERSION_aeson(2,0,0)
36−import qualified Data.Aeson.KeyMap as KeyMap
37−#endif
38import Data.Foldable (for_, sequenceA_,
34import Data.Foldable (for_, sequenceA_,
39 traverse_)
35 traverse_)
40−#if !MIN_VERSION_aeson(2,0,0)
41import Data.HashMap.Strict (HashMap)
36import Data.HashMap.Strict (HashMap)
42−#endif
37+import qualified Data.HashMap.Strict as HashMap
43import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
38import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
44import qualified "unordered-containers" Data.HashSet as HashSet
39import qualified "unordered-containers" Data.HashSet as HashSet
45import Data.Maybe (fromMaybe)
40import Data.Maybe (fromMaybe)
@@ -52,12 +47,11 @@ import qualified Data.Text.Lazy.Encoding as TL
52import Data.Vector (Vector)
47import Data.Vector (Vector)
53import qualified Data.Vector as Vector
48import qualified Data.Vector as Vector
54
49
55−import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)
56−import Data.OpenApi.Declare
50+import Data.OpenApi.Declare
51+import Data.OpenApi.Internal
57−import Data.OpenApi.Internal
52+import Data.OpenApi.Internal.Utils
58−import Data.OpenApi.Internal.Schema
53+import Data.OpenApi.Internal.Schema
59−import Data.OpenApi.Internal.Utils
60−import Data.OpenApi.Lens
54+import Data.OpenApi.Lens
61
55
62-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
56-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
63-- This can be used with QuickCheck to ensure those instances are coherent:
57-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -372,16 +366,10 @@ validateArray xs = do
372 len = Vector.length xs
366 len = Vector.length xs
373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
367 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
374
368
375−validateObject ::
376−#if MIN_VERSION_aeson(2,0,0)
377− KeyMap.KeyMap Value
378−#else
379− HashMap Text Value
369+validateObject :: HashMap Text Value -> Validation Schema ()
380−#endif
381− -> Validation Schema ()
382validateObject o = withSchema $ \sch ->
370validateObject o = withSchema $ \sch ->
383 case sch ^. discriminator of
371 case sch ^. discriminator of
384− Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of
372+ Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of
385 Just (Success pvalue) ->
373 Just (Success pvalue) ->
386 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
374 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
387 -- TODO ref may be name or reference
375 -- TODO ref may be name or reference
@@ -400,15 +388,15 @@ validateObject o = withSchema $ \sch ->
400 validateRequired
388 validateRequired
401 validateProps
389 validateProps
402 where
390 where
403− size = fromIntegral (length o)
391+ size = fromIntegral (HashMap.size o)
404
392
405 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
393 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
406 validateReq n =
394 validateReq n =
407− when (not (hasKey n o)) $
395+ when (not (HashMap.member n o)) $
408 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
396 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
409
397
410 validateProps = withSchema $ \sch -> do
398 validateProps = withSchema $ \sch -> do
411− for_ (objectToList o) $ \(keyToText -> k, v) ->
399+ for_ (HashMap.toList o) $ \(k, v) ->
412 case v of
400 case v of
413 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
401 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
414 _ ->
402 _ ->
src/Data/OpenApi/Schema/Generator.hs+1−3
@@ -25,8 +25,6 @@ import Test.QuickCheck (arbitrary)
25import Test.QuickCheck.Gen
25import Test.QuickCheck.Gen
26import Test.QuickCheck.Property
26import Test.QuickCheck.Property
27
27
28−import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)
29−
30-- | Note: 'schemaGen' may 'error', if schema type is not specified,
28-- | Note: 'schemaGen' may 'error', if schema type is not specified,
31-- and cannot be inferred.
29-- and cannot be inferred.
32schemaGen :: Definitions Schema -> Schema -> Gen Value
30schemaGen :: Definitions Schema -> Schema -> Gen Value
@@ -97,7 +95,7 @@ schemaGen defns schema =
97 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
95 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
98 _ -> return []
96 _ -> return []
99 x <- sequence $ gens <> additionalGens
97 x <- sequence $ gens <> additionalGens
100− return . Object $ fromInsOrdHashMap x
98+ return . Object $ M.toHashMap x
101
99
102dereference :: Definitions a -> Referenced a -> a
100dereference :: Definitions a -> Referenced a -> a
103dereference _ (Inline a) = a
101dereference _ (Inline a) = a
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-16.31
1+resolver: lts-16.8
2packages:
2packages:
3- '.'
3- '.'
4extra-deps:
4extra-deps:
test/Data/OpenApi/CommonTestTypes.hs−123
@@ -863,129 +863,6 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
863}
863}
864|]
864|]
865
865
866−-- ========================================================================
867−-- Natural Language (single field data with recursive fields)
868−-- ========================================================================
869−
870−data Predicate
871− = PredicateNoun Noun
872− | PredicateOmitted Omitted
873− deriving (Eq, Ord, Read, Show, Generic)
874−instance ToJSON Predicate
875−instance ToSchema Predicate
876−
877−data Noun
878− = Noun
879− { nounSurf :: LangWord
880− , nounModify :: [Modifier]
881− }
882− deriving (Eq, Ord, Read, Show, Generic)
883−instance ToJSON Noun
884−instance ToSchema Noun
885−
886−data LangWord
887− = LangWord
888− { langWordSurf :: String
889− , langWordBase :: String
890− }
891− deriving (Eq, Ord, Read, Show, Generic)
892−instance ToJSON LangWord
893−instance ToSchema LangWord
894−
895−data Modifier
896− = ModifierNoun Noun
897− | ModifierOmitted Omitted
898− deriving (Eq, Ord, Read, Show, Generic)
899−instance ToJSON Modifier
900−instance ToSchema Modifier
901−
902−newtype Omitted
903− = Omitted
904− { omittedModify :: [Modifier]
905− }
906− deriving (Eq, Ord, Read, Show, Generic)
907−instance ToJSON Omitted
908−instance ToSchema Omitted
909−
910−predicateSchemaDeclareJSON :: Value
911−predicateSchemaDeclareJSON = [aesonQQ|
912−[
913− {
914− "Predicate": {
915− "oneOf": [
916− {
917− "properties": {
918− "contents": { "$ref": "#/components/schemas/Noun" },
919− "tag": { "enum": ["PredicateNoun"], "type": "string" }
920− },
921− "required": ["tag", "contents"],
922− "type": "object"
923− },
924− {
925− "properties": {
926− "contents": { "$ref": "#/components/schemas/Omitted" },
927− "tag": { "enum": ["PredicateOmitted"], "type": "string" }
928− },
929− "required": ["tag", "contents"],
930− "type": "object"
931− }
932− ],
933− "type": "object"
934− },
935− "Noun": {
936− "properties": {
937− "nounModify": {
938− "items": { "$ref": "#/components/schemas/Modifier" },
939− "type": "array"
940− },
941− "nounSurf": { "$ref": "#/components/schemas/LangWord" }
942− },
943− "required": ["nounSurf", "nounModify"],
944− "type": "object"
945− },
946− "LangWord": {
947− "properties": {
948− "langWordBase": { "type": "string" },
949− "langWordSurf": { "type": "string" }
950− },
951− "required": ["langWordSurf", "langWordBase"],
952− "type": "object"
953− },
954− "Modifier": {
955− "oneOf": [
956− {
957− "properties": {
958− "contents": { "$ref": "#/components/schemas/Noun" },
959− "tag": { "enum": ["ModifierNoun"], "type": "string" }
960− },
961− "required": ["tag", "contents"],
962− "type": "object"
963− },
964− {
965− "properties": {
966− "contents": { "$ref": "#/components/schemas/Omitted" },
967− "tag": { "enum": ["ModifierOmitted"], "type": "string" }
968− },
969− "required": ["tag", "contents"],
970− "type": "object"
971− }
972− ],
973− "type": "object"
974− },
975− "Omitted": {
976− "properties": {
977− "omittedModify": {
978− "items": { "$ref": "#/components/schemas/Modifier" },
979− "type": "array"
980− }
981− },
982− "required": ["omittedModify"],
983− "type": "object"
984− }
985− },
986− { "$ref": "#/components/schemas/Predicate" }
987−]
988−|]
989
866
990-- ========================================================================
867-- ========================================================================
991-- TimeOfDay
868-- TimeOfDay
test/Data/OpenApi/Schema/ValidationSpec.hs+3−20
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE PackageImports #-}
2{-# LANGUAGE PackageImports #-}
4{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE RecordWildCards #-}
@@ -9,10 +8,6 @@ module Data.OpenApi.Schema.ValidationSpec where
9import Control.Applicative
8import Control.Applicative
10import Control.Lens ((&), (.~), (?~))
9import Control.Lens ((&), (.~), (?~))
11import Data.Aeson
10import Data.Aeson
12−#if MIN_VERSION_aeson(2,0,0)
13−import qualified Data.Aeson.Key as Key
14−import qualified Data.Aeson.KeyMap as KeyMap
15−#endif
16import Data.Aeson.Types
11import Data.Aeson.Types
17import Data.Hashable (Hashable)
12import Data.Hashable (Hashable)
18import Data.HashMap.Strict (HashMap)
13import Data.HashMap.Strict (HashMap)
@@ -35,7 +30,6 @@ import GHC.Generics
35
30
36import Data.OpenApi
31import Data.OpenApi
37import Data.OpenApi.Declare
32import Data.OpenApi.Declare
38−import Data.OpenApi.Aeson.Compat (stringToKey)
39
33
40import Test.Hspec
34import Test.Hspec
41import Test.Hspec.QuickCheck
35import Test.Hspec.QuickCheck
@@ -130,9 +124,9 @@ instance Arbitrary Person where
130
124
131invalidPersonToJSON :: Person -> Value
125invalidPersonToJSON :: Person -> Value
132invalidPersonToJSON Person{..} = object
126invalidPersonToJSON Person{..} = object
133− [ stringToKey "personName" .= toJSON name
127+ [ T.pack "personName" .= toJSON name
134− , stringToKey "personPhone" .= toJSON phone
128+ , T.pack "personPhone" .= toJSON phone
135− , stringToKey "personEmail" .= toJSON email
129+ , T.pack "personEmail" .= toJSON email
136 ]
130 ]
137
131
138-- ========================================================================
132-- ========================================================================
@@ -301,8 +295,6 @@ instance Eq ZonedTime where
301-- Arbitrary instance for Data.Aeson.Value
295-- Arbitrary instance for Data.Aeson.Value
302-- ========================================================================
296-- ========================================================================
303
297
304−-- These instances were introduces in aeson upstream in 2.0.3
305−#if !MIN_VERSION_aeson(2,0,3)
306instance Arbitrary Value where
298instance Arbitrary Value where
307 -- Weights are almost random
299 -- Weights are almost random
308 -- Uniform oneof tends not to build complex objects cause of recursive call.
300 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -313,12 +305,3 @@ instance Arbitrary Value where
313 , (3, Number <$> arbitrary)
305 , (3, Number <$> arbitrary)
314 , (3, Bool <$> arbitrary)
306 , (3, Bool <$> arbitrary)
315 , (1, return Null) ]
307 , (1, return Null) ]
316−
317−#if MIN_VERSION_aeson(2,0,0)
318−instance Arbitrary v => Arbitrary (KeyMap.KeyMap v) where
319− arbitrary = KeyMap.fromList <$> arbitrary
320−
321−instance Arbitrary Key.Key where
322− arbitrary = Key.fromText <$> arbitrary
323−#endif
324−#endif
test/Data/OpenApi/SchemaSpec.hs−4
@@ -59,9 +59,6 @@ checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js
59 where
59 where
60 (defs, s) = runDeclare (declareSchema proxy) mempty
60 (defs, s) = runDeclare (declareSchema proxy) mempty
61
61
62−checkToSchemaDeclare :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
63−checkToSchemaDeclare proxy js = runDeclare (declareSchemaRef proxy) mempty <=> js
64−
65spec :: Spec
62spec :: Spec
66spec = do
63spec = do
67 describe "Generic ToSchema" $ do
64 describe "Generic ToSchema" $ do
@@ -81,7 +78,6 @@ spec = do
81 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
78 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
82 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
79 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
83 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON
80 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON
84− context "Natural Language (single field data with recursive fields)" $ checkToSchemaDeclare (Proxy :: Proxy Predicate) predicateSchemaDeclareJSON
85 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
81 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
86 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
82 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
87 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
83 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
test/Data/OpenApiSpec.hs+1−17
@@ -45,10 +45,6 @@ spec = do
45 fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
45 fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
46 it "roundtrips: fmap toJSON . fromJSON" $ do
46 it "roundtrips: fmap toJSON . fromJSON" $ do
47 (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
47 (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
48− context "Security schemes" $ do
49− it "merged correctly" $ do
50− let merged = oAuth2SecurityDefinitionsReadOpenApi <> oAuth2SecurityDefinitionsWriteOpenApi
51− merged `shouldBe` oAuth2SecurityDefinitionsOpenApi
52
48
53main :: IO ()
49main :: IO ()
54main = hspec spec
50main = hspec spec
@@ -445,7 +441,7 @@ responsesDefinitionExampleJSON = [aesonQQ|
445|]
441|]
446
442
447-- =======================================================================
443-- =======================================================================
448−-- Security Definition object
444+-- Responses Definition object
449-- =======================================================================
445-- =======================================================================
450
446
451securityDefinitionsExample :: SecurityDefinitions
447securityDefinitionsExample :: SecurityDefinitions
@@ -531,18 +527,6 @@ oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
531}
527}
532|]
528|]
533
529
534−oAuth2SecurityDefinitionsReadOpenApi :: OpenApi
535−oAuth2SecurityDefinitionsReadOpenApi =
536− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsReadExample
537−
538−oAuth2SecurityDefinitionsWriteOpenApi :: OpenApi
539−oAuth2SecurityDefinitionsWriteOpenApi =
540− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsWriteExample
541−
542−oAuth2SecurityDefinitionsOpenApi :: OpenApi
543−oAuth2SecurityDefinitionsOpenApi =
544− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsExample
545−
546-- =======================================================================
530-- =======================================================================
547-- Swagger object
531-- Swagger object
548-- =======================================================================
532-- =======================================================================
test/SpecCommon.hs+8
@@ -8,6 +8,14 @@ import qualified Data.Vector as Vector
8
8
9import Test.Hspec
9import Test.Hspec
10
10
11+isSubJSON :: Value -> Value -> Bool
12+isSubJSON Null _ = True
13+isSubJSON (Object x) (Object y) = HashMap.keys x == HashMap.keys i && F.and i
14+ where
15+ i = HashMap.intersectionWith isSubJSON x y
16+isSubJSON (Array xs) (Array ys) = Vector.length xs == Vector.length ys && F.and (Vector.zipWith isSubJSON xs ys)
17+isSubJSON x y = x == y
18+
11(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
19(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
12x <=> js = do
20x <=> js = do
13 it "encodes correctly" $ do
21 it "encodes correctly" $ do