master..45ca90b · typeable/swagger2

git.iko.soy/typeable/swagger2

.ghci−1

@@ -1,2 +1 @@

1:set -itest -isrc -optP-include -optP.stack-work/dist/x86_64-linux/Cabal-1.24.2.0/build/autogen/cabal_macros.h -optP-I -optPinclude

2−:set -hide-package base-compat-0.10.4

.travis.yml+87−130

@@ -1,162 +1,119 @@

1# This Travis job script has been generated by a script via

3−# haskell-ci '--branches' 'master' '--haddock-jobs=>=8.4' '--output' '.travis.yml' 'swagger2.cabal'

3+# runghc make_travis_yml_2.hs '--branch' 'master' '--output' '.travis.yml' 'swagger2.cabal' '--env=8.2.2:HADDOCK=false' '--env=8.0.2:HADDOCK=false' '--env=7.10.3:HADDOCK=false' '--env=7.8.4:HADDOCK=false'

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

5+# For more information, see https://github.com/hvr/multi-ghc-travis

6−#

7−# version: 0.5.20191020

9language: c

7language: c

10−dist: xenial

8+sudo: false

11git:

10git:

12− # whether to recursively clone submodules

11+ submodules: false # whether to recursively clone submodules

13− submodules: false

12+

14branches:

13branches:

15 only:

14 only:

16 - master

15 - master

16+

17cache:

18 directories:

19 - $HOME/.cabal/packages

20 - $HOME/.cabal/store

21+

21before_cache:

22before_cache:

22− - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log

23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

23 # remove files that are regenerated by 'cabal update'

24 # remove files that are regenerated by 'cabal update'

24− - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*

25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

25− - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json

26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

26− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache

27+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

27− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar

28+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

28− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx

29+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

30+

29− - rm -rfv $CABALHOME/packages/head.hackage

31+ - rm -rfv $HOME/.cabal/packages/head.hackage

32+

30matrix:

33matrix:

31 include:

34 include:

32− - compiler: ghc-8.8.1

35+ - compiler: "ghc-8.4.3"

33− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}

36+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

37+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}

34− - compiler: ghc-8.6.5

38+ - compiler: "ghc-8.2.2"

35− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}}

39+ env: HADDOCK=false

40+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}}

36− - compiler: ghc-8.4.4

41+ - compiler: "ghc-8.0.2"

42+ env: HADDOCK=false

37− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}}

43+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}}

38− - compiler: ghc-8.2.2

44+ - compiler: "ghc-7.10.3"

45+ env: HADDOCK=false

39− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}}

46+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}}

40− - compiler: ghc-8.0.2

47+ - compiler: "ghc-7.8.4"

48+ env: HADDOCK=false

41− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}}

49+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}}

50+

42before_install:

51before_install:

43− - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')

52+ - HC=${CC}

44− - WITHCOMPILER="-w $HC"

45− - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')

46− - HCPKG="$HC-pkg"

53+ - HCPKG=${HC/ghc/ghc-pkg}

47 - unset CC

54 - unset CC

48− - CABAL=/opt/ghc/bin/cabal

55+ - ROOTDIR=$(pwd)

49− - CABALHOME=$HOME/.cabal

56+ - mkdir -p $HOME/.local/bin

50− - export PATH="$CABALHOME/bin:$PATH"

57+ - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"

51− - TOP=$(pwd)

52− - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"

58+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))

53 - echo $HCNUMVER

59 - echo $HCNUMVER

54− - CABAL="$CABAL -vnormal+nowrap+markoutput"

60+

55− - set -o pipefail

56− - |

57− echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk

58− echo 'BEGIN { state = "output"; }' >> .colorful.awk

59− echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk

60− echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk

61− echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk

62− echo ' if (state == "cabal") {' >> .colorful.awk

63− echo ' print blue($0)' >> .colorful.awk

64− echo ' } else {' >> .colorful.awk

65− echo ' print $0' >> .colorful.awk

66− echo ' }' >> .colorful.awk

67− echo '}' >> .colorful.awk

68− - cat .colorful.awk

69− - |

70− color_cabal_output () {

71− awk -f $TOP/.colorful.awk

72− }

73− - echo text | color_cabal_output

74install:

61install:

75− - ${CABAL} --version

62+ - cabal --version

76 - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

63 - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

77− - TEST=--enable-tests

78− - BENCH=--enable-benchmarks

64+ - BENCH=${BENCH---enable-benchmarks}

79− - HEADHACKAGE=false

65+ - TEST=${TEST---enable-tests}

80− - rm -f $CABALHOME/config

66+ - HADDOCK=${HADDOCK-true}

81− - |

67+ - UNCONSTRAINED=${UNCONSTRAINED-true}

82− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config

68+ - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}

83− echo "remote-build-reporting: anonymous" >> $CABALHOME/config

69+ - GHCHEAD=${GHCHEAD-false}

84− echo "write-ghc-environment-files: always" >> $CABALHOME/config

85− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config

86− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config

87− echo "world-file: $CABALHOME/world" >> $CABALHOME/config

88− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config

89− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config

90− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config

91− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config

92− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config

93− echo "install-dirs user" >> $CABALHOME/config

94− echo " prefix: $CABALHOME" >> $CABALHOME/config

95− echo "repository hackage.haskell.org" >> $CABALHOME/config

96− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config

97− echo " secure: True" >> $CABALHOME/config

98− echo " key-threshold: 3" >> $CABALHOME/config

99− echo " root-keys:" >> $CABALHOME/config

100− echo " fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0" >> $CABALHOME/config

101− echo " 1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42" >> $CABALHOME/config

102− echo " 2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3" >> $CABALHOME/config

103− echo " 0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d" >> $CABALHOME/config

104− echo " 51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921" >> $CABALHOME/config

105− - |

106− echo "program-default-options" >> $CABALHOME/config

107− echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config

108− - cat $CABALHOME/config

109− - rm -fv cabal.project cabal.project.local cabal.project.freeze

110− - travis_retry ${CABAL} v2-update -v

70+ - travis_retry cabal update -v

111− # Generate cabal.project

71+ - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"

112− - rm -rf cabal.project cabal.project.local cabal.project.freeze

72+ - rm -fv cabal.project cabal.project.local

73+ - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'

74+ - "printf 'packages: \".\"\\n' > cabal.project"

113− - touch cabal.project

75+ - touch cabal.project.local

114− - |

115− echo "packages: ." >> cabal.project

116− - |

117− - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(swagger2)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"

76+ - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"

118 - cat cabal.project || true

77 - cat cabal.project || true

119 - cat cabal.project.local || true

78 - cat cabal.project.local || true

120− - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi

79+ - if [ -f "./configure.ac" ]; then

121− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output

80+ (cd "." && autoreconf -i);

81+ fi

122− - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"

82+ - rm -f cabal.project.freeze

123− - rm cabal.project.freeze

83+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all

124− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output

125− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output

84+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all

126−script:

85+ - rm -rf .ghc.environment.* "."/dist

127 - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

86 - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

128− # Packaging...

87+

129− - ${CABAL} v2-sdist all | color_cabal_output

88+# Here starts the actual work to be performed for the package under test;

130− # Unpacking...

89+# any command which exits with a non-zero exit code causes the build to fail.

90+script:

91+ # test that source-distributions can be generated

92+ - (cd "." && cabal sdist)

131− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/

93+ - mv "."/dist/swagger2-*.tar.gz ${DISTDIR}/

132 - cd ${DISTDIR} || false

94 - cd ${DISTDIR} || false

133− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;

95+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;

134− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;

135− - PKGDIR_swagger2="$(find . -maxdepth 1 -type d -regex '.*/swagger2-[0-9.]*')"

136− # Generate cabal.project

137− - rm -rf cabal.project cabal.project.local cabal.project.freeze

138− - touch cabal.project

139− - |

140− echo "packages: ${PKGDIR_swagger2}" >> cabal.project

96+ - "printf 'packages: swagger2-*/*.cabal\\n' > cabal.project"

141− - |

97+ - touch cabal.project.local

142− - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(swagger2)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"

98+ - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"

143 - cat cabal.project || true

99 - cat cabal.project || true

144 - cat cabal.project.local || true

100 - cat cabal.project.local || true

145− # Building...

146 # this builds all libraries and executables (without tests/benchmarks)

101 # this builds all libraries and executables (without tests/benchmarks)

147− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output

102+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all

148− # Building with tests and benchmarks...

103+

149 # build & run tests, build benchmarks

104 # build & run tests, build benchmarks

150− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output

105+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all

151− # Testing...

106+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi

152− - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output

107+

153− # cabal check...

108+ # cabal check

154− - (cd ${PKGDIR_swagger2} && ${CABAL} -vnormal check)

109+ - (cd swagger2-* && cabal check)

110+

155− # haddock...

111+ # haddock

