master..d7cd058 · typeable/openapi3

git.iko.soy/typeable/openapi3

on d7cd058 help sign in

.github/workflows/haskell-ci.yml+30−96

since splitsnapshots

unifiedsplit

@@ -8,117 +8,67 @@

9# For more information, see https://github.com/haskell-CI/haskell-ci

10#

11−# version: 0.14.3

11+# version: 0.12

12#

13−# REGENDATA ("0.14.3",["github","cabal.project"])

13+# REGENDATA ("0.12",["github","cabal.project"])

14#

15name: Haskell-CI

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+1−26

@@ -1,32 +1,7 @@

1Unreleased

2----------

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−

22−3.1.0

23−-----

24−

25−- Use `format: date-time` for `ToParamSchema ZonedTime` instance (see

26− [#20](https://github.com/biocad/openapi3/pull/20)).

27−- Support generating schema for any polymorphic types via `Typeable` (see

28− [#19](https://github.com/biocad/openapi3/pull/19)).

29−- Allow `hashable-1.3.1`, prettify doctests (see [#18](https://github.com/biocad/openapi3/pull/18)).

4+- Allow `hashable-1.3.1`, prettify doctests.

313.0.2.0

63.0.2.0

32-------

7-------

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+14−17

@@ -1,6 +1,6 @@

1cabal-version: >=1.10

2name: openapi3

3−version: 3.2.2

3+version: 3.0.2.0

5synopsis: OpenAPI 3.0 data model

6category: Web, Swagger, OpenApi

@@ -26,9 +26,8 @@ tested-with:

26 GHC ==8.4.4

27 || ==8.6.5

28 || ==8.8.4

29− || ==8.10.7

29+ || ==8.10.4

30− || ==9.0.2

30+ || ==9.0.1

31− || ==9.2.2

33custom-setup

32custom-setup

34 setup-depends:

33 setup-depends:

@@ -57,33 +56,31 @@ library

57 Data.OpenApi.Internal.AesonUtils

56 Data.OpenApi.Internal.AesonUtils

58 Data.OpenApi.Internal.TypeShape

57 Data.OpenApi.Internal.TypeShape

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

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

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

82 , generics-sop >=0.5.1.0 && <0.6

79 , generics-sop >=0.5.1.0 && <0.6

83− , hashable >=1.2.7.0 && <1.5

80+ , hashable >=1.2.7.0 && <1.4

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.8

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.8

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

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)

60-- $setup

61-- >>> :seti -XDataKinds

@@ -196,7 +196,7 @@ data Components = Components

196 , _componentsExamples :: Definitions Example

197 , _componentsRequestBodies :: Definitions RequestBody

198 , _componentsHeaders :: Definitions Header

199− , _componentsSecuritySchemes :: SecurityDefinitions

199+ , _componentsSecuritySchemes :: Definitions SecurityScheme

200 , _componentsLinks :: Definitions Link

201 , _componentsCallbacks :: Definitions Callback

202 } deriving (Eq, Show, Generic, Data, Typeable)

@@ -337,7 +337,7 @@ data RequestBody = RequestBody

337 -- | The content of the request body.

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.

340− -- e.g. @text/plain@ overrides @text/\*@

340+ -- e.g. @text/plain@ overrides @text/*@

341 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject

342

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@;

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@),

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

399

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.

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.

737− -- e.g. @text/plain@ overrides @text/\*@.

737+ -- e.g. @text/plain@ overrides @text/*@.

738 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject

739

740 -- | Maps a header name to its definition.

@@ -1125,7 +1125,6 @@ instance SwaggerMonoid Response

1125instance SwaggerMonoid ExternalDocs

1126instance SwaggerMonoid Operation

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

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

43−import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)

44−

45-------------------------------------------------------------------------------

44-------------------------------------------------------------------------------

46-- SwaggerAesonOptions

45-- SwaggerAesonOptions

47-------------------------------------------------------------------------------

46-------------------------------------------------------------------------------

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 }

@@ -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/ParamSchema.hs+2−2

@@ -216,9 +216,9 @@ instance ToParamSchema LocalTime where

216

217-- |

218-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format

219−-- Just "date-time"

219+-- Just "yyyy-mm-ddThh:MM:ss+hhMM"

220instance ToParamSchema ZonedTime where

221− toParamSchema _ = timeParamSchema "date-time"

221+ toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"

222

223-- |

224-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format

src/Data/OpenApi/Internal/Schema.hs+81−57

@@ -64,14 +64,13 @@ import GHC.Generics

64import qualified Data.UUID.Types as UUID

65import Type.Reflection (Typeable, typeRep)

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

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

@@ -136,13 +135,13 @@ rename name (NamedSchema _ schema) = NamedSchema name schema

136--

135--

137-- instance ToSchema Coord

136-- instance ToSchema Coord

138-- @

137-- @

139−class Typeable a => ToSchema a where

138+class ToSchema a where

140 -- | Convert a type into an optionally named schema

139 -- | Convert a type into an optionally named schema

141 -- together with all used definitions.

140 -- together with all used definitions.

142 -- Note that the schema itself is included in definitions

141 -- Note that the schema itself is included in definitions

143 -- only if it is recursive (and thus needs its definition in scope).

142 -- only if it is recursive (and thus needs its definition in scope).

144 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema

143 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema

145− default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>

144+ default declareNamedSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>

146 Proxy a -> Declare (Definitions Schema) NamedSchema

145 Proxy a -> Declare (Definitions Schema) NamedSchema

147 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions

146 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions

148

147

@@ -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

@@ -611,12 +610,12 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc

611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema

610instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema

612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema

611instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema

613

612

614−instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema

613+instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema

615

614

616instance ToSchema a => ToSchema (Maybe a) where

615instance ToSchema a => ToSchema (Maybe a) where

617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)

616 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)

618

617

619−instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where

618+instance (ToSchema a, ToSchema b, Typeable a, Typeable b) => ToSchema (Either a b) where

620 -- To match Aeson instance

619 -- To match Aeson instance

621 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }

620 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }

622

621

@@ -628,18 +627,12 @@ instance ToSchema UUID.UUID where

628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p

627 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p

629 & example ?~ toJSON (UUID.toText UUID.nil)

628 & example ?~ toJSON (UUID.toText UUID.nil)

630

629

631−instance (ToSchema a, ToSchema b) => ToSchema (a, b) where

630+instance (ToSchema a, Typeable a, ToSchema b, Typeable b) => ToSchema (a, b)

632− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

631+instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c) => ToSchema (a, b, c)

633−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where

634− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

635−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where

632+instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d) => ToSchema (a, b, c, d)

636− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

637−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where

633+instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d, ToSchema e, Typeable e) => ToSchema (a, b, c, d, e)

638− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

639−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where

634+instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d, ToSchema e, Typeable e, ToSchema f, Typeable f) => ToSchema (a, b, c, d, e, f)

640− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

641−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) where

635+instance (ToSchema a, Typeable a, ToSchema b, Typeable b, ToSchema c, Typeable c, ToSchema d, Typeable d, ToSchema e, Typeable e, ToSchema f, Typeable f, ToSchema g, Typeable g) => ToSchema (a, b, c, d, e, f, g)

642− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

643

636

644timeSchema :: T.Text -> Schema

637timeSchema :: T.Text -> Schema

645timeSchema fmt = mempty

638timeSchema fmt = mempty

@@ -658,7 +651,7 @@ instance ToSchema LocalTime where

658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"

651 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"

659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))

652 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))

660

653

661−-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.

654+-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.

662instance ToSchema ZonedTime where

655instance ToSchema ZonedTime where

663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"

656 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"

664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))

657 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))

@@ -690,10 +683,10 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where

690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))

683instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))

691

684

692-- | NOTE: This schema does not account for the uniqueness of keys.

685-- | NOTE: This schema does not account for the uniqueness of keys.

693−instance (ToSchema a) => ToSchema (IntMap a) where

686+instance (ToSchema a, Typeable a) => ToSchema (IntMap a) where

694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])

687 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])

695

688

696−instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where

689+instance (ToJSONKey k, ToSchema k, ToSchema v, Typeable k, Typeable v) => ToSchema (Map k v) where

697 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of

690 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of

698 ToJSONKeyText _ _ -> declareObjectMapSchema

691 ToJSONKeyText _ _ -> declareObjectMapSchema

699 ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])

692 ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])

@@ -704,7 +697,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where

704 & type_ ?~ OpenApiObject

697 & type_ ?~ OpenApiObject

705 & additionalProperties ?~ AdditionalPropertiesSchema schema

698 & additionalProperties ?~ AdditionalPropertiesSchema schema

706

699

707−instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where

700+instance (ToJSONKey k, ToSchema k, ToSchema v, Typeable k, Typeable v) => ToSchema (HashMap k v) where

708 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))

701 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))

709

702

710instance {-# OVERLAPPING #-} ToSchema Object where

703instance {-# OVERLAPPING #-} ToSchema Object where

@@ -808,16 +801,16 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>

808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

801-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

802-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

810declareSchemaBoundedEnumKeyMapping :: forall map key value.

803declareSchemaBoundedEnumKeyMapping :: forall map key value.

811− (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

804+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value, Typeable key, Typeable value)

812 => Proxy (map key value) -> Declare (Definitions Schema) Schema

805 => Proxy (map key value) -> Declare (Definitions Schema) Schema

813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

806declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

814− ToJSONKeyText getKey _ -> objectSchema getKey

807+ ToJSONKeyText keyToText _ -> objectSchema keyToText

815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])

808 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])

816 where

809 where

817− objectSchema getKey = do

810+ objectSchema keyToText = do

818 valueRef <- declareSchemaRef (Proxy :: Proxy value)

811 valueRef <- declareSchemaRef (Proxy :: Proxy value)

819 let allKeys = [minBound..maxBound :: key]

812 let allKeys = [minBound..maxBound :: key]

820− mkPair k = (keyToText $ getKey k, valueRef)

813+ mkPair k = (keyToText k, valueRef)

821 return $ mempty

814 return $ mempty

822 & type_ ?~ OpenApiObject

815 & type_ ?~ OpenApiObject

823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)

816 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)

@@ -855,7 +848,7 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o

855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

848-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

849-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

857toSchemaBoundedEnumKeyMapping :: forall map key value.

850toSchemaBoundedEnumKeyMapping :: forall map key value.

858− (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

851+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value, Typeable key, Typeable value)

859 => Proxy (map key value) -> Schema

852 => Proxy (map key value) -> Schema

860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping

853toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping

861

854

@@ -868,23 +861,11 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche

868-- This function applied to @'defaultSchemaOptions'@

861-- This function applied to @'defaultSchemaOptions'@

869-- is used as the default for @'declareNamedSchema'@

862-- is used as the default for @'declareNamedSchema'@

870-- when the type is an instance of @'Generic'@.

863-- when the type is an instance of @'Generic'@.

871−--

872−-- Default implementation will use the name from 'Typeable' instance, including concrete

873−-- instantioations of type variables.

874−--

875−-- For example:

876−--

877−-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))

878−-- Just "Either_Int_Bool"

879genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>

864genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>

880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema

865 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema

881genericDeclareNamedSchema opts _ =

866genericDeclareNamedSchema opts _ =

882− rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

867+ rename (Just tName) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

883− where

868+ where tName = T.replace " " "_" $ T.pack $ show $ typeRep @a

884− unspace ' ' = '_'

885− unspace x = x

886− orig = fmap unspace $ show $ typeRep @a

887− name = datatypeNameModifier opts orig

888

869

889

870

890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.

871-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.

@@ -945,13 +926,10 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s

945 case schema ^. items of

926 case schema ^. items of

946 Just (OpenApiItemsArray [_]) -> fieldSchema

927 Just (OpenApiItemsArray [_]) -> fieldSchema

947 _ -> do

928 _ -> do

948− -- We have to run recordSchema instead of just using its defs,

929+ 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')

930+ return (unnamed schema)

953 where

931 where

954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty

932+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty

955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s

933 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s

956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s

934 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s

957

935

@@ -1114,6 +1092,49 @@ data Proxy2 a b = Proxy2

1114

1092

1115data Proxy3 a b c = Proxy3

1093data Proxy3 a b c = Proxy3

1116

1094

1095+-- | This class allows to generate schemas for polymorphic types (of kind @Type -> Type@).

1096+--

1097+-- Intended usage:

1098+--

1099+-- >>> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)

1100+-- >>> :{

1101+-- instance (ToSchema a, Typeable a) => ToSchema (Foo a) where

1102+-- declareNamedSchema _ = declareNamedSchema @(BySchema1 Foo a) Proxy

1103+-- :}

1104+--

1105+-- >>> toNamedSchema @(Foo Int) Proxy ^. name

1106+-- Just "Foo_Int"

1107+-- >>> toNamedSchema @(Foo Bool) Proxy ^. name

1108+-- Just "Foo_Bool"

1109+-- >>> toNamedSchema @(Foo (Foo T.Text)) Proxy ^. name

1110+-- Just "Foo_(Foo_Text)"

1111+class ToSchema1 (f :: * -> *) where

1112+ declareNamedSchema1 :: (Generic (f a), GToSchema (Rep (f a)), ToSchema a) => Proxy f -> Proxy a -> Declare (Definitions Schema) NamedSchema

1113+

1114+ -- It would be cleaner to have GToSchema constraint only on default signature and not in the class method

1115+ -- above, however sadly GHC does not like it.

1116+ default declareNamedSchema1 :: forall a. (ToSchema a, Generic (f a), GToSchema (Rep (f a)), Typeable (f a)) => Proxy f -> Proxy a -> Declare (Definitions Schema) NamedSchema

1117+ declareNamedSchema1 _ _ = genericDeclareNamedSchema @(f a) defaultSchemaOptions Proxy

1118+

1119+{- | For GHC 8.6+ it's more convenient to use @DerivingVia@ to derive instances of 'ToSchema'

1120+using 'ToSchema1' instance, like this:

1121+

1122+#if __GLASGOW_HASKELL__ >= 806

1123+>>> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)

1124+>>> deriving via BySchema1 Foo a instance (ToSchema a, Typeable a) => ToSchema (Foo a)

1125+#else

1126+> data Foo a = Foo { foo :: a, bar :: Int } deriving (Eq, Show, Generic, ToSchema1)

1127+> deriving via BySchema1 Foo a instance (ToSchema a, Typeable a) => ToSchema (Foo a)

1128+#endif

1129+-}

1130+newtype BySchema1 f a = BySchema1 (f a)

1131+

1132+instance (ToSchema1 f, Generic (f a), GToSchema (Rep (f a)), Typeable (f a), ToSchema a) => ToSchema (BySchema1 f a) where

1133+ declareNamedSchema _ = do

1134+ sch <- declareNamedSchema1 @f @a Proxy Proxy

1135+ let tName = T.replace " " "_" $ T.pack $ show $ typeRep @(f a)

1136+ return $ rename (Just tName) sch

1137+

1117{- $setup

1138{- $setup

1118>>> import Data.OpenApi

1139>>> import Data.OpenApi

1119>>> import Data.Aeson (encode)

1140>>> import Data.Aeson (encode)

@@ -1123,4 +1144,7 @@ data Proxy3 a b c = Proxy3

1123>>> :set -XDeriveAnyClass

1144>>> :set -XDeriveAnyClass

1124>>> :set -XStandaloneDeriving

1145>>> :set -XStandaloneDeriving

1125>>> :set -XTypeApplications

1146>>> :set -XTypeApplications

1147+#if __GLASGOW_HASKELL__ >= 806

1148+>>> :set -XDerivingVia

1149+#endif

1126-}

1150-}

src/Data/OpenApi/Internal/Schema/Validation.hs+11−23

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

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)

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

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

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.hs+2

@@ -13,6 +13,8 @@ module Data.OpenApi.Schema (

13 toSchemaRef,

14 schemaName,

15 toInlinedSchema,

16+ ToSchema1(..),

17+ BySchema1(..),

17 -- * Generic schema encoding

19 -- * Generic schema encoding

18 genericDeclareNamedSchema,

20 genericDeclareNamedSchema,

src/Data/OpenApi/Schema/Generator.hs+1−3

@@ -25,8 +25,6 @@ import Test.QuickCheck (arbitrary)

25import Test.QuickCheck.Gen

26import Test.QuickCheck.Property

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

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:

3- '.'

4extra-deps:

test/Data/OpenApi/CommonTestTypes.hs−123

@@ -863,129 +863,6 @@ singleMaybeFieldSchemaJSON = [aesonQQ|

863}

864|]

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

36import Data.OpenApi

31import Data.OpenApi

37import Data.OpenApi.Declare

32import Data.OpenApi.Declare

38−import Data.OpenApi.Aeson.Compat (stringToKey)

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

60 (defs, s) = runDeclare (declareSchema proxy) mempty

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)

46 it "roundtrips: fmap toJSON . fromJSON" $ do

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

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

9import Test.Hspec

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