156− - if [ $HCNUMVER -ge 80400 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output ; fi

112+ - rm -rf ./dist-newstyle

113+ - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi

114+

157− # Building without installed constraints for packages in global-db...

115+ # Build without installed constraints for packages in global-db

158− - rm -f cabal.project.local

116+ - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi

159− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output

160

117

161−# REGENDATA ("0.5.20191020",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])

118+# REGENDATA ["--branch","master","--output",".travis.yml","swagger2.cabal","--env=8.2.2:HADDOCK=false","--env=8.0.2:HADDOCK=false","--env=7.10.3:HADDOCK=false","--env=7.8.4:HADDOCK=false"]

162# EOF

119# EOF

CHANGELOG.md−45

@@ -1,48 +1,3 @@

1−2.5

2−---

3−

4−Highlights:

5−- Add instance for `TimeOfDay` (see [#196]( https://github.com/GetShopTV/swagger2/pull/196 ));

6−- Add support for [`optics`](https://hackage.haskell.org/package/optics) (see [#200]( https://github.com/GetShopTV/swagger2/pull/200 ));

7−- Slightly better validation errors (see [#195]( https://github.com/GetShopTV/swagger2/pull/195 ));

8−

9−Fixes and minor changes:

10−- Minor cleanup (see [#194]( https://github.com/GetShopTV/swagger2/pull/194 ));

11−- Allow base-4.13 and other GHC-8.8 related stuff (see [#198]( https://github.com/GetShopTV/swagger2/pull/198 ));

12−- Fix `stack.yaml` (see [#201]( https://github.com/GetShopTV/swagger2/pull/201 ));

13−

14−2.4

15−---

16−

17−- Allow hashable-1.3, semigroups-0.19, network-3.1, time-1.9, generics-sop-0.5

18−- Tags aren't sorted

19− (see [#165](https://github.com/GetShopTV/swagger2/issues/165))

20−- Schema type is optional

21− (see [#138](https://github.com/GetShopTV/swagger2/issues/138), [#164](https://github.com/GetShopTV/swagger2/pull/164))

22−- Take concrete 'Proxy' as argument

23− (see [#180](https://github.com/GetShopTV/swagger2/pull/180))

24−- GHC-8.8 preparations

25−

26−2.3.1.1

27−-------

28−

29−- Allow `network-3.0`

30−

31−2.3.1

32−-----

33−

34−- Add a quickcheck generator for aeson Values that match a swagger schema

35− (see [#162](https://github.com/GetShopTV/swagger2/pull/162))

36−- Add `ToParamSchema` instance for `SetCookie`

37− (see [#173](https://github.com/GetShopTV/swagger2/pull/173))

38−- Make nullary schemas valid

39− (see [#168](https://github.com/GetShopTV/swagger2/pull/168))

40−

41−2.3.0.1

42−-------

43−

44−- Support GHC-8.6

45−

462.3

12.3

47---

2---

aeson-0.11.cabal.confignew file+1

@@ -0,0 +1 @@

1+constraints: aeson ==0.11.*

cabal.projectdeleted−2

@@ -1,2 +0,0 @@

1−packages: .

2−tests: true

examples/hackage.hs+1−1

@@ -27,7 +27,7 @@ instance ToSchema UserSummary where

27 usernameSchema <- declareSchemaRef (Proxy :: Proxy Username)

28 useridSchema <- declareSchemaRef (Proxy :: Proxy Int)

29 return $ NamedSchema (Just "UserSummary") $ mempty

30− & type_ ?~ SwaggerObject

30+ & type_ .~ SwaggerObject

31 & properties .~

32 [ ("summaryUsername", usernameSchema )

33 , ("summaryUserid" , useridSchema )

src/Data/Swagger.hs+4−9

@@ -31,7 +31,6 @@ module Data.Swagger (

32 -- * Re-exports

33 module Data.Swagger.Lens,

34− module Data.Swagger.Optics,

35 module Data.Swagger.Operation,

34 module Data.Swagger.Operation,

36 module Data.Swagger.ParamSchema,

35 module Data.Swagger.ParamSchema,

37 module Data.Swagger.Schema,

36 module Data.Swagger.Schema,

@@ -89,7 +88,6 @@ module Data.Swagger (

89 SecurityScheme(..),

88 SecurityScheme(..),

90 SecuritySchemeType(..),

89 SecuritySchemeType(..),

91 SecurityRequirement(..),

90 SecurityRequirement(..),

92− SecurityDefinitions(..),

94 -- *** API key

92 -- *** API key

95 ApiKeyParams(..),

93 ApiKeyParams(..),

@@ -114,7 +112,6 @@ module Data.Swagger (

114) where

112) where

115

113

116import Data.Swagger.Lens

114import Data.Swagger.Lens

117−import Data.Swagger.Optics ()

118import Data.Swagger.Operation

115import Data.Swagger.Operation

119import Data.Swagger.ParamSchema

116import Data.Swagger.ParamSchema

120import Data.Swagger.Schema

117import Data.Swagger.Schema

@@ -178,15 +175,13 @@ import Data.Swagger.Internal

178

175

179-- $lens

176-- $lens

180--

177--

181−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.Swagger.Optics".

182−--

183-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used

178-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used

184-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses

179-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses

185-- make it fairly simple to construct/modify any part of the specification:

180-- make it fairly simple to construct/modify any part of the specification:

186--

181--

187-- >>> :{

182-- >>> :{

188-- encode $ (mempty :: Swagger)

183-- encode $ (mempty :: Swagger)

189−-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]

184+-- & definitions .~ [ ("User", mempty & type_ .~ SwaggerString) ]

190-- & paths .~

185-- & paths .~

191-- [ ("/user", mempty & get ?~ (mempty

186-- [ ("/user", mempty & get ?~ (mempty

192-- & produces ?~ MimeList ["application/json"]

187-- & produces ?~ MimeList ["application/json"]

@@ -209,7 +204,7 @@ import Data.Swagger.Internal

209-- "{\"description\":\"No content\"}"

204-- "{\"description\":\"No content\"}"

210-- >>> :{

205-- >>> :{

211-- encode $ (mempty :: Schema)

206-- encode $ (mempty :: Schema)

212−-- & type_ ?~ SwaggerBoolean

207+-- & type_ .~ SwaggerBoolean

213-- & description ?~ "To be or not to be"

208-- & description ?~ "To be or not to be"

214-- :}

209-- :}

215-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"

210-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"

@@ -218,7 +213,7 @@ import Data.Swagger.Internal

218-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.

213-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.

219-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:

214-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:

220--

215--

221−-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber

216+-- >>> encode $ (mempty :: Header) & type_ .~ SwaggerNumber

222-- "{\"type\":\"number\"}"

217-- "{\"type\":\"number\"}"

223--

218--

224-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@

219-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@

@@ -280,7 +275,7 @@ import Data.Swagger.Internal

280-- >>> encode $ toSchema (Proxy :: Proxy Person)

275-- >>> encode $ toSchema (Proxy :: Proxy Person)

281-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"

276-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"

282--

277--

283−-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a

278+-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a

284-- schema for basic enums like

279-- schema for basic enums like

285--

280--

286-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic

281-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic

src/Data/Swagger/Internal.hs+10−85

@@ -29,19 +29,18 @@ import Control.Applicative

29import Data.Aeson

30import qualified Data.Aeson.Types as JSON

31import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)

32−import Data.Hashable (Hashable)

33import qualified Data.HashMap.Strict as HashMap

32import qualified Data.HashMap.Strict as HashMap

34−import Data.HashSet.InsOrd (InsOrdHashSet)

35import Data.Map (Map)

33import Data.Map (Map)

36import qualified Data.Map as Map

34import qualified Data.Map as Map

37import Data.Monoid (Monoid (..))

35import Data.Monoid (Monoid (..))

38import Data.Semigroup.Compat (Semigroup (..))

36import Data.Semigroup.Compat (Semigroup (..))

39import Data.Scientific (Scientific)

37import Data.Scientific (Scientific)

38+import Data.Set (Set)

40import Data.String (IsString(..))

39import Data.String (IsString(..))

41import Data.Text (Text)

40import Data.Text (Text)

42import qualified Data.Text as Text

41import qualified Data.Text as Text

43import GHC.Generics (Generic)

42import GHC.Generics (Generic)

44−import Network.Socket (HostName, PortNumber)

43+import Network (HostName, PortNumber)

45import Network.HTTP.Media (MediaType)

44import Network.HTTP.Media (MediaType)

46import Text.Read (readMaybe)

45import Text.Read (readMaybe)

@@ -66,10 +65,6 @@ import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)

66#define DEFINE_TOENCODING

65#define DEFINE_TOENCODING

67#endif

66#endif

69−-- $setup

70−-- >>> :seti -XDataKinds

71−-- >>> import Data.Aeson

72−

73-- | A list of definitions that can be used in references.

68-- | A list of definitions that can be used in references.

74type Definitions = InsOrdHashMap Text

69type Definitions = InsOrdHashMap Text

@@ -117,7 +112,7 @@ data Swagger = Swagger

117 , _swaggerResponses :: Definitions Response

112 , _swaggerResponses :: Definitions Response

118

113

119 -- | Security scheme definitions that can be used across the specification.

114 -- | Security scheme definitions that can be used across the specification.

120− , _swaggerSecurityDefinitions :: SecurityDefinitions

115+ , _swaggerSecurityDefinitions :: Definitions SecurityScheme

121

116

122 -- | A declaration of which security schemes are applied for the API as a whole.

117 -- | A declaration of which security schemes are applied for the API as a whole.

123 -- The list of values describes alternative security schemes that can be used

118 -- The list of values describes alternative security schemes that can be used

@@ -130,7 +125,7 @@ data Swagger = Swagger

130 -- Not all tags that are used by the Operation Object must be declared.

125 -- Not all tags that are used by the Operation Object must be declared.

131 -- The tags that are not declared may be organized randomly or based on the tools' logic.

126 -- The tags that are not declared may be organized randomly or based on the tools' logic.

132 -- Each tag name in the list MUST be unique.

127 -- Each tag name in the list MUST be unique.

133− , _swaggerTags :: InsOrdHashSet Tag

128+ , _swaggerTags :: Set Tag

134

129

135 -- | Additional external documentation.

130 -- | Additional external documentation.

136 , _swaggerExternalDocs :: Maybe ExternalDocs

131 , _swaggerExternalDocs :: Maybe ExternalDocs

@@ -252,7 +247,7 @@ data PathItem = PathItem

252data Operation = Operation

247data Operation = Operation

253 { -- | A list of tags for API documentation control.

248 { -- | A list of tags for API documentation control.

254 -- Tags can be used for logical grouping of operations by resources or any other qualifier.

249 -- Tags can be used for logical grouping of operations by resources or any other qualifier.

255− _operationTags :: InsOrdHashSet TagName

250+ _operationTags :: Set TagName

256

251

257 -- | A short summary of what the operation does.

252 -- | A short summary of what the operation does.

258 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.

253 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.

@@ -594,7 +589,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema

594 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

589 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

595 _paramSchemaDefault :: Maybe Value

590 _paramSchemaDefault :: Maybe Value

596

591

597− , _paramSchemaType :: Maybe (SwaggerType t)

592+ , _paramSchemaType :: SwaggerType t

598 , _paramSchemaFormat :: Maybe Format

593 , _paramSchemaFormat :: Maybe Format

599 , _paramSchemaItems :: Maybe (SwaggerItems t)

594 , _paramSchemaItems :: Maybe (SwaggerItems t)

600 , _paramSchemaMaximum :: Maybe Scientific

595 , _paramSchemaMaximum :: Maybe Scientific

@@ -611,7 +606,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema

611 , _paramSchemaMultipleOf :: Maybe Scientific

606 , _paramSchemaMultipleOf :: Maybe Scientific

612 } deriving (Eq, Show, Generic, Typeable)

607 } deriving (Eq, Show, Generic, Typeable)

613

608

614−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)

609+deriving instance (Typeable k, Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k)

615

610

616data Xml = Xml

611data Xml = Xml

617 { -- | Replaces the name of the element/attribute used for the described schema property.

612 { -- | Replaces the name of the element/attribute used for the described schema property.

@@ -755,22 +750,6 @@ data SecurityScheme = SecurityScheme

755 , _securitySchemeDescription :: Maybe Text

750 , _securitySchemeDescription :: Maybe Text

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

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

757

752

758−

759−-- | merge scopes of two OAuth2 security schemes when their flows are identical.

760−-- In other case returns first security scheme

761−mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme

762−mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)

763− s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)

764− = if flow1 == flow2 then

765− SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc

766− else

767− s1

768−mergeSecurityScheme s1 _ = s1

769−

770−newtype SecurityDefinitions

771− = SecurityDefinitions (Definitions SecurityScheme)

772− deriving (Eq, Show, Generic, Data, Typeable)

773−

774-- | Lists the required security schemes to execute this operation.

753-- | Lists the required security schemes to execute this operation.

775-- The object can have multiple security schemes declared in it which are all required

754-- The object can have multiple security schemes declared in it which are all required

776-- (that is, there is a logical AND between the schemes).

755-- (that is, there is a logical AND between the schemes).

@@ -795,8 +774,6 @@ data Tag = Tag

795 , _tagExternalDocs :: Maybe ExternalDocs

774 , _tagExternalDocs :: Maybe ExternalDocs

796 } deriving (Eq, Ord, Show, Generic, Data, Typeable)

775 } deriving (Eq, Ord, Show, Generic, Data, Typeable)

797

776

798−instance Hashable Tag

799−

800instance IsString Tag where

777instance IsString Tag where

801 fromString s = Tag (fromString s) Nothing Nothing

778 fromString s = Tag (fromString s) Nothing Nothing

802

779

@@ -810,8 +787,6 @@ data ExternalDocs = ExternalDocs

810 , _externalDocsUrl :: URL

787 , _externalDocsUrl :: URL

811 } deriving (Eq, Ord, Show, Generic, Data, Typeable)

788 } deriving (Eq, Ord, Show, Generic, Data, Typeable)

812

789

813−instance Hashable ExternalDocs

814−

815-- | A simple object to allow referencing other definitions in the specification.

790-- | A simple object to allow referencing other definitions in the specification.

816-- It can be used to reference parameters and responses that are defined at the top level for reuse.

791-- It can be used to reference parameters and responses that are defined at the top level for reuse.

817newtype Reference = Reference { getReference :: Text }

792newtype Reference = Reference { getReference :: Text }

@@ -825,7 +800,7 @@ data Referenced a

825instance IsString a => IsString (Referenced a) where

800instance IsString a => IsString (Referenced a) where

826 fromString = Inline . fromString

801 fromString = Inline . fromString

827

802

828−newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)

803+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, ToJSON, FromJSON, Data, Typeable)

829

804

830data AdditionalProperties

805data AdditionalProperties

831 = AdditionalPropertiesAllowed Bool

806 = AdditionalPropertiesAllowed Bool

@@ -920,17 +895,6 @@ instance Monoid Example where

920 mempty = genericMempty

895 mempty = genericMempty

921 mappend = (<>)

896 mappend = (<>)

922

897

923−instance Semigroup SecurityScheme where

924− (<>) = mergeSecurityScheme

925−

926−instance Semigroup SecurityDefinitions where

927− (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =

928− SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2

929−

930−instance Monoid SecurityDefinitions where

931− mempty = SecurityDefinitions $ InsOrdHashMap.empty

932− mappend = (<>)

933−

934-- =======================================================================

898-- =======================================================================

935-- SwaggerMonoid helper instances

899-- SwaggerMonoid helper instances

936-- =======================================================================

900-- =======================================================================

@@ -945,8 +909,6 @@ instance SwaggerMonoid Responses

945instance SwaggerMonoid Response

909instance SwaggerMonoid Response

946instance SwaggerMonoid ExternalDocs

910instance SwaggerMonoid ExternalDocs

947instance SwaggerMonoid Operation

911instance SwaggerMonoid Operation

948−instance SwaggerMonoid SecurityDefinitions

949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)

950

912

951instance SwaggerMonoid MimeList

913instance SwaggerMonoid MimeList

952deriving instance SwaggerMonoid URL

914deriving instance SwaggerMonoid URL

@@ -1088,22 +1050,11 @@ instance ToJSON Header where

1088 toJSON = sopSwaggerGenericToJSON

1050 toJSON = sopSwaggerGenericToJSON

1089 DEFINE_TOENCODING

1051 DEFINE_TOENCODING

1090

1052

1091−-- | As for nullary schema for 0-arity type constructors, see

1092−-- <https://github.com/GetShopTV/swagger2/issues/167>.

1093−--

1094−-- >>> encode (SwaggerItemsArray [])

1095−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"

1096−--

1097instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where

1053instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where

1098 toJSON (SwaggerItemsPrimitive fmt schema) = object

1054 toJSON (SwaggerItemsPrimitive fmt schema) = object

1099 [ "collectionFormat" .= fmt

1055 [ "collectionFormat" .= fmt

1100 , "items" .= schema ]

1056 , "items" .= schema ]

1101 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]

1057 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]

1102− toJSON (SwaggerItemsArray []) = object

1103− [ "items" .= object []

1104− , "maxItems" .= (0 :: Int)

1105− , "example" .= Array mempty

1106− ]

1107 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]

1058 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]

1108

1059

1109instance ToJSON Host where

1060instance ToJSON Host where

@@ -1146,9 +1097,6 @@ instance ToJSON PathItem where

1146instance ToJSON Example where

1097instance ToJSON Example where

1147 toJSON = toJSON . Map.mapKeys show . getExample

1098 toJSON = toJSON . Map.mapKeys show . getExample

1148

1099

1149−instance ToJSON SecurityDefinitions where

1150− toJSON (SecurityDefinitions sd) = toJSON sd

1151−

1152instance ToJSON Reference where

1100instance ToJSON Reference where

1153 toJSON (Reference ref) = object [ "$ref" .= ref ]

1101 toJSON (Reference ref) = object [ "$ref" .= ref ]

1154

1102

@@ -1223,13 +1171,7 @@ instance FromJSON SecurityScheme where

1223 parseJSON = sopSwaggerGenericParseJSON

1171 parseJSON = sopSwaggerGenericParseJSON

1224

1172

1225instance FromJSON Schema where

1173instance FromJSON Schema where

1226− parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON

1174+ parseJSON = sopSwaggerGenericParseJSON

1227− where nullaryCleanup :: Schema -> Schema

1228− nullaryCleanup s@Schema{_schemaParamSchema=ps} =

1229− if _paramSchemaItems ps == Just (SwaggerItemsArray [])

1230− then s { _schemaExample = Nothing

1231− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }

1232− else s

1233

1175

1234instance FromJSON Header where

1176instance FromJSON Header where

1235 parseJSON = sopSwaggerGenericParseJSON

1177 parseJSON = sopSwaggerGenericParseJSON

@@ -1244,21 +1186,8 @@ instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where

1244 <$> o .:? "collectionFormat"

1186 <$> o .:? "collectionFormat"

1245 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))

1187 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))

1246

1188

1247−-- |

1248−--

1249−-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)

1250−-- Just (SwaggerItemsArray [])

1251−--

1252−-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)

1253−-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))

1254−--

1255−-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)

1256−-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])

1257−--

1258instance FromJSON (SwaggerItems 'SwaggerKindSchema) where

1189instance FromJSON (SwaggerItems 'SwaggerKindSchema) where

1259− parseJSON js@(Object obj)

1260− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.

1261− | otherwise = SwaggerItemsObject <$> parseJSON js

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

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

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

1263 parseJSON _ = empty

1192 parseJSON _ = empty

1264

1193

@@ -1310,9 +1239,6 @@ instance FromJSON Operation where

1310instance FromJSON PathItem where

1239instance FromJSON PathItem where

1311 parseJSON = sopSwaggerGenericParseJSON

1240 parseJSON = sopSwaggerGenericParseJSON

1312

1241

1313−instance FromJSON SecurityDefinitions where

1314− parseJSON js = SecurityDefinitions <$> parseJSON js

1315−

1316instance FromJSON Reference where

1242instance FromJSON Reference where

1317 parseJSON (Object o) = Reference <$> o .: "$ref"

1243 parseJSON (Object o) = Reference <$> o .: "$ref"

1318 parseJSON _ = empty

1244 parseJSON _ = empty

@@ -1424,4 +1350,3 @@ instance AesonDefaultValue (SwaggerType a)

1424instance AesonDefaultValue MimeList where defaultValue = Just mempty

1350instance AesonDefaultValue MimeList where defaultValue = Just mempty

1425instance AesonDefaultValue Info

1351instance AesonDefaultValue Info

1426instance AesonDefaultValue ParamLocation

1352instance AesonDefaultValue ParamLocation

1427−instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty

src/Data/Swagger/Internal/AesonUtils.hs+2−16

@@ -44,7 +44,6 @@ import qualified Data.Text as T

44import qualified Data.HashMap.Strict as HM

45import qualified Data.Set as Set

46import qualified Data.HashMap.Strict.InsOrd as InsOrd

47−import qualified Data.HashSet.InsOrd as InsOrdHS

49#if MIN_VERSION_aeson(0,10,0)

48#if MIN_VERSION_aeson(0,10,0)

50import Data.Aeson (Encoding, pairs, (.=), Series)

49import Data.Aeson (Encoding, pairs, (.=), Series)

@@ -68,10 +67,10 @@ mkSwaggerAesonOptions pfx = SwaggerAesonOptions pfx [] Nothing

68makeLenses ''SwaggerAesonOptions

67makeLenses ''SwaggerAesonOptions

70class (Generic a, All2 AesonDefaultValue (Code a)) => HasSwaggerAesonOptions a where

69class (Generic a, All2 AesonDefaultValue (Code a)) => HasSwaggerAesonOptions a where

71− swaggerAesonOptions :: Proxy a -> SwaggerAesonOptions

70+ swaggerAesonOptions :: proxy a -> SwaggerAesonOptions

73 -- So far we use only default definitions

72 -- So far we use only default definitions

74− aesonDefaults :: Proxy a -> POP Maybe (Code a)

73+ aesonDefaults :: proxy a -> POP Maybe (Code a)

75 aesonDefaults _ = hcpure (Proxy :: Proxy AesonDefaultValue) defaultValue

74 aesonDefaults _ = hcpure (Proxy :: Proxy AesonDefaultValue) defaultValue

77-------------------------------------------------------------------------------

76-------------------------------------------------------------------------------

@@ -86,7 +85,6 @@ instance AesonDefaultValue Text where defaultValue = Nothing

86instance AesonDefaultValue (Maybe a) where defaultValue = Just Nothing

85instance AesonDefaultValue (Maybe a) where defaultValue = Just Nothing

87instance AesonDefaultValue [a] where defaultValue = Just []

86instance AesonDefaultValue [a] where defaultValue = Just []

88instance AesonDefaultValue (Set.Set a) where defaultValue = Just Set.empty

87instance AesonDefaultValue (Set.Set a) where defaultValue = Just Set.empty

89−instance AesonDefaultValue (InsOrdHS.InsOrdHashSet k) where defaultValue = Just InsOrdHS.empty

90instance AesonDefaultValue (InsOrd.InsOrdHashMap k v) where defaultValue = Just InsOrd.empty

88instance AesonDefaultValue (InsOrd.InsOrdHashMap k v) where defaultValue = Just InsOrd.empty

92-------------------------------------------------------------------------------

90-------------------------------------------------------------------------------

@@ -146,11 +144,7 @@ sopSwaggerGenericToJSON'

146 -> DatatypeInfo '[xs]

144 -> DatatypeInfo '[xs]

147 -> POP Maybe '[xs]

145 -> POP Maybe '[xs]

148 -> [Pair]

146 -> [Pair]

149−#if MIN_VERSION_generics_sop(0,5,0)

150−sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

151−#else

152sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

147sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

153−#endif

154 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs

148 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs

155sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"

149sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"

156

150

@@ -226,11 +220,7 @@ sopSwaggerGenericParseJSON'

226 -> DatatypeInfo '[xs]

220 -> DatatypeInfo '[xs]

227 -> POP Maybe '[xs]

221 -> POP Maybe '[xs]

228 -> Parser (SOP I '[xs])

222 -> Parser (SOP I '[xs])

229−#if MIN_VERSION_generics_sop(0,5,0)

230−sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

231−#else

232sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

223sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

233−#endif

234 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs

224 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs

235sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"

225sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"

236

226

@@ -302,11 +292,7 @@ sopSwaggerGenericToEncoding'

302 -> DatatypeInfo '[xs]

292 -> DatatypeInfo '[xs]

303 -> POP Maybe '[xs]

293 -> POP Maybe '[xs]

304 -> Series

294 -> Series

305−#if MIN_VERSION_generics_sop(0,5,0)

306−sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

307−#else

308sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

295sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

309−#endif

310 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs

296 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs

311sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"

297sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"

312

298

src/Data/Swagger/Internal/ParamSchema.hs+26−38

@@ -43,7 +43,6 @@ import Data.Version (Version)

43import Numeric.Natural.Compat (Natural)

44import Data.Word

45import Data.UUID.Types (UUID)

46−import Web.Cookie (SetCookie)

48import Data.Swagger.Internal

47import Data.Swagger.Internal

49import Data.Swagger.Lens

48import Data.Swagger.Lens

@@ -59,20 +58,20 @@ import GHC.TypeLits (TypeError, ErrorMessage(..))

59-- | Default schema for binary data (any sequence of octets).

58-- | Default schema for binary data (any sequence of octets).

60binaryParamSchema :: ParamSchema t

59binaryParamSchema :: ParamSchema t

61binaryParamSchema = mempty

60binaryParamSchema = mempty

62− & type_ ?~ SwaggerString

61+ & type_ .~ SwaggerString

63 & format ?~ "binary"

62 & format ?~ "binary"

65-- | Default schema for binary data (base64 encoded).

64-- | Default schema for binary data (base64 encoded).

66byteParamSchema :: ParamSchema t

65byteParamSchema :: ParamSchema t

67byteParamSchema = mempty

66byteParamSchema = mempty

68− & type_ ?~ SwaggerString

67+ & type_ .~ SwaggerString

69 & format ?~ "byte"

68 & format ?~ "byte"

71-- | Default schema for password string.

70-- | Default schema for password string.

72-- @"password"@ format is used to hint UIs the input needs to be obscured.

71-- @"password"@ format is used to hint UIs the input needs to be obscured.

73passwordParamSchema :: ParamSchema t

72passwordParamSchema :: ParamSchema t

74passwordParamSchema = mempty

73passwordParamSchema = mempty

75− & type_ ?~ SwaggerString

74+ & type_ .~ SwaggerString

76 & format ?~ "password"

75 & format ?~ "password"

78-- | Convert a type into a plain @'ParamSchema'@.

77-- | Convert a type into a plain @'ParamSchema'@.

@@ -88,7 +87,7 @@ passwordParamSchema = mempty

88--

87--

89-- instance ToParamSchema Direction where

88-- instance ToParamSchema Direction where

90-- toParamSchema _ = mempty

89-- toParamSchema _ = mempty

91−-- & type_ ?~ SwaggerString

90+-- & type_ .~ SwaggerString

92-- & enum_ ?~ [ \"Up\", \"Down\" ]

91-- & enum_ ?~ [ \"Up\", \"Down\" ]

93-- @

92-- @

94--

93--

@@ -115,22 +114,22 @@ class ToParamSchema a where

115 --

114 --

116 -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)

115 -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)

117 -- "{\"type\":\"integer\"}"

116 -- "{\"type\":\"integer\"}"

118− toParamSchema :: Proxy a -> ParamSchema t

117+ toParamSchema :: proxy a -> ParamSchema t

119− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t

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

120 toParamSchema = genericToParamSchema defaultSchemaOptions

119 toParamSchema = genericToParamSchema defaultSchemaOptions

121

120

122instance OVERLAPPING_ ToParamSchema String where

121instance OVERLAPPING_ ToParamSchema String where

123− toParamSchema _ = mempty & type_ ?~ SwaggerString

122+ toParamSchema _ = mempty & type_ .~ SwaggerString

124

123

125instance ToParamSchema Bool where

124instance ToParamSchema Bool where

126− toParamSchema _ = mempty & type_ ?~ SwaggerBoolean

125+ toParamSchema _ = mempty & type_ .~ SwaggerBoolean

127

126

128instance ToParamSchema Integer where

127instance ToParamSchema Integer where

129− toParamSchema _ = mempty & type_ ?~ SwaggerInteger

128+ toParamSchema _ = mempty & type_ .~ SwaggerInteger

130

129

131instance ToParamSchema Natural where

130instance ToParamSchema Natural where

132 toParamSchema _ = mempty

131 toParamSchema _ = mempty

133− & type_ ?~ SwaggerInteger

132+ & type_ .~ SwaggerInteger

134 & minimum_ ?~ 0

133 & minimum_ ?~ 0

135 & exclusiveMinimum ?~ False

134 & exclusiveMinimum ?~ False

136

135

@@ -154,51 +153,45 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral

154--

153--

155-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)

154-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)

156-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"

155-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"

157−toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t

156+toParamSchemaBoundedIntegral :: forall proxy a t. (Bounded a, Integral a) => proxy a -> ParamSchema t

158toParamSchemaBoundedIntegral _ = mempty

157toParamSchemaBoundedIntegral _ = mempty

159− & type_ ?~ SwaggerInteger

158+ & type_ .~ SwaggerInteger

160 & minimum_ ?~ fromInteger (toInteger (minBound :: a))

159 & minimum_ ?~ fromInteger (toInteger (minBound :: a))

161 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))

160 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))

162

161

163instance ToParamSchema Char where

162instance ToParamSchema Char where

164 toParamSchema _ = mempty

163 toParamSchema _ = mempty

165− & type_ ?~ SwaggerString

164+ & type_ .~ SwaggerString

166 & maxLength ?~ 1

165 & maxLength ?~ 1

167 & minLength ?~ 1

166 & minLength ?~ 1

168

167

169instance ToParamSchema Scientific where

168instance ToParamSchema Scientific where

170− toParamSchema _ = mempty & type_ ?~ SwaggerNumber

169+ toParamSchema _ = mempty & type_ .~ SwaggerNumber

171

170

172instance HasResolution a => ToParamSchema (Fixed a) where

171instance HasResolution a => ToParamSchema (Fixed a) where

173 toParamSchema _ = mempty

172 toParamSchema _ = mempty

174− & type_ ?~ SwaggerNumber

173+ & type_ .~ SwaggerNumber

175 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))

174 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))

176

175

177instance ToParamSchema Double where

176instance ToParamSchema Double where

178 toParamSchema _ = mempty

177 toParamSchema _ = mempty

179− & type_ ?~ SwaggerNumber

178+ & type_ .~ SwaggerNumber

180 & format ?~ "double"

179 & format ?~ "double"

181

180

182instance ToParamSchema Float where

181instance ToParamSchema Float where

183 toParamSchema _ = mempty

182 toParamSchema _ = mempty

184− & type_ ?~ SwaggerNumber

183+ & type_ .~ SwaggerNumber

185 & format ?~ "float"

184 & format ?~ "float"

186

185

187timeParamSchema :: String -> ParamSchema t

186timeParamSchema :: String -> ParamSchema t

188timeParamSchema fmt = mempty

187timeParamSchema fmt = mempty

189− & type_ ?~ SwaggerString

188+ & type_ .~ SwaggerString

190 & format ?~ T.pack fmt

189 & format ?~ T.pack fmt

191

190

192-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.

191-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.

193instance ToParamSchema Day where

192instance ToParamSchema Day where

194 toParamSchema _ = timeParamSchema "date"

193 toParamSchema _ = timeParamSchema "date"

195

194

196−-- |

197−-- >>> toParamSchema (Proxy :: Proxy TimeOfDay) ^. format

198−-- Just "hh:MM:ss"

199−instance ToParamSchema TimeOfDay where

200− toParamSchema _ = timeParamSchema "hh:MM:ss"

201−

202-- |

195-- |

203-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format

196-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format

204-- Just "yyyy-mm-ddThh:MM:ss"

197-- Just "yyyy-mm-ddThh:MM:ss"

@@ -228,14 +221,9 @@ instance ToParamSchema TL.Text where

228

221

229instance ToParamSchema Version where

222instance ToParamSchema Version where

230 toParamSchema _ = mempty

223 toParamSchema _ = mempty

231− & type_ ?~ SwaggerString

224+ & type_ .~ SwaggerString

232 & pattern ?~ "^\\d+(\\.\\d+)*$"

225 & pattern ?~ "^\\d+(\\.\\d+)*$"

233

226

234−instance ToParamSchema SetCookie where

235− toParamSchema _ = mempty

236− & type_ ?~ SwaggerString

237−

238−

239#if __GLASGOW_HASKELL__ < 800

227#if __GLASGOW_HASKELL__ < 800

240#else

228#else

241type family ToParamSchemaByteStringError bs where

229type family ToParamSchemaByteStringError bs where

@@ -260,7 +248,7 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t

260

248

261instance ToParamSchema a => ToParamSchema [a] where

249instance ToParamSchema a => ToParamSchema [a] where

262 toParamSchema _ = mempty

250 toParamSchema _ = mempty

263− & type_ ?~ SwaggerArray

251+ & type_ .~ SwaggerArray

264 & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))

252 & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))

265

253

266instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])

254instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])

@@ -280,12 +268,12 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where

280-- "{\"type\":\"string\",\"enum\":[\"_\"]}"

268-- "{\"type\":\"string\",\"enum\":[\"_\"]}"

281instance ToParamSchema () where

269instance ToParamSchema () where

282 toParamSchema _ = mempty

270 toParamSchema _ = mempty

283− & type_ ?~ SwaggerString

271+ & type_ .~ SwaggerString

284 & enum_ ?~ ["_"]

272 & enum_ ?~ ["_"]

285

273

286instance ToParamSchema UUID where

274instance ToParamSchema UUID where

287 toParamSchema _ = mempty

275 toParamSchema _ = mempty

288− & type_ ?~ SwaggerString

276+ & type_ .~ SwaggerString

289 & format ?~ "uuid"

277 & format ?~ "uuid"

290

278

291-- | A configurable generic @'ParamSchema'@ creator.

279-- | A configurable generic @'ParamSchema'@ creator.

@@ -294,11 +282,11 @@ instance ToParamSchema UUID where

294-- >>> data Color = Red | Blue deriving Generic

282-- >>> data Color = Red | Blue deriving Generic

295-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)

283-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)

296-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"

284-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"

297−genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema t

285+genericToParamSchema :: forall proxy a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> proxy a -> ParamSchema t

298genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty

286genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty

299

287

300class GToParamSchema (f :: * -> *) where

288class GToParamSchema (f :: * -> *) where

301− gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t

289+ gtoParamSchema :: SchemaOptions -> proxy f -> ParamSchema t -> ParamSchema t

302

290

303instance GToParamSchema f => GToParamSchema (D1 d f) where

291instance GToParamSchema f => GToParamSchema (D1 d f) where

304 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)

292 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)

@@ -316,14 +304,14 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh

316 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))

304 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))

317

305

318class GEnumParamSchema (f :: * -> *) where

306class GEnumParamSchema (f :: * -> *) where

319− genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t

307+ genumParamSchema :: SchemaOptions -> proxy f -> ParamSchema t -> ParamSchema t

320

308

321instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where

309instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where

322 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)

310 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)

323

311

324instance Constructor c => GEnumParamSchema (C1 c U1) where

312instance Constructor c => GEnumParamSchema (C1 c U1) where

325 genumParamSchema opts _ s = s

313 genumParamSchema opts _ s = s

326− & type_ ?~ SwaggerString

314+ & type_ .~ SwaggerString

327 & enum_ %~ addEnumValue tag

315 & enum_ %~ addEnumValue tag

328 where

316 where

329 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

317 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

src/Data/Swagger/Internal/Schema.hs+70−73

@@ -111,7 +111,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema

111-- declareNamedSchema _ = do

112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)

113-- return $ NamedSchema (Just \"Coord\") $ mempty

114−-- & type_ ?~ SwaggerObject

114+-- & type_ .~ SwaggerObject

115-- & properties .~

116-- [ (\"x\", doubleSchema)

117-- , (\"y\", doubleSchema)

@@ -142,17 +142,13 @@ class ToSchema a where

142 -- together with all used definitions.

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

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

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

145+ declareNamedSchema :: proxy a -> Declare (Definitions Schema) NamedSchema

146 default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>

147− Proxy a -> Declare (Definitions Schema) NamedSchema

147+ proxy a -> Declare (Definitions Schema) NamedSchema

148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions

149

150−instance ToSchema TimeOfDay where

151− declareNamedSchema _ = pure $ named "TimeOfDay" $ timeSchema "hh:MM:ss"

152− & example ?~ toJSON (TimeOfDay 12 33 15)

153−

154-- | Convert a type into a schema and declare all used schema definitions.

150-- | Convert a type into a schema and declare all used schema definitions.

155−declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema

151+declareSchema :: ToSchema a => proxy a -> Declare (Definitions Schema) Schema

156declareSchema = fmap _namedSchemaSchema . declareNamedSchema

152declareSchema = fmap _namedSchemaSchema . declareNamedSchema

157

153

158-- | Convert a type into an optionally named schema.

154-- | Convert a type into an optionally named schema.

@@ -166,7 +162,7 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema

166-- Just "Day"

162-- Just "Day"

167-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)

163-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)

168-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"

164-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"

169−toNamedSchema :: ToSchema a => Proxy a -> NamedSchema

165+toNamedSchema :: ToSchema a => proxy a -> NamedSchema

170toNamedSchema = undeclare . declareNamedSchema

166toNamedSchema = undeclare . declareNamedSchema

171

167

172-- | Get type's schema name according to its @'ToSchema'@ instance.

168-- | Get type's schema name according to its @'ToSchema'@ instance.

@@ -176,7 +172,7 @@ toNamedSchema = undeclare . declareNamedSchema

176--

172--

177-- >>> schemaName (Proxy :: Proxy UTCTime)

173-- >>> schemaName (Proxy :: Proxy UTCTime)

178-- Just "UTCTime"

174-- Just "UTCTime"

179−schemaName :: ToSchema a => Proxy a -> Maybe T.Text

175+schemaName :: ToSchema a => proxy a -> Maybe T.Text

180schemaName = _namedSchemaName . toNamedSchema

176schemaName = _namedSchemaName . toNamedSchema

181

177

182-- | Convert a type into a schema.

178-- | Convert a type into a schema.

@@ -186,7 +182,7 @@ schemaName = _namedSchemaName . toNamedSchema

186--

182--

187-- >>> encode $ toSchema (Proxy :: Proxy [Day])

183-- >>> encode $ toSchema (Proxy :: Proxy [Day])

188-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"

184-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"

189−toSchema :: ToSchema a => Proxy a -> Schema

185+toSchema :: ToSchema a => proxy a -> Schema

190toSchema = _namedSchemaSchema . toNamedSchema

186toSchema = _namedSchemaSchema . toNamedSchema

191

187

192-- | Convert a type into a referenced schema if possible.

188-- | Convert a type into a referenced schema if possible.

@@ -197,7 +193,7 @@ toSchema = _namedSchemaSchema . toNamedSchema

197--

193--

198-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)

194-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)

199-- "{\"$ref\":\"#/definitions/Day\"}"

195-- "{\"$ref\":\"#/definitions/Day\"}"

200−toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema

196+toSchemaRef :: ToSchema a => proxy a -> Referenced Schema

201toSchemaRef = undeclare . declareSchemaRef

197toSchemaRef = undeclare . declareSchemaRef

202

198

203-- | Convert a type into a referenced schema if possible

199-- | Convert a type into a referenced schema if possible

@@ -207,7 +203,7 @@ toSchemaRef = undeclare . declareSchemaRef

207-- Schema definitions are typically declared for every referenced schema.

203-- Schema definitions are typically declared for every referenced schema.

208-- If @'declareSchemaRef'@ returns a reference, a corresponding schema

204-- If @'declareSchemaRef'@ returns a reference, a corresponding schema

209-- will be declared (regardless of whether it is recusive or not).

205-- will be declared (regardless of whether it is recusive or not).

210−declareSchemaRef :: ToSchema a => Proxy a -> Declare (Definitions Schema) (Referenced Schema)

206+declareSchemaRef :: ToSchema a => proxy a -> Declare (Definitions Schema) (Referenced Schema)

211declareSchemaRef proxy = do

207declareSchemaRef proxy = do

212 case toNamedSchema proxy of

208 case toNamedSchema proxy of

213 NamedSchema (Just name) schema -> do

209 NamedSchema (Just name) schema -> do

@@ -269,7 +265,7 @@ inlineAllSchemas = inlineSchemasWhen (const True)

269--

265--

270-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema

266-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema

271-- when inlining recursive schemas.

267-- when inlining recursive schemas.

272−toInlinedSchema :: ToSchema a => Proxy a -> Schema

268+toInlinedSchema :: ToSchema a => proxy a -> Schema

273toInlinedSchema proxy = inlineAllSchemas defs schema

269toInlinedSchema proxy = inlineAllSchemas defs schema

274 where

270 where

275 (defs, schema) = runDeclare (declareSchema proxy) mempty

271 (defs, schema) = runDeclare (declareSchema proxy) mempty

@@ -298,20 +294,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

298-- | Default schema for binary data (any sequence of octets).

294-- | Default schema for binary data (any sequence of octets).

299binarySchema :: Schema

295binarySchema :: Schema

300binarySchema = mempty

296binarySchema = mempty

301− & type_ ?~ SwaggerString

297+ & type_ .~ SwaggerString

302 & format ?~ "binary"

298 & format ?~ "binary"

303

299

304-- | Default schema for binary data (base64 encoded).

300-- | Default schema for binary data (base64 encoded).

305byteSchema :: Schema

301byteSchema :: Schema

306byteSchema = mempty

302byteSchema = mempty

307− & type_ ?~ SwaggerString

303+ & type_ .~ SwaggerString

308 & format ?~ "byte"

304 & format ?~ "byte"

309

305

310-- | Default schema for password string.

306-- | Default schema for password string.

311-- @"password"@ format is used to hint UIs the input needs to be obscured.

307-- @"password"@ format is used to hint UIs the input needs to be obscured.

312passwordSchema :: Schema

308passwordSchema :: Schema

313passwordSchema = mempty

309passwordSchema = mempty

314− & type_ ?~ SwaggerString

310+ & type_ .~ SwaggerString

315 & format ?~ "password"

311 & format ?~ "password"

316

312

317-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.

313-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.

@@ -337,12 +333,12 @@ sketchSchema = sketch . toJSON

337 sketch js@(Bool _) = go js

333 sketch js@(Bool _) = go js

338 sketch js = go js & example ?~ js

334 sketch js = go js & example ?~ js

339

335

340− go Null = mempty & type_ ?~ SwaggerNull

336+ go Null = mempty & type_ .~ SwaggerNull

341− go (Bool _) = mempty & type_ ?~ SwaggerBoolean

337+ go (Bool _) = mempty & type_ .~ SwaggerBoolean

342− go (String _) = mempty & type_ ?~ SwaggerString

338+ go (String _) = mempty & type_ .~ SwaggerString

343− go (Number _) = mempty & type_ ?~ SwaggerNumber

339+ go (Number _) = mempty & type_ .~ SwaggerNumber

344 go (Array xs) = mempty

340 go (Array xs) = mempty

345− & type_ ?~ SwaggerArray

341+ & type_ .~ SwaggerArray

346 & items ?~ case ischema of

342 & items ?~ case ischema of

347 Just s -> SwaggerItemsObject (Inline s)

343 Just s -> SwaggerItemsObject (Inline s)

348 _ -> SwaggerItemsArray (map Inline ys)

344 _ -> SwaggerItemsArray (map Inline ys)

@@ -354,7 +350,7 @@ sketchSchema = sketch . toJSON

354 (z:_) | allSame -> Just z

350 (z:_) | allSame -> Just z

355 _ -> Nothing

351 _ -> Nothing

356 go (Object o) = mempty

352 go (Object o) = mempty

357− & type_ ?~ SwaggerObject

353+ & type_ .~ SwaggerObject

358 & required .~ HashMap.keys o

354 & required .~ HashMap.keys o

359 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)

355 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)

360

356

@@ -377,24 +373,24 @@ sketchSchema = sketch . toJSON

377sketchStrictSchema :: ToJSON a => a -> Schema

373sketchStrictSchema :: ToJSON a => a -> Schema

378sketchStrictSchema = go . toJSON

374sketchStrictSchema = go . toJSON

379 where

375 where

380− go Null = mempty & type_ ?~ SwaggerNull

376+ go Null = mempty & type_ .~ SwaggerNull

381 go js@(Bool _) = mempty

377 go js@(Bool _) = mempty

382− & type_ ?~ SwaggerBoolean

378+ & type_ .~ SwaggerBoolean

383 & enum_ ?~ [js]

379 & enum_ ?~ [js]

384 go js@(String s) = mempty

380 go js@(String s) = mempty

385− & type_ ?~ SwaggerString

381+ & type_ .~ SwaggerString

386 & maxLength ?~ fromIntegral (T.length s)

382 & maxLength ?~ fromIntegral (T.length s)

387 & minLength ?~ fromIntegral (T.length s)

383 & minLength ?~ fromIntegral (T.length s)

388 & pattern ?~ s

384 & pattern ?~ s

389 & enum_ ?~ [js]

385 & enum_ ?~ [js]

390 go js@(Number n) = mempty

386 go js@(Number n) = mempty

391− & type_ ?~ SwaggerNumber

387+ & type_ .~ SwaggerNumber

392 & maximum_ ?~ n

388 & maximum_ ?~ n

393 & minimum_ ?~ n

389 & minimum_ ?~ n

394 & multipleOf ?~ n

390 & multipleOf ?~ n

395 & enum_ ?~ [js]

391 & enum_ ?~ [js]

396 go js@(Array xs) = mempty

392 go js@(Array xs) = mempty

397− & type_ ?~ SwaggerArray

393+ & type_ .~ SwaggerArray

398 & maxItems ?~ fromIntegral sz

394 & maxItems ?~ fromIntegral sz

399 & minItems ?~ fromIntegral sz

395 & minItems ?~ fromIntegral sz

400 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))

396 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))

@@ -404,7 +400,7 @@ sketchStrictSchema = go . toJSON

404 sz = length xs

400 sz = length xs

405 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))

401 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))

406 go js@(Object o) = mempty

402 go js@(Object o) = mempty

407− & type_ ?~ SwaggerObject

403+ & type_ .~ SwaggerObject

408 & required .~ names

404 & required .~ names

409 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)

405 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)

410 & maxProperties ?~ fromIntegral (length names)

406 & maxProperties ?~ fromIntegral (length names)

@@ -414,13 +410,13 @@ sketchStrictSchema = go . toJSON

414 names = HashMap.keys o

410 names = HashMap.keys o

415

411

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

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

417− gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

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

418

414

419instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where

415instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where

420 declareNamedSchema _ = do

416 declareNamedSchema _ = do

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

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

422 return $ unnamed $ mempty

418 return $ unnamed $ mempty

423− & type_ ?~ SwaggerArray

419+ & type_ .~ SwaggerArray

424 & items ?~ SwaggerItemsObject ref

420 & items ?~ SwaggerItemsObject ref

425

421

426instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema

422instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema

@@ -470,7 +466,7 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f

470

466

471timeSchema :: T.Text -> Schema

467timeSchema :: T.Text -> Schema

472timeSchema fmt = mempty

468timeSchema fmt = mempty

473− & type_ ?~ SwaggerString

469+ & type_ .~ SwaggerString

474 & format ?~ fmt

470 & format ?~ fmt

475

471

476-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.

472-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.

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

532 declareObjectMapSchema = do

528 declareObjectMapSchema = do

533 schema <- declareSchemaRef (Proxy :: Proxy v)

529 schema <- declareSchemaRef (Proxy :: Proxy v)

534 return $ unnamed $ mempty

530 return $ unnamed $ mempty

535− & type_ ?~ SwaggerObject

531+ & type_ .~ SwaggerObject

536 & additionalProperties ?~ AdditionalPropertiesSchema schema

532 & additionalProperties ?~ AdditionalPropertiesSchema schema

537

533

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

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

@@ -544,7 +540,7 @@ instance ToSchema a => ToSchema (Map String a) where

544 declareNamedSchema _ = do

540 declareNamedSchema _ = do

545 schema <- declareSchemaRef (Proxy :: Proxy a)

541 schema <- declareSchemaRef (Proxy :: Proxy a)

546 return $ unnamed $ mempty

542 return $ unnamed $ mempty

547− & type_ ?~ SwaggerObject

543+ & type_ .~ SwaggerObject

548 & additionalProperties ?~ schema

544 & additionalProperties ?~ schema

549

545

550instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))

546instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))

@@ -558,7 +554,7 @@ instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ =

558

554

559instance OVERLAPPING_ ToSchema Object where

555instance OVERLAPPING_ ToSchema Object where

560 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty

556 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty

561− & type_ ?~ SwaggerObject

557+ & type_ .~ SwaggerObject

562 & description ?~ "Arbitrary JSON object."

558 & description ?~ "Arbitrary JSON object."

563 & additionalProperties ?~ AdditionalPropertiesAllowed True

559 & additionalProperties ?~ AdditionalPropertiesAllowed True

564

560

@@ -597,26 +593,26 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar

597--

593--

598-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)

594-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)

599-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"

595-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"

600−toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema

596+toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema

601toSchemaBoundedIntegral _ = mempty

597toSchemaBoundedIntegral _ = mempty

602− & type_ ?~ SwaggerInteger

598+ & type_ .~ SwaggerInteger

603 & minimum_ ?~ fromInteger (toInteger (minBound :: a))

599 & minimum_ ?~ fromInteger (toInteger (minBound :: a))

604 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))

600 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))

605

601

606-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.

602-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.

607−genericToNamedSchemaBoundedIntegral :: forall a d f.

603+genericToNamedSchemaBoundedIntegral :: forall a d f proxy.

608 ( Bounded a, Integral a

604 ( Bounded a, Integral a

609 , Generic a, Rep a ~ D1 d f, Datatype d)

605 , Generic a, Rep a ~ D1 d f, Datatype d)

610− => SchemaOptions -> Proxy a -> NamedSchema

606+ => SchemaOptions -> proxy a -> NamedSchema

611genericToNamedSchemaBoundedIntegral opts proxy

607genericToNamedSchemaBoundedIntegral opts proxy

612 = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)

608 = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)

613

609

614-- | Declare a named schema for a @newtype@ wrapper.

610-- | Declare a named schema for a @newtype@ wrapper.

615−genericDeclareNamedSchemaNewtype :: forall a d c s i inner.

611+genericDeclareNamedSchemaNewtype :: forall proxy a d c s i inner.

616 (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))

612 (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))

617 => SchemaOptions -- ^ How to derive the name.

613 => SchemaOptions -- ^ How to derive the name.

618 -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type.

614 -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type.

619− -> Proxy a

615+ -> proxy a

620 -> Declare (Definitions Schema) NamedSchema

616 -> Declare (Definitions Schema) NamedSchema

621genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$> f (Proxy :: Proxy inner)

617genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$> f (Proxy :: Proxy inner)

622

618

@@ -633,9 +629,9 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>

633--

629--

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

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

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

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

636−declareSchemaBoundedEnumKeyMapping :: forall map key value.

632+declareSchemaBoundedEnumKeyMapping :: forall map key value proxy.

637 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

633 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

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

634+ => proxy (map key value) -> Declare (Definitions Schema) Schema

639declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

635declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

640 ToJSONKeyText keyToText _ -> objectSchema keyToText

636 ToJSONKeyText keyToText _ -> objectSchema keyToText

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

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

@@ -645,7 +641,7 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o

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

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

646 mkPair k = (keyToText k, valueRef)

642 mkPair k = (keyToText k, valueRef)

647 return $ mempty

643 return $ mempty

648− & type_ ?~ SwaggerObject

644+ & type_ .~ SwaggerObject

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

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

650

646

651-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.

647-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.

@@ -661,46 +657,46 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o

661--

657--

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

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

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

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

664−toSchemaBoundedEnumKeyMapping :: forall map key value.

660+toSchemaBoundedEnumKeyMapping :: forall map key value proxy.

665 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

661 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

666− => Proxy (map key value) -> Schema

662+ => proxy (map key value) -> Schema

667toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping

663toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping

668

664

669-- | A configurable generic @'Schema'@ creator.

665-- | A configurable generic @'Schema'@ creator.

670genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>

666genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>

671− SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema

667+ SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema

672genericDeclareSchema = genericDeclareSchemaUnrestricted

668genericDeclareSchema = genericDeclareSchemaUnrestricted

673

669

674-- | A configurable generic @'NamedSchema'@ creator.

670-- | A configurable generic @'NamedSchema'@ creator.

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

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

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

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

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

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

678−genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>

674+genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>

679− SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema

675+ SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema

680genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted

676genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted

681

677

682-- | A configurable generic @'Schema'@ creator.

678-- | A configurable generic @'Schema'@ creator.

683--

679--

684-- Unlike 'genericDeclareSchema' also works for mixed sum types.

680-- Unlike 'genericDeclareSchema' also works for mixed sum types.

685-- Use with care since some Swagger tools do not support well schemas for mixed sum types.

681-- Use with care since some Swagger tools do not support well schemas for mixed sum types.

686−genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema

682+genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema

687genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy

683genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy

688

684

689-- | A configurable generic @'NamedSchema'@ creator.

685-- | A configurable generic @'NamedSchema'@ creator.

690--

686--

691-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.

687-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.

692-- Use with care since some Swagger tools do not support well schemas for mixed sum types.

688-- Use with care since some Swagger tools do not support well schemas for mixed sum types.

693−genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>

689+genericDeclareNamedSchemaUnrestricted :: forall a proxy. (Generic a, GToSchema (Rep a)) =>

694− SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema

690+ SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema

695genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

691genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

696

692

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

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

698−genericNameSchema :: forall a d f.

694+genericNameSchema :: forall a d f proxy.

699 (Generic a, Rep a ~ D1 d f, Datatype d)

695 (Generic a, Rep a ~ D1 d f, Datatype d)

700− => SchemaOptions -> Proxy a -> Schema -> NamedSchema

696+ => SchemaOptions -> proxy a -> Schema -> NamedSchema

701genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))

697genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))

702

698

703−gdatatypeSchemaName :: forall d. Datatype d => SchemaOptions -> Proxy d -> Maybe T.Text

699+gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text

704gdatatypeSchemaName opts _ = case orig of

700gdatatypeSchemaName opts _ = case orig of

705 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)

701 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)

706 _ -> Nothing

702 _ -> Nothing

@@ -709,23 +705,24 @@ gdatatypeSchemaName opts _ = case orig of

709 name = datatypeNameModifier opts orig

705 name = datatypeNameModifier opts orig

710

706

711-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.

707-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.

708+paramSchemaToNamedSchema :: forall a d f proxy.

712−paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>

709+ (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d)

713− SchemaOptions -> Proxy a -> NamedSchema

710+ => SchemaOptions -> proxy a -> NamedSchema

714paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)

711paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)

715

712

716-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.

713-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.

717−paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema

714+paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema

718−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy

715+paramSchemaToSchema _ = mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a)

719

716

720nullarySchema :: Schema

717nullarySchema :: Schema

721nullarySchema = mempty

718nullarySchema = mempty

722− & type_ ?~ SwaggerArray

719+ & type_ .~ SwaggerArray

723 & items ?~ SwaggerItemsArray []

720 & items ?~ SwaggerItemsArray []

724

721

725−gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema

722+gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema

726gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

723gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

727

724

728−gdeclareSchema :: GToSchema f => SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema

725+gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare (Definitions Schema) Schema

729gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty

726gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty

730

727

731instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where

728instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where

@@ -759,7 +756,7 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s

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

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

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

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

761

758

762−gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)

759+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare (Definitions Schema) (Referenced Schema)

763gdeclareSchemaRef opts proxy = do

760gdeclareSchemaRef opts proxy = do

764 case gtoNamedSchema opts proxy of

761 case gtoNamedSchema opts proxy of

765 NamedSchema (Just name) schema -> do

762 NamedSchema (Just name) schema -> do

@@ -790,12 +787,12 @@ withFieldSchema opts _ isRequiredField schema = do

790 return $

787 return $

791 if T.null fname

788 if T.null fname

792 then schema

789 then schema

793− & type_ ?~ SwaggerArray

790+ & type_ .~ SwaggerArray

794 & items %~ appendItem ref

791 & items %~ appendItem ref

795 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems

792 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems

796 & minItems %~ Just . maybe 1 (+1) -- increment minItems

793 & minItems %~ Just . maybe 1 (+1) -- increment minItems

797 else schema

794 else schema

798− & type_ ?~ SwaggerObject

795+ & type_ .~ SwaggerObject

799 & properties . at fname ?~ ref

796 & properties . at fname ?~ ref

800 & if isRequiredField

797 & if isRequiredField

801 then required %~ (++ [fname])

798 then required %~ (++ [fname])

@@ -823,7 +820,7 @@ instance ( GSumToSchema f

823 where

820 where

824 gdeclareNamedSchema = gdeclareNamedSumSchema

821 gdeclareNamedSchema = gdeclareNamedSumSchema

825

822

826−gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

823+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

827gdeclareNamedSumSchema opts proxy s

824gdeclareNamedSumSchema opts proxy s

828 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)

825 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)

829 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema

826 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema

@@ -832,29 +829,29 @@ gdeclareNamedSumSchema opts proxy s

832 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)

829 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)

833

830

834 toStringTag schema = mempty

831 toStringTag schema = mempty

835− & type_ ?~ SwaggerString

832+ & type_ .~ SwaggerString

836 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)

833 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)

837

834

838type AllNullary = All

835type AllNullary = All

839

836

840class GSumToSchema (f :: * -> *) where

837class GSumToSchema (f :: * -> *) where

841− gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema

838+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema

842

839

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

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

844 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)

841 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)

845

842

846−gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>

843+gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>

847− Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema

844+ Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema

848gsumConToSchemaWith ref opts _ schema = schema

845gsumConToSchemaWith ref opts _ schema = schema

849− & type_ ?~ SwaggerObject

846+ & type_ .~ SwaggerObject

850 & properties . at tag ?~ ref

847 & properties . at tag ?~ ref

851 & maxProperties ?~ 1

848 & maxProperties ?~ 1

852 & minProperties ?~ 1

849 & minProperties ?~ 1

853 where

850 where

854 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

851 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

855

852

856−gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>

853+gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>

857− SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema

854+ SchemaOptions -> proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema

858gsumConToSchema opts proxy schema = do

855gsumConToSchema opts proxy schema = do

859 ref <- gdeclareSchemaRef opts proxy

856 ref <- gdeclareSchemaRef opts proxy

860 return $ gsumConToSchemaWith ref opts proxy schema

857 return $ gsumConToSchemaWith ref opts proxy schema

src/Data/Swagger/Internal/Schema/Validation.hs+49−207

@@ -1,17 +1,15 @@

1−{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE DeriveFunctor #-}

1+{-# LANGUAGE DeriveFunctor #-}

4−{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE FlexibleInstances #-}

5−{-# LANGUAGE FunctionalDependencies #-}

3+{-# LANGUAGE FunctionalDependencies #-}

6−{-# LANGUAGE GADTs #-}

4+{-# LANGUAGE GADTs #-}

7{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8−{-# LANGUAGE LambdaCase #-}

6+{-# LANGUAGE LambdaCase #-}

9−{-# LANGUAGE MultiParamTypeClasses #-}

7+{-# LANGUAGE MultiParamTypeClasses #-}

10−{-# LANGUAGE PackageImports #-}

8+{-# LANGUAGE PackageImports #-}

11−{-# LANGUAGE RankNTypes #-}

9+{-# LANGUAGE RankNTypes #-}

12−{-# LANGUAGE ScopedTypeVariables #-}

10+{-# LANGUAGE ScopedTypeVariables #-}

13−{-# LANGUAGE TemplateHaskell #-}

11+{-# LANGUAGE TemplateHaskell #-}

14−{-# LANGUAGE UndecidableInstances #-}

12+{-# LANGUAGE UndecidableInstances #-}

15-- |

13-- |

16-- Module: Data.Swagger.Internal.Schema.Validation

14-- Module: Data.Swagger.Internal.Schema.Validation

@@ -22,34 +20,28 @@

22-- Validate JSON values with Swagger Schema.

20-- Validate JSON values with Swagger Schema.

23module Data.Swagger.Internal.Schema.Validation where

21module Data.Swagger.Internal.Schema.Validation where

25−import Prelude ()

23+import Control.Applicative

26−import Prelude.Compat

24+import Control.Lens

25+import Control.Monad (when)

28−import Control.Applicative

29−import Control.Lens

30−import Control.Monad (when)

31−

32−import Data.Aeson hiding (Result)

27+import Data.Aeson hiding (Result)

33−import Data.Aeson.Encode.Pretty (encodePretty)

34−import Data.Foldable (for_, sequenceA_,

28+import Data.Foldable (traverse_, for_, sequenceA_)

35− traverse_)

36−import Data.HashMap.Strict (HashMap)

29+import Data.HashMap.Strict (HashMap)

37−import qualified Data.HashMap.Strict as HashMap

30+import qualified Data.HashMap.Strict as HashMap

38−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

39import qualified "unordered-containers" Data.HashSet as HashSet

31import qualified "unordered-containers" Data.HashSet as HashSet

32+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

33+import Data.Monoid

40−import Data.Proxy

34+import Data.Proxy

41−import Data.Scientific (Scientific, isInteger)

35+import Data.Scientific (Scientific, isInteger)

42−import Data.Text (Text)

36+import Data.Text (Text)

43−import qualified Data.Text as Text

37+import qualified Data.Text as Text

44−import qualified Data.Text.Lazy as TL

38+import Data.Vector (Vector)

45−import qualified Data.Text.Lazy.Encoding as TL

46−import Data.Vector (Vector)

47−import qualified Data.Vector as Vector

39+import qualified Data.Vector as Vector

48−

40+

49−import Data.Swagger.Declare

41+import Data.Swagger.Declare

50−import Data.Swagger.Internal

42+import Data.Swagger.Internal

51−import Data.Swagger.Internal.Schema

43+import Data.Swagger.Internal.Schema

52−import Data.Swagger.Lens

44+import Data.Swagger.Lens

54-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.

46-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.

55-- This can be used with QuickCheck to ensure those instances are coherent:

47-- This can be used with QuickCheck to ensure those instances are coherent:

@@ -58,101 +50,18 @@ import Data.Swagger.Lens

58--

50--

59-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.

51-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.

60-- See @'validateToJSONWithPatternChecker'@.

52-- See @'validateToJSONWithPatternChecker'@.

61−--

62−-- See 'renderValidationErrors' on how the output is structured.

63−validatePrettyToJSON :: forall a. (ToJSON a, ToSchema a) => a -> Maybe String

64−validatePrettyToJSON = renderValidationErrors validateToJSON

65−

66−-- | Variant of 'validatePrettyToJSON' with typed output.

67validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]

53validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]

68validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)

54validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)

70-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.

56-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.

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

72--

58--

73−-- For validation without patterns see @'validateToJSON'@. See also:

59+-- For validation without patterns see @'validateToJSON'@.

74−-- 'renderValidationErrors'.

75validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]

60validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]

76validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON

61validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON

77 where

62 where

78 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty

63 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty

80−-- | Pretty print validation errors

81−-- together with actual JSON and Swagger Schema

82−-- (using 'encodePretty').

83−--

84−-- >>> import Data.Aeson as Aeson

85−-- >>> import Data.Foldable (traverse_)

86−-- >>> import GHC.Generics

87−-- >>> data Phone = Phone { value :: String } deriving (Generic)

88−-- >>> data Person = Person { name :: String, phone :: Phone } deriving (Generic)

89−-- >>> instance ToJSON Person where toJSON p = object [ "name" Aeson..= name p ]

90−-- >>> instance ToSchema Phone

91−-- >>> instance ToSchema Person

92−-- >>> let person = Person { name = "John", phone = Phone "123456" }

93−-- >>> traverse_ putStrLn $ renderValidationErrors validateToJSON person

94−-- Validation against the schema fails:

95−-- * property "phone" is required, but not found in "{\"name\":\"John\"}"

96−-- <BLANKLINE>

97−-- JSON value:

98−-- {

99−-- "name": "John"

100−-- }

101−-- <BLANKLINE>

102−-- Swagger Schema:

103−-- {

104−-- "required": [

105−-- "name",

106−-- "phone"

107−-- ],

108−-- "type": "object",

109−-- "properties": {

110−-- "phone": {

111−-- "$ref": "#/definitions/Phone"

112−-- },

113−-- "name": {

114−-- "type": "string"

115−-- }

116−-- }

117−-- }

118−-- <BLANKLINE>

119−-- Swagger Description Context:

120−-- {

121−-- "Phone": {

122−-- "required": [

123−-- "value"

124−-- ],

125−-- "type": "object",

126−-- "properties": {

127−-- "value": {

128−-- "type": "string"

129−-- }

130−-- }

131−-- }

132−-- }

133−-- <BLANKLINE>

134−renderValidationErrors

135− :: forall a. (ToJSON a, ToSchema a)

136− => (a -> [ValidationError]) -> a -> Maybe String

137−renderValidationErrors f x =

138− case f x of

139− [] -> Nothing

140− errors -> Just $ unlines

141− [ "Validation against the schema fails:"

142− , unlines (map (" * " ++) errors)

143− , "JSON value:"

144− , ppJSONString (toJSON x)

145− , ""

146− , "Swagger Schema:"

147− , ppJSONString (toJSON schema_)

148− , ""

149− , "Swagger Description Context:"

150− , ppJSONString (toJSON refs_)

151− ]

152− where

153− ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty

154− (refs_, schema_) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty

155−

156-- | Validate JSON @'Value'@ against Swagger @'Schema'@.

65-- | Validate JSON @'Value'@ against Swagger @'Schema'@.

157--

66--

158-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []

67-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []

@@ -411,8 +320,8 @@ validateObject o = withSchema $ \sch ->

411 validateAdditional _ v (AdditionalPropertiesSchema s) = validateWithSchemaRef s v

320 validateAdditional _ v (AdditionalPropertiesSchema s) = validateWithSchemaRef s v

412

321

413 unknownProperty :: Text -> Validation s a

322 unknownProperty :: Text -> Validation s a

414− unknownProperty pname = invalid $

323+ unknownProperty name = invalid $

415− "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"

324+ "property " <> show name <> " is found in JSON value, but it is not mentioned in Swagger schema"

416

325

417validateEnum :: Value -> Validation (ParamSchema t) ()

326validateEnum :: Value -> Validation (ParamSchema t) ()

418validateEnum value = do

327validateEnum value = do

@@ -420,92 +329,25 @@ validateEnum value = do

420 when (value `notElem` xs) $

329 when (value `notElem` xs) $

421 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)

330 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)

422

331

423−-- | Infer schema type based on used properties.

424−--

425−-- This is like 'inferParamSchemaTypes', but also works for objects:

426−--

427−-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"

428−-- Just [SwaggerObject]

429−inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]

430−inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++

431− [ SwaggerObject | any ($ sch)

432− [ has (additionalProperties._Just)

433− , has (maxProperties._Just)

434− , has (minProperties._Just)

435− , has (properties.folded)

436− , has (required.folded) ] ]

437−

438−-- | Infer schema type based on used properties.

439−--

440−-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"

441−-- Just [SwaggerString]

442−--

443−-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"

444−-- Just [SwaggerArray]

445−--

446−-- From numeric properties 'SwaggerInteger' type is inferred.

447−-- If you want 'SwaggerNumber' instead, you must specify it explicitly.

448−--

449−-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"

450−-- Just [SwaggerInteger]

451−inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]

452−inferParamSchemaTypes sch = concat

453− [ [ SwaggerArray | any ($ sch)

454− [ has (items._Just)

455− , has (maxItems._Just)

456− , has (minItems._Just)

457− , has (uniqueItems._Just) ] ]

458− , [ SwaggerInteger | any ($ sch)

459− [ has (exclusiveMaximum._Just)

460− , has (exclusiveMinimum._Just)

461− , has (maximum_._Just)

462− , has (minimum_._Just)

463− , has (multipleOf._Just) ] ]

464− , [ SwaggerString | any ($ sch)

465− [ has (maxLength._Just)

466− , has (minLength._Just)

467− , has (pattern._Just) ] ]

468− ]

469−

470validateSchemaType :: Value -> Validation Schema ()

332validateSchemaType :: Value -> Validation Schema ()

471validateSchemaType value = withSchema $ \sch ->

333validateSchemaType value = withSchema $ \sch ->

472 case (sch ^. type_, value) of

334 case (sch ^. type_, value) of

473− (Just SwaggerNull, Null) -> valid

335+ (SwaggerNull, Null) -> valid

474− (Just SwaggerBoolean, Bool _) -> valid

336+ (SwaggerBoolean, Bool _) -> valid

475− (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)

337+ (SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)

476− (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)

338+ (SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)

477− (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)

339+ (SwaggerString, String s) -> sub_ paramSchema (validateString s)

478− (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)

340+ (SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)

479− (Just SwaggerObject, Object o) -> validateObject o

341+ (SwaggerObject, Object o) -> validateObject o

480− (Nothing, Null) -> valid

481− (Nothing, Bool _) -> valid

482− -- Number by default

483− (Nothing, Number n) -> sub_ paramSchema (validateNumber n)

484− (Nothing, String s) -> sub_ paramSchema (validateString s)

485− (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)

486− (Nothing, Object o) -> validateObject o

487− bad -> invalid $ "expected JSON value of type " ++ showType bad

342+ (t, _) -> invalid $ "expected JSON value of type " ++ show t

488

343

489validateParamSchemaType :: Value -> Validation (ParamSchema t) ()

344validateParamSchemaType :: Value -> Validation (ParamSchema t) ()

490validateParamSchemaType value = withSchema $ \sch ->

345validateParamSchemaType value = withSchema $ \sch ->

491 case (sch ^. type_, value) of

346 case (sch ^. type_, value) of

492− (Just SwaggerBoolean, Bool _) -> valid

347+ (SwaggerBoolean, Bool _) -> valid

493− (Just SwaggerInteger, Number n) -> validateInteger n

348+ (SwaggerInteger, Number n) -> validateInteger n

494− (Just SwaggerNumber, Number n) -> validateNumber n

349+ (SwaggerNumber, Number n) -> validateNumber n

495− (Just SwaggerString, String s) -> validateString s

350+ (SwaggerString, String s) -> validateString s

496− (Just SwaggerArray, Array xs) -> validateArray xs

351+ (SwaggerArray, Array xs) -> validateArray xs

497− (Nothing, Bool _) -> valid

498− -- Number by default

499− (Nothing, Number n) -> validateNumber n

500− (Nothing, String s) -> validateString s

501− (Nothing, Array xs) -> validateArray xs

502− bad -> invalid $ "expected JSON value of type " ++ showType bad

352+ (t, _) -> invalid $ "expected JSON value of type " ++ show t

503−

353+

504−showType :: (Maybe (SwaggerType t), Value) -> String

505−showType (Just type_, _) = show type_

506−showType (Nothing, Null) = "SwaggerNull"

507−showType (Nothing, Bool _) = "SwaggerBoolean"

508−showType (Nothing, Number _) = "SwaggerNumber"

509−showType (Nothing, String _) = "SwaggerString"

510−showType (Nothing, Array _) = "SwaggerArray"

511−showType (Nothing, Object _) = "SwaggerObject"

src/Data/Swagger/Lens.hs+4−10

@@ -96,19 +96,13 @@ instance At Responses where at n = responses . at n

96instance Ixed Operation where ix n = responses . ix n

97instance At Operation where at n = responses . at n

99−type instance Index SecurityDefinitions = Text

100−type instance IxValue SecurityDefinitions = SecurityScheme

101−

102−instance Ixed SecurityDefinitions where ix n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). ix n

103−instance At SecurityDefinitions where at n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). at n

104−

105instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema

99instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema

106

100

107-- HasType instances

101-- HasType instances

108−instance HasType Header (Maybe (SwaggerType ('SwaggerKindNormal Header))) where type_ = paramSchema.type_

102+instance HasType Header (SwaggerType ('SwaggerKindNormal Header)) where type_ = paramSchema.type_

109−instance HasType Schema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_

103+instance HasType Schema (SwaggerType 'SwaggerKindSchema) where type_ = paramSchema.type_

110−instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_

104+instance HasType NamedSchema (SwaggerType 'SwaggerKindSchema) where type_ = paramSchema.type_

111−instance HasType ParamOtherSchema (Maybe (SwaggerType 'SwaggerKindParamOtherSchema)) where type_ = paramSchema.type_

105+instance HasType ParamOtherSchema (SwaggerType 'SwaggerKindParamOtherSchema) where type_ = paramSchema.type_

112

106

113-- HasDefault instances

107-- HasDefault instances

114instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_

108instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_

src/Data/Swagger/Operation.hs+4−5

@@ -37,7 +37,6 @@ import Control.Lens

37import Data.Data.Lens

38import Data.List.Compat

39import Data.Maybe (mapMaybe)

40−import Data.Proxy

41import qualified Data.Set as Set

40import qualified Data.Set as Set

43import Data.Swagger.Declare

42import Data.Swagger.Declare

@@ -46,7 +45,6 @@ import Data.Swagger.Lens

46import Data.Swagger.Schema

45import Data.Swagger.Schema

48import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

47import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

49−import qualified Data.HashSet.InsOrd as InsOrdHS

51-- $setup

49-- $setup

52-- >>> import Data.Aeson

50-- >>> import Data.Aeson

@@ -112,15 +110,15 @@ applyTags = applyTagsFor allOperations

112-- list of tags.

110-- list of tags.

113applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger

111applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger

114applyTagsFor ops ts swag = swag

112applyTagsFor ops ts swag = swag

115− & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))

113+ & ops . tags %~ (<> Set.fromList (map _tagName ts))

116− & tags %~ (<> InsOrdHS.fromList ts)

114+ & tags %~ (<> Set.fromList ts)

117

115

118-- | Construct a response with @'Schema'@ while declaring all

116-- | Construct a response with @'Schema'@ while declaring all

119-- necessary schema definitions.

117-- necessary schema definitions.

120--

118--

121-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty

119-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty

122-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"

120-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"

123−declareResponse :: ToSchema a => Proxy a -> Declare (Definitions Schema) Response

121+declareResponse :: ToSchema a => proxy a -> Declare (Definitions Schema) Response

124declareResponse proxy = do

122declareResponse proxy = do

125 s <- declareSchemaRef proxy

123 s <- declareSchemaRef proxy

126 return (mempty & schema ?~ s)

124 return (mempty & schema ?~ s)

@@ -191,3 +189,4 @@ setResponseForWith ops f code dres swag = swag

191 Nothing -> new -- response name can't be dereferenced, replacing with new response

189 Nothing -> new -- response name can't be dereferenced, replacing with new response

192 combine (Just (Inline old)) = f old new

190 combine (Just (Inline old)) = f old new

193 combine Nothing = new

191 combine Nothing = new

192+

src/Data/Swagger/Optics.hsdeleted−597

@@ -1,597 +0,0 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

4−{-# LANGUAGE OverloadedLabels #-}

5−{-# LANGUAGE TemplateHaskell #-}

6−{-# LANGUAGE TypeFamilies #-}

7−{-# LANGUAGE UndecidableInstances #-}

8−{-# OPTIONS_GHC -fno-warn-orphans #-}

9−-- |

10−-- Module: Data.Swagger.Optics

11−-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>

12−-- Stability: experimental

13−--

14−-- Lenses and prisms for the <https://hackage.haskell.org/package/optics optics>

15−-- library.

16−--

17−-- >>> import Data.Aeson

18−-- >>> import Optics.Core

19−-- >>> :set -XOverloadedLabels

20−--

21−-- Example from the "Data.Swagger" module using @optics@:

22−--

23−-- >>> :{

24−-- encode $ (mempty :: Swagger)

25−-- & #definitions .~ [ ("User", mempty & #type ?~ SwaggerString) ]

26−-- & #paths .~

27−-- [ ("/user", mempty & #get ?~ (mempty

28−-- & #produces ?~ MimeList ["application/json"]

29−-- & at 200 ?~ ("OK" & #_Inline % #schema ?~ Ref (Reference "User"))

30−-- & at 404 ?~ "User info not found")) ]

31−-- :}

32−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"produces\":[\"application/json\"],\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}}}}},\"definitions\":{\"User\":{\"type\":\"string\"}}}"

33−--

34−-- For convenience optics are defined as /labels/. It means that field accessor

35−-- names can be overloaded for different types. One such common field is

36−-- @#description@. Many components of a Swagger specification can have

37−-- descriptions, and you can use the same name for them:

38−--

39−-- >>> encode $ (mempty :: Response) & #description .~ "No content"

40−-- "{\"description\":\"No content\"}"

41−-- >>> :{

42−-- encode $ (mempty :: Schema)

43−-- & #type ?~ SwaggerBoolean

44−-- & #description ?~ "To be or not to be"

45−-- :}

46−-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"

47−--

48−-- @'ParamSchema'@ is basically the /base schema specification/ and many types

49−-- contain it. So for convenience, all @'ParamSchema'@ fields are transitively

50−-- made fields of the type that has it. For example, you can use @#type@ to

51−-- access @'SwaggerType'@ of @'Header'@ schema without having to use

52−-- @#paramSchema@:

53−--

54−-- >>> encode $ (mempty :: Header) & #type ?~ SwaggerNumber

55−-- "{\"type\":\"number\"}"

56−--

57−-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and

58−-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:

59−--

60−-- >>> :{

61−-- encode $ (mempty :: Operation)

62−-- & at 404 ?~ "Not found"

63−-- :}

64−-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"

65−--

66−module Data.Swagger.Optics () where

67−

68−import Data.Aeson (Value)

69−import Data.Scientific (Scientific)

70−import Data.Swagger.Internal

71−import Data.Text (Text)

72−import Optics.Core

73−import Optics.TH

74−

75−-- Lenses

76−

77−makeFieldLabels ''Swagger

78−makeFieldLabels ''Host

79−makeFieldLabels ''Info

80−makeFieldLabels ''Contact

81−makeFieldLabels ''License

82−makeFieldLabels ''PathItem

83−makeFieldLabels ''Tag

84−makeFieldLabels ''Operation

85−makeFieldLabels ''Param

86−makeFieldLabels ''ParamOtherSchema

87−makeFieldLabels ''Header

88−makeFieldLabels ''Schema

89−makeFieldLabels ''NamedSchema

90−makeFieldLabels ''ParamSchema

91−makeFieldLabels ''Xml

92−makeFieldLabels ''Responses

93−makeFieldLabels ''Response

94−makeFieldLabels ''SecurityScheme

95−makeFieldLabels ''ApiKeyParams

96−makeFieldLabels ''OAuth2Params

97−makeFieldLabels ''ExternalDocs

98−

99−-- Prisms

100−

101−makePrismLabels ''ParamAnySchema

102−makePrismLabels ''SecuritySchemeType

103−makePrismLabels ''Referenced

104−

105−-- SwaggerItems prisms

106−

107−instance

108− ( a ~ [Referenced Schema]

109− , b ~ [Referenced Schema]

110− ) => LabelOptic "_SwaggerItemsArray"

111− A_Review

112− (SwaggerItems 'SwaggerKindSchema)

113− (SwaggerItems 'SwaggerKindSchema)

114− a

115− b where

116− labelOptic = unto (\x -> SwaggerItemsArray x)

117− {-# INLINE labelOptic #-}

118−

119−instance

120− ( a ~ Referenced Schema

121− , b ~ Referenced Schema

122− ) => LabelOptic "_SwaggerItemsObject"

123− A_Review

124− (SwaggerItems 'SwaggerKindSchema)

125− (SwaggerItems 'SwaggerKindSchema)

126− a

127− b where

128− labelOptic = unto (\x -> SwaggerItemsObject x)

129− {-# INLINE labelOptic #-}

130−

131−instance

132− ( a ~ (Maybe (CollectionFormat t), ParamSchema t)

133− , b ~ (Maybe (CollectionFormat t), ParamSchema t)

134− ) => LabelOptic "_SwaggerItemsPrimitive"

135− A_Review

136− (SwaggerItems t)

137− (SwaggerItems t)

138− a

139− b where

140− labelOptic = unto (\(c, p) -> SwaggerItemsPrimitive c p)

141− {-# INLINE labelOptic #-}

142−

143−-- =============================================================

144−-- More helpful instances for easier access to schema properties

145−

146−type instance Index Responses = HttpStatusCode

147−type instance Index Operation = HttpStatusCode

148−

149−type instance IxValue Responses = Referenced Response

150−type instance IxValue Operation = Referenced Response

151−

152−instance Ixed Responses where

153− ix n = #responses % ix n

154− {-# INLINE ix #-}

155−instance At Responses where

156− at n = #responses % at n

157− {-# INLINE at #-}

158−

159−instance Ixed Operation where

160− ix n = #responses % ix n

161− {-# INLINE ix #-}

162−instance At Operation where

163− at n = #responses % at n

164− {-# INLINE at #-}

165−

166−-- #paramSchema

167−

168−instance

169− ( a ~ ParamSchema 'SwaggerKindSchema

170− , b ~ ParamSchema 'SwaggerKindSchema

171− ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where

172− labelOptic = #schema % #paramSchema

173− {-# INLINE labelOptic #-}

174−

175−-- #type

176−

177−instance

178− ( a ~ Maybe (SwaggerType ('SwaggerKindNormal Header))

179− , b ~ Maybe (SwaggerType ('SwaggerKindNormal Header))

180− ) => LabelOptic "type" A_Lens Header Header a b where

181− labelOptic = #paramSchema % #type

182− {-# INLINE labelOptic #-}

183−

184−instance

185− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)

186− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)

187− ) => LabelOptic "type" A_Lens Schema Schema a b where

188− labelOptic = #paramSchema % #type

189− {-# INLINE labelOptic #-}

190−

191−instance

192− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)

193− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)

194− ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where

195− labelOptic = #paramSchema % #type

196− {-# INLINE labelOptic #-}

197−

198−instance

199− ( a ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)

200− , b ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)

201− ) => LabelOptic "type" A_Lens ParamOtherSchema ParamOtherSchema a b where

202− labelOptic = #paramSchema % #type

203− {-# INLINE labelOptic #-}

204−

205−-- #default

206−

207−instance

208− ( a ~ Maybe Value, b ~ Maybe Value

209− ) => LabelOptic "default" A_Lens Header Header a b where

210− labelOptic = #paramSchema % #default

211− {-# INLINE labelOptic #-}

212−

213−instance

214− ( a ~ Maybe Value, b ~ Maybe Value

215− ) => LabelOptic "default" A_Lens Schema Schema a b where

216− labelOptic = #paramSchema % #default

217− {-# INLINE labelOptic #-}

218−

219−instance

220− ( a ~ Maybe Value, b ~ Maybe Value

221− ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where

222− labelOptic = #paramSchema % #default

223− {-# INLINE labelOptic #-}

224−

225−instance

226− ( a ~ Maybe Value, b ~ Maybe Value

227− ) => LabelOptic "default" A_Lens ParamOtherSchema ParamOtherSchema a b where

228− labelOptic = #paramSchema % #default

229− {-# INLINE labelOptic #-}

230−

231−-- #format

232−

233−instance

234− ( a ~ Maybe Format, b ~ Maybe Format

235− ) => LabelOptic "format" A_Lens Header Header a b where

236− labelOptic = #paramSchema % #format

237− {-# INLINE labelOptic #-}

238−

239−instance

240− ( a ~ Maybe Format, b ~ Maybe Format

241− ) => LabelOptic "format" A_Lens Schema Schema a b where

242− labelOptic = #paramSchema % #format

243− {-# INLINE labelOptic #-}

244−

245−instance

246− ( a ~ Maybe Format, b ~ Maybe Format

247− ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where

248− labelOptic = #paramSchema % #format

249− {-# INLINE labelOptic #-}

250−

251−instance

252− ( a ~ Maybe Format, b ~ Maybe Format

253− ) => LabelOptic "format" A_Lens ParamOtherSchema ParamOtherSchema a b where

254− labelOptic = #paramSchema % #format

255− {-# INLINE labelOptic #-}

256−

257−-- #items

258−

259−instance

260− ( a ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))

261− , b ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))

262− ) => LabelOptic "items" A_Lens Header Header a b where

263− labelOptic = #paramSchema % #items

264− {-# INLINE labelOptic #-}

265−

266−instance

267− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)

268− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)

269− ) => LabelOptic "items" A_Lens Schema Schema a b where

270− labelOptic = #paramSchema % #items

271− {-# INLINE labelOptic #-}

272−

273−instance

274− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)

275− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)

276− ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where

277− labelOptic = #paramSchema % #items

278− {-# INLINE labelOptic #-}

279−

280−instance

281− ( a ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)

282− , b ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)

283− ) => LabelOptic "items" A_Lens ParamOtherSchema ParamOtherSchema a b where

284− labelOptic = #paramSchema % #items

285− {-# INLINE labelOptic #-}

286−

287−-- #maximum

288−

289−instance

290− ( a ~ Maybe Scientific, b ~ Maybe Scientific

291− ) => LabelOptic "maximum" A_Lens Header Header a b where

292− labelOptic = #paramSchema % #maximum

293− {-# INLINE labelOptic #-}

294−

295−instance

296− ( a ~ Maybe Scientific, b ~ Maybe Scientific

297− ) => LabelOptic "maximum" A_Lens Schema Schema a b where

298− labelOptic = #paramSchema % #maximum

299− {-# INLINE labelOptic #-}

300−

301−instance

302− ( a ~ Maybe Scientific, b ~ Maybe Scientific

303− ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where

304− labelOptic = #paramSchema % #maximum

305− {-# INLINE labelOptic #-}

306−

307−instance

308− ( a ~ Maybe Scientific, b ~ Maybe Scientific

309− ) => LabelOptic "maximum" A_Lens ParamOtherSchema ParamOtherSchema a b where

310− labelOptic = #paramSchema % #maximum

311− {-# INLINE labelOptic #-}

312−

313−-- #exclusiveMaximum

314−

315−instance

316− ( a ~ Maybe Bool, b ~ Maybe Bool

317− ) => LabelOptic "exclusiveMaximum" A_Lens Header Header a b where

318− labelOptic = #paramSchema % #exclusiveMaximum

319− {-# INLINE labelOptic #-}

320−

321−instance

322− ( a ~ Maybe Bool, b ~ Maybe Bool

323− ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where

324− labelOptic = #paramSchema % #exclusiveMaximum

325− {-# INLINE labelOptic #-}

326−

327−instance

328− ( a ~ Maybe Bool, b ~ Maybe Bool

329− ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where

330− labelOptic = #paramSchema % #exclusiveMaximum

331− {-# INLINE labelOptic #-}

332−

333−instance

334− ( a ~ Maybe Bool, b ~ Maybe Bool

335− ) => LabelOptic "exclusiveMaximum" A_Lens ParamOtherSchema ParamOtherSchema a b where

336− labelOptic = #paramSchema % #exclusiveMaximum

337− {-# INLINE labelOptic #-}

338−

339−-- #minimum

340−

341−instance

342− ( a ~ Maybe Scientific, b ~ Maybe Scientific

343− ) => LabelOptic "minimum" A_Lens Header Header a b where

344− labelOptic = #paramSchema % #minimum

345− {-# INLINE labelOptic #-}

346−

347−instance

348− ( a ~ Maybe Scientific, b ~ Maybe Scientific

349− ) => LabelOptic "minimum" A_Lens Schema Schema a b where

350− labelOptic = #paramSchema % #minimum

351− {-# INLINE labelOptic #-}

352−

353−instance

354− ( a ~ Maybe Scientific, b ~ Maybe Scientific

355− ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where

356− labelOptic = #paramSchema % #minimum

357− {-# INLINE labelOptic #-}

358−

359−instance

360− ( a ~ Maybe Scientific, b ~ Maybe Scientific

361− ) => LabelOptic "minimum" A_Lens ParamOtherSchema ParamOtherSchema a b where

362− labelOptic = #paramSchema % #minimum

363− {-# INLINE labelOptic #-}

364−

365−-- #exclusiveMinimum

366−

367−instance

368− ( a ~ Maybe Bool, b ~ Maybe Bool

369− ) => LabelOptic "exclusiveMinimum" A_Lens Header Header a b where

370− labelOptic = #paramSchema % #exclusiveMinimum

371− {-# INLINE labelOptic #-}

372−

373−instance

374− ( a ~ Maybe Bool, b ~ Maybe Bool

375− ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where

376− labelOptic = #paramSchema % #exclusiveMinimum

377− {-# INLINE labelOptic #-}

378−

379−instance

380− ( a ~ Maybe Bool, b ~ Maybe Bool

381− ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where

382− labelOptic = #paramSchema % #exclusiveMinimum

383− {-# INLINE labelOptic #-}

384−

385−instance

386− ( a ~ Maybe Bool, b ~ Maybe Bool

387− ) => LabelOptic "exclusiveMinimum" A_Lens ParamOtherSchema ParamOtherSchema a b where

388− labelOptic = #paramSchema % #exclusiveMinimum

389− {-# INLINE labelOptic #-}

390−

391−-- #maxLength

392−

393−instance

394− ( a ~ Maybe Integer, b ~ Maybe Integer

395− ) => LabelOptic "maxLength" A_Lens Header Header a b where

396− labelOptic = #paramSchema % #maxLength

397− {-# INLINE labelOptic #-}

398−

399−instance

400− ( a ~ Maybe Integer, b ~ Maybe Integer

401− ) => LabelOptic "maxLength" A_Lens Schema Schema a b where

402− labelOptic = #paramSchema % #maxLength

403− {-# INLINE labelOptic #-}

404−

405−instance

406− ( a ~ Maybe Integer, b ~ Maybe Integer

407− ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where

408− labelOptic = #paramSchema % #maxLength

409− {-# INLINE labelOptic #-}

410−

411−instance

412− ( a ~ Maybe Integer, b ~ Maybe Integer

413− ) => LabelOptic "maxLength" A_Lens ParamOtherSchema ParamOtherSchema a b where

414− labelOptic = #paramSchema % #maxLength

415− {-# INLINE labelOptic #-}

416−

417−-- #minLength

418−

419−instance

420− ( a ~ Maybe Integer, b ~ Maybe Integer

421− ) => LabelOptic "minLength" A_Lens Header Header a b where

422− labelOptic = #paramSchema % #minLength

423− {-# INLINE labelOptic #-}

424−

425−instance

426− ( a ~ Maybe Integer, b ~ Maybe Integer

427− ) => LabelOptic "minLength" A_Lens Schema Schema a b where

428− labelOptic = #paramSchema % #minLength

429− {-# INLINE labelOptic #-}

430−

431−instance

432− ( a ~ Maybe Integer, b ~ Maybe Integer

433− ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where

434− labelOptic = #paramSchema % #minLength

435− {-# INLINE labelOptic #-}

436−

437−instance

438− ( a ~ Maybe Integer, b ~ Maybe Integer

439− ) => LabelOptic "minLength" A_Lens ParamOtherSchema ParamOtherSchema a b where

440− labelOptic = #paramSchema % #minLength

441− {-# INLINE labelOptic #-}

442−

443−-- #pattern

444−

445−instance

446− ( a ~ Maybe Text, b ~ Maybe Text

447− ) => LabelOptic "pattern" A_Lens Header Header a b where

448− labelOptic = #paramSchema % #pattern

449− {-# INLINE labelOptic #-}

450−

451−instance

452− ( a ~ Maybe Text, b ~ Maybe Text

453− ) => LabelOptic "pattern" A_Lens Schema Schema a b where

454− labelOptic = #paramSchema % #pattern

455− {-# INLINE labelOptic #-}

456−

457−instance

458− ( a ~ Maybe Text, b ~ Maybe Text

459− ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where

460− labelOptic = #paramSchema % #pattern

461− {-# INLINE labelOptic #-}

462−

463−instance

464− ( a ~ Maybe Text, b ~ Maybe Text

465− ) => LabelOptic "pattern" A_Lens ParamOtherSchema ParamOtherSchema a b where

466− labelOptic = #paramSchema % #pattern

467− {-# INLINE labelOptic #-}

468−

469−-- #maxItems

470−

471−instance

472− ( a ~ Maybe Integer, b ~ Maybe Integer

473− ) => LabelOptic "maxItems" A_Lens Header Header a b where

474− labelOptic = #paramSchema % #maxItems

475− {-# INLINE labelOptic #-}

476−

477−instance

478− ( a ~ Maybe Integer, b ~ Maybe Integer

479− ) => LabelOptic "maxItems" A_Lens Schema Schema a b where

480− labelOptic = #paramSchema % #maxItems

481− {-# INLINE labelOptic #-}

482−

483−instance

484− ( a ~ Maybe Integer, b ~ Maybe Integer

485− ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where

486− labelOptic = #paramSchema % #maxItems

487− {-# INLINE labelOptic #-}

488−

489−instance

490− ( a ~ Maybe Integer, b ~ Maybe Integer

491− ) => LabelOptic "maxItems" A_Lens ParamOtherSchema ParamOtherSchema a b where

492− labelOptic = #paramSchema % #maxItems

493− {-# INLINE labelOptic #-}

494−

495−-- #minItems

496−

497−instance

498− ( a ~ Maybe Integer, b ~ Maybe Integer

499− ) => LabelOptic "minItems" A_Lens Header Header a b where

500− labelOptic = #paramSchema % #minItems

501− {-# INLINE labelOptic #-}

502−

503−instance

504− ( a ~ Maybe Integer, b ~ Maybe Integer

505− ) => LabelOptic "minItems" A_Lens Schema Schema a b where

506− labelOptic = #paramSchema % #minItems

507− {-# INLINE labelOptic #-}

508−

509−instance

510− ( a ~ Maybe Integer, b ~ Maybe Integer

511− ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where

512− labelOptic = #paramSchema % #minItems

513− {-# INLINE labelOptic #-}

514−

515−instance

516− ( a ~ Maybe Integer, b ~ Maybe Integer

517− ) => LabelOptic "minItems" A_Lens ParamOtherSchema ParamOtherSchema a b where

518− labelOptic = #paramSchema % #minItems

519− {-# INLINE labelOptic #-}

520−

521−-- #uniqueItems

522−

523−instance

524− ( a ~ Maybe Bool, b ~ Maybe Bool

525− ) => LabelOptic "uniqueItems" A_Lens Header Header a b where

526− labelOptic = #paramSchema % #uniqueItems

527− {-# INLINE labelOptic #-}

528−

529−instance

530− ( a ~ Maybe Bool, b ~ Maybe Bool

531− ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where

532− labelOptic = #paramSchema % #uniqueItems

533− {-# INLINE labelOptic #-}

534−

535−instance

536− ( a ~ Maybe Bool, b ~ Maybe Bool

537− ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where

538− labelOptic = #paramSchema % #uniqueItems

539− {-# INLINE labelOptic #-}

540−

541−instance

542− ( a ~ Maybe Bool, b ~ Maybe Bool

543− ) => LabelOptic "uniqueItems" A_Lens ParamOtherSchema ParamOtherSchema a b where

544− labelOptic = #paramSchema % #uniqueItems

545− {-# INLINE labelOptic #-}

546−

547−-- #enum

548−

549−instance

550− ( a ~ Maybe [Value], b ~ Maybe [Value]

551− ) => LabelOptic "enum" A_Lens Header Header a b where

552− labelOptic = #paramSchema % #enum

553− {-# INLINE labelOptic #-}

554−

555−instance

556− ( a ~ Maybe [Value], b ~ Maybe [Value]

557− ) => LabelOptic "enum" A_Lens Schema Schema a b where

558− labelOptic = #paramSchema % #enum

559− {-# INLINE labelOptic #-}

560−

561−instance

562− ( a ~ Maybe [Value], b ~ Maybe [Value]

563− ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where

564− labelOptic = #paramSchema % #enum

565− {-# INLINE labelOptic #-}

566−

567−instance

568− ( a ~ Maybe [Value], b ~ Maybe [Value]

569− ) => LabelOptic "enum" A_Lens ParamOtherSchema ParamOtherSchema a b where

570− labelOptic = #paramSchema % #enum

571− {-# INLINE labelOptic #-}

572−

573−-- #multipleOf

574−

575−instance

576− ( a ~ Maybe Scientific, b ~ Maybe Scientific

577− ) => LabelOptic "multipleOf" A_Lens Header Header a b where

578− labelOptic = #paramSchema % #multipleOf

579− {-# INLINE labelOptic #-}

580−

581−instance

582− ( a ~ Maybe Scientific, b ~ Maybe Scientific

583− ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where

584− labelOptic = #paramSchema % #multipleOf

585− {-# INLINE labelOptic #-}

586−

587−instance

588− ( a ~ Maybe Scientific, b ~ Maybe Scientific

589− ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where

590− labelOptic = #paramSchema % #multipleOf

591− {-# INLINE labelOptic #-}

592−

593−instance

594− ( a ~ Maybe Scientific, b ~ Maybe Scientific

595− ) => LabelOptic "multipleOf" A_Lens ParamOtherSchema ParamOtherSchema a b where

596− labelOptic = #paramSchema % #multipleOf

597− {-# INLINE labelOptic #-}

src/Data/Swagger/Schema/Generator.hsdeleted−114

@@ -1,114 +0,0 @@

1−{-# LANGUAGE GADTs #-}

2−{-# LANGUAGE OverloadedLists #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4−

5−module Data.Swagger.Schema.Generator where

6−

7−import Prelude ()

8−import Prelude.Compat

9−

10−import Control.Lens.Operators

11−import Control.Monad (filterM)

12−import Data.Aeson

13−import Data.Aeson.Types

14−import qualified Data.HashMap.Strict.InsOrd as M

15−import Data.Maybe

16−import Data.Maybe

17−import Data.Proxy

18−import Data.Scientific

19−import qualified Data.Set as S

20−import Data.Swagger

21−import Data.Swagger.Declare

22−import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)

23−import qualified Data.Text as T

24−import qualified Data.Vector as V

25−import Test.QuickCheck (arbitrary)

26−import Test.QuickCheck.Gen

27−import Test.QuickCheck.Property

28−

29−-- | Note: 'schemaGen' may 'error', if schema type is not specified,

30−-- and cannot be inferred.

31−schemaGen :: Definitions Schema -> Schema -> Gen Value

32−schemaGen _ schema

33− | Just cases <- schema ^. paramSchema . enum_ = elements cases

34−schemaGen defns schema =

35− case schema ^. type_ of

36− Nothing ->

37− case inferSchemaTypes schema of

38− [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)

39− -- Gen is not MonadFail

40− _ -> error "unable to infer schema type"

41− Just SwaggerBoolean -> Bool <$> elements [True, False]

42− Just SwaggerNull -> pure Null

43− Just SwaggerNumber

44− | Just min <- schema ^. minimum_

45− , Just max <- schema ^. maximum_ ->

46− Number . fromFloatDigits <$>

47− choose (toRealFloat min, toRealFloat max :: Double)

48− | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)

49− Just SwaggerInteger

50− | Just min <- schema ^. minimum_

51− , Just max <- schema ^. maximum_ ->

52− Number . fromInteger <$>

53− choose (truncate min, truncate max)

54− | otherwise -> Number . fromInteger <$> arbitrary

55− Just SwaggerArray

56− | Just 0 <- schema ^. maxLength -> pure $ Array V.empty

57− | Just items <- schema ^. items ->

58− case items of

59− SwaggerItemsObject ref -> do

60− size <- getSize

61− let itemSchema = dereference defns ref

62− minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems

63− maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxItems

64− arrayLength <- choose (minLength', max minLength' maxLength')

65− generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema

66− return . Array $ V.fromList generatedArray

67− SwaggerItemsArray refs ->

68− let itemGens = schemaGen defns . dereference defns <$> refs

69− in fmap (Array . V.fromList) $ sequence itemGens

70− Just SwaggerString -> do

71− size <- getSize

72− let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength

73− let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength

74− length <- choose (minLength', max minLength' maxLength')

75− str <- vectorOf length arbitrary

76− return . String $ T.pack str

77− Just SwaggerObject -> do

78− size <- getSize

79− let props = dereference defns <$> schema ^. properties

80− reqKeys = S.fromList $ schema ^. required

81− allKeys = S.fromList . M.keys $ schema ^. properties

82− optionalKeys = allKeys S.\\ reqKeys

83− minProps' = fromMaybe (length reqKeys) $

84− fromInteger <$> schema ^. minProperties

85− maxProps' = fromMaybe size $ fromInteger <$> schema ^. maxProperties

86− shuffledOptional <- shuffle $ S.toList optionalKeys

87− numProps <- choose (minProps', max minProps' maxProps')

88− let presentKeys = take numProps $ S.toList reqKeys ++ shuffledOptional

89− let presentProps = M.filterWithKey (\k _ -> k `elem` presentKeys) props

90− let gens = schemaGen defns <$> presentProps

91− additionalGens <- case schema ^. additionalProperties of

92− Just (AdditionalPropertiesSchema addlSchema) -> do

93− additionalKeys <- sequence . take (numProps - length presentProps) . repeat $ T.pack <$> arbitrary

94− return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)

95− _ -> return []

96− x <- sequence $ gens <> additionalGens

97− return . Object $ M.toHashMap x

98− where

99− dereference :: Definitions a -> Referenced a -> a

100− dereference _ (Inline a) = a

101− dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs

102−

103−genValue :: (ToSchema a) => Proxy a -> Gen Value

104−genValue p =

105− let (defs, NamedSchema _ schema) = runDeclare (declareNamedSchema p) M.empty

106− in schemaGen defs schema

107−

108−validateFromJSON :: forall a . (ToSchema a, FromJSON a) => Proxy a -> Property

109−validateFromJSON p = forAll (genValue p) $

110− \val -> case parseEither parseJSON val of

111− Right (_ :: a) -> succeeded

112− Left err -> failed

113− { reason = err

114− }

src/Data/Swagger/Schema/Validation.hs−2

@@ -19,10 +19,8 @@ module Data.Swagger.Schema.Validation (

19 ValidationError,

21 -- ** Using 'ToJSON' and 'ToSchema'

22− validatePrettyToJSON,

23 validateToJSON,

22 validateToJSON,

24 validateToJSONWithPatternChecker,

23 validateToJSONWithPatternChecker,

25− renderValidationErrors,

27 -- ** Using 'Value' and 'Schema'

25 -- ** Using 'Value' and 'Schema'

28 validateJSON,

26 validateJSON,

stack.yaml+4−6

@@ -1,9 +1,7 @@

1−resolver: lts-14.3

1+resolver: lts-11.14

2packages:

3- '.'

4extra-deps:

5−- optics-core-0.2

5+- aeson-1.3.1.0

6−- optics-th-0.2

6+- base-compat-0.10.1

7−- optics-extra-0.2

7+- base-compat-batteries-0.10.1

8−- indexed-profunctors-0.1

9−- insert-ordered-containers-0.2.3

swagger2.cabal+27−42

@@ -1,11 +1,10 @@

1cabal-version: >=1.10

2name: swagger2

3−version: 2.5

3+version: 2.3

5synopsis: Swagger 2.0 data model

6−category: Web, Swagger

7description:

6description:

8− This library is intended to be used for decoding and encoding Swagger 2.0 API

7+ This library is inteded to be used for decoding and encoding Swagger 2.0 API

9 specifications as well as manipulating them.

8 specifications as well as manipulating them.

10 .

9 .

11 The original Swagger 2.0 specification is available at http://swagger.io/specification/.

10 The original Swagger 2.0 specification is available at http://swagger.io/specification/.

@@ -17,22 +16,18 @@ license-file: LICENSE

17author: Nickolay Kudasov

16author: Nickolay Kudasov

18maintainer: nickolay@getshoptv.com

17maintainer: nickolay@getshoptv.com

19+category: Web, Swagger

20build-type: Custom

21extra-source-files:

22 README.md

23 , CHANGELOG.md

24 , examples/*.hs

25 , include/overlapping-compat.h

26−tested-with:

26+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

27− GHC ==8.0.2

28− || ==8.2.2

29− || ==8.4.4

30− || ==8.6.5

31− || ==8.8.1

33custom-setup

28custom-setup

34 setup-depends:

29 setup-depends:

35− base, Cabal, cabal-doctest >=1.0.6 && <1.1

30+ base, Cabal, cabal-doctest >=1.0.2 && <1.1

37library

32library

38 hs-source-dirs: src

33 hs-source-dirs: src

@@ -42,10 +37,8 @@ library

42 Data.Swagger.Declare

37 Data.Swagger.Declare

43 Data.Swagger.Lens

38 Data.Swagger.Lens

44 Data.Swagger.Operation

39 Data.Swagger.Operation

45− Data.Swagger.Optics

46 Data.Swagger.ParamSchema

40 Data.Swagger.ParamSchema

47 Data.Swagger.Schema

41 Data.Swagger.Schema

48− Data.Swagger.Schema.Generator

49 Data.Swagger.Schema.Validation

42 Data.Swagger.Schema.Validation

50 Data.Swagger.SchemaOptions

43 Data.Swagger.SchemaOptions

@@ -60,13 +53,12 @@ library

61 -- GHC boot libraries

54 -- GHC boot libraries

62 build-depends:

55 build-depends:

63− base >=4.9 && <4.14

56+ base >=4.7 && <4.12

64− , aeson-pretty >=0.8.7 && <0.9

65− , bytestring >=0.10.4.0 && <0.11

57+ , bytestring >=0.10.4 && <0.11

66− , containers >=0.5.5.1 && <0.7

58+ , containers >=0.5.5.1 && <0.6

67− , template-haskell >=2.9.0.0 && <2.16

59+ , template-haskell >=2.9.0.0 && <2.14

68− , time >=1.4.2 && <1.10

60+ , time >=1.4.2 && <1.9

69− , transformers >=0.3.0.0 && <0.6

61+ , transformers >=0.3.0.0 && <0.6

71 build-depends:

63 build-depends:

72 mtl >=2.1 && <2.3

64 mtl >=2.1 && <2.3

@@ -74,24 +66,19 @@ library

75 -- other dependencies

67 -- other dependencies

76 build-depends:

68 build-depends:

77− base-compat-batteries >=0.10.4 && <0.12

69+ base-compat-batteries >=0.10.1 && <0.11

78− , aeson >=1.4.2.0 && <1.5

70+ , aeson >=1.0.0.0 && <1.5

79− -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint

80− , cookie >=0.4.3 && <0.5

81− , generics-sop >=0.3.2.0 && <0.6

71+ , generics-sop >=0.3.2.0 && <0.4

82− , hashable >=1.2.7.0 && <1.4

72+ , hashable >=1.2.7.0 && <1.3

83− , http-media >=0.7.1.2 && <0.9

73+ , http-media >=0.7.1.2 && <0.8

84− , insert-ordered-containers >=0.2.3 && <0.3

74+ , insert-ordered-containers >=0.1.0.0 && <0.3

85− , lens >=4.16.1 && <4.19

75+ , lens >=4.16.1 && <4.18

86− , network >=2.6.3.5 && <3.2

76+ , network >=2.6.3.5 && <2.8

87− , optics-core >=0.2 && <0.3

88− , optics-th >=0.2 && <0.3

89− , scientific >=0.3.6.2 && <0.4

77+ , scientific >=0.3.5.3 && <0.4

90 , transformers-compat >=0.3 && <0.7

78 , transformers-compat >=0.3 && <0.7

91 , unordered-containers >=0.2.9.0 && <0.3

79 , unordered-containers >=0.2.9.0 && <0.3

92− , uuid-types >=1.0.3 && <1.1

80+ , uuid-types >=1.0.2 && <1.1

93 , vector >=0.12.0.1 && <0.13

81 , vector >=0.12.0.1 && <0.13

94− , QuickCheck >=2.10.1 && <2.14

96 default-language: Haskell2010

83 default-language: Haskell2010

@@ -102,7 +89,7 @@ test-suite spec

102

103 -- From library parat

90 -- From library parat

104 -- We need aeson's toEncoding for doctests too

91 -- We need aeson's toEncoding for doctests too

105− build-depends:

92+ build-depends:

106 base

93 base

107 , swagger2

94 , swagger2

108 , aeson

95 , aeson

@@ -113,23 +100,22 @@ test-suite spec

113 , insert-ordered-containers

100 , insert-ordered-containers

114 , lens

101 , lens

115 , mtl

102 , mtl

116− , template-haskell

117 , text

103 , text

118 , time

104 , time

119 , unordered-containers

105 , unordered-containers

120 , vector

106 , vector

121− , QuickCheck

122

107

123 -- test-suite only dependencies

108 -- test-suite only dependencies

124 build-depends:

109 build-depends:

110+ aeson-qq >=0.8.2 && <0.9

125− hspec >=2.5.5 && <2.8

111+ , hspec >=2.4.8 && <2.6

126 , HUnit >=1.6.0.0 && <1.7

112 , HUnit >=1.6.0.0 && <1.7

113+ , QuickCheck >=2.10.1 && <2.12

127− , quickcheck-instances >=0.3.19 && <0.14

114+ , quickcheck-instances >=0.3.18 && <0.14

128− , utf8-string >=1.0.1.1 && <1.1

129

115

130 -- https://github.com/haskell/cabal/issues/3708

116 -- https://github.com/haskell/cabal/issues/3708

131 build-tool-depends:

117 build-tool-depends:

132− hspec-discover:hspec-discover >=2.5.5 && <2.8

118+ hspec-discover:hspec-discover >=2.4.8 && <2.6

133

119

134 other-modules:

120 other-modules:

135 SpecCommon

121 SpecCommon

@@ -138,7 +124,6 @@ test-suite spec

138 Data.Swagger.ParamSchemaSpec

124 Data.Swagger.ParamSchemaSpec

139 Data.Swagger.SchemaSpec

125 Data.Swagger.SchemaSpec

140 Data.Swagger.Schema.ValidationSpec

126 Data.Swagger.Schema.ValidationSpec

141− Data.Swagger.Schema.GeneratorSpec

142 default-language: Haskell2010

127 default-language: Haskell2010

143

128

144test-suite doctests

129test-suite doctests

test/Data/Swagger/CommonTestTypes.hs+5−32

@@ -8,7 +8,7 @@ import Prelude ()

8import Prelude.Compat

10import Data.Aeson (ToJSON (..), ToJSONKey (..), Value)

11−import Data.Aeson.QQ.Simple

11+import Data.Aeson.QQ

12import Data.Aeson.Types (toJSONKeyText)

13import Data.Char

14import Data.Map (Map)

@@ -18,6 +18,8 @@ import qualified Data.Text as Text

18import GHC.Generics

20import Data.Swagger

21+import Data.Swagger.Declare

22+import Data.Swagger.Internal (SwaggerKind (..))

22-- ========================================================================

24-- ========================================================================

23-- Unit type

25-- Unit type

@@ -550,7 +552,7 @@ lightSchemaJSON = [aesonQQ|

550 "type": "object",

552 "type": "object",

551 "properties":

553 "properties":

552 {

554 {

553− "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },

555+ "NoLight": { "type": "array", "items": [] },

554 "LightFreq": { "type": "number", "format": "double" },

556 "LightFreq": { "type": "number", "format": "double" },

555 "LightColor": { "$ref": "#/definitions/Color" },

557 "LightColor": { "$ref": "#/definitions/Color" },

556 "LightWaveLength": { "type": "number", "format": "double" }

558 "LightWaveLength": { "type": "number", "format": "double" }

@@ -566,7 +568,7 @@ lightInlinedSchemaJSON = [aesonQQ|

566 "type": "object",

568 "type": "object",

567 "properties":

569 "properties":

568 {

570 {

569− "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },

571+ "NoLight": { "type": "array", "items": [] },

570 "LightFreq": { "type": "number", "format": "double" },

572 "LightFreq": { "type": "number", "format": "double" },

571 "LightColor":

573 "LightColor":

572 {

574 {

@@ -648,32 +650,3 @@ singleMaybeFieldSchemaJSON = [aesonQQ|

648 }

650 }

649}

651}

650|]

652|]

651−

652−

653−-- ========================================================================

654−-- TimeOfDay

655−-- ========================================================================

656−data TimeOfDay

657− = Int

658− | Pico

659− deriving (Generic)

660−instance ToSchema TimeOfDay

661−instance ToParamSchema TimeOfDay

662−

663−

664−timeOfDaySchemaJSON :: Value

665−timeOfDaySchemaJSON = [aesonQQ|

666−{

667− "example": "12:33:15",

668− "type": "string",

669− "format": "hh:MM:ss"

670−}

671−|]

672−

673−timeOfDayParamSchemaJSON :: Value

674−timeOfDayParamSchemaJSON = [aesonQQ|

675−{

676− "type": "string",

677− "format": "hh:MM:ss"

678−}

679−|]

test/Data/Swagger/ParamSchemaSpec.hs+2−7

@@ -3,11 +3,10 @@

3{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE TemplateHaskell #-}

5{-# LANGUAGE QuasiQuotes #-}

6−{-# LANGUAGE OverloadedStrings #-}

7module Data.Swagger.ParamSchemaSpec where

6module Data.Swagger.ParamSchemaSpec where

9−import Data.Aeson

8+import Data.Aeson (Value)

10−import Data.Aeson.QQ.Simple

9+import Data.Aeson.QQ

11import Data.Char

10import Data.Char

12import Data.Proxy

11import Data.Proxy

13import GHC.Generics

12import GHC.Generics

@@ -18,9 +17,6 @@ import Data.Swagger.Internal (SwaggerKind(..))

18import Data.Swagger.CommonTestTypes

17import Data.Swagger.CommonTestTypes

19import SpecCommon

18import SpecCommon

20import Test.Hspec

19import Test.Hspec

21−import Data.Time.LocalTime

22−

23−import qualified Data.HashMap.Strict as HM

25checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec

21checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec

26checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js

22checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js

@@ -34,7 +30,6 @@ spec = do

34 context "Unary records" $ do

30 context "Unary records" $ do

35 context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON

31 context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON

36 context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON

32 context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON

37− context "TimeOfDay" $ checkToParamSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDayParamSchemaJSON

39main :: IO ()

34main :: IO ()

40main = hspec spec

35main = hspec spec

test/Data/Swagger/Schema/GeneratorSpec.hsdeleted−168

@@ -1,168 +0,0 @@

1−{-# LANGUAGE OverloadedLists #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE PackageImports #-}

4−module Data.Swagger.Schema.GeneratorSpec where

5−

6−import Prelude ()

7−import Prelude.Compat

8−

9−import Data.Swagger

10−import Data.Swagger.Schema.Generator

11−

12−import Control.Lens.Operators

13−import Data.Aeson

14−import Data.Hashable (Hashable)

15−import Data.HashMap.Strict (HashMap)

16−import qualified Data.HashMap.Strict as HashMap

17−import "unordered-containers" Data.HashSet (HashSet)

18−import qualified "unordered-containers" Data.HashSet as HashSet

19−import Data.Int

20−import Data.IntMap (IntMap)

21−import Data.List.NonEmpty.Compat (NonEmpty (..), nonEmpty)

22−import Data.Map (Map, fromList)

23−import Data.Monoid (mempty)

24−import Data.Proxy

25−import Data.Proxy

26−import Data.Set (Set)

27−import qualified Data.Text as T

28−import qualified Data.Text.Lazy as TL

29−import Data.Time

30−import Data.Version (Version)

31−import Data.Word

32−import GHC.Generics

33−

34−import Test.Hspec

35−import Test.Hspec.QuickCheck

36−import Test.QuickCheck

37−

38−shouldValidate :: (FromJSON a, ToSchema a) => Proxy a -> Property

39−shouldValidate = validateFromJSON

40−

41−

42−shouldNotValidate :: (FromJSON a, ToSchema a) => Proxy a -> Property

43−shouldNotValidate = expectFailure . shouldValidate

44−

45−

46−spec :: Spec

47−spec = do

48− describe "FromJSON validation" $ do

49− prop "Bool" $ shouldValidate (Proxy :: Proxy Bool)

50− prop "Char" $ shouldValidate (Proxy :: Proxy Char)

51− prop "Double" $ shouldValidate (Proxy :: Proxy Double)

52− prop "Float" $ shouldValidate (Proxy :: Proxy Float)

53− prop "Int" $ shouldValidate (Proxy :: Proxy Int)

54− prop "Int8" $ shouldValidate (Proxy :: Proxy Int8)

55− prop "Int16" $ shouldValidate (Proxy :: Proxy Int16)

56− prop "Int32" $ shouldValidate (Proxy :: Proxy Int32)

57− prop "Int64" $ shouldValidate (Proxy :: Proxy Int64)

58− prop "Integer" $ shouldValidate (Proxy :: Proxy Integer)

59− prop "Word" $ shouldValidate (Proxy :: Proxy Word)

60− prop "Word8" $ shouldValidate (Proxy :: Proxy Word8)

61− prop "Word16" $ shouldValidate (Proxy :: Proxy Word16)

62− prop "Word32" $ shouldValidate (Proxy :: Proxy Word32)

63− prop "Word64" $ shouldValidate (Proxy :: Proxy Word64)

64− prop "String" $ shouldValidate (Proxy :: Proxy String)

65− prop "()" $ shouldValidate (Proxy :: Proxy ())

66−-- prop "ZonedTime" $ shouldValidate (Proxy :: Proxy ZonedTime)

67−-- prop "UTCTime" $ shouldValidate (Proxy :: Proxy UTCTime)

68− prop "T.Text" $ shouldValidate (Proxy :: Proxy T.Text)

69− prop "TL.Text" $ shouldValidate (Proxy :: Proxy TL.Text)

70− prop "[String]" $ shouldValidate (Proxy :: Proxy [String])

71− -- prop "(Maybe [Int])" $ shouldValidate (Proxy :: Proxy (Maybe [Int]))

72− prop "(IntMap String)" $ shouldValidate (Proxy :: Proxy (IntMap String))

73− prop "(Set Bool)" $ shouldValidate (Proxy :: Proxy (Set Bool))

74− prop "(NonEmpty Bool)" $ shouldValidate (Proxy :: Proxy (NonEmpty Bool))

75− prop "(HashSet Bool)" $ shouldValidate (Proxy :: Proxy (HashSet Bool))

76− prop "(Either Int String)" $ shouldValidate (Proxy :: Proxy (Either Int String))

77− prop "(Int, String)" $ shouldValidate (Proxy :: Proxy (Int, String))

78− prop "(Map String Int)" $ shouldValidate (Proxy :: Proxy (Map String Int))

79− prop "(Map T.Text Int)" $ shouldValidate (Proxy :: Proxy (Map T.Text Int))

80− prop "(Map TL.Text Bool)" $ shouldValidate (Proxy :: Proxy (Map TL.Text Bool))

81− prop "(HashMap String Int)" $ shouldValidate (Proxy :: Proxy (HashMap String Int))

82− prop "(HashMap T.Text Int)" $ shouldValidate (Proxy :: Proxy (HashMap T.Text Int))

83− prop "(HashMap TL.Text Bool)" $ shouldValidate (Proxy :: Proxy (HashMap TL.Text Bool))

84− prop "Object" $ shouldValidate (Proxy :: Proxy Object)

85− prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))

86− prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))

87− prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))

88− describe "Invalid FromJSON validation" $ do

89− prop "WrongType" $ shouldNotValidate (Proxy :: Proxy WrongType)

90− prop "MissingRequired" $ shouldNotValidate (Proxy :: Proxy MissingRequired)

91− prop "MissingProperty" $ shouldNotValidate (Proxy :: Proxy MissingProperty)

92− prop "WrongPropType" $ shouldNotValidate (Proxy :: Proxy WrongPropType)

93−

94−-- =============================

95−-- Data types and bunk instances

96−-- =============================

97−

98−data WrongType = WrongType Bool

99−

100−instance FromJSON WrongType where

101− parseJSON = withBool "WrongType" $ return . WrongType

102−

103−instance ToSchema WrongType where

104− declareNamedSchema _ = return . NamedSchema (Just "WrongType") $

105− mempty

106− & type_ ?~ SwaggerObject

107−

108−

109−data MissingRequired = MissingRequired

110− { propA :: String

111− , propB :: Bool

112− }

113−

114−instance FromJSON MissingRequired where

115− parseJSON = withObject "MissingRequired" $ \o ->

116− MissingRequired

117− <$> o .: "propA"

118− <*> o .: "propB"

119−

120−instance ToSchema MissingRequired where

121− declareNamedSchema _ = do

122− stringSchema <- declareSchemaRef (Proxy :: Proxy String)

123− boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)

124− return . NamedSchema (Just "MissingRequired") $

125− mempty

126− & type_ ?~ SwaggerObject

127− & properties .~ [("propA", stringSchema)

128− ,("propB", boolSchema)

129− ]

130− & required .~ ["propA"]

131−

132−data MissingProperty = MissingProperty

133− { propC :: String

134− , propD :: Bool

135− }

136−

137−instance FromJSON MissingProperty where

138− parseJSON = withObject "MissingProperty" $ \o ->

139− MissingProperty

140− <$> o .: "propC"

141− <*> o .: "propD"

142−

143−instance ToSchema MissingProperty where

144− declareNamedSchema _ = do

145− stringSchema <- declareSchemaRef (Proxy :: Proxy String)

146− return . NamedSchema (Just "MissingProperty") $

147− mempty

148− & type_ ?~ SwaggerObject

149− & properties .~ [("propC", stringSchema)]

150− & required .~ ["propC"]

151−

152−data WrongPropType = WrongPropType

153− { propE :: String

154− }

155−

156−instance FromJSON WrongPropType where

157− parseJSON = withObject "WrongPropType" $ \o ->

158− WrongPropType

159− <$> o .: "propE"

160−

161−instance ToSchema WrongPropType where

162− declareNamedSchema _ = do

163− boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)

164− return . NamedSchema (Just "WrongPropType") $

165− mempty

166− & type_ ?~ SwaggerObject

167− & properties .~ [("propE", boolSchema)]

168− & required .~ ["propE"]

test/Data/Swagger/Schema/ValidationSpec.hs+1−1

@@ -248,7 +248,7 @@ instance ToJSON FreeForm where

248

249instance ToSchema FreeForm where

250 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty

251− & type_ ?~ SwaggerObject

251+ & type_ .~ SwaggerObject

252 & additionalProperties ?~ AdditionalPropertiesAllowed True

253

254instance Arbitrary FreeForm where

test/Data/Swagger/SchemaSpec.hs+6−5

@@ -8,11 +8,16 @@ import Prelude ()

8import Prelude.Compat

10import Control.Lens ((^.))

11−import Data.Aeson (Value)

11+import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))

12+import Data.Aeson.Types (toJSONKeyText)

13+import Data.Aeson.QQ

14+import Data.Char

12import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

15import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

13import Data.Proxy

16import Data.Proxy

14import Data.Set (Set)

17import Data.Set (Set)

18+import Data.Map (Map)

15import qualified Data.Text as Text

19import qualified Data.Text as Text

20+import GHC.Generics

17import Data.Swagger

22import Data.Swagger

18import Data.Swagger.Declare

23import Data.Swagger.Declare

@@ -21,9 +26,6 @@ import Data.Swagger.CommonTestTypes

21import SpecCommon

26import SpecCommon

22import Test.Hspec

27import Test.Hspec

24−import qualified Data.HashMap.Strict as HM

25−import Data.Time.LocalTime

26−

27checkToSchema :: ToSchema a => Proxy a -> Value -> Spec

29checkToSchema :: ToSchema a => Proxy a -> Value -> Spec

28checkToSchema proxy js = toSchema proxy <=> js

30checkToSchema proxy js = toSchema proxy <=> js

@@ -108,7 +110,6 @@ spec = do

108 context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'

110 context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'

109 describe "Bounded Enum key mapping" $ do

111 describe "Bounded Enum key mapping" $ do

110 context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON

112 context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON

111− context "TimeOfDay" $ checkToSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDaySchemaJSON

112

113

113main :: IO ()

114main :: IO ()

114main = hspec spec

115main = hspec spec

test/Data/SwaggerSpec.hs+32−73

@@ -10,9 +10,9 @@ import Prelude.Compat

10import Control.Lens

12import Data.Aeson

13−import Data.Aeson.QQ.Simple

13+import Data.Aeson.QQ

14import Data.HashMap.Strict (HashMap)

15−import qualified Data.HashSet.InsOrd as InsOrdHS

15+import qualified Data.Set as Set

16import Data.Text (Text)

18import Data.Swagger

@@ -43,7 +43,6 @@ spec = do

43 describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON

44 describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON

45 describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON

46− describe "OAuth2 Security Definitions with merged Scope" $ oAuth2SecurityDefinitionsExample <=> oAuth2SecurityDefinitionsExampleJSON

47 describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON

46 describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON

48 describe "Swagger Object" $ do

47 describe "Swagger Object" $ do

49 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON

48 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON

@@ -128,7 +127,7 @@ licenseExampleJSON = [aesonQQ|

128

127

129operationExample :: Operation

128operationExample :: Operation

130operationExample = mempty

129operationExample = mempty

131− & tags .~ InsOrdHS.fromList ["pet"]

130+ & tags .~ Set.fromList ["pet"]

132 & summary ?~ "Updates a pet in the store with form data"

131 & summary ?~ "Updates a pet in the store with form data"

133 & description ?~ ""

132 & description ?~ ""

134 & operationId ?~ "updatePetWithForm"

133 & operationId ?~ "updatePetWithForm"

@@ -159,7 +158,7 @@ operationExample = mempty

159 stringSchema :: ParamLocation -> ParamOtherSchema

158 stringSchema :: ParamLocation -> ParamOtherSchema

160 stringSchema loc = mempty

159 stringSchema loc = mempty

161 & in_ .~ loc

160 & in_ .~ loc

162− & type_ ?~ SwaggerString

161+ & type_ .~ SwaggerString

163

162

164operationExampleJSON :: Value

163operationExampleJSON :: Value

165operationExampleJSON = [aesonQQ|

164operationExampleJSON = [aesonQQ|

@@ -225,7 +224,7 @@ operationExampleJSON = [aesonQQ|

225

224

226schemaPrimitiveExample :: Schema

225schemaPrimitiveExample :: Schema

227schemaPrimitiveExample = mempty

226schemaPrimitiveExample = mempty

228− & type_ ?~ SwaggerString

227+ & type_ .~ SwaggerString

229 & format ?~ "email"

228 & format ?~ "email"

230

229

231schemaPrimitiveExampleJSON :: Value

230schemaPrimitiveExampleJSON :: Value

@@ -238,14 +237,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|

238

237

239schemaSimpleModelExample :: Schema

238schemaSimpleModelExample :: Schema

240schemaSimpleModelExample = mempty

239schemaSimpleModelExample = mempty

241− & type_ ?~ SwaggerObject

240+ & type_ .~ SwaggerObject

242 & required .~ [ "name" ]

241 & required .~ [ "name" ]

243 & properties .~

242 & properties .~

244− [ ("name", Inline (mempty & type_ ?~ SwaggerString))

243+ [ ("name", Inline (mempty & type_ .~ SwaggerString))

245 , ("address", Ref (Reference "Address"))

244 , ("address", Ref (Reference "Address"))

246 , ("age", Inline $ mempty

245 , ("age", Inline $ mempty

247 & minimum_ ?~ 0

246 & minimum_ ?~ 0

248− & type_ ?~ SwaggerInteger

247+ & type_ .~ SwaggerInteger

249 & format ?~ "int32" ) ]

248 & format ?~ "int32" ) ]

250

249

251schemaSimpleModelExampleJSON :: Value

250schemaSimpleModelExampleJSON :: Value

@@ -273,8 +272,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|

273

272

274schemaModelDictExample :: Schema

273schemaModelDictExample :: Schema

275schemaModelDictExample = mempty

274schemaModelDictExample = mempty

276− & type_ ?~ SwaggerObject

275+ & type_ .~ SwaggerObject

277− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))

276+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ .~ SwaggerString))

278

277

279schemaModelDictExampleJSON :: Value

278schemaModelDictExampleJSON :: Value

280schemaModelDictExampleJSON = [aesonQQ|

279schemaModelDictExampleJSON = [aesonQQ|

@@ -288,7 +287,7 @@ schemaModelDictExampleJSON = [aesonQQ|

288

287

289schemaAdditionalExample :: Schema

288schemaAdditionalExample :: Schema

290schemaAdditionalExample = mempty

289schemaAdditionalExample = mempty

291− & type_ ?~ SwaggerObject

290+ & type_ .~ SwaggerObject

292 & additionalProperties ?~ AdditionalPropertiesAllowed True

291 & additionalProperties ?~ AdditionalPropertiesAllowed True

293

292

294schemaAdditionalExampleJSON :: Value

293schemaAdditionalExampleJSON :: Value

@@ -301,13 +300,13 @@ schemaAdditionalExampleJSON = [aesonQQ|

301

300

302schemaWithExampleExample :: Schema

301schemaWithExampleExample :: Schema

303schemaWithExampleExample = mempty

302schemaWithExampleExample = mempty

304− & type_ ?~ SwaggerObject

303+ & type_ .~ SwaggerObject

305 & properties .~

304 & properties .~

306 [ ("id", Inline $ mempty

305 [ ("id", Inline $ mempty

307− & type_ ?~ SwaggerInteger

306+ & type_ .~ SwaggerInteger

308 & format ?~ "int64" )

307 & format ?~ "int64" )

309 , ("name", Inline $ mempty

308 , ("name", Inline $ mempty

310− & type_ ?~ SwaggerString) ]

309+ & type_ .~ SwaggerString) ]

311 & required .~ [ "name" ]

310 & required .~ [ "name" ]

312 & example ?~ [aesonQQ|

311 & example ?~ [aesonQQ|

313 {

312 {

@@ -346,19 +345,19 @@ schemaWithExampleExampleJSON = [aesonQQ|

346definitionsExample :: HashMap Text Schema

345definitionsExample :: HashMap Text Schema

347definitionsExample =

346definitionsExample =

348 [ ("Category", mempty

347 [ ("Category", mempty

349− & type_ ?~ SwaggerObject

348+ & type_ .~ SwaggerObject

350 & properties .~

349 & properties .~

351 [ ("id", Inline $ mempty

350 [ ("id", Inline $ mempty

352− & type_ ?~ SwaggerInteger

351+ & type_ .~ SwaggerInteger

353 & format ?~ "int64")

352 & format ?~ "int64")

354− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )

353+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] )

355 , ("Tag", mempty

354 , ("Tag", mempty

356− & type_ ?~ SwaggerObject

355+ & type_ .~ SwaggerObject

357 & properties .~

356 & properties .~

358 [ ("id", Inline $ mempty

357 [ ("id", Inline $ mempty

359− & type_ ?~ SwaggerInteger

358+ & type_ .~ SwaggerInteger

360 & format ?~ "int64")

359 & format ?~ "int64")

361− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]

360+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] ) ]

362

361

363definitionsExampleJSON :: Value

362definitionsExampleJSON :: Value

364definitionsExampleJSON = [aesonQQ|

363definitionsExampleJSON = [aesonQQ|

@@ -402,7 +401,7 @@ paramsDefinitionExample =

402 & required ?~ True

401 & required ?~ True

403 & schema .~ ParamOther (mempty

402 & schema .~ ParamOther (mempty

404 & in_ .~ ParamQuery

403 & in_ .~ ParamQuery

405− & type_ ?~ SwaggerInteger

404+ & type_ .~ SwaggerInteger

406 & format ?~ "int32" ))

405 & format ?~ "int32" ))

407 , ("limitParam", mempty

406 , ("limitParam", mempty

408 & name .~ "limit"

407 & name .~ "limit"

@@ -410,7 +409,7 @@ paramsDefinitionExample =

410 & required ?~ True

409 & required ?~ True

411 & schema .~ ParamOther (mempty

410 & schema .~ ParamOther (mempty

412 & in_ .~ ParamQuery

411 & in_ .~ ParamQuery

413− & type_ ?~ SwaggerInteger

412+ & type_ .~ SwaggerInteger

414 & format ?~ "int32" )) ]

413 & format ?~ "int32" )) ]

415

414

416paramsDefinitionExampleJSON :: Value

415paramsDefinitionExampleJSON :: Value

@@ -460,8 +459,8 @@ responsesDefinitionExampleJSON = [aesonQQ|

460-- Responses Definition object

459-- Responses Definition object

461-- =======================================================================

460-- =======================================================================

462

461

463−securityDefinitionsExample :: SecurityDefinitions

462+securityDefinitionsExample :: HashMap Text SecurityScheme

464−securityDefinitionsExample = SecurityDefinitions

463+securityDefinitionsExample =

465 [ ("api_key", SecurityScheme

464 [ ("api_key", SecurityScheme

466 { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)

465 { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)

467 , _securitySchemeDescription = Nothing })

466 , _securitySchemeDescription = Nothing })

@@ -493,46 +492,6 @@ securityDefinitionsExampleJSON = [aesonQQ|

493}

492}

494|]

493|]

495

494

496−oAuth2SecurityDefinitionsReadExample :: SecurityDefinitions

497−oAuth2SecurityDefinitionsReadExample = SecurityDefinitions

498− [ ("petstore_auth", SecurityScheme

499− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params

500− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"

501− , _oauth2Scopes =

502− [ ("read:pets", "read your pets") ] } )

503− , _securitySchemeDescription = Nothing })

504− ]

505−

506−oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions

507−oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions

508− [ ("petstore_auth", SecurityScheme

509− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params

510− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"

511− , _oauth2Scopes =

512− [ ("write:pets", "modify pets in your account") ] } )

513− , _securitySchemeDescription = Nothing })

514− ]

515−

516−oAuth2SecurityDefinitionsExample :: SecurityDefinitions

517−oAuth2SecurityDefinitionsExample =

518− oAuth2SecurityDefinitionsWriteExample <>

519− oAuth2SecurityDefinitionsReadExample

520−

521−oAuth2SecurityDefinitionsExampleJSON :: Value

522−oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|

523−{

524− "petstore_auth": {

525− "type": "oauth2",

526− "authorizationUrl": "http://swagger.io/api/oauth/dialog",

527− "flow": "implicit",

528− "scopes": {

529− "write:pets": "modify pets in your account",

530− "read:pets": "read your pets"

531− }

532− }

533−}

534−|]

535−

536-- =======================================================================

495-- =======================================================================

537-- Swagger object

496-- Swagger object

538-- =======================================================================

497-- =======================================================================

@@ -551,7 +510,7 @@ swaggerExample = mempty

551 & at 200 ?~ Inline (mempty

510 & at 200 ?~ Inline (mempty

552 & description .~ "OK"

511 & description .~ "OK"

553 & schema ?~ Inline (mempty

512 & schema ?~ Inline (mempty

554− & type_ ?~ SwaggerObject

513+ & type_ .~ SwaggerObject

555 & example ?~ [aesonQQ|

514 & example ?~ [aesonQQ|

556 {

515 {

557 "created": 100,

516 "created": 100,

@@ -560,9 +519,9 @@ swaggerExample = mempty

560 & description ?~ "This is some real Todo right here"

519 & description ?~ "This is some real Todo right here"

561 & properties .~

520 & properties .~

562 [ ("created", Inline $ mempty

521 [ ("created", Inline $ mempty

563− & type_ ?~ SwaggerInteger

522+ & type_ .~ SwaggerInteger

564 & format ?~ "int32")

523 & format ?~ "int32")

565− , ("description", Inline (mempty & type_ ?~ SwaggerString))]))

524+ , ("description", Inline (mempty & type_ .~ SwaggerString))]))

566 & produces ?~ MimeList [ "application/json" ]

525 & produces ?~ MimeList [ "application/json" ]

567 & parameters .~

526 & parameters .~

568 [ Inline $ mempty

527 [ Inline $ mempty

@@ -571,8 +530,8 @@ swaggerExample = mempty

571 & description ?~ "TodoId param"

530 & description ?~ "TodoId param"

572 & schema .~ ParamOther (mempty

531 & schema .~ ParamOther (mempty

573 & in_ .~ ParamPath

532 & in_ .~ ParamPath

574− & type_ ?~ SwaggerString ) ]

533+ & type_ .~ SwaggerString ) ]

575− & tags .~ InsOrdHS.fromList [ "todo" ] ))

534+ & tags .~ Set.fromList [ "todo" ] ))

576

535

577swaggerExampleJSON :: Value

536swaggerExampleJSON :: Value

578swaggerExampleJSON = [aesonQQ|

537swaggerExampleJSON = [aesonQQ|

@@ -1673,14 +1632,14 @@ petstoreExampleJSON = [aesonQQ|

1673

1632

1674compositionSchemaExample :: Schema

1633compositionSchemaExample :: Schema

1675compositionSchemaExample = mempty

1634compositionSchemaExample = mempty

1676− & type_ ?~ SwaggerObject

1635+ & type_ .~ SwaggerObject

1677 & Data.Swagger.allOf ?~ [

1636 & Data.Swagger.allOf ?~ [

1678 Ref (Reference "Other")

1637 Ref (Reference "Other")

1679 , Inline (mempty

1638 , Inline (mempty

1680− & type_ ?~ SwaggerObject

1639+ & type_ .~ SwaggerObject

1681 & properties .~

1640 & properties .~

1682 [ ("greet", Inline $ mempty

1641 [ ("greet", Inline $ mempty

1683− & type_ ?~ SwaggerString) ])

1642+ & type_ .~ SwaggerString) ])

1684 ]

1643 ]

1685

1644

1686compositionSchemaExampleJSON :: Value

1645compositionSchemaExampleJSON :: Value