master..e71cbde · typeable/compaREST

.github/actions/common_setup/action.yamldeleted−42

since splitsnapshots

unifiedsplit

@@ -1,42 +0,0 @@

1−name: "Common setup"

2−description: "Common setup steps"

3−inputs:

4− authToken:

5− description: "Cachix auth token"

6− required: true

7−runs:

8− using: "composite"

9− steps:

10− - name: Increase swap if linux

11− shell: bash

12− run: |

13− if [ "$RUNNER_OS" == "Linux" ]; then

14−

15− echo "Is Linux"

16−

17− free -h

18−

19− sudo swapoff /mnt/swapfile

20− sudo fallocate -l 12G /mnt/swapfile

21− sudo mkswap /mnt/swapfile

22− sudo swapon /mnt/swapfile

23−

24− free -h

25−

26− else

27−

28− echo "Not Linux"

29−

30− fi

31−

32− - name: Install Nix

33− uses: cachix/install-nix-action@v27

34− with:

35− extra_nix_config: |

36− system-features = kvm

37− trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=

38− substituters = https://hydra.iohk.io https://cache.nixos.org/

39− - uses: cachix/cachix-action@v15

40− with:

41− name: typeable

42− authToken: "${{ inputs.authToken }}"

.github/workflows/github-actions-image.yaml+27−261

@@ -5,286 +5,52 @@ on:

5 branches: [master]

6 pull_request:

7 branches: [master]

8− release:

9− types: [prereleased]

10

8

11jobs:

9jobs:

12−# check-formatting:

10+ build-github-action-image:

13−# name: Check Haskell formatting

14−# runs-on: ubuntu-latest

15−# steps:

16−# - uses: actions/checkout@v2

17−#

18−# - name: Common setup

19−# uses: ./.github/actions/common_setup

20−# with:

21−# authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}

22−#

23−# - name: Run fourmolu

24−# run: |

25−# nix-shell nix/ci.nix -j auto --run "git ls-files '*.hs' | xargs fourmolu -m inplace -o -XRecursiveDo -o -XTypeApplications -o -XPatternSynonyms -o -XBangPatterns"

26−# git diff --exit-code

27−

28− check_versions:

29 runs-on: ubuntu-latest

11 runs-on: ubuntu-latest

12+

30 steps:

13 steps:

31 - uses: actions/checkout@v2

14 - uses: actions/checkout@v2

32 with:

15 with:

33 submodules: recursive

16 submodules: recursive

34−

17+ - name: Increase swap

35− - name: Common setup

36− uses: ./.github/actions/common_setup

37− with:

38− authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}

39−

40− - name: Check library version

41− if: github.event_name == 'release'

42 run: |

18 run: |

43− if [ "$(awk -F ':' '/^version/ {gsub(/ /, "", $2); print $2}' compaREST.cabal)" != "${{ github.event.release.tag_name }}" ]; then

19+ free -h

44− echo "::error file=compaREST.cabal::Library version does not match release version."

45− exit 1

46− fi

47

20

48− - name: Check docker tag

21+ sudo swapoff /mnt/swapfile

49− if: github.event_name == 'release'

22+ sudo fallocate -l 12G /mnt/swapfile

50− run: |

23+ sudo mkswap /mnt/swapfile

51− if [ "$(yq eval '.runs.image' action.yaml | awk -F ':' '{print $NF}')" != "${{ github.event.release.tag_name }}" ]; then

24+ sudo swapon /mnt/swapfile

52− echo "::error file=action.yaml::Action docker tag does not match release tag."

53− exit 1

54− fi

55

25

56− - name: Check changelog

26+ free -h

57− if: github.event_name == 'release'

58− run: |

59− if ! grep '^## ${{ github.event.release.tag_name }}$' CHANGELOG.md; then

60− echo "::error file=CHANGELOG.md::CHANGELOG.md does not contain an entry for this release."

61− exit 1

62− fi

63

27

64− Linux:

28+ - name: Install Nix

65− needs: check_versions

29+ uses: cachix/install-nix-action@v12

66− runs-on: ubuntu-latest

67− steps:

68− - uses: actions/checkout@v2

69− with:

70− submodules: recursive

71−

72− - name: Common setup

73− uses: ./.github/actions/common_setup

74 with:

30 with:

75− authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}

31+ extra_nix_config: |

76−

32+ trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=

77− - name: Test

33+ substituters = https://hydra.iohk.io https://cache.nixos.org/

78− shell: bash

79− run: |

80− $(nix-build -A test -j auto --no-out-link)/bin/compaREST-tests

81−

82− - name: Build Linux static binary

83− shell: bash

84− run: |

85− cp $(nix-build -A compaRESTStaticBin -j auto --no-out-link)/bin/compaREST compaREST

86

34

87− - name: Upload compaREST Linux Binary

35+ - name: Login to Cachix

88− uses: actions/upload-artifact@v2

36+ uses: cachix/cachix-action@v8

89 with:

37 with:

90− name: compaREST-Linux

38+ name: octopod

91− path: compaREST

39+ signingKey: ${{ secrets.CACHIX_SIGNING_KEY }}

92

40

93− - name: Build Docker Images

41+ - name: Build Github Action Docker Image

94− shell: bash

95 run: |

42 run: |

96− cp $(nix-build -A compaRESTGithubAction -j auto --no-out-link) compaREST-Github-Action-image.tar.gz

43+ nix-build -A compaRESTGithubAction -j auto -o image

97− cp $(nix-build -A compaRESTImage -j auto --no-out-link) compaREST-image.tar.gz

98

44

99− - name: Upload compaREST Docker Github Action Image

45+ - name: Log into Docker Hub

100− uses: actions/upload-artifact@v2

46+ if: github.ref == 'refs/heads/master'

101− with:

102− name: compaREST Github Action Docker Image

103− path: compaREST-Github-Action-image.tar.gz

104−

105− - name: Upload compaREST Docker Image

106− uses: actions/upload-artifact@v2

107− with:

108− name: compaREST Docker Image

109− path: compaREST-image.tar.gz

110−

111− - name: Login to DockerHub

112− uses: docker/login-action@v1.10.0

47+ uses: docker/login-action@v1

113 with:

48 with:

114 username: ${{ secrets.DOCKER_HUB_USERNAME }}

49 username: ${{ secrets.DOCKER_HUB_USERNAME }}

115 password: ${{ secrets.DOCKER_HUB_ACCESS_TOKEN }}

50 password: ${{ secrets.DOCKER_HUB_ACCESS_TOKEN }}

116

51

117− - name: Push Nightly Docker Images to DockerHub

52+ - name: Upload Image to Docker Hub

118− if: github.ref == 'refs/heads/master' && github.event_name == 'push'

53+ if: github.ref == 'refs/heads/master'

119− shell: bash

120− run: |

121− skopeo copy docker-archive:$(nix-build -A compaRESTGithubAction -j auto --no-out-link) docker://typeable/comparest-github-action:nightly

122− skopeo copy docker-archive:$(nix-build -A compaRESTImage -j auto --no-out-link) docker://typeable/comparest:nightly

123−

124− - name: Push Release Docker Images to DockerHub

125− if: github.event_name == 'release'

126− shell: bash

127− run: |

128− skopeo copy docker-archive:$(nix-build -A compaRESTGithubAction -j auto --no-out-link) docker://typeable/comparest-github-action:${{ github.event.release.tag_name }}

129− skopeo copy docker-archive:$(nix-build -A compaRESTImage -j auto --no-out-link) docker://typeable/comparest:${{ github.event.release.tag_name }}

130−

131− - name: Zip Release Assets

132− if: github.event_name == 'release'

133− shell: bash

134− run: |

135− zip compaREST-Linux-x86.zip compaREST

136−

137− - name: Upload compaREST Github Action Docker Image to release

138− if: github.event_name == 'release'

139− uses: svenstaro/upload-release-action@2.2.1

140− with:

141− repo_token: ${{ secrets.GITHUB_TOKEN }}

142− file: compaREST-Github-Action-image.tar.gz

143− tag: ${{ github.ref }}

144−

145− - name: Upload compaREST Docker Image to release

146− if: github.event_name == 'release'

147− uses: svenstaro/upload-release-action@2.2.1

148− with:

149− repo_token: ${{ secrets.GITHUB_TOKEN }}

150− file: compaREST-image.tar.gz

151− tag: ${{ github.ref }}

152−

153− - name: Upload compaREST binary – Linux – x86 to release

154− if: github.event_name == 'release'

155− uses: svenstaro/upload-release-action@2.2.1

156− with:

157− repo_token: ${{ secrets.GITHUB_TOKEN }}

158− file: compaREST-Linux-x86.zip

159− tag: ${{ github.ref }}

160−

161− dist:

162− needs: [check_versions, Linux]

163− runs-on: ubuntu-latest

164− steps:

165− - uses: actions/checkout@v2

166− with:

167− submodules: recursive

168−

169− - name: Common setup

170− uses: ./.github/actions/common_setup

171− with:

172− authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}

173−

174− - name: Cache

175− uses: actions/cache@v1

176− with:

177− path: |

178− ~/.stack

179− .stack-work

180− key: ${{ runner.os }}-stack-${{ hashFiles('stack.yaml') }}-${{ hashFiles('**.cabal') }}

181− restore-keys: |

182− ${{ runner.os }}-stack-${{ hashFiles('stack.yaml') }}

183− ${{ runner.os }}-stack

184−

185− - name: Upgrade stack

186− shell: bash

187− # Needed for Hackage token authorization

188− run: stack upgrade --git

189−

190− - name: Build dist

191− run: |

192− stack sdist --pvp-bounds both

193− echo "distPath=$(stack path | awk -F ": " '/dist-dir/ {print $2}')" >> $GITHUB_ENV

194−

195− - name: Upload compaREST sources artifact

196− uses: actions/upload-artifact@v2

197− with:

198− name: compaREST sources

199− path: ${{ env.distPath }}/*.tar.gz

200−

201− - name: Upload compaREST sources to release

202− if: github.event_name == 'release'

203− uses: svenstaro/upload-release-action@2.2.1

204− with:

205− repo_token: ${{ secrets.GITHUB_TOKEN }}

206− file_glob: true

207− file: ${{ env.distPath }}/*.tar.gz

208− tag: ${{ github.ref }}

209−

210− - name: Publish compaREST candidate to Hackage

211− shell: bash

212− if: github.event_name == 'release'

213− env:

214− HACKAGE_KEY: ${{ secrets.HACKAGE_KEY }}

215 run: |

54 run: |

216− stack upload --pvp-bounds both --candidate .

55+ docker load -i image

217−

56+ docker push typeable/comparest-github-action:latest

218− macOS:

219− needs: check_versions

220− runs-on: macos-latest

221− steps:

222− - uses: actions/checkout@v2

223− with:

224− submodules: recursive

225−

226− - name: Common setup

227− uses: ./.github/actions/common_setup

228− with:

229− authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}

230−

231− - name: Build macOS binary bundle

232− run: |

233− cp -LR $(nix-build -A macOSCompaRESTBundle -j auto --no-out-link) compaREST

234−

235− - name: Upload macOS compaREST bundle

236− uses: actions/upload-artifact@v2

237− with:

238− name: compaREST binary – macOS – x86

239− path: compaREST

240−

241− - name: Zip Release Assets

242− if: github.event_name == 'release'

243− shell: bash

244− run: |

245− zip -r compaREST-macOS-x86.zip compaREST

246−

247− - name: Upload compaREST binary – macOS – x86 to release

248− if: github.event_name == 'release'

249− uses: svenstaro/upload-release-action@2.2.1

250− with:

251− repo_token: ${{ secrets.GITHUB_TOKEN }}

252− file: compaREST-macOS-x86.zip

253− tag: ${{ github.ref }}

254−

255−# Linux-Windows:

256−# needs: check_versions

257−# runs-on: ubuntu-latest

258−# steps:

259−# - uses: actions/checkout@v2

260−# with:

261−# submodules: recursive

262−#

263−# - name: Common setup

264−# uses: ./.github/actions/common_setup

265−# with:

266−# authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}

267−#

268−# - name: Build Windows binary

269−# run: |

270−# cp -LR $(nix-build -A WindowsCompaRESTBin -j auto --no-out-link)/bin compaREST

271−#

272−# - name: Upload Windows compaREST bundle

273−# uses: actions/upload-artifact@v2

274−# with:

275−# name: compaREST binary – Windows

276−# path: compaREST

277−#

278−# - name: Zip Release Assets

279−# if: github.event_name == 'release'

280−# shell: bash

281−# run: |

282−# zip -r compaREST-Windows.zip compaREST

283−#

284−# - name: Upload compaREST binary – Windows to release

285−# if: github.event_name == 'release'

286−# uses: svenstaro/upload-release-action@2.2.1

287−# with:

288−# repo_token: ${{ secrets.GITHUB_TOKEN }}

289−# file: compaREST-Windows.zip

290−# tag: ${{ github.ref }}

.github/workflows/linux-binary.yamlnew file+54

@@ -0,0 +1,54 @@

1+name: Linux binary

2+

3+on:

4+ push:

5+ branches: [master]

6+ pull_request:

7+ branches: [master]

8+

9+jobs:

10+ linux-build:

11+ runs-on: ubuntu-latest

12+

13+ steps:

14+ - uses: actions/checkout@v2

15+ with:

16+ submodules: recursive

17+ - name: Cache

18+ uses: actions/cache@v1

19+ with:

20+ path: ~/.stack

21+ key: ${{ runner.os }}-build-stack-${{ hashFiles('**/stack.yaml') }}-${{ hashFiles('**/*.cabal') }}

22+ restore-keys: |

23+ ${{ runner.os }}-build-stack-${{ hashFiles('**/stack.yaml') }}

24+ ${{ runner.os }}-build-stack-

25+ - name: Increase swap

26+ run: |

27+ free -h

28+

29+ sudo swapoff /mnt/swapfile

30+ sudo fallocate -l 13G /mnt/swapfile

31+ sudo mkswap /mnt/swapfile

32+ sudo swapon /mnt/swapfile

33+

34+ free -h

35+

36+ - name: Build

37+ run: |

38+ stack build --ghc-options=-O3 --local-bin-path comparest-linux --copy-bins --flag comparest:Static

39+ - name: Test

40+ run: stack test --ghc-options=-O3 --flag comparest:Static --test-arguments='--hide-successes --no-create'

41+

42+ - name: Zip

43+ if: github.ref == 'refs/heads/master'

44+ run: |

45+ zip comparest-linux comparest-linux/comparest

46+ - uses: "marvinpinto/action-automatic-releases@latest"

47+ if: github.ref == 'refs/heads/master'

48+ with:

49+ repo_token: "${{ secrets.GITHUB_TOKEN }}"

50+ automatic_release_tag: "latest"

51+ prerelease: false

52+ title: "Pre-Release"

53+ files: |

54+ *.zip

.github/workflows/remove-artifacts.yamlnew file+17

@@ -0,0 +1,17 @@

1+name: Remove old artifacts

2+

3+on:

4+ schedule:

5+ - cron: '0 0 * * *'

6+jobs:

7+ remove-old-artifacts:

8+ runs-on: ubuntu-latest

9+ timeout-minutes: 10

10+

11+ steps:

12+ - name: Remove old artifacts

13+ uses: c-hive/gha-remove-artifacts@v1

14+ with:

15+ age: '7 days'

16+ skip-tags: true

17+ skip-recent: 10

.gitmodulesnew file+3

@@ -0,0 +1,3 @@

1+[submodule "awsm-css"]

2+ path = awsm-css

3+ url = https://github.com/igoradamenko/awsm.css.git

CHANGELOG.md+3−7

@@ -1,13 +1,9 @@

1# Changelog

2

3−`compaREST` uses [PVP Versioning][1].

3+`comparest` uses [PVP Versioning][1].

4

5−## 0.1.0.1

5+## 0.0.0.0

6

7−* Fixed an issue related to empty commit SHAs in GitHub Actions.

7+* Initially created.

8−

9−## 0.1.0.0

10−

11−* Initial release.

12

8

13[1]: https://pvp.haskell.org

9[1]: https://pvp.haskell.org

LICENSE+1−1

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

1MIT License

2

4

5Permission is hereby granted, free of charge, to any person obtaining a copy

6of this software and associated documentation files (the "Software"), to deal

README.md+19−40

@@ -1,33 +1,14 @@

1−# compaREST

1+# CompaREST

2

3−[![Hackage](https://img.shields.io/hackage/v/compaREST.svg?logo=haskell)](https://hackage.haskell.org/package/compaREST)

3+[![Hackage](https://img.shields.io/hackage/v/comparest.svg?logo=haskell)](https://hackage.haskell.org/package/comparest)

4+[![Stackage Lts](http://stackage.org/package/comparest/badge/lts)](http://stackage.org/lts/package/comparest)

5+[![Stackage Nightly](http://stackage.org/package/comparest/badge/nightly)](http://stackage.org/nightly/package/comparest)

4[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE)

6[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE)

5

7

6Compatibility checker for OpenAPI

8Compatibility checker for OpenAPI

9+# Quick Start Guide

7

10

8−## Using compaREST in Github Actions

9−

10−Add the following step to your Github Actions workflow:

11−

12−```yaml

13−- uses: typeable/comparest

14− if: ${{ github.event_name == 'pull_request' }}

15− with:

16− old: old-openapi.yaml

17− new: new-openapi.yaml

18−```

19−

20−The `new` and `old` values should be paths to your OpenAPI specifications you want to compare.

21−

22−You will get something like this in your pull requests:

23−

24−![](docs/img/github-action-report.png)

25−

26−For more detail please see our [integration guide](docs/Integration_guide.md).

27−

28−## An example

29−

30−### Your situation

11+## Your situation

31

12

32You are developing a very important server with a REST API. You have clients who use your API that you do not control. Say, you are also developing a mobile app that uses your API and you can't force someone to update to the latest version. (Or you prefer not to for UX reasons.)

13You are developing a very important server with a REST API. You have clients who use your API that you do not control. Say, you are also developing a mobile app that uses your API and you can't force someone to update to the latest version. (Or you prefer not to for UX reasons.)

33

14

@@ -94,7 +75,7 @@ components:

94 $ref: "#/components/schemas/Pet"

75 $ref: "#/components/schemas/Pet"

95```

76```

96

77

97−### Evolving your product

78+## Evolving your product

98

79

99Enthused over your initial success you hurry to release a new and improved version of your API and mobile app.

80Enthused over your initial success you hurry to release a new and improved version of your API and mobile app.

100

81

@@ -163,7 +144,7 @@ components:

163

144

164Looking at the very large and complex API description, you grow more and more concerned that your old mobile app might stop working when you update the server. But the spec is too large and too complex to reasonably assess this manually.

145Looking at the very large and complex API description, you grow more and more concerned that your old mobile app might stop working when you update the server. But the spec is too large and too complex to reasonably assess this manually.

165

146

166−### Assessing compatibility automatically

147+## Assessing compatibility automatically

167

148

168Luckily, you have access to compaREST which can programmatically analyze your APIs and determine what, if anything, breaks compatibility and what doesn't.

149Luckily, you have access to compaREST which can programmatically analyze your APIs and determine what, if anything, breaks compatibility and what doesn't.

169

150

@@ -177,15 +158,15 @@ Running this command will output a file `report.md`, containing the compatibilit

177

158

178> # Summary

159> # Summary

179>

160>

180−> | [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

161+> | [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |

181−> |------------------------------------------|--------------------------------------------------|

162+> |------------------------------------------|-------------------------------------------------|-------------------------------|

182−> | 5 | 6 |

163+> | 5 | 6 | 0 |

183>

164>

184−> # ❌ Breaking changes

165+> # ⚠️ Breaking changes

185>

166>

186> ## **GET** /pets

167> ## **GET** /pets

187>

168>

188−> ### ⬅️☁️ JSON Response – 200

169+> ### 📱⬅️ JSON Response – 200

189>

170>

190> #### `$[*].name(String)`

171> #### `$[*].name(String)`

191>

172>

@@ -195,7 +176,7 @@ Running this command will output a file `report.md`, containing the compatibilit

195>

176>

196> ## **POST** /pets

177> ## **POST** /pets

197>

178>

198−> ### ➡️☁️ JSON Request

179+> ### 📱➡️ JSON Request

199>

180>

200> #### `$.weight`

181> #### `$.weight`

201>

182>

@@ -210,7 +191,7 @@ Running this command will output a file `report.md`, containing the compatibilit

210>

191>

211> Value is now a multiple of 1.0.

192> Value is now a multiple of 1.0.

212>

193>

213−> # ⚠️ Non-breaking changes

194+> # 🙆 Non-breaking changes

214>

195>

215> ## **GET** /pets

196> ## **GET** /pets

216>

197>

@@ -222,7 +203,7 @@ Running this command will output a file `report.md`, containing the compatibilit

222>

203>

223> Upper bound changed from 20.0 inclusive to 30.0 inclusive.

204> Upper bound changed from 20.0 inclusive to 30.0 inclusive.

224>

205>

225−> ### ⬅️☁️ JSON Response – 200

206+> ### 📱⬅️ JSON Response – 200

226>

207>

227> #### `$[*].weight`

208> #### `$[*].weight`

228>

209>

@@ -239,7 +220,7 @@ Running this command will output a file `report.md`, containing the compatibilit

239>

220>

240> ## **POST** /pets

221> ## **POST** /pets

241>

222>

242−> ### ➡️☁️ JSON Request

223+> ### 📱➡️ JSON Request

243>

224>

244> #### `$.name(String)`

225> #### `$.name(String)`

245>

226>

@@ -249,7 +230,7 @@ Running this command will output a file `report.md`, containing the compatibilit

249

230

250You now know exactly in what situations and in what way your 1.0 version of the app will break if you deploy your 1.1 version of the server.

231You now know exactly in what situations and in what way your 1.0 version of the app will break if you deploy your 1.1 version of the server.

251

232

252−### Additional formats

233+## Additional formats

253

234

254You can also produce a self-contained HTML report that you can open in your browser by simply omitting the file extension of the output file:

235You can also produce a self-contained HTML report that you can open in your browser by simply omitting the file extension of the output file:

255

236

@@ -257,9 +238,7 @@ You can also produce a self-contained HTML report that you can open in your brow

257docker run --rm -v $(pwd):/data:rw typeable/comparest --client /data/api-1.0.0.yaml --server /data/api-1.1.0.yaml --output /data/report

238docker run --rm -v $(pwd):/data:rw typeable/comparest --client /data/api-1.0.0.yaml --server /data/api-1.1.0.yaml --output /data/report

258```

239```

259

240

260−## CLI docs

241+# CLI docs

261−

262−For more detail please see our [user guide](docs/User_guide.md).

263

242

264```

243```

265Usage: comparest (-c|--client ARG) (-s|--server ARG)

244Usage: comparest (-c|--client ARG) (-s|--server ARG)

action.yaml+13−14

@@ -7,42 +7,41 @@ inputs:

7 default: "${{ github.token }}"

8 required: false

9 repo:

10− description: The owner of the repo in which to post the results.

10+ description: The owner of the repo in which to post the comment.

11 default: "${{ github.repository }}"

12 required: false

13− project_name:

13+ pull_request:

14− description: The name of the project to which the API pertains. Used to name the check. Useful when you have multiple APIs in the same repo.

14+ description: The pull request in which to post the comment.

15+ default: "${{ github.event.pull_request.number }}"

15 required: false

16 required: false

16− default: ""

17+ project_name:

18+ description: The name of the project to which the API pertains.

19+ required: true

17 footer:

20 footer:

18− description: A footer that can be appended to the check body.

21+ description: A footer that can be appended to the comment.

19 required: false

22 required: false

20 default: ""

23 default: ""

21 old:

24 old:

22− description: The path to the old (client) specification of the API.

25+ description: The path to old specification of the API.

23 required: true

26 required: true

24 new:

27 new:

25− description: The path to new (server) specification of the API.

28+ description: The path to new specification of the API.

26 required: true

29 required: true

27− sha:

28− description: The sha of the commit to post the check for.

29− required: false

30− default: "${{ github.event.pull_request.head.sha }}"

31runs:

30runs:

32 using: "docker"

31 using: "docker"

33− image: "docker://typeable/comparest-github-action:0.1.0.1"

32+ image: "typeable/comparest-github-action:latest"

34 env:

33 env:

35 GITHUB_TOKEN: "${{ inputs.GITHUB_TOKEN }}"

34 GITHUB_TOKEN: "${{ inputs.GITHUB_TOKEN }}"

36 REPO: "${{ inputs.repo }}"

35 REPO: "${{ inputs.repo }}"

36+ PR_NUMBER: "${{ inputs.pull_request }}"

37 PROJECT_NAME: "${{ inputs.project_name }}"

38 FOOTER: "${{ inputs.footer }}"

39 ROOT: "/github/workspace"

40 OLD: "${{ inputs.old }}"

41 NEW: "${{ inputs.new }}"

42− SHA: "${{ inputs.sha }}"

43 pre-entrypoint: "/bin/pre"

42 pre-entrypoint: "/bin/pre"

44 entrypoint: "/bin/run"

43 entrypoint: "/bin/run"

45

44

46branding:

45branding:

47 icon: crosshair

46 icon: crosshair

48− color: blue

47+ color: gray-dark

app/Data/OpenApi/Compare/Options.hs+72−92

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

1module Data.OpenApi.Compare.Options

2− ( Options (..),

2+ ( Options (..)

3− OutputMode (..),

3+ , OutputMode (..)

4− parseOptions,

4+ , parseOptions

5 )

6where

7

@@ -9,7 +9,6 @@ import Data.OpenApi.Compare.Report

9import GHC.Generics (Generic)

10import Options.Applicative

11import Options.Applicative.Help hiding (fullDesc)

12−import Text.PrettyPrint.ANSI.Leijen ((<$$>),string)

13

12

14parseOptions :: IO Options

13parseOptions :: IO Options

15parseOptions = customExecParser (prefs $ showHelpOnError) optionsParserInfo

14parseOptions = customExecParser (prefs $ showHelpOnError) optionsParserInfo

@@ -31,105 +30,86 @@ optionsParserInfo :: ParserInfo Options

31optionsParserInfo =

30optionsParserInfo =

32 info

31 info

33 (helper <*> optionsParser)

32 (helper <*> optionsParser)

34− ( fullDesc

33+ (fullDesc

35− <> header "CompaREST"

34+ <> header "CompaREST"

36− <> progDescDoc

35+ <> progDescDoc

37− ( Just $

36+ (Just $

38− par "A tool to check compatibility between two OpenAPI specifications."

37+ par "A tool to check compatibility between two OpenAPI specifications."

39− <$$> hardline <> par "Usage examples" <> hardline

38+ <$$> hardline <> par "Usage examples" <> hardline

40− <$$> indent

39+ <$$> indent

41− 4

40+ 4

42− ( par "Compare files old.yaml with new.yaml and output the resulting report to stdout:"

41+ (par "Compare files old.yaml with new.yaml and output the resulting report to stdout:"

43− <$$> hardline <> indent 4 "comparest -c old.yaml -s new.yaml"

42+ <$$> hardline <> indent 4 "comparest -c old.yaml -s new.yaml"

44− <$$> hardline <> par "Only output breaking changes and write a styled HTML report to file report.html:"

43+ <$$> hardline <> par "Only output breaking changes and write a styled HTML report to file report.html:"

45− <$$> hardline <> indent 4 "comparest -c old.yaml -s new.yaml --only-breaking -o report"

44+ <$$> hardline <> indent 4 "comparest -c old.yaml -s new.yaml --only-breaking -o report"

46− <$$> hardline <> par "Don't output anything, only fail if there are breaking changes:"

45+ <$$> hardline <> par "Don't output anything, only fail if there are breaking changes:"

47− <$$> hardline <> indent 4 "comparest -c old.json -s new.json --silent"

46+ <$$> hardline <> indent 4 "comparest -c old.json -s new.json --silent"

48− <$$> hardline <> par "Write full report suitable for embedding into a GitHub comment to report.html:"

47+ <$$> hardline <> par "Write full report suitable for embedding into a GitHub comment to report.html:"

49− <$$> hardline <> indent 4 "comparest -c old.json -s new.json --folding-block-quotes-style -o report.html"

48+ <$$> hardline <> indent 4 "comparest -c old.json -s new.json --folding-block-quotes-style -o report.html")))

50− )

51− )

52− )

53

49

54optionsParser :: Parser Options

50optionsParser :: Parser Options

55optionsParser =

51optionsParser =

56 Options

52 Options

57 <$> strOption

53 <$> strOption

58− ( short 'c'

54+ (short 'c'

59− <> long "client"

55+ <> long "client"

60− <> help

56+ <> help

61− "A path to the file containing the specification that will be \

57+ "A path to the file containing the specification that will be \

62− \used for the client of the API. Can be either a YAML or JSON file."

58+ \used for the client of the API. Can be either a YAML or JSON file.")

63− )

64 <*> strOption

59 <*> strOption

65− ( short 's'

60+ (short 's'

66− <> long "server"

61+ <> long "server"

67− <> help

62+ <> help

68− "A path to the file containing the specification that will be \

63+ "A path to the file containing the specification that will be \

69− \used for the server of the API. Can be either a YAML or JSON file."

64+ \used for the server of the API. Can be either a YAML or JSON file.")

70− )

71− <*> ( flag'

65+ <*> (flag'

72− Nothing

66+ Nothing

73− ( long "silent"

67+ (long "silent"

74− <> help "Silence all output. Only makes sense in combination with --signal-exit-code."

68+ <> help "Silence all output. Only makes sense in combination with --signal-exit-code.")

75− )

76− <|> flag'

69+ <|> flag'

77− (Just OnlyErrors)

70+ (Just OnlyErrors)

78− ( long "only-breaking"

71+ (long "only-breaking"

79− <> help "Only report breaking changes in the output."

72+ <> help "Only report breaking changes in the output.")

80− )

81− <|> flag'

73+ <|> flag'

82− (Just All)

74+ (Just All)

83− ( long "all"

75+ (long "all"

84− <> help

76+ <> help

85− "Report both incompatible and compatible changes. \

77+ "Report both incompatible and compatible changes. \

86− \Compatible changes will not trigger a failure exit code."

78+ \Compatible changes will not trigger a failure exit code.")

87− )

88− <|> pure (Just All)

79+ <|> pure (Just All))

89− )

90− <*> ( ( FileMode

80+ <*> ((FileMode

91− <$> strOption

81+ <$> strOption

92− ( short 'o' <> long "output"

82+ (short 'o' <> long "output"

93− <> helpDoc

83+ <> helpDoc

94− ( Just $

84+ (Just $

95− par "The file path where the output should be written. If the option is omitted the result will be written to stdout."

85+ par "The file path where the output should be written. If the option is omitted the result will be written to stdout."

96− <$$> hardline <> par "The file extension is used to determine the type of the output file."

86+ <$$> hardline <> par "The file extension is used to determine the type of the output file."

97− <$$> hardline <> par "Supports many formats such as markdown, html, rtf, doc, txt, rst, and many more."

87+ <$$> hardline <> par "Supports many formats such as markdown, html, rtf, doc, txt, rst, and many more."

98− <$$> hardline <> par "Leave out the extension to produce a self-contained HTML report with styling."

88+ <$$> hardline <> par "Leave out the extension to produce a self-contained HTML report with styling.")))

99− )

100− )

101− )

102− <|> pure StdoutMode

89+ <|> pure StdoutMode)

103− )

104− <*> ( flag'

90+ <*> (flag'

105− FoldingBlockquotesTreeStyle

91+ FoldingBlockquotesTreeStyle

106− ( long "folding-block-quotes-style"

92+ (long "folding-block-quotes-style"

93+ <> help

94+ "The report tree is structured using \

95+ \summary/detail HTML elements and indented using \

96+ \block quotes. This style renders well on GitHub.\

97+ \Intended for HTML output format. Markdown has rendering \

98+ \bugs on GitHub.")

99+ <|> flag'

100+ HeadersTreeStyle

101+ (long "header-style"

107 <> help

102 <> help

108 "The report tree is structured using \

103 "The report tree is structured using \

109− \summary/detail HTML elements and indented using \

110− \block quotes. This style renders well on GitHub.\

111− \Intended for HTML output format. Markdown has rendering \

112− \bugs on GitHub."

113− )

114− <|> flag'

115− HeadersTreeStyle

116− ( long "header-style"

117− <> help

118− "The report tree is structured using \

119− \increasing levels of headers."

104+ \increasing levels of headers.")

120− )

121− <|> pure HeadersTreeStyle

105+ <|> pure HeadersTreeStyle)

122− )

123− <*> switch

106+ <*> switch

124− ( long "signal-exit-code"

107+ (long "signal-exit-code"

125− <> helpDoc

108+ <> helpDoc (Just $

126− ( Just $

127 par "Signal API compatibility with the exit code."

109 par "Signal API compatibility with the exit code."

128 <$$> hardline <> par "Exit with 0 if there are no breaking changes."

110 <$$> hardline <> par "Exit with 0 if there are no breaking changes."

129 <$$> par "Exit with 1 if there are breaking changes."

111 <$$> par "Exit with 1 if there are breaking changes."

130− <$$> par "Exit with 2 if could not determine compatibility."

112+ <$$> par "Exit with 2 if could not determine compatibility."))

131− )

132− )

133

113

134par :: String -> Doc

114par :: String -> Doc

135par = foldr1 (</>) . fmap string . words

115par = foldr1 (</>) . fmap string . words

app/FormatHeuristic.hs+1−1

@@ -2,7 +2,7 @@

2-- Originally based on:

3-- https://github.com/jgm/pandoc/blob/master/src/Text/Pandoc/App/FormatHeuristics.hs

4module FormatHeuristic

5− ( formatFromFilePath,

5+ ( formatFromFilePath

6 )

7where

8

app/Main.hs−1

@@ -2,7 +2,6 @@ module Main (main) where

2

3import Control.Monad

4import Control.Monad.Except

5−import Control.Monad.Trans (lift)

6import Data.Aeson

5import Data.Aeson

7import qualified Data.ByteString.Lazy as BSL

6import qualified Data.ByteString.Lazy as BSL

8import Data.Default

7import Data.Default

awsm-cssnew file+1

Submodule changed.

ci/policeman.nixdeleted−4

@@ -1,4 +0,0 @@

1−{ sources ? import ../nix/sources.nix

2−, pkgs ? import sources.nixpkgs { }

3−}:

4−pkgs.haskellPackages.policeman

compaREST.cabal → comparest.cabalrenamed+20−24

@@ -1,24 +1,29 @@

1cabal-version: 2.4

2−name: compaREST

2+name: comparest

3−version: 0.1.0.1

3+version: 0.0.0.0

4synopsis: Compatibility checker for OpenAPI

5description: Compatibility checker for OpenAPI.

6license: MIT

7license-file: LICENSE

8author: Typeable

9−maintainer: compaREST@typeable.io

9+maintainer: comparest@typeable.io

10copyright: 2021 Typeable

11category: Web

12build-type: Simple

13extra-doc-files: README.md

14 CHANGELOG.md

15−tested-with: GHC == 9.6

15+tested-with: GHC == 8.10.4

16−extra-source-files: css/awsm.min.css

16+extra-source-files: awsm-css/dist/awsm.min.css

17−extra-source-files:

17+

18− test/golden/**/*.yaml

18+Flag static

19− test/golden/**/*.md

19+ Default: False

20+ Manual: True

20

21

21common common-options

22common common-options

23+ if flag(static)

24+ cc-options: -static

25+ ld-options: -static -pthread

26+ ghc-options: -static

22 ghc-options:

27 ghc-options:

23 -Weverything

28 -Weverything

24 -Wno-implicit-prelude

29 -Wno-implicit-prelude

@@ -26,17 +31,15 @@ common common-options

26 -Wno-safe

31 -Wno-safe

27 -Wno-prepositive-qualified-module

32 -Wno-prepositive-qualified-module

28 -Wno-missing-import-lists

33 -Wno-missing-import-lists

29− -Wno-missing-kind-signatures

30 -Wno-partial-fields

34 -Wno-partial-fields

31 -Wno-all-missed-specialisations

35 -Wno-all-missed-specialisations

32 -Wno-missing-local-signatures

36 -Wno-missing-local-signatures

33 -Wno-unsafe

37 -Wno-unsafe

34 -fconstraint-solver-iterations=0

38 -fconstraint-solver-iterations=0

35 default-language: Haskell2010

39 default-language: Haskell2010

36− build-depends: base >= 4.12.0.0 && < 5

40+ build-depends: base >= 4.12.0.0 && < 4.16

37 , text

41 , text

38

42

39−

40 default-extensions: ApplicativeDo

43 default-extensions: ApplicativeDo

41 , BangPatterns

44 , BangPatterns

42 , ConstraintKinds

45 , ConstraintKinds

@@ -78,7 +81,6 @@ common common-options

78 , QuantifiedConstraints

81 , QuantifiedConstraints

79 , DefaultSignatures

82 , DefaultSignatures

80

83

81−

82library

84library

83 import: common-options

85 import: common-options

84 build-depends:

86 build-depends:

@@ -149,12 +151,12 @@ library

149 other-modules: Data.HList

151 other-modules: Data.HList

150 , Data.OpenUnion.Extra

152 , Data.OpenUnion.Extra

151

153

152−executable compaREST

154+executable comparest

153 import: common-options

155 import: common-options

154 hs-source-dirs: app

156 hs-source-dirs: app

155 main-is: Main.hs

157 main-is: Main.hs

156 build-depends:

158 build-depends:

157− compaREST

159+ comparest

158 , pandoc

160 , pandoc

159 , data-default

161 , data-default

160 , bytestring

162 , bytestring

@@ -166,7 +168,6 @@ executable compaREST

166 , containers

168 , containers

167 , doctemplates

169 , doctemplates

168 , pandoc-types

170 , pandoc-types

169− , prettyprinter-compat-ansi-wl-pprint

170 ghc-options: -threaded

171 ghc-options: -threaded

171 -rtsopts

172 -rtsopts

172 -with-rtsopts=-N

173 -with-rtsopts=-N

@@ -174,12 +175,12 @@ executable compaREST

174 FormatHeuristic

175 FormatHeuristic

175 Data.OpenApi.Compare.Options

176 Data.OpenApi.Compare.Options

176

177

177−executable compaREST-GitHub-Action

178+executable comparest-github-action

178 import: common-options

179 import: common-options

179 hs-source-dirs: github-action

180 hs-source-dirs: github-action

180 main-is: Main.hs

181 main-is: Main.hs

181 build-depends:

182 build-depends:

182− compaREST

183+ comparest

183 , pandoc

184 , pandoc

184 , yaml

185 , yaml

185 , aeson

186 , aeson

@@ -189,7 +190,6 @@ executable compaREST-GitHub-Action

189 , pandoc-types

190 , pandoc-types

190 , envy

191 , envy

191 , filepath

192 , filepath

192− , bytestring

193 ghc-options: -threaded

194 -rtsopts

195 -with-rtsopts=-N

@@ -197,10 +197,8 @@ executable compaREST-GitHub-Action

197 Control.Monad.Freer.GitHub

198 CompaREST.GitHub.API

199 CompaREST.GitHub.Action.Config

200− GitHub.Data.Checks

201− GitHub.Endpoints.Checks

202

200

203−test-suite compaREST-tests

201+test-suite comparest-tests

204 import: common-options

202 import: common-options

205 type: exitcode-stdio-1.0

203 type: exitcode-stdio-1.0

206 hs-source-dirs: test

204 hs-source-dirs: test

@@ -208,10 +206,8 @@ test-suite compaREST-tests

208 other-modules:

206 other-modules:

209 Spec.Golden.Extra

207 Spec.Golden.Extra

210 Spec.Golden.TraceTree

208 Spec.Golden.TraceTree

211− Paths_compaREST

212− autogen-modules: Paths_compaREST

213 build-depends:

209 build-depends:

214− , compaREST

210+ , comparest

215 , tasty-golden

211 , tasty-golden

216 , tasty

212 , tasty

217 , bytestring

213 , bytestring

css/awsm.min.cssdeleted−1

@@ -1 +0,0 @@

1−@charset "UTF-8";html{font-family:"PT Serif",Georgia,serif;font-size:100%;line-height:1.6;background:#fff;color:#000;-webkit-overflow-scrolling:touch}body{margin:1em;font-size:1rem}@media (min-width:20rem){body{font-size:calc(1rem + .0125*(100vw - 20rem))}}@media (min-width:40rem){body{font-size:1.25rem}}body article,body footer,body header,body main{position:relative;max-width:40rem;margin:0 auto}body>header{margin-bottom:3.5em}body>header h1{margin:0;font-size:1.5em}body>header p{margin:0;font-size:.85em}body>footer{margin-top:4.5em;padding-bottom:1.5em;text-align:center;font-size:.8rem;color:#aaa}details,nav,p{margin:1em 0}nav ul{list-style:none;margin:0;padding:0}nav li{display:inline-block;margin-right:1em;margin-bottom:.25em}nav a:visited{color:#0064c1}article header h1 a:visited:hover,article header h2 a:visited:hover,nav a:hover{color:#3000c1}ol,ul{margin-top:0;padding-top:0;padding-left:2.5em}p{-webkit-hyphens:auto;-ms-hyphens:auto;hyphens:auto}aside:first-child,p:first-child{margin-top:0}aside:last-child,p:last-child{margin-bottom:0}p+ol,p+ul{margin-top:-.75em}p img,p picture{float:right;margin-bottom:.5em;margin-left:.5em}p picture img{float:none;margin:0}blockquote,dd{padding-left:2.5em}dd{margin-bottom:1em;margin-left:0}dt{font-weight:700}blockquote{margin:0}aside{margin:.5em 0;font-style:italic;color:#aaa}@media (min-width:65rem){aside{position:absolute;right:-12.5rem;width:9.375rem;max-width:9.375rem;margin:0;padding-left:.5em;font-size:.8em;border-left:1px solid #f2f2f2}}section+section{margin-top:2em}h1,h2,h3,h4,h5,h6{margin:1.25em 0 0;line-height:1.2}h1:focus>a[href^="#"][id],h1:hover>a[href^="#"][id],h2:focus>a[href^="#"][id],h2:hover>a[href^="#"][id],h3:focus>a[href^="#"][id],h3:hover>a[href^="#"][id],h4:focus>a[href^="#"][id],h4:hover>a[href^="#"][id],h5:focus>a[href^="#"][id],h5:hover>a[href^="#"][id],h6:focus>a[href^="#"][id],h6:hover>a[href^="#"][id]{opacity:1;transition:opacity 0s,color 300ms ease-out}figure+p,h1+details,h1+p,h2+details,h2+p,h3+details,h3+p,h4+details,h4+p,h5+details,h5+p,h6+details,h6+p{margin-top:.5em}h1>a[href^="#"][id],h2>a[href^="#"][id],h3>a[href^="#"][id],h4>a[href^="#"][id],h5>a[href^="#"][id],h6>a[href^="#"][id]{position:absolute;left:-.5em;opacity:0;background:0 0;color:rgba(0,0,0,.5);transition:opacity 300ms ease-out}h1>a[href^="#"][id]:focus,h1>a[href^="#"][id]:hover,h1>a[href^="#"][id]:target,h2>a[href^="#"][id]:focus,h2>a[href^="#"][id]:hover,h2>a[href^="#"][id]:target,h3>a[href^="#"][id]:focus,h3>a[href^="#"][id]:hover,h3>a[href^="#"][id]:target,h4>a[href^="#"][id]:focus,h4>a[href^="#"][id]:hover,h4>a[href^="#"][id]:target,h5>a[href^="#"][id]:focus,h5>a[href^="#"][id]:hover,h5>a[href^="#"][id]:target,h6>a[href^="#"][id]:focus,h6>a[href^="#"][id]:hover,h6>a[href^="#"][id]:target{opacity:1;box-shadow:none;color:#000;transition:opacity 0s,color 0s}h1>a[href^="#"][id]:target:focus,h2>a[href^="#"][id]:target:focus,h3>a[href^="#"][id]:target:focus,h4>a[href^="#"][id]:target:focus,h5>a[href^="#"][id]:target:focus,h6>a[href^="#"][id]:target:focus{outline:0}h1>a[href^="#"][id]::before,h2>a[href^="#"][id]::before,h3>a[href^="#"][id]::before,h4>a[href^="#"][id]::before,h5>a[href^="#"][id]::before,h6>a[href^="#"][id]::before{content:"â€¢"}h1{font-size:2em}h2{font-size:1.75em}h3{font-size:1.25em}h4{font-size:1.15em}h5,h6{font-size:1em}h6{margin-top:1em;color:#aaa}article+article{margin-top:5em}article header p{font-family:system-ui,-apple-system,BlinkMacSystemFont,"Segoe UI",Roboto,Oxygen,Ubuntu,Cantarell,"Fira Sans","Droid Sans","Helvetica Neue",Helvetica,Arial,sans-serif;font-size:.6em;color:#aaa}article header p+h1,article header p+h2{margin-top:-.25em}article header h1+p,article header h2+p{margin-top:.25em}article header h1 a,article header h2 a{color:#000;background:url('data:image/svg+xml;charset=utf8,%3Csvg xmlns="http://www.w3.org/2000/svg" width="1" height="1"%3E%3Crect x="0" y="0.5" width="1" height="0.5" fill="rgba(0, 0, 0, 0.35)"/%3E%3C/svg%3E') left bottom repeat-x}@media screen and (-ms-high-contrast:active),(-ms-high-contrast:none){article header h1 a,article header h2 a{background:url('data:image/svg+xml;charset=utf8,%3Csvg xmlns="http://www.w3.org/2000/svg" width="1" height="2"%3E%3Crect x="0" y="1" width="1" height="1" fill="rgba(0, 0, 0, 0.35)"/%3E%3C/svg%3E') left bottom repeat-x}}article header h1 a:visited,article header h2 a:visited{color:#aaa;background:url('data:image/svg+xml;charset=utf8,%3Csvg xmlns="http://www.w3.org/2000/svg" width="1" height="1"%3E%3Crect x="0" y="0.5" width="1" height="0.5" fill="rgba(170, 170, 170, 0.35)"/%3E%3C/svg%3E') left bottom repeat-x}@media screen and (-ms-high-contrast:active),(-ms-high-contrast:none){article header h1 a:visited,article header h2 a:visited{background:url('data:image/svg+xml;charset=utf8,%3Csvg xmlns="http://www.w3.org/2000/svg" width="1" height="2"%3E%3Crect x="0" y="1" width="1" height="1" fill="rgba(170, 170, 170, 0.35)"/%3E%3C/svg%3E') left bottom repeat-x}}article>footer{margin-top:1.5em;font-size:.85em}a,abbr{text-decoration:none}a{color:#0064c1;transition:color 300ms ease-out,box-shadow 300ms ease-out;background:url('data:image/svg+xml;charset=utf8,%3Csvg xmlns="http://www.w3.org/2000/svg" width="1" height="1"%3E%3Crect x="0" y="0.5" width="1" height="0.5" fill="rgba(0, 100, 193, 0.35)"/%3E%3C/svg%3E') left bottom repeat-x}@media screen and (-ms-high-contrast:active),(-ms-high-contrast:none){a{background:url('data:image/svg+xml;charset=utf8,%3Csvg xmlns="http://www.w3.org/2000/svg" width="1" height="2"%3E%3Crect x="0" y="1" width="1" height="1" fill="rgba(0, 100, 193, 0.35)"/%3E%3C/svg%3E') left bottom repeat-x}}a:visited{color:#80b2e0}a:active,a:hover{outline-width:0}a:hover{box-shadow:inset 0 -1px #3000c1;color:#3000c1;transition:color 0s,box-shadow 0s}abbr{margin-right:-.075em;-webkit-hyphens:none;-ms-hyphens:none;hyphens:none;letter-spacing:.075em;font-size:.9em;border-bottom:1px dotted}img,picture{display:block;max-width:100%;margin:0 auto}audio,video{width:100%;max-width:100%}video{-o-object-position:0 -1px;object-position:0 -1px}figure{margin:1em 0 .5em;padding:0}figure figcaption{opacity:.65;font-size:.85em}table{display:inline-block;border-spacing:0;border-collapse:collapse;overflow-x:auto;max-width:100%;text-align:left;vertical-align:top;background:linear-gradient(rgba(0,0,0,.15) 0%,rgba(0,0,0,.15) 100%) 0 0,linear-gradient(rgba(0,0,0,.15) 0%,rgba(0,0,0,.15) 100%) 100% 0;background-attachment:scroll,scroll;background-size:1px 100%,1px 100%;background-repeat:no-repeat,no-repeat}table caption{font-size:.9em;background:#fff}table td,table th{padding:.35em .75em;vertical-align:top;font-size:.9em;border:1px solid #f2f2f2;border-top:0;border-left:0}table td:first-child,table th:first-child{padding-left:0;background-image:linear-gradient(to right,#fff 50%,rgba(255,255,255,0) 100%);background-size:2px 100%;background-repeat:no-repeat}table td:last-child,table th:last-child{padding-right:0;border-right:0;background-image:linear-gradient(to left,#fff 50%,rgba(255,255,255,0) 100%);background-position:100% 0;background-size:2px 100%;background-repeat:no-repeat}table td:only-child,table th:only-child{background-image:linear-gradient(to right,#fff 50%,rgba(255,255,255,0) 100%),linear-gradient(to left,#fff 50%,rgba(255,255,255,0) 100%);background-position:0 0,100% 0;background-size:2px 100%,2px 100%;background-repeat:no-repeat,no-repeat}table th{line-height:1.2}code,kbd,samp,var{font-family:Consolas,"Lucida Console",Monaco,monospace;font-style:normal}pre{overflow-x:auto;font-size:.8em;background:linear-gradient(rgba(0,0,0,.15) 0%,rgba(0,0,0,.15) 100%) 0 0,linear-gradient(rgba(0,0,0,.15) 0%,rgba(0,0,0,.15) 100%) 100% 0;background-attachment:scroll,scroll;background-size:1px 100%,1px 100%;background-repeat:no-repeat,no-repeat}pre>code,summary{display:inline-block}pre>code{overflow-x:visible;box-sizing:border-box;min-width:100%;border-right:3px solid #fff;border-left:1px solid #fff}hr{height:1px;margin:2em 0;border:0;background:#f2f2f2}details[open]{padding-bottom:.5em;border-bottom:1px solid #f2f2f2}summary{font-weight:700;border-bottom:1px dashed;cursor:pointer}summary::-webkit-details-marker{display:none}noscript{color:#d00000}::selection{background:rgba(0,100,193,.15)}

default.nix+14−68

@@ -1,14 +1,10 @@

1{ sources ? import ./nix/sources.nix

2, haskellNix ? import sources.haskellNix { inherit system; }

3−, pkgs ? import haskellNix.sources.nixpkgs-2311 (haskellNix.nixpkgsArgs // { inherit system; })

3+, pkgs ? import haskellNix.sources.nixpkgs-2105 (haskellNix.nixpkgsArgs // { inherit system; })

4, system ? builtins.currentSystem

5, nix-filter ? import sources.nix-filter

6}:

7let

8− masterPkgs = import sources.nixpkgs { inherit system; };

9− yq = import ./nix/yq.nix { pkgs = masterPkgs; };

10− diffYaml = import ./nix/diff-yaml.nix { pkgs = masterPkgs; };

11−

12 hsPkgs = pkgs.haskell-nix.stackProject {

8 hsPkgs = pkgs.haskell-nix.stackProject {

13 src = nix-filter {

9 src = nix-filter {

14 root = ./.;

10 root = ./.;

@@ -16,7 +12,7 @@ let

16 include = [

12 include = [

17 ./stack.yaml

13 ./stack.yaml

18 ./stack.yaml.lock

14 ./stack.yaml.lock

19− ./compaREST.cabal

15+ ./comparest.cabal

20 ];

16 ];

21 };

17 };

22

18

@@ -25,22 +21,16 @@ let

25 dontStrip = false;

21 dontStrip = false;

26 dontPatchELF = false;

22 dontPatchELF = false;

27 enableDeadCodeElimination = true;

23 enableDeadCodeElimination = true;

28− ghcOptions = [

29− "-O2"

30− "-fexpose-all-unfoldings"

31− "-fspecialise-aggressively"

32− ];

33− packages.pandoc.ghcOptions = [ "-O1" ];

34− packages.compaREST.src = nix-filter {

24+ packages.comparest.src = nix-filter {

35 root = ./.;

25 root = ./.;

36 name = "compaREST-src";

26 name = "compaREST-src";

37 include = with nix-filter; [

27 include = with nix-filter; [

38− (./compaREST.cabal)

28+ (./comparest.cabal)

39 (inDirectory ./test)

29 (inDirectory ./test)

40 (inDirectory ./src)

30 (inDirectory ./src)

41 (inDirectory ./app)

31 (inDirectory ./app)

42 (inDirectory ./github-action)

32 (inDirectory ./github-action)

43− ./css/awsm.min.css

33+ ./awsm-css/dist/awsm.min.css

44 ./LICENSE

34 ./LICENSE

45 ];

35 ];

46 };

36 };

@@ -55,71 +45,27 @@ let

55 ${pkgs.nukeReferences}/bin/nuke-refs $out/bin/*

45 ${pkgs.nukeReferences}/bin/nuke-refs $out/bin/*

56 '';

46 '';

57

47

58− compaRESTBin = hsPkgs.compaREST.components.exes.compaREST;

59− compaRESTStaticBin = (staticify "compaREST-static" hsPkgs.projectCross.musl64.hsPkgs.compaREST.components.exes.compaREST);

60−

61−

62− # doesn't work

63− armDarwinCompaREST = hsPkgs.projectCross.aarch64-darwin.hsPkgs.compaREST.components.exes.compaREST;

64−

65− compaRESTImage = pkgs.dockerTools.buildImage {

48+ compaREST = pkgs.dockerTools.buildImage {

66 name = "compaREST";

49 name = "compaREST";

67− contents = [ compaRESTStaticBin ];

50+ contents = [ (staticify "compaREST-static" hsPkgs.projectCross.musl64.hsPkgs.comparest.components.exes.comparest) ];

68 config = {

51 config = {

69− Entrypoint = [ "/bin/compaREST" ];

52+ Entrypoint = [ "/bin/comparest" ];

70 };

53 };

71 };

54 };

72

55

73− macOSCompaRESTBundle = pkgs.runCommand "compaREST-macOS-bundled"

74− {

75− buildInputs = [ masterPkgs.macdylibbundler ];

76− } ''

77− mkdir -p $out/lib

78− cp ${compaRESTBin}/bin/compaREST $out/compaREST

79− chmod 755 $out/compaREST

80− dylibbundler -b \

81− -x $out/compaREST \

82− -d $out/lib \

83− -p '@executable_path/lib'

84− '';

85−

86−

87 compaRESTGithubAction =

56 compaRESTGithubAction =

88 let

57 let

89− action = staticify "compaREST-GitHub-Action-static" hsPkgs.projectCross.musl64.hsPkgs.compaREST.components.exes.compaREST-GitHub-Action;

58+ action = staticify "compaREST-github-action-static" hsPkgs.projectCross.musl64.hsPkgs.comparest.components.exes.comparest-github-action;

90− wrapped = pkgs.runCommand "wrapped-compaREST-GitHub-Action" { buildInputs = [ pkgs.makeWrapper ]; } ''

59+ wrapped = pkgs.runCommand "wrapped-compaREST-github-action" { buildInputs = [ pkgs.makeWrapper ]; } ''

91− makeWrapper ${action}/bin/compaREST-GitHub-Action $out/bin/pre --add-flags "pre"

60+ makeWrapper ${action}/bin/comparest-github-action $out/bin/pre --add-flags "pre"

92− makeWrapper ${action}/bin/compaREST-GitHub-Action $out/bin/run --add-flags "run"

61+ makeWrapper ${action}/bin/comparest-github-action $out/bin/run --add-flags "run"

93 '';

62 '';

94 in

63 in

95 pkgs.dockerTools.buildImage {

64 pkgs.dockerTools.buildImage {

96− name = "typeable/compaREST-GitHub-Action";

65+ name = "typeable/comparest-github-action";

97 tag = "latest";

66 tag = "latest";

98 contents = [ wrapped pkgs.cacert ];

67 contents = [ wrapped pkgs.cacert ];

99 };

68 };

100

69

101− WindowsCompaRESTBin = hsPkgs.projectCross.mingwW64.hsPkgs.compaREST.components.exes.compaREST;

102−

103− # We use the static version so that we don't have to rebuild everything on CI.

104− # The only binaries build on CI are static.

105− test = hsPkgs.projectCross.musl64.hsPkgs.compaREST.components.tests.compaREST-tests.overrideAttrs (final: old: {

106− buildInputs = old.buildInputs ++ [ diffYaml yq ];

107− nativeBuildInputs = old.nativeBuildInputs ++ (with masterPkgs; [ makeWrapper ]);

108−

109− postInstall = ''

110− wrapProgram $out/bin/compaREST-tests \

111− --prefix PATH : ${masterPkgs.lib.makeBinPath [ diffYaml yq ]}

112− '';

113− });

114in

70in

115−{

116− inherit

117− compaRESTImage

118− compaRESTGithubAction

71+{ inherit compaREST compaRESTGithubAction hsPkgs haskellNix; }

119− compaRESTStaticBin

120− compaRESTBin

121− hsPkgs

122− macOSCompaRESTBundle

123− WindowsCompaRESTBin

124− test;

125−}

docs/Development_guide.mddeleted−149

@@ -1,149 +0,0 @@

1−CompaREST

2−=========

3−The tool works by simultaneously looking at a pair of nodes in OpenAPI schema

4−trees. At every place we try to understand whether one side (the producer) can

5−produce something that the other side (the consumer) cannot consume. This often

6−involves recursively running the same check on child sub-nodes. The necessary

7−criteria are implemented manually for all types of nodes that appear in the

8−schema. The `Subtree` class in `Data.OpenApi.Compare.Subtree` designates types

9−of nodes for which this compatibility checking is defined. The implementations

10−for various types reside in `Data.OpenApi.Compare.Validate.*`.

11−

12−Producer/Consumer

13−-----------------

14−Rather than looking at which schema is the server's and which is the client's,

15−in terms of compatibility checking it is more useful to track which side is the

16−"producer" and which is the "consumer". At the root of the schema the producer

17−is the client, but as we descend into an HTTP response, the direction flips and

18−the producer becomes the server.

19−

20−We deal with a lot of things in pairs, where one thing belongs to the producer

21−and another belongs to the consumer. The `ProdCons` datatype (in

22−`Data.OpenApi.Compare.Subtree`) is just a pair type that provides an Applicative

23−abstraction for working with two things simultaneously.

24−

25−Trees

26−-----

27−We directly use the datatypes defined in the `openapi3` library. For reasons of

28−identifiability and memoization we tag all nodes in the trees with a path from

29−the root. The tree is heterogeneous (nodes have different types), and every type

30−of node has a different arrangement of children. There is a `Step` data family

31−that defines all the possible children (of a specific type) of a node (of a

32−specific type).

33−

34−A `Trace` is a sequence of steps, except in a path the types of adjacent steps

35−have to agree. The `Paths` datatype achieves this. Together all paths form a

36−`Category`, and we often concatenate them using `>>>`. This is defined in

37−`Data.OpenApi.Compare.Paths`.

38−

39−We often keep a node and a path to it next to each other using an environment

40−comonad. `Traced` is a type alias around `Env` which ensures that the type of

41−the path matches the type of the node.

42−

43−Issues

44−------

45−The output of the tool is a list of compatibility issues that came up during

46−checking. The `Issue` data family describes the kinds of issues that can occur

47−at each type of node. An issue is supposed to characterize a set of interactions

48−(requests or responses) that demonstrate that the schemas are incompatible.

49−

50−Each issue is tagged with a `Behavior` that describes the path to reproducing

51−the issue. While a `Trace` describes a syntactic path down the schema tree, a

52−`Behavior` describes which part of an interaction needs to be focused on for the

53−issue to manifest itself.

54−

55−In most places where we keep multiple issues (e.g. the output), to store them we

56−use a prefix tree map, indexed by both types and values of `Behavior`s. See

57−`Data.OpenApi.Compare.PathsPrefixTree`.

58−

59−Report

60−------

61−The checker ultimately outputs a list of `Issue`s, together with `Behavior`s

62−that cause them. We run the checker twice: forwards and backwards -- to detect

63−non-breaking changes. All of this is then compiled into a report in

64−`Data.OpenApi.Compare.Report`. The tree structure of headings is computed from

65−`Behavior`s, using `Jet`s to collapse particular sequences of behavior steps

66−into a single human-readable header item. The text of each paragraph comes from

67−`describeIssue`.

68−

69−We then use the `pandoc` library to render the report in a variety of formats.

70−

71−Formulas

72−--------

73−The schema has references, so it can end up being recursive. Similarly the

74−process for establishing compatibility can end up being recursive. To keep track

75−of this, the checker actually manipulates *formulas* which can have variables in

76−them, defined in (`Data.OpenApi.Compare.Formula`).

77−

78−A formula represents a set of issues, with the empty set corresponding to a

79−successful compatibility check. A formula can have conjunctions, where we only

80−report success if all parts succeeded, and if not we take the union of all

81−issues. A formula can also have disjunctions, but there it's impossible to

82−guarantee that the issues for the parts also make sense as issues for the whole

83−thing. Due to this if all disjuncted parts have issues we instead return a

84−different issue (usually non-descriptive).

85−

86−The `FormulaF` datatype implements a functor that carries formulaic calculations

87−as well as a result value (a co-Yoneda extension of formulas for the most part).

88−The Applicative interface provides conjunction, and the Alternative interface

89−provides disjunction.

90−

91−When we detect recursion we introduce a variable, compute the compatibility

92−check as a formula with that variable, and then we solve a fixed point equation

93−(`maxFixpoint`) with the variable to obtain the answer.

94−

95−This `FomulaF` is further wrapped in a couple monad transformers

96−(`SemanticCompatFormula`, `StructuralCompatFormula`), and the whole checker is

97−then implemented in the resulting Applicative using ApplicativeDo.

98−

99−Memoization

100−-----------

101−The `Data.OpenApi.Compare.Memo` module contains utilities for stateful

102−memoization and recursion detection. The entire checking process is memoized,

103−and can detect, propagate, and resolve recursion.

104−

105−Structural/Semantic Compatibility

106−---------------------------------

107−When we encounter two nodes we first try to optimistically establish whether

108−they're structurally equal, i.e. the trees are exactly the same modulo reference

109−inlining. This check is also memoized and recursion-aware. If the check succeeds

110−we conclude that the schemas are compatible. Otherwise we fall back to the

111−"normal" semantic compatibility.

112−

113−

114−JSON Schema

115−-----------

116−The language that describes JSON payloads is probably the richest part of

117−OpenAPI schemas, and the checker for it also comes with a lot of moving parts.

118−

119−JSON schema allows arbitrary set arithmetic using `allOf`, `anyOf`, `not` and

120−`oneOf`. To fully check `not` and `oneOf` we would need to compare set

121−subtraction, which involves negating a comparison result. If recursion is

122−involved we would need to be able to solve equations with negation, which we

123−cannot do. So `not` is unsupported altogether, and `oneOf` is only supported

124−when it has disjoint branches and behaves like `anyOf`.

125−

126−With that in mind a JSON schema is first pre-processed into a Disjunctive Normal

127−Form (`DNF` in `Data.OpenApi.Compare.Validate.Schema.DNF`). This pre-processing

128−happens in `Data.OpenApi.Compare.Validate.Schema.Process`.

129−

130−The DNF contains elementary clauses that match on a specific aspect of a JSON

131−object (`Condition`). Most clauses only affect objects of a single type, so JSON

132−values and clauses are segregated by type (`JsonType`, `TypedValue` in

133−`Data.OpenApi.Compare.Validate.Schema.JsonFormula`)

134−

135−Then we reduce the problem of comparing two DNF's to the comparison of a

136−conjunction of clauses in the producer with a single clause in the consumer

137−(`checkFormulas` in `Data.OpenApi.Compare.Validate.Schema`).

138−

139−When we do disjunction in the formula we lose information, so we try to avoid

140−having disjunctions in the consumer DNF. This is done by the means of

141−partitioning. We look for factors that would let us partition the set of all

142−objects into several bins, in a way that hopefully corresponds only a single

143−consumer to each producer. This is implemented in

144−`Data.OpenApi.Compare.Validate.Schema.Partition`. Currently we can only

145−partition by an `enum` value that is accessible via a chain of `required`

146−fields.

147−

148−The same partitioning mechanism is used to test whether the branches of a

149−`oneOf` are disjoint, and emit a warning otherwise.

docs/Integration_guide.md+5−3

@@ -28,6 +28,8 @@ In our example we have already generated the two OpenAPI specs and placed them i

28

29We can now run our action:

30

31+##### NOTE: will only work after public release

32+

31```yaml

33```yaml

32- uses: typeable/comparest

34- uses: typeable/comparest

33 with:

35 with:

@@ -36,11 +38,11 @@ We can now run our action:

36 project_name: TEST

38 project_name: TEST

37```

39```

38

40

39−This will create a check on the pull request displaying the changes (if there are any) similar to this:

41+This will create a comment on the pull request displaying the changes (if there are any) similar to this:

40

42

41−![](img/github-action-report.png)

43+![](img/github-action-comment.png)

42

44

43−The check will show success when there are no breaking changes, and be neutral otherwise.

45+Consecutive runs of the action will update the comment instead of creating new ones. This will prevent the pile-up of compaREST comments and save you from distracting notifications.

44

46

45## Integrating into something other than Github Actions

47## Integrating into something other than Github Actions

46

48

docs/Releasing.mddeleted−15

@@ -1,15 +0,0 @@

1−# The release procedure

2−

3−1. Update the version number everywhere:

4− 1. Version in [compaREST.cabal](../compaREST.cabal)

5− 2. Docker tag in [action.yaml](../action.yaml)

6− 3. Set the version of unreleased changes in [CHANGELOG.md](../CHANGELOG.md)

7−2. Publish!

8− 1. Create a pre-release on GitHub:

9− ![](img/pre-release.png)

10− 2. This will automatically start the release procedure. You can check the state of it in the "Actions" tab on GitHub:

11− ![](img/pre-release-ci.png)

12− 3. If everything goes as planned, the release action should pass and all assets should be added to the release:

13− ![](img/pre-release-artifacts.png)

14− 4. The new version should be automatically uploaded a release candidate to [Hackage](https://hackage.haskell.org/package/compaREST/candidates/). Make sure everything looks okay and publish it.

15− 5. Go to the Releases tab on GitHub and edit the release to make it not a "pre-release".

docs/User_guide.mddeleted−51

@@ -1,51 +0,0 @@

1−CompaREST User Guide

2−====================

3−

4−Running the Tool

5−----------------

6−The tool accepts two OpenAPI 3.0.0 schema files in either JSON or YAML format.

7−One is assumed to be the client version of the schema, and the other is the

8−server version.

9−

10−The tool will look for changes between the schemas and detect whether they are

11−breaking or not -- that is, if they prevent interoperability between the client

12−and the server.

13−

14−Running:

15−```

16−comparest -c client.json -s server.json

17−```

18−will output a markdown report of the changes to the standard output.

19−

20−Compatibility status can be signaled via the exit code using

21−`--signal-exit-code`. In case no report is needed, output can be suppressed with

22−`--silent`. For example:

23−```

24−comparest -c client.json -s server.json --signal-exit-code --silent

25−echo $?

26−```

27−If there were changes that the tool determined to be breaking, the exit code

28−will be 1. If there were some changes the tool couldn't understand, the exit

29−code will be 2. Otherwise if there were no breaking changes, the exit code will

30−be 0.

31−

32−Controlling the Report

33−----------------------

34−By default the report includes breaking changes, as well as non-breaking:

35−changes that would be considered breaking in the opposite direction. To only

36−include breaking changes in the report use `--only-breaking`. The `--all` option

37−restores the default behavior.

38−

39−The report can be formatted in a variety of ways supported by Pandoc. The `-o`

40−option causes the report to be written to a file. The format of the file is

41−determined from the extension. The supported extensions include:

42− - `.md` for markdown

43− - `.html` for an HTML snippet

44− - `.rst` for restructured text

45− - no extension for a self-contained HTML document with styles

46−

47−By default the report is split up into parts relating to different paths,

48−requests, responses, etc, using headers of various levels. Alternatively, the

49−report can use indended block-quotes to visualize the tree structure of the

50−report. The header style is enabled with `--header-style`, and the block-quote

51−style is enabled with `--folding-block-quotes-style`.

docs/img/github-action-comment.pngnew file

Binary file not shown.

docs/img/github-action-report.pngdeleted

Binary file not shown.

docs/img/pre-release-artifacts.pngdeleted

Binary file not shown.

docs/img/pre-release-ci.pngdeleted

Binary file not shown.

docs/img/pre-release.pngdeleted

Binary file not shown.

github-action/CompaREST/GitHub/API.hs+39−70

@@ -1,86 +1,55 @@

1module CompaREST.GitHub.API

2− ( postStatus,

2+ ( mapComment,

3− postStatusProcessing,

3+ createOrUpdateComment,

4 )

5where

6

7import CompaREST.GitHub.Action.Config

8+import Control.Monad

8import Control.Monad.Freer

9import Control.Monad.Freer

9import Control.Monad.Freer.GitHub

10import Control.Monad.Freer.GitHub

10import Control.Monad.Freer.Reader

11import Control.Monad.Freer.Reader

11−import Control.Monad.IO.Class

12+import Data.Foldable

12−import Data.Aeson

13−import qualified Data.ByteString.Lazy.Char8 as BSLC

14−import Data.OpenApi.Compare.Report

15import Data.Proxy

13import Data.Proxy

16import Data.Text (Text)

14import Data.Text (Text)

15+import qualified Data.Text as T

16+import qualified Data.Vector as V

17import GitHub

18−import GitHub.Data.Checks

18+import qualified GitHub as GH

19−import GitHub.Endpoints.Checks

20

19

21−postStatusProcessing ::

22− (Members '[GitHub, Reader Config] effs, MonadIO (Eff effs)) =>

20+findComment :: Members '[GitHub, Reader Config] effs => Eff effs (Maybe GH.IssueComment)

23− Eff effs ()

21+findComment = do

24−postStatusProcessing = do

25 Config {..} <- ask

22 Config {..} <- ask

26− printJSON $

23+ comments <- sendGitHub $ GH.commentsR repoOwner repoName issue GH.FetchAll

27− sendGitHub $

24+ htmlComment <- getHTMLComment

28− checkR

25+ let tryStripPrefix :: GH.IssueComment -> Maybe GH.IssueComment

29− repoOwner

26+ tryStripPrefix c@GH.IssueComment {issueCommentBody = (T.stripSuffix htmlComment -> Just b)} =

30− repoName

27+ Just $ c {GH.issueCommentBody = b}

31− Check

28+ tryStripPrefix _ = Nothing

32− { checkName = mkName Proxy checkName

29+ pure . (V.!? 0) $ V.mapMaybe tryStripPrefix comments

33− , checkSha = sha

34− , checkDetailsURL = Nothing

35− , checkExternalId = Nothing

36− , checkStatus = Just CheckInProgress

37− , checkStartedAt = Nothing

38− , checkConclusion = Nothing

39− , checkCompletedAt = Nothing

40− , checkOutput = Nothing

41− , checkActions = Nothing

42− }

43

30

44−postStatus ::

45− (Members '[GitHub, Reader Config] effs, MonadIO (Eff effs)) =>

31+mapComment :: Members '[GitHub, Reader Config] effs => (Text -> Text) -> Eff effs ()

46− -- | 'Nothing' means that there were no changes at all

32+mapComment f = do

47− Maybe (Text, ReportStatus) ->

33+ findComment

48− Eff effs ()

34+ >>= traverse_

49−postStatus x = do

35+ ( \comment -> do

50− let (body, (title, conclusion)) = case x of

36+ Config {..} <- ask

51− Just (b, s) -> (b,) $ case s of

37+ htmlComment <- getHTMLComment

52− BreakingChanges -> ("⚠️ Breaking changes found!", CheckNeutral)

38+ sendGitHub $ editCommentR repoOwner repoName (GH.mkId Proxy $ GH.issueCommentId comment) ((<> htmlComment) . f $ GH.issueCommentBody comment)

53− NoBreakingChanges -> ("No breaking changes found ✨", CheckSuccess)

39+ pure ()

54− OnlyUnsupportedChanges -> ("🤷 Couldn't determine compatibility", CheckNeutral)

40+ )

55− Nothing -> ("", ("✅ The API did not change", CheckSuccess))

41+

42+createOrUpdateComment :: Members '[GitHub, Reader Config] effs => Text -> Eff effs ()

43+createOrUpdateComment body' = do

56 Config {..} <- ask

44 Config {..} <- ask

57− printJSON $

45+ htmlComment <- getHTMLComment

58− sendGitHub $

46+ let body = body' <> htmlComment

59− checkR

47+ void $

60− repoOwner

48+ findComment >>= \case

61− repoName

49+ Just comment -> sendGitHub $ editCommentR repoOwner repoName (GH.mkId Proxy $ GH.issueCommentId comment) body

62− Check

50+ Nothing -> sendGitHub $ createCommentR repoOwner repoName issue body

63− { checkName = mkName Proxy checkName

64− , checkSha = sha

65− , checkDetailsURL = Nothing

66− , checkExternalId = Nothing

67− , checkStatus = Just CheckCompleted

68− , checkStartedAt = Nothing

69− , checkConclusion = Just conclusion

70− , checkCompletedAt = Nothing

71− , checkOutput =

72− Just $

73− CheckOutput

74− { checkTitle = title

75− , checkSummary = body

76− , checkText = Nothing

77− , checkAnnotations = Nothing

78− , checkImages = Nothing

79− }

80− , checkActions = Nothing

81− }

82

51

83−printJSON :: MonadIO (Eff effs) => Eff effs Value -> Eff effs ()

52+getHTMLComment :: Member (Reader Config) effs => Eff effs Text

84−printJSON m = do

53+getHTMLComment = do

85− x <- m

54+ name <- asks projectName

86− liftIO . BSLC.putStrLn $ encode x

55+ pure $ "\n\n"

github-action/CompaREST/GitHub/Action/Config.hs+6−10

@@ -8,17 +8,16 @@ import Data.Text (Text)

8import qualified Data.Text as T

9import qualified GitHub as GH

10

11−import Data.Functor

12import System.Envy

11import System.Envy

13

12

14data Config = Config

13data Config = Config

15 { githubToken :: GH.Auth

14 { githubToken :: GH.Auth

16 , repoOwner :: GH.Name GH.Owner

15 , repoOwner :: GH.Name GH.Owner

17 , repoName :: GH.Name GH.Repo

16 , repoName :: GH.Name GH.Repo

18− , checkName :: Text

17+ , issue :: GH.IssueNumber

18+ , projectName :: Text

19 , footerText :: Text

20 , root :: FilePath

21− , sha :: GH.Name GH.Commit

22 }

21 }

23

22

24instance FromEnv Config where

23instance FromEnv Config where

@@ -28,20 +27,17 @@ instance FromEnv Config where

28 T.split (== '/') <$> env "REPO" >>= \case

27 T.split (== '/') <$> env "REPO" >>= \case

29 [owner, name] -> pure (owner, name)

28 [owner, name] -> pure (owner, name)

30 _ -> fail "malformed repo"

29 _ -> fail "malformed repo"

31− checkName <-

30+ issue <- GH.IssueNumber <$> env "PR_NUMBER"

32− envMaybe "PROJECT_NAME" <&> \case

31+ projectName <- env "PROJECT_NAME"

33− Just pName | not . T.null . T.strip $ pName -> "compaREST – " <> pName

34− _ -> "compaREST"

35 footerText <- env "FOOTER"

32 footerText <- env "FOOTER"

36 root <- envMaybe "ROOT" .!= "."

33 root <- envMaybe "ROOT" .!= "."

37− sha <- env "SHA"

38 pure $

34 pure $

39 Config

35 Config

40 { githubToken = token

36 { githubToken = token

41 , repoOwner = GH.mkName Proxy owner

37 , repoOwner = GH.mkName Proxy owner

42 , repoName = GH.mkName Proxy repo

38 , repoName = GH.mkName Proxy repo

43− , checkName = checkName

39+ , issue = issue

40+ , projectName = projectName

44 , footerText = footerText

41 , footerText = footerText

45 , root = root

42 , root = root

46− , sha = GH.mkName Proxy sha

47 }

43 }

github-action/GitHub/Data/Checks.hsdeleted−173

@@ -1,173 +0,0 @@

1−module GitHub.Data.Checks

2− ( Check (..),

3− CheckStatus (..),

4− CheckConclusion (..),

5− CheckOutput (..),

6− CheckAnnotation (..),

7− CheckAnnotationLevel (..),

8− CheckImage (..),

9− CheckAction (..),

10− )

11−where

12−

13−import Data.Aeson

14−import Data.Aeson.Types

15−import Data.Text (Text)

16−import Data.Vector (Vector)

17−import GHC.Generics (Generic)

18−import GitHub

19−import GitHub.Internal.Prelude (UTCTime)

20−

21−data Check = Check

22− { checkName :: !(Name Check)

23− , checkSha :: !(Name Commit)

24− , checkDetailsURL :: !(Maybe URL)

25− , checkExternalId :: !(Maybe (Id Check))

26− , checkStatus :: !(Maybe CheckStatus)

27− , checkStartedAt :: !(Maybe UTCTime)

28− , checkConclusion :: !(Maybe CheckConclusion)

29− , checkCompletedAt :: !(Maybe UTCTime)

30− , checkOutput :: !(Maybe CheckOutput)

31− , checkActions :: !(Maybe (Vector CheckAction))

32− }

33− deriving stock (Show, Eq, Ord, Generic)

34−

35−instance ToJSON Check where

36− toJSON (Check n sha durl eid s sa c ca o a) =

37− object'

38− [ "name" .= n

39− , "head_sha" .= sha

40− , "details_url" .= durl

41− , "external_id" .= eid

42− , "status" .= s

43− , "started_at" .= sa

44− , "conclusion" .= c

45− , "completed_at" .= ca

46− , "output" .= o

47− , "actions" .= a

48− ]

49−

50−data CheckStatus

51− = CheckQueued

52− | CheckInProgress

53− | CheckCompleted

54− deriving stock (Show, Enum, Bounded, Eq, Ord, Generic)

55−

56−instance ToJSON CheckStatus where

57− toJSON CheckQueued = String "queued"

58− toJSON CheckInProgress = String "in_progress"

59− toJSON CheckCompleted = String "completed"

60−

61−data CheckConclusion

62− = CheckActionRequired

63− | CheckCancelled

64− | CheckFailure

65− | CheckNeutral

66− | CheckSuccess

67− | CheckSkipped

68− | CheckStale

69− | CheckTimedOut

70− deriving stock (Show, Enum, Bounded, Eq, Ord, Generic)

71−

72−instance ToJSON CheckConclusion where

73− toJSON CheckActionRequired = String "action_required"

74− toJSON CheckCancelled = String "cancelled"

75− toJSON CheckFailure = String "failure"

76− toJSON CheckNeutral = String "neutral"

77− toJSON CheckSuccess = String "success"

78− toJSON CheckSkipped = String "skipped"

79− toJSON CheckStale = String "stale"

80− toJSON CheckTimedOut = String "timed_out"

81−

82−data CheckOutput = CheckOutput

83− { checkTitle :: !Text

84− , checkSummary :: !Text

85− , checkText :: !(Maybe Text)

86− , checkAnnotations :: !(Maybe (Vector CheckAnnotation))

87− , checkImages :: !(Maybe (Vector CheckImage))

88− }

89− deriving stock (Show, Eq, Ord, Generic)

90−

91−instance ToJSON CheckOutput where

92− toJSON (CheckOutput t s txt a i) =

93− object'

94− [ "title" .= t

95− , "summary" .= s

96− , "text" .= txt

97− , "annotations" .= a

98− , "images" .= i

99− ]

100−

101−data CheckAnnotation = CheckAnnotation

102− { checkPath :: !Text

103− , checkStartLine :: !Int

104− , checkEndLine :: !Int

105− , checkStartColumn :: !(Maybe Int)

106− , checkEndColumn :: !(Maybe Int)

107− , checkAnnotationLevel :: !CheckAnnotationLevel

108− , checkMessage :: !Text

109− , checkTitle :: !(Maybe Text)

110− , checkRawDetails :: !(Maybe Text)

111− }

112− deriving stock (Show, Eq, Ord, Generic)

113−

114−instance ToJSON CheckAnnotation where

115− toJSON (CheckAnnotation p sl el sc ec al m t rd) =

116− object'

117− [ "path" .= p

118− , "start_line" .= sl

119− , "end_line" .= el

120− , "start_column" .= sc

121− , "end_column" .= ec

122− , "annotation_level" .= al

123− , "message" .= m

124− , "title" .= t

125− , "raw_details" .= rd

126− ]

127−

128−data CheckAnnotationLevel

129− = NoticeAnnotation

130− | WarningAnnotation

131− | FailureAnnotation

132− deriving stock (Show, Enum, Bounded, Eq, Ord, Generic)

133−

134−instance ToJSON CheckAnnotationLevel where

135− toJSON NoticeAnnotation = String "notice"

136− toJSON WarningAnnotation = String "warning"

137− toJSON FailureAnnotation = String "failure"

138−

139−data CheckImage = CheckImage

140− { checkImageAlt :: !Text

141− , checkImageURL :: !URL

142− , checkImageCaption :: !(Maybe Text)

143− }

144− deriving stock (Show, Eq, Ord, Generic)

145−

146−instance ToJSON CheckImage where

147− toJSON (CheckImage a url c) =

148− object'

149− [ "alt" .= a

150− , "image_url" .= url

151− , "caption" .= c

152− ]

153−

154−data CheckAction = CheckAction

155− { checkActionLabel :: !Text

156− , checkActionDescription :: !Text

157− , checkActionIdentifier :: !Text

158− }

159− deriving stock (Show, Eq, Ord, Generic)

160−

161−instance ToJSON CheckAction where

162− toJSON (CheckAction l d i) =

163− object'

164− [ "label" .= l

165− , "description" .= d

166− , "identifier" .= i

167− ]

168−

169−object' :: [Pair] -> Value

170−object' = object . filter notNull

171− where

172− notNull (_, Null) = False

173− notNull (_, _) = True

github-action/GitHub/Endpoints/Checks.hsdeleted−12

@@ -1,12 +0,0 @@

1−module GitHub.Endpoints.Checks

2− ( checkR,

3− )

4−where

5−

6−import Data.Aeson

7−import GitHub

8−import GitHub.Data.Checks

9−

10−checkR :: Name Owner -> Name Repo -> Check -> Request 'RW Value

11−checkR user repo =

12− command Post ["repos", toPathPart user, toPathPart repo, "check-runs"] . encode

github-action/Main.hs+35−20

@@ -9,7 +9,6 @@ import Control.Monad.Freer.GitHub

9import Control.Monad.Freer.Reader

10import Data.OpenApi.Compare.Run

11import Data.Text (Text)

12−import qualified Data.Text as T

13import qualified Data.Yaml.Aeson as Yaml

12import qualified Data.Yaml.Aeson as Yaml

14import qualified GitHub as GH

13import qualified GitHub as GH

15import System.Environment

14import System.Environment

@@ -23,18 +22,13 @@ import Text.Pandoc.Writers

23main :: IO ()

22main :: IO ()

24main = do

23main = do

25 cfg <- decodeEnv >>= either error pure

24 cfg <- decodeEnv >>= either error pure

26− case sha cfg of

27− x | T.null . T.strip . GH.untagName $ x -> do

28− putStrLn "SHA not specified. Exiting without doing anything."

29− pure ()

30− _ ->

31− getArgs >>= \case

25+ getArgs >>= \case

32− ["pre"] -> runPre cfg

26+ ["pre"] -> runPre cfg

33− ["run"] -> do

27+ ["run"] -> do

34− oldFile <- getEnv "OLD"

28+ oldFile <- getEnv "OLD"

35− newFile <- getEnv "NEW"

29+ newFile <- getEnv "NEW"

36− runRun cfg (root cfg </> oldFile) (root cfg </> newFile)

30+ runRun cfg (root cfg </> oldFile) (root cfg </> newFile)

37− _ -> error "Invalid arguments."

31+ _ -> error "Invalid arguments."

38

32

39runner :: Config -> Eff '[GitHub, Error GH.Error, Reader Config, IO] a -> IO a

33runner :: Config -> Eff '[GitHub, Error GH.Error, Reader Config, IO] a -> IO a

40runner cfg =

34runner cfg =

@@ -43,7 +37,10 @@ runner cfg =

43 . runGitHub (githubToken cfg)

37 . runGitHub (githubToken cfg)

44

38

45runPre :: Config -> IO ()

39runPre :: Config -> IO ()

46−runPre cfg = runner cfg postStatusProcessing

40+runPre cfg =

41+ runner cfg $

42+ mapComment

43+ (markdown (header 4 "⏳ Report might not be accurate. Attempting to update." <> horizontalRule) <>)

47

44

48runRun :: Config -> FilePath -> FilePath -> IO ()

45runRun :: Config -> FilePath -> FilePath -> IO ()

49runRun cfg old' new' = runner cfg $ do

46runRun cfg old' new' = runner cfg $ do

@@ -56,13 +53,31 @@ runRun cfg old' new' = runner cfg $ do

56 }

53 }

57 (report, status) = runReport reportConfig (old, new)

54 (report, status) = runReport reportConfig (old, new)

58

55

59− body = markdown report <> "\n\n" <> footerText cfg

56+ summaryDetail s d =

57+ rawHtml "<details>"

58+ <> rawHtml "<summary>"

59+ <> s

60+ <> rawHtml "</summary>"

61+ <> d

62+ <> rawHtml "</details>"

63+ where

64+ rawHtml = rawBlock "html"

60

65

61− result =

66+ message =

67+ header 3 (text $ "⛄ compaREST – " <> projectName cfg)

62− if old == new

68+ <> if old == new

63− then Nothing

69+ then header 1 "✅ The API did not change"

70+ else

71+ header

72+ 1

64− else Just (body, status)

73+ ( case status of

65− postStatus result

74+ BreakingChanges -> "⚠️ Breaking changes found!"

75+ NoBreakingChanges -> "No breaking changes found ✨"

76+ OnlyUnsupportedChanges -> "🤷 Couldn't determine compatibility"

77+ )

78+ <> summaryDetail (plain "ℹ️ Details") report

79+ messageBody = markdown message <> "\n\n" <> footerText cfg

80+ createOrUpdateComment messageBody

66

81

67markdown :: Blocks -> Text

82markdown :: Blocks -> Text

68markdown =

83markdown =

nix/ci.nixdeleted−11

@@ -1,11 +0,0 @@

1−{ sources ? import ./sources.nix

2−, pkgs ? import sources.nixpkgs { }

3−}:

4−

5−let

6− yq = import ./yq.nix { inherit pkgs; };

7− diff-yaml = import ./diff-yaml.nix { inherit pkgs; };

8−in

9−pkgs.mkShell {

10− packages = [ pkgs.haskellPackages.fourmolu diff-yaml yq ];

11−}

nix/diff-yaml.nixdeleted−20

@@ -1,20 +0,0 @@

1−{ pkgs ? import <nixpkgs> {} }:

2−

3−let

4− inherit (pkgs) stdenv;

5− yq = import ./yq.nix { inherit pkgs; };

6−in

7−stdenv.mkDerivation {

8− name = "diff-yaml";

9−

10− src = ../scripts/diff-yaml;

11−

12− buildInputs = [ pkgs.bash yq ];

13−

14− phases = [ "installPhase" ];

15−

16− installPhase = ''

17− mkdir -p $out/bin

18− cp $src $out/bin/diff-yaml

19− '';

20−}

nix/shell.nixdeleted−11

@@ -1,11 +0,0 @@

1−{ sources ? import ./sources.nix

2−, pkgs ? import sources.nixpkgs { }

3−}:

4−

5−let

6− patched-yq = import ./yq.nix { inherit pkgs; };

7− diffYaml = import ./diff-yaml.nix { inherit pkgs; };

8−in

9−pkgs.mkShell {

10− buildInputs = with pkgs; [ pkg-config diffYaml patched-yq zlib ];

11−}

nix/sources.json+10−22

@@ -5,10 +5,10 @@

5 "homepage": "https://input-output-hk.github.io/haskell.nix",

6 "owner": "input-output-hk",

7 "repo": "haskell.nix",

8− "rev": "d7f95903c84a5a50d6fe0844280da82c3c81680a",

8+ "rev": "1992b910e9b4d880e1f4639f4fe7266bceb9a5ad",

9− "sha256": "02870rk4sx44lwwa0k20iwdhqcx0ayz34yb3b0qy045p22q45815",

9+ "sha256": "15w3wixjnb52f7cj3s94fy0zc0l1gc94p3n2wyq3qqxj10hvirfw",

10 "type": "tarball",

11− "url": "https://github.com/input-output-hk/haskell.nix/archive/d7f95903c84a5a50d6fe0844280da82c3c81680a.tar.gz",

11+ "url": "https://github.com/input-output-hk/haskell.nix/archive/1992b910e9b4d880e1f4639f4fe7266bceb9a5ad.tar.gz",

12 "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

13 },

14 "niv": {

@@ -17,34 +17,22 @@

17 "homepage": "https://github.com/nmattia/niv",

18 "owner": "nmattia",

19 "repo": "niv",

20− "rev": "f7c538837892dd2eb83567c9f380a11efb59b53f",

20+ "rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070",

21− "sha256": "0xl33k24vfc29cg9lnp95kvcq69qbq5fzb7jk9ig4lgrhaarh651",

21+ "sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx",

22 "type": "tarball",

23− "url": "https://github.com/nmattia/niv/archive/f7c538837892dd2eb83567c9f380a11efb59b53f.tar.gz",

23+ "url": "https://github.com/nmattia/niv/archive/e0ca65c81a2d7a4d82a189f1e23a48d59ad42070.tar.gz",

24 "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

25 },

26 "nix-filter": {

27− "branch": "main",

27+ "branch": "master",

28 "description": "a small self-container source filtering lib",

29 "homepage": "",

30 "owner": "numtide",

31 "repo": "nix-filter",

32− "rev": "3342559a24e85fc164b295c3444e8a139924675b",

32+ "rev": "3c9e33ed627e009428197b07216613206f06ed80",

33− "sha256": "08xia32g5jzaiyhfl3kzxslzbr4w1i56i0mhy5gpfggv8gqy8sym",

33+ "sha256": "19w142crrkywxynmyw4rhz4nglrg64yjawfkw3j91qwkwbfjds84",

34− "type": "tarball",

35− "url": "https://github.com/numtide/nix-filter/archive/3342559a24e85fc164b295c3444e8a139924675b.tar.gz",

36− "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

37− },

38− "nixpkgs": {

39− "branch": "master",

40− "description": "Nix Packages collection",

41− "homepage": "",

42− "owner": "NixOS",

43− "repo": "nixpkgs",

44− "rev": "bf038bd724982de67a2ee9a6b2f1fcb7d6a87bd7",

45− "sha256": "0ivvwdmg9fipj6ylq5ipxqpb0xnz6hsx3lyn377jacfpiqi9w0cv",

46 "type": "tarball",

34 "type": "tarball",

47− "url": "https://github.com/NixOS/nixpkgs/archive/bf038bd724982de67a2ee9a6b2f1fcb7d6a87bd7.tar.gz",

35+ "url": "https://github.com/numtide/nix-filter/archive/3c9e33ed627e009428197b07216613206f06ed80.tar.gz",

48 "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

36 "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

49 }

37 }

50}

38}

nix/yq.nixdeleted−26

@@ -1,26 +0,0 @@

1−{ pkgs ? import <nixpkgs> {} }:

2−

3−# Make yq work inside whatever `stack test` launches.

4−# Nuke this when https://github.com/kislyuk/yq/pull/193 is merged

5−# and nixpkgs includes that fix.

6−

7−let

8− yq-patch = pkgs.writeText "yq-tty-fix.patch" ''

9−diff --git a/yq/__init__.py b/yq/__init__.py

10−index d95ac4b..ae7d59e 100644

11−--- a/yq/__init__.py

12−+++ b/yq/__init__.py

13−@@ -110,7 +110,7 @@ def cli(args=None, input_format="yaml", program_name="yq"):

14− in_place = args.in_place

15− delattr(args, "in_place")

16−

17−- if sys.stdin.isatty() and not args.input_streams:

18−+ if (sys.stdin is None or sys.stdin.isatty()) and not args.input_streams:

19− parser.print_help()

20− sys.exit(2)

21− elif not args.input_streams:

22− '';

23−in

24−pkgs.yq.overrideAttrs (final: old: {

25− patches = old.patches ++ [ yq-patch ];

26−})

scripts/diff-yamldeleted−35

@@ -1,35 +0,0 @@

1−#!/usr/bin/env bash

2−set -e

3−

4−# Normalise YAML files passed as inputs, then run diff on them.

5−

6−check_util() {

7− local util=$1

8−

9− if [ -z $util ]; then

10− echo "Error: $util not found in PATH"

11− exit 1

12− fi

13−}

14−

15−DIFF=`which diff`

16−check_util $DIFF

17−

18−YQ=`which yq`

19−check_util $YQ

20−

21−# Only normalise YAML files.

22−# Print anything else as is.

23−normalise() {

24− local file=$1

25− local contents=($YQ -y -S '.' $file)

26−

27− # if $contents contains actual YAML data, print it

28− if [[ $? == 0 ]]; then

29− echo $contents

30− else

31− cat $file

32− fi

33−}

34−

35−$DIFF -u <(normalise $1) <(normalise $2)

src/Data/HList.hs+11−11

@@ -1,11 +1,11 @@

1module Data.HList

2− ( Has,

2+ ( Has

3− HasAll,

3+ , HasAll

4− getH,

4+ , getH

5− HList (..),

5+ , HList (..)

6− singletonH,

6+ , singletonH

7− ReassembleHList,

7+ , ReassembleHList

8− reassemble,

8+ , reassemble

9 )

10where

11

@@ -40,8 +40,8 @@ instance (Has' x xs t, HeadEq x (y : xs) ~ 'False) => Has' x (y ': xs) 'False wh

40 {-# INLINE getH #-}

41

42instance

43− TypeError ( 'ShowType x ':<>: 'Text " is not a part of the list.") =>

43+ TypeError ('ShowType x ':<>: 'Text " is not a part of the list.")

44− Has' x '[] 'False

44+ => Has' x '[] 'False

45 where

46 getH HNil = undefined

47 {-# INLINE getH #-}

@@ -74,8 +74,8 @@ instance ReassembleHList' (x ': xs) '[] 'False where

74 {-# INLINE reassemble #-}

75

76instance

77− (Has y xs, ReassembleHList' xs ys f, (xs == (y ': ys)) ~ 'False) =>

77+ (Has y xs, ReassembleHList' xs ys f, (xs == (y ': ys)) ~ 'False)

78− ReassembleHList' xs (y ': ys) 'False

78+ => ReassembleHList' xs (y ': ys) 'False

79 where

80 reassemble xs = getH @y xs `HCons` reassemble xs

81 {-# INLINE reassemble #-}

src/Data/OpenApi/Compare/Behavior.hs+11−11

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

1module Data.OpenApi.Compare.Behavior

2− ( BehaviorLevel (..),

2+ ( BehaviorLevel (..)

3− Behavable (..),

3+ , Behavable (..)

4− IssueKind (..),

4+ , IssueKind (..)

5− Issuable (..),

5+ , Issuable (..)

6− Orientation (..),

6+ , Orientation (..)

7− toggleOrientation,

7+ , toggleOrientation

8− Behavior,

8+ , Behavior

9− AnIssue (..),

9+ , AnIssue (..)

10− withClass,

10+ , withClass

11− anIssueKind,

11+ , anIssueKind

12− relatedAnIssues,

12+ , relatedAnIssues

13 )

14where

15

src/Data/OpenApi/Compare/Common.hs+1−1

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

1module Data.OpenApi.Compare.Common

2− ( zipAll,

2+ ( zipAll

3 )

4where

5

src/Data/OpenApi/Compare/Formula.hs+21−31

@@ -1,15 +1,14 @@

1module Data.OpenApi.Compare.Formula

2− ( FormulaF,

2+ ( FormulaF

3− VarRef,

3+ , VarRef

4− variable,

4+ , variable

5− eitherOf,

5+ , eitherOf

6− anError,

6+ , anError

7− errors,

7+ , errors

8− calculate,

8+ , calculate

9− maxFixpoint,

9+ , maxFixpoint

10− mapErrors,

10+ , mapErrors

11− )

12−where

11+ ) where

13

12

14import Data.Kind

13import Data.Kind

15import qualified Data.List.NonEmpty as NE

14import qualified Data.List.NonEmpty as NE

@@ -25,24 +24,15 @@ type VarRef = Int

25-- fixpoints always exist, i.e. that @x = f x@ has at least one solution.

24-- fixpoints always exist, i.e. that @x = f x@ has at least one solution.

26data FormulaF (q :: k -> k -> Type) (f :: k -> Type) (r :: k) (a :: Type) where

25data FormulaF (q :: k -> k -> Type) (f :: k -> Type) (r :: k) (a :: Type) where

27 Result :: a -> FormulaF q f r a

26 Result :: a -> FormulaF q f r a

28− Errors ::

29− !(P.PathsPrefixTree q f r) ->

27+ Errors :: !(P.PathsPrefixTree q f r) -> FormulaF q f r a

30− -- | invariant: never empty

28+ -- ^ invariant: never empty

31− FormulaF q f r a

32− Apply ::

33− FormulaF q f r (b -> c) ->

29+ Apply :: FormulaF q f r (b -> c) -> FormulaF q f r b -> (c -> a) -> FormulaF q f r a

34− FormulaF q f r b ->

35− (c -> a) ->

36− -- | invariant: at least one of LHS and RHS is not 'Errors', and they are

30+ -- ^ invariant: at least one of LHS and RHS is not 'Errors', and they are

37 -- both not 'Result'

31 -- both not 'Result'

38− FormulaF q f r a

39− SelectFirst ::

40− NE.NonEmpty (SomeFormulaF b) ->

32+ SelectFirst :: NE.NonEmpty (SomeFormulaF b)

41− !(P.PathsPrefixTree q f r) ->

33+ -> !(P.PathsPrefixTree q f r) -> (b -> a) -> FormulaF q f r a

42− (b -> a) ->

43− -- | invariant: the list doesn't contain any 'Result's, 'Errors' or

34+ -- ^ invariant: the list doesn't contain any 'Result's, 'Errors' or

44 -- 'SelectFirst'

35 -- 'SelectFirst'

45− FormulaF q f r a

46 Variable :: !VarRef -> a -> FormulaF q f r a

36 Variable :: !VarRef -> a -> FormulaF q f r a

47

37

48mkApply :: FormulaF q f r (b -> c) -> FormulaF q f r b -> (c -> a) -> FormulaF q f r a

38mkApply :: FormulaF q f r (b -> c) -> FormulaF q f r b -> (c -> a) -> FormulaF q f r a

@@ -54,13 +44,13 @@ mkApply f x h = Apply f x h

54mkSelectFirst :: [SomeFormulaF b] -> P.PathsPrefixTree q f r -> (b -> a) -> FormulaF q f r a

44mkSelectFirst :: [SomeFormulaF b] -> P.PathsPrefixTree q f r -> (b -> a) -> FormulaF q f r a

55mkSelectFirst fs allE h = case foldMap check fs of

45mkSelectFirst fs allE h = case foldMap check fs of

56 (First (Just x), _) -> Result (h x)

46 (First (Just x), _) -> Result (h x)

57− (First Nothing, x : xs) -> SelectFirst (x NE.:| xs) allE h

47+ (First Nothing, x:xs) -> SelectFirst (x NE.:| xs) allE h

58 (First Nothing, []) -> Errors allE

48 (First Nothing, []) -> Errors allE

59 where

49 where

60 check (SomeFormulaF (Result x)) = (First (Just x), mempty)

50 check (SomeFormulaF (Result x)) = (First (Just x), mempty)

61 check (SomeFormulaF (Errors _)) = (mempty, mempty)

51 check (SomeFormulaF (Errors _)) = (mempty, mempty)

62− check (SomeFormulaF (SelectFirst xs _ h')) =

52+ check (SomeFormulaF (SelectFirst xs _ h'))

63− (mempty, NE.toList (fmap (fmap h') xs))

53+ = (mempty, NE.toList (fmap (fmap h') xs))

64 check x = (mempty, [x])

54 check x = (mempty, [x])

65

55

66data SomeFormulaF (a :: Type) where

56data SomeFormulaF (a :: Type) where

@@ -106,7 +96,7 @@ calculate (Apply f x h) = case calculate f of

106 Right x' -> Right (h (f' x'))

96 Right x' -> Right (h (f' x'))

107calculate (SelectFirst xs e h) = go (NE.toList xs)

97calculate (SelectFirst xs e h) = go (NE.toList xs)

108 where

98 where

109− go (SomeFormulaF r : rs) = case calculate r of

99+ go (SomeFormulaF r:rs) = case calculate r of

110 Left _ -> go rs

100 Left _ -> go rs

111 Right x -> Right (h x)

101 Right x -> Right (h x)

112 go [] = Left e

102 go [] = Left e

src/Data/OpenApi/Compare/Memo.hs+66−104

@@ -1,24 +1,22 @@

1{-# LANGUAGE AllowAmbiguousTypes #-}

2−

3-- | Utilities for effectfully memoizing other, more effectful functions.

2-- | Utilities for effectfully memoizing other, more effectful functions.

4module Data.OpenApi.Compare.Memo

3module Data.OpenApi.Compare.Memo

5− ( MonadMemo,

4+ ( MonadMemo

6− MemoState,

5+ , MemoState

7− runMemo,

6+ , runMemo

8− modifyMemoNonce,

7+ , modifyMemoNonce

9− KnotTier (..),

8+ , KnotTier(..)

10− unknot,

9+ , unknot

11− memoWithKnot,

10+ , memoWithKnot

12− memoTaggedWithKnot,

11+ , memoTaggedWithKnot

13− )

14−where

12+ ) where

15

13

16import Control.Monad.State

14import Control.Monad.State

17import Data.Dynamic

15import Data.Dynamic

18import qualified Data.Map as M

16import qualified Data.Map as M

19import Data.Tagged

17import Data.Tagged

20−import qualified Data.TypeRepMap as T

21import Data.Void

18import Data.Void

19+import qualified Data.TypeRepMap as T

22import Type.Reflection

20import Type.Reflection

23

21

24data Progress a = Finished a | Started | TyingKnot Dynamic

22data Progress a = Finished a | Started | TyingKnot Dynamic

@@ -31,23 +29,16 @@ data MemoState s = MemoState s (T.TypeRepMap MemoMap)

31-- | An effectful memoization monad.

29-- | An effectful memoization monad.

32type MonadMemo s m = MonadState (MemoState s) m

30type MonadMemo s m = MonadState (MemoState s) m

33

31

34−memoStateLookup ::

32+memoStateLookup

35− forall k v s.

36− (Typeable k, Typeable v, Ord k) =>

33+ :: forall k v s. (Typeable k, Typeable v, Ord k)

37− k ->

38− MemoState s ->

39− Maybe (Progress v)

34+ => k -> MemoState s -> Maybe (Progress v)

40memoStateLookup k (MemoState _ t) = case T.lookup @(k, v) t of

35memoStateLookup k (MemoState _ t) = case T.lookup @(k, v) t of

41 Just (MemoMap m) -> M.lookup k m

36 Just (MemoMap m) -> M.lookup k m

42 Nothing -> Nothing

37 Nothing -> Nothing

43

38

44−memoStateInsert ::

39+memoStateInsert

45− forall k v s.

46− (Typeable k, Typeable v, Ord k) =>

40+ :: forall k v s. (Typeable k, Typeable v, Ord k)

47− k ->

48− Progress v ->

49− MemoState s ->

41+ => k -> Progress v -> MemoState s -> MemoState s

50− MemoState s

51memoStateInsert k x (MemoState s t) = MemoState s $ T.insert (MemoMap m'') t

42memoStateInsert k x (MemoState s t) = MemoState s $ T.insert (MemoMap m'') t

52 where

43 where

53 m'' = M.insert k x m'

44 m'' = M.insert k x m'

@@ -68,23 +59,19 @@ runMemo s = (`evalStateT` MemoState s T.empty)

68-- | A description of how to effectfully tie knots in type @v@, using the @m@

59-- | A description of how to effectfully tie knots in type @v@, using the @m@

69-- monad, and by sharing some @d@ data among the recursive instances.

60-- monad, and by sharing some @d@ data among the recursive instances.

70data KnotTier v d m = KnotTier

61data KnotTier v d m = KnotTier

71− { -- | Create some data that will be connected to this knot

62+ { onKnotFound :: m d -- ^ Create some data that will be connected to this knot

72− onKnotFound :: m d

73− , -- | This is what the knot will look like as a value

63+ , onKnotUsed :: d -> m v -- ^ This is what the knot will look like as a value

74 -- to the inner computations

64 -- to the inner computations

75− onKnotUsed :: d -> m v

76− , -- | Once we're done and we're outside, tie the

65+ , tieKnot :: d -> v -> m v -- ^ Once we're done and we're outside, tie the

77 -- knot using the datum

66 -- knot using the datum

78− tieKnot :: d -> v -> m v

79 }

67 }

80

68

81unknot :: KnotTier v Void m

69unknot :: KnotTier v Void m

82−unknot =

83− KnotTier

70+unknot = KnotTier

84− { onKnotFound = error "Recursion detected"

71+ { onKnotFound = error "Recursion detected"

85− , onKnotUsed = absurd

72+ , onKnotUsed = absurd

86− , tieKnot = absurd

73+ , tieKnot = absurd

87− }

74+ }

88

75

89-- | Run a potentially recursive computation. The provided key will be used to

76-- | Run a potentially recursive computation. The provided key will be used to

90-- refer to the result of this computation. If during the computation, another

77-- refer to the result of this computation. If during the computation, another

@@ -93,72 +80,47 @@ unknot =

93--

80--

94-- If another attempt to run the computation with the same key is made

81-- If another attempt to run the computation with the same key is made

95-- *after we're done*, we will return the memoized value.

82-- *after we're done*, we will return the memoized value.

96−memoWithKnot ::

83+memoWithKnot

97− forall k v d m s.

84+ :: forall k v d m s.

98− (Typeable k, Typeable v, Typeable d, Ord k, MonadMemo s m) =>

85+ (Typeable k, Typeable v, Typeable d, Ord k, MonadMemo s m)

99− KnotTier v d m ->

86+ => KnotTier v d m

100− -- | the computation to memoize

87+ -> m v -- ^ the computation to memoize

101− m v ->

102− -- | key for memoization

88+ -> k -- ^ key for memoization

103− k ->

104− m v

89+ -> m v

105−memoWithKnot tier f k =

106− memoStateLookup @k @v k <$> get >>= \case

90+memoWithKnot tier f k = memoStateLookup @k @v k <$> get >>= \case

107− Just (Finished v) -> pure v

91+ Just (Finished v) -> pure v

108− Just Started -> do

92+ Just Started -> do

109− d <- onKnotFound tier

93+ d <- onKnotFound tier

110− modify $ memoStateInsert @k @v k (TyingKnot $ toDyn d)

94+ modify $ memoStateInsert @k @v k (TyingKnot $ toDyn d)

111− onKnotUsed tier d

95+ onKnotUsed tier d

112− Just (TyingKnot dyn) -> case fromDynamic dyn of

96+ Just (TyingKnot dyn) -> case fromDynamic dyn of

113− Just d -> onKnotUsed tier d

97+ Just d -> onKnotUsed tier d

114− Nothing ->

115− error $

116− "Type mismatch when examining the knot of "

98+ Nothing -> error $ "Type mismatch when examining the knot of "

117− <> show (typeRep @(k -> v))

99+ <> show (typeRep @(k -> v)) <> ": expected " <> show (typeRep @d)

118− <> ": expected "

119− <> show (typeRep @d)

120− <> ", got "

121− <> show (dynTypeRep dyn)

100+ <> ", got " <> show (dynTypeRep dyn)

122− Nothing -> do

101+ Nothing -> do

123− modify $ memoStateInsert @k @v k Started

102+ modify $ memoStateInsert @k @v k Started

124− v <- f

103+ v <- f

125− v' <-

126− memoStateLookup @k @v k <$> get >>= \case

104+ v' <- memoStateLookup @k @v k <$> get >>= \case

127− Just Started -> pure v

105+ Just Started -> pure v

128− Just (TyingKnot dyn) -> case fromDynamic dyn of

106+ Just (TyingKnot dyn) -> case fromDynamic dyn of

129− Just d -> tieKnot tier d v

107+ Just d -> tieKnot tier d v

130− Nothing ->

131− error $

132− "Type mismatch when tying the knot of "

108+ Nothing -> error $ "Type mismatch when tying the knot of "

133− <> show (typeRep @(k -> v))

109+ <> show (typeRep @(k -> v)) <> ": expected " <> show (typeRep @d)

134− <> ": expected "

135− <> show (typeRep @d)

136− <> ", got "

137− <> show (dynTypeRep dyn)

110+ <> ", got " <> show (dynTypeRep dyn)

138− Just (Finished _) ->

139− error $

140− "Unexpected Finished when memoizing "

111+ Just (Finished _) -> error $ "Unexpected Finished when memoizing "

141− <> show (typeRep @(k -> v))

112+ <> show (typeRep @(k -> v))

142− Nothing -> pure v

113+ Nothing -> pure v

143− -- Normally this would be an error, but the underlying monad can refuse

114+ -- Normally this would be an error, but the underlying monad can refuse

144− -- to remember memoization state

115+ -- to remember memoization state

145− modify $ memoStateInsert @k @v k (Finished v')

116+ modify $ memoStateInsert @k @v k (Finished v')

146− pure v'

117+ pure v'

147

118

148-- | Disambiguate memoized computations with an arbitrary tag.

119-- | Disambiguate memoized computations with an arbitrary tag.

149−memoTaggedWithKnot ::

120+memoTaggedWithKnot

150− forall t k v d m s.

121+ :: forall t k v d m s.

151− ( Typeable t

122+ ( Typeable t, Typeable k, Typeable v, Typeable d

152− , Typeable k

153− , Typeable v

154− , Typeable d

155− , Ord k

156− , MonadMemo s m

123+ , Ord k, MonadMemo s m )

157− ) =>

158− KnotTier v d m ->

124+ => KnotTier v d m -> m v -> k -> m v

159− m v ->

160− k ->

161− m v

162−memoTaggedWithKnot tier f k =

163− withTypeable (typeRepKind $ typeRep @t) $

125+memoTaggedWithKnot tier f k = withTypeable (typeRepKind $ typeRep @t) $

164− memoWithKnot tier f (Tagged @t k)

126+ memoWithKnot tier f (Tagged @t k)

src/Data/OpenApi/Compare/Paths.hs+9−9

@@ -2,17 +2,17 @@

2-- collection of datatypes that "contain" eachother in some form of tree

3-- structure.

4module Data.OpenApi.Compare.Paths

5− ( NiceQuiver,

5+ ( NiceQuiver

6− AdditionalQuiverConstraints,

6+ , AdditionalQuiverConstraints

7− Paths (..),

7+ , Paths (..)

8− DiffPaths (..),

8+ , DiffPaths (..)

9− catDiffPaths,

9+ , catDiffPaths

10− AnItem (..),

10+ , AnItem (..)

11− step,

11+ , step

12

13 -- * Reexports

14− (>>>),

14+ , (>>>)

15− (<<<),

15+ , (<<<)

16 )

17where

18

src/Data/OpenApi/Compare/PathsPrefixTree.hs+41−42

@@ -1,30 +1,29 @@

1{-# LANGUAGE QuantifiedConstraints #-}

2

3module Data.OpenApi.Compare.PathsPrefixTree

4− ( PathsPrefixTree (PathsPrefixNode),

4+ ( PathsPrefixTree (PathsPrefixNode)

5− AStep (..),

5+ , AStep (..)

6− empty,

6+ , empty

7− singleton,

7+ , singleton

8− fromList,

8+ , fromList

9− null,

9+ , null

10− foldWith,

10+ , foldWith

11− toList,

11+ , toList

12− filter,

12+ , filter

13− filterWithKey,

13+ , filterWithKey

14− takeSubtree,

14+ , takeSubtree

15− lookup,

15+ , lookup

16− embed,

16+ , embed

17− size,

17+ , size

18− partition,

18+ , partition

19− map,

19+ , map

20 )

21where

22

23import Control.Monad

24import Data.Aeson

25import Data.Foldable hiding (null, toList)

26−import qualified Data.Aeson.Key as Key

26+import qualified Data.HashMap.Strict as HM

27−import qualified Data.Aeson.KeyMap as KeyMap

28import Data.Kind

27import Data.Kind

29import qualified Data.Map as M

28import qualified Data.Map as M

30import Data.Monoid

29import Data.Monoid

@@ -36,7 +35,7 @@ import qualified Data.TypeRepMap as TRM

36import qualified Data.Vector as V

35import qualified Data.Vector as V

37import qualified GHC.Exts as Exts

36import qualified GHC.Exts as Exts

38import Type.Reflection

37import Type.Reflection

39−import Prelude hiding (filter, lookup, map, null)

38+import Prelude hiding (filter, map, null, lookup)

40

39

41-- | A list of @AnItem r f@, but optimized into a prefix tree.

40-- | A list of @AnItem r f@, but optimized into a prefix tree.

42data PathsPrefixTree (q :: k -> k -> Type) (f :: k -> Type) (r :: k) = PathsPrefixTree

41data PathsPrefixTree (q :: k -> k -> Type) (f :: k -> Type) (r :: k) = PathsPrefixTree

@@ -103,11 +102,11 @@ deriving stock instance Eq (PathsPrefixTree q f a)

103

102

104-- Kind of orphan. Treat the map as an infinite tuple of @Maybe (f a)@'s, where

103-- Kind of orphan. Treat the map as an infinite tuple of @Maybe (f a)@'s, where

105-- the components are ordered by the @SomeTypeRep@ of the @a@.

104-- the components are ordered by the @SomeTypeRep@ of the @a@.

106−compareTRM ::

105+compareTRM

107− (forall a. Typeable a => Ord (f a)) =>

106+ :: (forall a. Typeable a => Ord (f a))

108− TRM.TypeRepMap f ->

107+ => TRM.TypeRepMap f

109− TRM.TypeRepMap f ->

108+ -> TRM.TypeRepMap f

110− Ordering

109+ -> Ordering

111compareTRM s1 s2 =

110compareTRM s1 s2 =

112 foldMap (\k -> compareMaybe compareW (M.lookup k m1) (M.lookup k m2)) mKeys

111 foldMap (\k -> compareMaybe compareW (M.lookup k m1) (M.lookup k m2)) mKeys

113 where

112 where

@@ -117,11 +116,11 @@ compareTRM s1 s2 =

117 compareMaybe _ Nothing (Just _) = LT

116 compareMaybe _ Nothing (Just _) = LT

118 compareMaybe _ (Just _) Nothing = GT

117 compareMaybe _ (Just _) Nothing = GT

119 compareMaybe cmp (Just x) (Just y) = cmp x y

118 compareMaybe cmp (Just x) (Just y) = cmp x y

120− compareW ::

119+ compareW

121− (forall a. Typeable a => Ord (f a)) =>

120+ :: (forall a. Typeable a => Ord (f a))

122− TRM.WrapTypeable f ->

121+ => TRM.WrapTypeable f

123− TRM.WrapTypeable f ->

122+ -> TRM.WrapTypeable f

124− Ordering

123+ -> Ordering

125 compareW (TRM.WrapTypeable (x :: f a)) (TRM.WrapTypeable (y :: f b))

124 compareW (TRM.WrapTypeable (x :: f a)) (TRM.WrapTypeable (y :: f b))

126 | Just Refl <- testEquality (typeRep @a) (typeRep @b) = compare x y

125 | Just Refl <- testEquality (typeRep @a) (typeRep @b) = compare x y

127 | otherwise = EQ -- unreachable

126 | otherwise = EQ -- unreachable

@@ -173,10 +172,10 @@ instance Monoid (ASet a) where

173 mempty = AnEmptySet

172 mempty = AnEmptySet

174

173

175data AStep (q :: k -> k -> Type) (f :: k -> Type) (r :: k) (a :: k) where

174data AStep (q :: k -> k -> Type) (f :: k -> Type) (r :: k) (a :: k) where

176− AStep ::

175+ AStep

177− NiceQuiver q r a =>

176+ :: NiceQuiver q r a =>

178− !(M.Map (q r a) (PathsPrefixTree q f a)) ->

177+ !(M.Map (q r a) (PathsPrefixTree q f a))

179− AStep q f r a

178+ -> AStep q f r a

180

179

181mapAStep :: (forall x. f x -> f x) -> AStep q f r a -> AStep q f r a

180mapAStep :: (forall x. f x -> f x) -> AStep q f r a -> AStep q f r a

182mapAStep f (AStep m) = AStep $ M.map (map f) m

181mapAStep f (AStep m) = AStep $ M.map (map f) m

@@ -216,12 +215,12 @@ null :: PathsPrefixTree q f r -> Bool

216null (PathsPrefixTree AnEmptySet s) = all (\(TRM.WrapTypeable (AStep x)) -> all null x) (Exts.toList s)

215null (PathsPrefixTree AnEmptySet s) = all (\(TRM.WrapTypeable (AStep x)) -> all null x) (Exts.toList s)

217null _ = False

216null _ = False

218

217

219−foldWith ::

218+foldWith

220− forall q f m r.

219+ :: forall q f m r.

221− Monoid m =>

220+ Monoid m

222− (forall a. Ord (f a) => Paths q r a -> f a -> m) ->

221+ => (forall a. Ord (f a) => Paths q r a -> f a -> m)

223− PathsPrefixTree q f r ->

222+ -> PathsPrefixTree q f r

224− m

223+ -> m

225foldWith k = goTPT Root

224foldWith k = goTPT Root

226 where

225 where

227 goTPT :: forall a. Paths q r a -> PathsPrefixTree q f a -> m

226 goTPT :: forall a. Paths q r a -> PathsPrefixTree q f a -> m

@@ -257,7 +256,7 @@ newtype MergableObject = MergableObject {getMergableObject :: Object}

257

256

258instance Semigroup MergableObject where

257instance Semigroup MergableObject where

259 (MergableObject x) <> (MergableObject y) =

258 (MergableObject x) <> (MergableObject y) =

260− MergableObject $ KeyMap.unionWith mergeValue x y

259+ MergableObject $ HM.unionWith mergeValue x y

261 where

260 where

262 mergeValue :: Value -> Value -> Value

261 mergeValue :: Value -> Value -> Value

263 mergeValue (Object a) (Object b) =

262 mergeValue (Object a) (Object b) =

@@ -272,6 +271,6 @@ instance Monoid MergableObject where

272

271

273traceObject :: Paths q r a -> Value -> Object

272traceObject :: Paths q r a -> Value -> Object

274traceObject Root (Object o) = o

273traceObject Root (Object o) = o

275−traceObject Root v = KeyMap.singleton "root" v

274+traceObject Root v = HM.singleton "root" v

276traceObject (root `Snoc` s) v =

275traceObject (root `Snoc` s) v =

277− traceObject root . Object $ KeyMap.singleton (Key.fromText . T.pack . show $ s) v

276+ traceObject root . Object $ HM.singleton (T.pack . show $ s) v

src/Data/OpenApi/Compare/References.hs+9−8

@@ -1,9 +1,9 @@

1{-# OPTIONS_GHC -Wno-orphans #-}

2

3module Data.OpenApi.Compare.References

4− ( Step (..),

4+ ( Step (..)

5− dereference,

5+ , dereference

6− Typeable,

6+ , Typeable

7 )

8where

9

@@ -13,16 +13,17 @@ import Data.Maybe

13import Data.OpenApi

14import Data.OpenApi.Compare.Orphans ()

15import Data.OpenApi.Compare.Subtree

16+import Data.Typeable

16

17

17instance Typeable a => Steppable (Referenced a) a where

18instance Typeable a => Steppable (Referenced a) a where

18 data Step (Referenced a) a = InlineStep

19 data Step (Referenced a) a = InlineStep

19 deriving stock (Eq, Ord, Show)

20 deriving stock (Eq, Ord, Show)

20

21

21−dereference ::

22+dereference

22− Typeable a =>

23+ :: Typeable a

23− Traced (Definitions a) ->

24+ => Traced (Definitions a)

24− Traced (Referenced a) ->

25+ -> Traced (Referenced a)

25− Traced a

26+ -> Traced a

26dereference defs x = case extract x of

27dereference defs x = case extract x of

27 Inline a ->

28 Inline a ->

28 traced (ask x >>> step InlineStep) a

29 traced (ask x >>> step InlineStep) a

src/Data/OpenApi/Compare/Report.hs+119−139

@@ -1,13 +1,13 @@

1module Data.OpenApi.Compare.Report

2− ( generateReport,

2+ ( generateReport

3− CheckerOutput (..),

3+ , CheckerOutput(..)

4− ReportInput (..),

4+ , ReportInput (..)

5− segregateIssues,

5+ , segregateIssues

6− ReportStatus (..),

6+ , ReportStatus (..)

7− Pandoc,

7+ , Pandoc

8− ReportConfig (..),

8+ , ReportConfig (..)

9− ReportTreeStyle (..),

9+ , ReportTreeStyle (..)

10− ReportMode (..),

10+ , ReportMode (..)

11 )

12where

13

@@ -30,8 +30,8 @@ import qualified Data.OpenApi.Compare.PathsPrefixTree as P hiding (empty)

30import Data.OpenApi.Compare.Report.Jet

31import Data.OpenApi.Compare.Subtree (invertIssueOrientationP)

32import Data.OpenApi.Compare.Validate.OpenApi

33−import Data.OpenApi.Compare.Validate.Schema.Issues

34import Data.OpenApi.Compare.Validate.Schema.TypedJson

33import Data.OpenApi.Compare.Validate.Schema.TypedJson

34+import Data.OpenApi.Compare.Validate.Schema.Issues

35import Data.OpenUnion

36import Data.OpenUnion.Extra

37import Data.Set

@@ -54,27 +54,22 @@ data CheckerOutput = CheckerOutput

54 deriving anyclass (ToJSON)

55

56data ReportInput = ReportInput

57− { -- | forward 'CertainIssue', 'ProbablyIssue' and 'Comment'

58− breakingChanges :: Changes

57+ { breakingChanges :: Changes -- ^ forward 'CertainIssue', 'ProbablyIssue' and 'Comment'

59− , -- | backward 'CertainIssue', 'ProbablyIssue' and 'Comment', except those shadowed by 'relatedIssues'

58+ , nonBreakingChanges :: Changes -- ^ backward 'CertainIssue', 'ProbablyIssue' and 'Comment', except those shadowed by 'relatedIssues'

60− nonBreakingChanges :: Changes

61− , -- | forward and backward 'Unsupported' (assumed to be the same anyway)

59+ , unsupportedChanges :: Changes -- ^ forward and backward 'Unsupported' (assumed to be the same anyway)

62− unsupportedChanges :: Changes

63− , -- | forward and backward 'SchemaInvalid' (assumed to be the same anyway)

64− schemaIssues :: Changes

60+ , schemaIssues :: Changes -- ^ forward and backward 'SchemaInvalid' (assumed to be the same anyway)

65 }

61 }

66 deriving stock (Generic)

62 deriving stock (Generic)

67 deriving (Semigroup, Monoid) via (Generically ReportInput)

63 deriving (Semigroup, Monoid) via (Generically ReportInput)

68 deriving anyclass (ToJSON)

64 deriving anyclass (ToJSON)

69

65

70segregateIssues :: CheckerOutput -> ReportInput

66segregateIssues :: CheckerOutput -> ReportInput

71−segregateIssues CheckerOutput {forwardChanges = fwd, backwardChanges = bck} =

67+segregateIssues CheckerOutput {forwardChanges = fwd, backwardChanges = bck} = ReportInput

72− ReportInput

73− { breakingChanges = P.filter isBreaking fwd

68+ { breakingChanges = P.filter isBreaking fwd

74− , nonBreakingChanges = invertIssueOrientationP $ P.filterWithKey isNonBreaking bck

69+ , nonBreakingChanges = invertIssueOrientationP $ P.filterWithKey isNonBreaking bck

75− , unsupportedChanges = P.filter isUnsupported fwd <> P.filter isUnsupported bck

70+ , unsupportedChanges = P.filter isUnsupported fwd <> P.filter isUnsupported bck

76− , schemaIssues = P.filter isSchemaIssue fwd <> P.filter isSchemaIssue bck

71+ , schemaIssues = P.filter isSchemaIssue fwd <> P.filter isSchemaIssue bck

77− }

72+ }

78 where

73 where

79 isBreaking i = anIssueKind i `elem` [CertainIssue, ProbablyIssue, Comment]

74 isBreaking i = anIssueKind i `elem` [CertainIssue, ProbablyIssue, Comment]

80 isNonBreaking :: Paths Behave 'APILevel a -> AnIssue a -> Bool

75 isNonBreaking :: Paths Behave 'APILevel a -> AnIssue a -> Bool

@@ -111,7 +106,8 @@ twoRowTable x = simpleTable (para . fst <$> x) [para . snd <$> x]

111

106

112generateReport :: ReportConfig -> ReportInput -> (Blocks, ReportStatus)

107generateReport :: ReportConfig -> ReportInput -> (Blocks, ReportStatus)

113generateReport cfg inp =

108generateReport cfg inp =

109+ let

114− let schemaIssuesPresent = not $ P.null $ schemaIssues inp

110+ schemaIssuesPresent = not $ P.null $ schemaIssues inp

115 breakingChangesPresent = not $ P.null $ breakingChanges inp

111 breakingChangesPresent = not $ P.null $ breakingChanges inp

116 nonBreakingChangesPresent = not $ P.null $ nonBreakingChanges inp

112 nonBreakingChangesPresent = not $ P.null $ nonBreakingChanges inp

117 unsupportedChangesPresent = not $ P.null $ unsupportedChanges inp

113 unsupportedChangesPresent = not $ P.null $ unsupportedChanges inp

@@ -120,55 +116,47 @@ generateReport cfg inp =

120 OnlyErrors -> False

116 OnlyErrors -> False

121 builder = buildReport cfg

117 builder = buildReport cfg

122 report =

118 report =

123− header 1 "Summary"

119+ header 1 "Summary"

124− <> twoRowTable

120+ <> twoRowTable

125− ( when'

121+ (when'

126− schemaIssuesPresent

122+ schemaIssuesPresent

127− [

128− ( refOpt schemaIssuesPresent schemaIssuesId "‼️ Schema issues"

123+ [ ( refOpt schemaIssuesPresent schemaIssuesId "‼️ Schema issues"

129− , show' $ P.size $ schemaIssues inp

124+ , show' $ P.size $ schemaIssues inp

130− )

125+ )

131− ]

126+ ]

132− ++ [

127+ ++

133− ( refOpt breakingChangesPresent breakingChangesId "❌ Breaking changes"

128+ [ ( refOpt breakingChangesPresent breakingChangesId "❌ Breaking changes"

134 , show' $ P.size $ breakingChanges inp

129 , show' $ P.size $ breakingChanges inp

135 )

130 )

136 ]

131 ]

137− ++ when'

132+ ++ when'

138− nonBreakingChangesShown

133+ nonBreakingChangesShown

139− [

140− ( refOpt nonBreakingChangesPresent nonBreakingChangesId "⚠️ Non-breaking changes"

134+ [ ( refOpt nonBreakingChangesPresent nonBreakingChangesId "⚠️ Non-breaking changes"

141− , show' $ P.size $ nonBreakingChanges inp

135+ , show' $ P.size $ nonBreakingChanges inp

142− )

136+ )

143− ]

137+ ]

144− ++ when'

138+ ++ when'

145− unsupportedChangesPresent

139+ unsupportedChangesPresent

146− [

147− ( refOpt unsupportedChangesPresent unsupportedChangesId "❓ Unsupported feature changes"

140+ [ ( refOpt unsupportedChangesPresent unsupportedChangesId "❓ Unsupported feature changes"

148− , show' $ P.size $ unsupportedChanges inp

141+ , show' $ P.size $ unsupportedChanges inp

149− )

142+ )

150− ]

143+ ])

151− )

152− <> when'

144+ <> when'

153− schemaIssuesPresent

145+ schemaIssuesPresent

154− ( header 1 (anchor schemaIssuesId <> "‼️ Schema issues")

146+ (header 1 (anchor schemaIssuesId <> "‼️ Schema issues")

155− <> builder (showErrs $ schemaIssues inp)

147+ <> builder (showErrs $ schemaIssues inp))

156− )

157− <> when'

148+ <> when'

158− breakingChangesPresent

149+ breakingChangesPresent

159− ( header 1 (anchor breakingChangesId <> "❌ Breaking changes")

150+ (header 1 (anchor breakingChangesId <> "❌ Breaking changes")

160− <> builder (showErrs $ breakingChanges inp)

151+ <> builder (showErrs $ breakingChanges inp))

161− )

162− <> when'

152+ <> when'

163− (nonBreakingChangesPresent && nonBreakingChangesShown)

153+ (nonBreakingChangesPresent && nonBreakingChangesShown)

164− ( header 1 (anchor nonBreakingChangesId <> "⚠️ Non-breaking changes")

154+ (header 1 (anchor nonBreakingChangesId <> "⚠️ Non-breaking changes")

165− <> builder (showErrs $ nonBreakingChanges inp)

155+ <> builder (showErrs $ nonBreakingChanges inp))

166− )

167− <> when'

156+ <> when'

168− unsupportedChangesPresent

157+ unsupportedChangesPresent

169− ( header 1 (anchor unsupportedChangesId <> "❓ Unsupported feature changes")

158+ (header 1 (anchor unsupportedChangesId <> "❓ Unsupported feature changes")

170− <> builder (showErrs $ unsupportedChanges inp)

159+ <> builder (showErrs $ unsupportedChanges inp))

171− )

172 status =

160 status =

173 if

161 if

174 | breakingChangesPresent -> BreakingChanges

162 | breakingChangesPresent -> BreakingChanges

@@ -202,10 +190,9 @@ showErrs x@(P.PathsPrefixNode currentIssues _) =

202 Just Refl

190 Just Refl

203 | (S.toList -> p@((AnIssue ori _) : _), o) <-

191 | (S.toList -> p@((AnIssue ori _) : _), o) <-

204 S.partition

192 S.partition

205− ( \((AnIssue _ u)) -> case u of

193+ (\((AnIssue _ u)) -> case u of

206− NoPathsMatched {} -> True

194+ NoPathsMatched {} -> True

207− AllPathsFailed {} -> True

195+ AllPathsFailed {} -> True)

208− )

209 currentIssues ->

196 currentIssues ->

210 let p' = p <&> (\(AnIssue _ i) -> i)

197 let p' = p <&> (\(AnIssue _ i) -> i)

211 in (Just (ori, p'), o)

198 in (Just (ori, p'), o)

@@ -216,10 +203,9 @@ showErrs x@(P.PathsPrefixNode currentIssues _) =

216 paths = case removedPaths of

203 paths = case removedPaths of

217 Just (ori, ps) -> do

204 Just (ori, ps) -> do

218 singletonHeader

205 singletonHeader

219− ( case ori of

206+ (case ori of

220− Forward -> "Removed paths"

207+ Forward -> "Removed paths"

221− Backward -> "Added paths"

208+ Backward -> "Added paths")

222− )

223 $ singletonBody $

209 $ singletonBody $

224 bulletList $

210 bulletList $

225 ps <&> \case

211 ps <&> \case

@@ -263,54 +249,52 @@ jets =

263 unwrapReportJetResult (Pure _) = error "There really shouldn't be any results here."

249 unwrapReportJetResult (Pure _) = error "There really shouldn't be any results here."

264 unwrapReportJetResult (Free f) = f

250 unwrapReportJetResult (Free f) = f

265

251

266− jsonPathJet ::

252+ jsonPathJet

267− NonEmpty

253+ :: NonEmpty

268− ( Union

254+ ( Union

269− '[ Behave 'SchemaLevel 'TypedSchemaLevel

255+ '[ Behave 'SchemaLevel 'TypedSchemaLevel

270− , Behave 'TypedSchemaLevel 'SchemaLevel

256+ , Behave 'TypedSchemaLevel 'SchemaLevel

271− ]

257+ ]

272− ) ->

258+ )

273− Inlines

259+ -> Inlines

274 jsonPathJet x = code $ "$" <> showParts (NE.toList x)

260 jsonPathJet x = code $ "$" <> showParts (NE.toList x)

275 where

261 where

276− showParts ::

262+ showParts

277− [ Union

263+ :: [ Union

278− '[ Behave 'SchemaLevel 'TypedSchemaLevel

264+ '[ Behave 'SchemaLevel 'TypedSchemaLevel

279− , Behave 'TypedSchemaLevel 'SchemaLevel

265+ , Behave 'TypedSchemaLevel 'SchemaLevel

280− ]

266+ ]

281− ] ->

267+ ]

282− Text

268+ -> Text

283 showParts [] = mempty

269 showParts [] = mempty

284 showParts (SingletonUnion (OfType Object) : xs@((SingletonUnion (InProperty _)) : _)) = showParts xs

270 showParts (SingletonUnion (OfType Object) : xs@((SingletonUnion (InProperty _)) : _)) = showParts xs

285 showParts (SingletonUnion (OfType Object) : xs@((SingletonUnion InAdditionalProperty) : _)) = showParts xs

271 showParts (SingletonUnion (OfType Object) : xs@((SingletonUnion InAdditionalProperty) : _)) = showParts xs

286 showParts (SingletonUnion (OfType Array) : xs@(SingletonUnion InItems : _)) = showParts xs

272 showParts (SingletonUnion (OfType Array) : xs@(SingletonUnion InItems : _)) = showParts xs

287 showParts (SingletonUnion (OfType Array) : xs@(SingletonUnion (InItem _) : _)) = showParts xs

273 showParts (SingletonUnion (OfType Array) : xs@(SingletonUnion (InItem _) : _)) = showParts xs

288 showParts (y : ys) =

274 showParts (y : ys) =

289− ( (\(OfType t) -> "(" <> describeJSONType t <> ")")

275+ ((\(OfType t) -> "(" <> describeJSONType t <> ")")

290− @@> ( \case

276+ @@> (\case

291− InItems -> "[*]"

277+ InItems -> "[*]"

292− InItem i -> "[" <> T.pack (show i) <> "]"

278+ InItem i -> "[" <> T.pack (show i) <> "]"

293− InProperty p -> "." <> p

279+ InProperty p -> "." <> p

294− InAdditionalProperty -> ".*"

280+ InAdditionalProperty -> ".*")

295− )

296− @@> typesExhausted

281+ @@> typesExhausted)

297− )

298 y

282 y

299 <> showParts ys

283 <> showParts ys

300

284

301−observeJetShowErrs ::

285+observeJetShowErrs

302− ReportJet' Behave (Maybe Inlines) ->

286+ :: ReportJet' Behave (Maybe Inlines)

303− P.PathsPrefixTree Behave AnIssue a ->

287+ -> P.PathsPrefixTree Behave AnIssue a

304− (Report, P.PathsPrefixTree Behave AnIssue a)

288+ -> (Report, P.PathsPrefixTree Behave AnIssue a)

305observeJetShowErrs jet p = case observeJetShowErrs' jet p of

289observeJetShowErrs jet p = case observeJetShowErrs' jet p of

306 Just m -> m

290 Just m -> m

307 Nothing -> (mempty, p)

291 Nothing -> (mempty, p)

308

292

309−observeJetShowErrs' ::

293+observeJetShowErrs'

310− forall a.

294+ :: forall a.

311− ReportJet' Behave (Maybe Inlines) ->

295+ ReportJet' Behave (Maybe Inlines)

312− P.PathsPrefixTree Behave AnIssue a ->

296+ -> P.PathsPrefixTree Behave AnIssue a

313− Maybe (Report, P.PathsPrefixTree Behave AnIssue a)

297+ -> Maybe (Report, P.PathsPrefixTree Behave AnIssue a)

314observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues) =

298observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues) =

315 let results =

299 let results =

316 subIssues >>= \(WrapTypeable (AStep m)) ->

300 subIssues >>= \(WrapTypeable (AStep m)) ->

@@ -318,23 +302,21 @@ observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues)

318 maybe (Left $ embed (step bhv) subErrs) Right . listToMaybe $

302 maybe (Left $ embed (step bhv) subErrs) Right . listToMaybe $

319 jet @_ @_ @[] bhv

303 jet @_ @_ @[] bhv

320 & mapMaybe

304 & mapMaybe

321− ( \case

305+ (\case

322− Free jet' -> fmap (embed $ step bhv) <$> observeJetShowErrs' jet' subErrs

306+ Free jet' -> fmap (embed $ step bhv) <$> observeJetShowErrs' jet' subErrs

323− Pure (Just h) ->

307+ Pure (Just h) ->

324− if P.null subErrs

308+ if P.null subErrs

325− then Just mempty

309+ then Just mempty

326− else Just (singletonHeader h (showErrs subErrs), mempty)

310+ else Just (singletonHeader h (showErrs subErrs), mempty)

327− Pure Nothing -> Nothing

311+ Pure Nothing -> Nothing)

328− )

329 in (fmap . fmap) (PathsPrefixNode currentIssues mempty <>) $

312 in (fmap . fmap) (PathsPrefixNode currentIssues mempty <>) $

330 if any isRight results

313 if any isRight results

331 then

314 then

332 Just $

315 Just $

333 foldMap

316 foldMap

334− ( \case

317+ (\case

335− Left e -> (mempty, e)

318+ Left e -> (mempty, e)

336− Right m -> m

319+ Right m -> m)

337− )

338 results

320 results

339 else Nothing

321 else Nothing

340

322

@@ -357,9 +339,8 @@ buildReport cfg = case treeStyle cfg of

357 body rprt

339 body rprt

358 <> foldOMapWithKey

340 <> foldOMapWithKey

359 (headers rprt)

341 (headers rprt)

360− ( \k v ->

342+ (\k v ->

361− header level k <> subBuilder v

343+ header level k <> subBuilder v)

362− )

363 where

344 where

364 subBuilder = headerStyleBuilder (level + 1)

345 subBuilder = headerStyleBuilder (level + 1)

365

346

@@ -368,17 +349,16 @@ buildReport cfg = case treeStyle cfg of

368 body rprt

349 body rprt

369 <> foldOMapWithKey

350 <> foldOMapWithKey

370 (headers rprt)

351 (headers rprt)

371− ( \k v ->

352+ (\k v ->

372− if (OM.size . headers $ rprt) < 2

353+ if (OM.size . headers $ rprt) < 2

373− then para k <> blockQuote (subBuilder v)

354+ then para k <> blockQuote (subBuilder v)

374− else

355+ else

375− rawHtml "<details>"

356+ rawHtml "<details>"

376− <> rawHtml "<summary>"

357+ <> rawHtml "<summary>"

377− <> plain k

358+ <> plain k

378− <> rawHtml "</summary>"

359+ <> rawHtml "</summary>"

379− <> blockQuote (subBuilder v)

360+ <> blockQuote (subBuilder v)

380− <> rawHtml "</details>"

361+ <> rawHtml "</details>")

381− )

382 where

362 where

383 subBuilder = foldingStyleBuilder

363 subBuilder = foldingStyleBuilder

384

364

src/Data/OpenApi/Compare/Report/Html/Template.hs+2−2

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

1{-# LANGUAGE TemplateHaskell #-}

2

3module Data.OpenApi.Compare.Report.Html.Template

4− ( template,

4+ ( template

5 )

6where

7

@@ -36,4 +36,4 @@ template =

36 \</html>"

37

38awsmCss :: ByteString

39−awsmCss = $(makeRelativeToProject "css/awsm.min.css" >>= embedFile)

39+awsmCss = $(makeRelativeToProject "awsm-css/dist/awsm.min.css" >>= embedFile)

src/Data/OpenApi/Compare/Report/Jet.hs+4−4

@@ -1,8 +1,8 @@

1module Data.OpenApi.Compare.Report.Jet

2− ( ReportJet (..),

2+ ( ReportJet (..)

3− ReportJet',

3+ , ReportJet'

4− ConstructReportJet (..),

4+ , ConstructReportJet (..)

5− ReportJetResult,

5+ , ReportJetResult

6 )

7where

8

src/Data/OpenApi/Compare/Run.hs+4−4

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

1module Data.OpenApi.Compare.Run

2− ( runChecker,

2+ ( runChecker

3− runReport,

3+ , runReport

4− module Data.OpenApi.Compare.Report,

4+ , module Data.OpenApi.Compare.Report

5 )

6where

7

8import Data.HList

9import Data.OpenApi (OpenApi)

10+import Text.Pandoc.Builder

10import Data.OpenApi.Compare.Paths

11import Data.OpenApi.Compare.Paths

11import Data.OpenApi.Compare.Report

12import Data.OpenApi.Compare.Report

12import Data.OpenApi.Compare.Subtree

13import Data.OpenApi.Compare.Subtree

13import Data.OpenApi.Compare.Validate.OpenApi ()

14import Data.OpenApi.Compare.Validate.OpenApi ()

14−import Text.Pandoc.Builder

15

16runChecker :: (OpenApi, OpenApi) -> CheckerOutput

17runChecker (client, server) =

src/Data/OpenApi/Compare/Subtree.hs+120−122

@@ -1,52 +1,52 @@

1{-# OPTIONS_GHC -Wno-orphans #-}

2

3module Data.OpenApi.Compare.Subtree

4− ( Steppable (..),

4+ ( Steppable (..)

5− Step (..),

5+ , Step (..)

6− TraceRoot,

6+ , TraceRoot

7− Trace,

7+ , Trace

8− Traced,

8+ , Traced

9− Traced',

9+ , Traced'

10− pattern Traced,

10+ , pattern Traced

11− traced,

11+ , traced

12− retraced,

12+ , retraced

13− stepTraced,

13+ , stepTraced

14− Subtree (..),

14+ , Subtree (..)

15− checkCompatibility,

15+ , checkCompatibility

16− checkSubstructure,

16+ , checkSubstructure

17− CompatM (..),

17+ , CompatM (..)

18− CompatFormula',

18+ , CompatFormula'

19− SemanticCompatFormula,

19+ , SemanticCompatFormula

20− ProdCons (..),

20+ , ProdCons (..)

21− orientProdCons,

21+ , orientProdCons

22− swapProdCons,

22+ , swapProdCons

23− runCompatFormula,

23+ , runCompatFormula

24− issueAt,

24+ , issueAt

25− anItem,

25+ , anItem

26− anIssue,

26+ , anIssue

27− invertIssueOrientation,

27+ , invertIssueOrientation

28− invertIssueOrientationP,

28+ , invertIssueOrientationP

29− embedFormula,

29+ , embedFormula

30− anyOfAt,

30+ , anyOfAt

31− clarifyIssue,

31+ , clarifyIssue

32− structuralIssue,

32+ , structuralIssue

33

34 -- * Structural helpers

35− structuralMaybe,

35+ , structuralMaybe

36− structuralMaybeWith,

36+ , structuralMaybeWith

37− structuralEq,

37+ , structuralEq

38− iohmStructural,

38+ , iohmStructural

39− iohmStructuralWith,

39+ , iohmStructuralWith

40− structuralList,

40+ , structuralList

41

42 -- * Reexports

43− (>>>),

43+ , (>>>)

44− (<<<),

44+ , (<<<)

45− extract,

45+ , extract

46− ask,

46+ , ask

47− local,

47+ , local

48− step,

48+ , step

49− Typeable,

49+ , Typeable

50 )

51where

52

@@ -115,10 +115,10 @@ orientProdCons :: Orientation -> ProdCons x -> ProdCons x

115orientProdCons Forward x = x

116orientProdCons Backward (ProdCons p c) = ProdCons c p

117

118−swapProdCons ::

118+swapProdCons

119− SwapEnvRoles xs =>

119+ :: SwapEnvRoles xs

120− (HList xs -> ProdCons x -> CompatFormula' q AnIssue r a) ->

120+ => (HList xs -> ProdCons x -> CompatFormula' q AnIssue r a)

121− (HList xs -> ProdCons x -> CompatFormula' q AnIssue r a)

121+ -> (HList xs -> ProdCons x -> CompatFormula' q AnIssue r a)

122swapProdCons f e (ProdCons p c) =

123 invertIssueOrientation $

124 f (swapEnvRoles e) (ProdCons c p)

@@ -153,8 +153,8 @@ instance Applicative ProdCons where

153 ProdCons fp fc <*> ProdCons xp xc = ProdCons (fp xp) (fc xc)

154

155newtype CompatM a = CompatM

156− { unCompatM ::

156+ { unCompatM

157− StateT (MemoState VarRef) Identity a

157+ :: StateT (MemoState VarRef) Identity a

158 }

159 deriving newtype

160 ( Functor

@@ -183,64 +183,64 @@ class (Typeable t, Issuable (SubtreeLevel t)) => Subtree (t :: Type) where

183 type CheckEnv t :: [Type]

184 type SubtreeLevel t :: BehaviorLevel

185

186− checkStructuralCompatibility ::

186+ checkStructuralCompatibility

187− HList (CheckEnv t) ->

187+ :: HList (CheckEnv t)

188− ProdCons (Traced t) ->

188+ -> ProdCons (Traced t)

189− StructuralCompatFormula ()

189+ -> StructuralCompatFormula ()

190

191− checkSemanticCompatibility ::

191+ checkSemanticCompatibility

192− HList (CheckEnv t) ->

192+ :: HList (CheckEnv t)

193− Behavior (SubtreeLevel t) ->

193+ -> Behavior (SubtreeLevel t)

194− ProdCons (Traced t) ->

194+ -> ProdCons (Traced t)

195− SemanticCompatFormula ()

195+ -> SemanticCompatFormula ()

196

197{-# WARNING checkStructuralCompatibility "You should not be calling this directly. Use 'checkSubstructure'" #-}

198

199{-# WARNING checkSemanticCompatibility "You should not be calling this directly. Use 'checkCompatibility'" #-}

200

201−checkCompatibility ::

201+checkCompatibility

202− forall t xs.

202+ :: forall t xs.

203− (ReassembleHList xs (CheckEnv t), Subtree t) =>

203+ (ReassembleHList xs (CheckEnv t), Subtree t)

204− Behavior (SubtreeLevel t) ->

204+ => Behavior (SubtreeLevel t)

205− HList xs ->

205+ -> HList xs

206− ProdCons (Traced t) ->

206+ -> ProdCons (Traced t)

207− SemanticCompatFormula ()

207+ -> SemanticCompatFormula ()

208checkCompatibility bhv e = memo bhv SemanticMemoKey $ \pc ->

209 case runCompatFormula $ checkSubstructure e pc of

210 Left _ -> checkSemanticCompatibility (reassemble e) bhv pc

211 Right () -> pure ()

212{-# INLINE checkCompatibility #-}

213

214−checkSubstructure ::

214+checkSubstructure

215− (ReassembleHList xs (CheckEnv t), Subtree t) =>

215+ :: (ReassembleHList xs (CheckEnv t), Subtree t)

216− HList xs ->

216+ => HList xs

217− ProdCons (Traced t) ->

217+ -> ProdCons (Traced t)

218− StructuralCompatFormula ()

218+ -> StructuralCompatFormula ()

219checkSubstructure e = memo Root StructuralMemoKey $ checkStructuralCompatibility (reassemble e)

220{-# INLINE checkSubstructure #-}

221

222−structuralMaybe ::

222+structuralMaybe

223− (Subtree a, ReassembleHList xs (CheckEnv a)) =>

223+ :: (Subtree a, ReassembleHList xs (CheckEnv a))

224− HList xs ->

224+ => HList xs

225− ProdCons (Maybe (Traced a)) ->

225+ -> ProdCons (Maybe (Traced a))

226− StructuralCompatFormula ()

226+ -> StructuralCompatFormula ()

227structuralMaybe e = structuralMaybeWith (checkSubstructure e)

228{-# INLINE structuralMaybe #-}

229

230−structuralMaybeWith ::

230+structuralMaybeWith

231− (ProdCons a -> StructuralCompatFormula ()) ->

231+ :: (ProdCons a -> StructuralCompatFormula ())

232− ProdCons (Maybe a) ->

232+ -> ProdCons (Maybe a)

233− StructuralCompatFormula ()

233+ -> StructuralCompatFormula ()

234structuralMaybeWith f (ProdCons (Just a) (Just b)) = f $ ProdCons a b

235structuralMaybeWith _ (ProdCons Nothing Nothing) = pure ()

236structuralMaybeWith _ _ = structuralIssue

237{-# INLINE structuralMaybeWith #-}

238

239−structuralList ::

239+structuralList

240− (Subtree a, ReassembleHList xs (CheckEnv a)) =>

240+ :: (Subtree a, ReassembleHList xs (CheckEnv a))

241− HList xs ->

241+ => HList xs

242− ProdCons [Traced a] ->

242+ -> ProdCons [Traced a]

243− StructuralCompatFormula ()

243+ -> StructuralCompatFormula ()

244structuralList _ (ProdCons [] []) = pure ()

245structuralList e (ProdCons (a : aa) (b : bb)) = do

246 checkSubstructure e $ ProdCons a b

@@ -253,11 +253,11 @@ structuralEq :: (Eq a, Comonad w) => ProdCons (w a) -> StructuralCompatFormula (

253structuralEq (ProdCons a b) = if extract a == extract b then pure () else structuralIssue

254{-# INLINE structuralEq #-}

255

256−iohmStructural ::

256+iohmStructural

257− (ReassembleHList (k ': xs) (CheckEnv v), Ord k, Subtree v, Hashable k, Typeable k, Show k) =>

257+ :: (ReassembleHList (k ': xs) (CheckEnv v), Ord k, Subtree v, Hashable k, Typeable k, Show k)

258− HList xs ->

258+ => HList xs

259− ProdCons (Traced (IOHM.InsOrdHashMap k v)) ->

259+ -> ProdCons (Traced (IOHM.InsOrdHashMap k v))

260− StructuralCompatFormula ()

260+ -> StructuralCompatFormula ()

261iohmStructural e =

262 iohmStructuralWith (\k -> checkSubstructure (k `HCons` e))

263{-# INLINE iohmStructural #-}

@@ -266,26 +266,25 @@ instance (Typeable k, Typeable v, Ord k, Show k) => Steppable (IOHM.InsOrdHashMa

266 data Step (IOHM.InsOrdHashMap k v) v = InsOrdHashMapKeyStep k

267 deriving stock (Eq, Ord, Show)

268

269−iohmStructuralWith ::

269+iohmStructuralWith

270− (Ord k, Hashable k, Typeable k, Typeable v, Show k) =>

270+ :: (Ord k, Hashable k, Typeable k, Typeable v, Show k)

271− (k -> ProdCons (Traced v) -> StructuralCompatFormula ()) ->

271+ => (k -> ProdCons (Traced v) -> StructuralCompatFormula ())

272− ProdCons (Traced (IOHM.InsOrdHashMap k v)) ->

272+ -> ProdCons (Traced (IOHM.InsOrdHashMap k v))

273− StructuralCompatFormula ()

273+ -> StructuralCompatFormula ()

274iohmStructuralWith f pc = do

275 let ProdCons pEKeys cEKeys = S.fromList . IOHM.keys . extract <$> pc

276 if pEKeys == cEKeys

277 then

278 for_

279 pEKeys

280− ( \eKey ->

280+ (\eKey ->

281− f eKey $ stepTraced (InsOrdHashMapKeyStep eKey) . fmap (IOHM.lookupDefault (error "impossible") eKey) <$> pc

281+ f eKey $ stepTraced (InsOrdHashMapKeyStep eKey) . fmap (IOHM.lookupDefault (error "impossible") eKey) <$> pc)

282− )

283 else structuralIssue

282 else structuralIssue

284{-# INLINE iohmStructuralWith #-}

283{-# INLINE iohmStructuralWith #-}

285

284

286−runCompatFormula ::

285+runCompatFormula

287− CompatFormula' q f r a ->

286+ :: CompatFormula' q f r a

288− Either (P.PathsPrefixTree q f r) a

287+ -> Either (P.PathsPrefixTree q f r) a

289runCompatFormula (Compose f) =

288runCompatFormula (Compose f) =

290 calculate . runIdentity . runMemo 0 . unCompatM $ f

289 calculate . runIdentity . runMemo 0 . unCompatM $ f

291{-# INLINE runCompatFormula #-}

290{-# INLINE runCompatFormula #-}

@@ -315,27 +314,27 @@ invertIssueOrientationP = P.map (\(AnIssue ori i) -> AnIssue (toggleOrientation

315structuralIssue :: StructuralCompatFormula a

314structuralIssue :: StructuralCompatFormula a

316structuralIssue = Compose $ pure $ anError $ AnItem Root Proxy

315structuralIssue = Compose $ pure $ anError $ AnItem Root Proxy

317

316

318−anyOfAt ::

317+anyOfAt

319− Issuable l =>

318+ :: Issuable l

320− Paths q r l ->

319+ => Paths q r l

321− Issue l ->

320+ -> Issue l

322− [CompatFormula' q AnIssue r a] ->

321+ -> [CompatFormula' q AnIssue r a]

323− CompatFormula' q AnIssue r a

322+ -> CompatFormula' q AnIssue r a

324anyOfAt _ _ [x] = x

323anyOfAt _ _ [x] = x

325anyOfAt xs issue fs =

324anyOfAt xs issue fs =

326 Compose $ (`eitherOf` AnItem xs (anIssue issue)) <$> traverse getCompose fs

325 Compose $ (`eitherOf` AnItem xs (anIssue issue)) <$> traverse getCompose fs

327

326

328-- | If the given formula contains any issues, add another issue on top. Otherwise succeed.

327-- | If the given formula contains any issues, add another issue on top. Otherwise succeed.

329−clarifyIssue ::

328+clarifyIssue

330− AnItem q AnIssue r ->

329+ :: AnItem q AnIssue r

331− CompatFormula' q AnIssue r a ->

330+ -> CompatFormula' q AnIssue r a

332− CompatFormula' q AnIssue r a

331+ -> CompatFormula' q AnIssue r a

333clarifyIssue item f =

332clarifyIssue item f =

334 Compose ((`eitherOf` item) <$> pure <$> getCompose f) *> f

333 Compose ((`eitherOf` item) <$> pure <$> getCompose f) *> f

335

334

336−fixpointKnot ::

335+fixpointKnot

337− MonadState (MemoState VarRef) m =>

336+ :: MonadState (MemoState VarRef) m

338− KnotTier (FormulaF q f r ()) VarRef m

337+ => KnotTier (FormulaF q f r ()) VarRef m

339fixpointKnot =

338fixpointKnot =

340 KnotTier

339 KnotTier

341 { onKnotFound = modifyMemoNonce succ

340 { onKnotFound = modifyMemoNonce succ

@@ -343,20 +342,19 @@ fixpointKnot =

343 , tieKnot = \i x -> pure $ maxFixpoint i x

342 , tieKnot = \i x -> pure $ maxFixpoint i x

344 }

343 }

345

344

346−memo ::

345+memo

347− (Typeable (l :: k), Typeable q, Typeable f, Typeable k, Typeable a) =>

346+ :: (Typeable (l :: k), Typeable q, Typeable f, Typeable k, Typeable a)

348− Paths q r l ->

347+ => Paths q r l

349− MemoKey ->

348+ -> MemoKey

350− (ProdCons (Traced a) -> CompatFormula' q f r ()) ->

349+ -> (ProdCons (Traced a) -> CompatFormula' q f r ())

351− (ProdCons (Traced a) -> CompatFormula' q f r ())

350+ -> (ProdCons (Traced a) -> CompatFormula' q f r ())

352memo bhv k f pc = Compose $ do

351memo bhv k f pc = Compose $ do

353 formula' <-

352 formula' <-

354 memoWithKnot

353 memoWithKnot

355 fixpointKnot

354 fixpointKnot

356− ( do

355+ (do

357− formula <- getCompose $ f pc

356+ formula <- getCompose $ f pc

358− pure $ mapErrors (P.takeSubtree bhv) formula

357+ pure $ mapErrors (P.takeSubtree bhv) formula)

359− )

360 (k, ask <$> pc)

358 (k, ask <$> pc)

361 pure $ mapErrors (P.embed bhv) formula'

359 pure $ mapErrors (P.embed bhv) formula'

362

360

src/Data/OpenApi/Compare/Validate/MediaTypeObject.hs+2−2

@@ -1,8 +1,8 @@

1{-# OPTIONS_GHC -Wno-orphans #-}

2

3module Data.OpenApi.Compare.Validate.MediaTypeObject

4− ( Issue (..),

4+ ( Issue (..)

5− Behave (..),

5+ , Behave (..)

6 )

7where

8

src/Data/OpenApi/Compare/Validate/OAuth2Flows.hs+13−13

@@ -1,9 +1,9 @@

1{-# OPTIONS_GHC -Wno-orphans #-}

2

3module Data.OpenApi.Compare.Validate.OAuth2Flows

4− ( Step (..),

4+ ( Step (..)

5− Issue (..),

5+ , Issue (..)

6− Behave (..),

6+ , Behave (..)

7 )

8where

9

@@ -26,11 +26,11 @@ instance Subtree OAuth2Flows where

26 type SubtreeLevel OAuth2Flows = 'SecuritySchemeLevel

27 checkStructuralCompatibility _ = structuralEq

28 checkSemanticCompatibility env bhv pc = do

29− let supportFlow ::

29+ let supportFlow

30− (Subtree t, SubtreeLevel t ~ SubtreeLevel OAuth2Flows, CheckEnv OAuth2Flows ~ CheckEnv t) =>

30+ :: (Subtree t, SubtreeLevel t ~ SubtreeLevel OAuth2Flows, CheckEnv OAuth2Flows ~ CheckEnv t)

31− Issue 'SecuritySchemeLevel ->

31+ => Issue 'SecuritySchemeLevel

32− ProdCons (Maybe (Traced t)) ->

32+ -> ProdCons (Maybe (Traced t))

33− SemanticCompatFormula ()

33+ -> SemanticCompatFormula ()

34 supportFlow i x = case x of

35 -- producer will not attempt this flow

36 (ProdCons Nothing _) -> pure ()

@@ -38,11 +38,11 @@ instance Subtree OAuth2Flows where

38 (ProdCons (Just _) Nothing) -> issueAt bhv i

39 (ProdCons (Just p) (Just c)) ->

40 checkCompatibility bhv env $ ProdCons p c

41− getFlow ::

41+ getFlow

42− Typeable x =>

42+ :: Typeable x

43− (OAuth2Flows -> Maybe (OAuth2Flow x)) ->

43+ => (OAuth2Flows -> Maybe (OAuth2Flow x))

44− Traced OAuth2Flows ->

44+ -> Traced OAuth2Flows

45− Maybe (Traced (OAuth2Flow x))

45+ -> Maybe (Traced (OAuth2Flow x))

46 getFlow f (Traced t a) = Traced (t >>> step (OAuth2FlowsFlow Proxy)) <$> f a

47 supportFlow ConsumerDoesNotSupportImplicitFlow $ getFlow _oAuth2FlowsImplicit <$> pc

48 supportFlow ConsumerDoesNotSupportPasswordFlow $ getFlow _oAuth2FlowsPassword <$> pc

src/Data/OpenApi/Compare/Validate/OpenApi.hs+13−15

@@ -3,8 +3,8 @@

3{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}

4

5module Data.OpenApi.Compare.Validate.OpenApi

6− ( Behave (..),

6+ ( Behave (..)

7− Issue (..),

7+ , Issue (..)

8 )

9where

10

@@ -38,8 +38,7 @@ tracedSecuritySchemes :: Traced OpenApi -> Traced (Definitions SecurityScheme)

38tracedSecuritySchemes oa =

39 traced

40 (ask oa >>> step ComponentsSecurityScheme)

41− (unSecurityDefinitions . _componentsSecuritySchemes . _openApiComponents . extract $ oa)

41+ (_componentsSecuritySchemes . _openApiComponents . extract $ oa)

42− where unSecurityDefinitions (SecurityDefinitions ds) = ds

43

42

44tracedResponses :: Traced OpenApi -> Traced (Definitions Response)

43tracedResponses :: Traced OpenApi -> Traced (Definitions Response)

45tracedResponses oa =

44tracedResponses oa =

@@ -80,17 +79,16 @@ instance Subtree OpenApi where

80 checkSemanticCompatibility _ beh prodCons = do

79 checkSemanticCompatibility _ beh prodCons = do

81 checkCompatibility @ProcessedPathItems

80 checkCompatibility @ProcessedPathItems

82 beh

81 beh

83− ( (tracedRequestBodies <$> prodCons)

82+ ((tracedRequestBodies <$> prodCons)

84− `HCons` (tracedParameters <$> prodCons)

83+ `HCons` (tracedParameters <$> prodCons)

85− `HCons` (tracedSecuritySchemes <$> prodCons)

84+ `HCons` (tracedSecuritySchemes <$> prodCons)

86− `HCons` (tracedResponses <$> prodCons)

85+ `HCons` (tracedResponses <$> prodCons)

87− `HCons` (tracedHeaders <$> prodCons)

86+ `HCons` (tracedHeaders <$> prodCons)

88− `HCons` (tracedSchemas <$> prodCons)

87+ `HCons` (tracedSchemas <$> prodCons)

89− `HCons` (_openApiServers . extract <$> prodCons)

88+ `HCons` (_openApiServers . extract <$> prodCons)

90− `HCons` (tracedLinks <$> prodCons)

89+ `HCons` (tracedLinks <$> prodCons)

91− `HCons` (tracedCallbacks <$> prodCons)

90+ `HCons` (tracedCallbacks <$> prodCons)

92− `HCons` HNil

91+ `HCons` HNil)

93− )

94 (tracedPaths <$> prodCons)

92 (tracedPaths <$> prodCons)

95

93

96instance Steppable OpenApi ProcessedPathItems where

94instance Steppable OpenApi ProcessedPathItems where

src/Data/OpenApi/Compare/Validate/Operation.hs+24−26

@@ -4,17 +4,17 @@

4

5module Data.OpenApi.Compare.Validate.Operation

6 ( -- * Operation

7− MatchedOperation (..),

7+ MatchedOperation (..)

8− OperationMethod (..),

8+ , OperationMethod (..)

9− pathItemMethod,

9+ , pathItemMethod

10

11 -- * ProcessedPathItem

12− ProcessedPathItem (..),

12+ , ProcessedPathItem (..)

13− ProcessedPathItems (..),

13+ , ProcessedPathItems (..)

14− processPathItems,

14+ , processPathItems

15− Step (..),

15+ , Step (..)

16− Behave (..),

16+ , Behave (..)

17− Issue (..),

17+ , Issue (..)

18 )

19where

20

@@ -87,11 +87,10 @@ tracedCallbacks (Traced t oper) =

87 ]

88

89-- FIXME: #28

90−getServers ::

90+getServers

91− -- | Servers from env

91+ :: [Server] -- ^ Servers from env

92− [Server] ->

93− MatchedOperation ->

92+ -> MatchedOperation

94− [Server]

93+ -> [Server]

95getServers env oper =

94getServers env oper =

96 case _operationServers . operation $ oper of

95 case _operationServers . operation $ oper of

97 [] -> env

96 [] -> env

@@ -338,10 +337,9 @@ instance Issuable 'APILevel where

338 deriving stock (Eq, Ord, Show)

337 deriving stock (Eq, Ord, Show)

339 issueKind = \case

338 issueKind = \case

340 _ -> CertainIssue

339 _ -> CertainIssue

341− relatedIssues =

340+ relatedIssues = (==) `withClass` \case

342− (==) `withClass` \case

343− NoPathsMatched fp -> Just fp

341+ NoPathsMatched fp -> Just fp

344− AllPathsFailed fp -> Just fp

342+ AllPathsFailed fp -> Just fp

345 describeIssue Forward (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " has been removed."

343 describeIssue Forward (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " has been removed."

346 describeIssue Backward (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " has been added."

344 describeIssue Backward (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " has been added."

347 describeIssue Forward (AllPathsFailed p) = para $ "The path " <> (code . T.pack) p <> " has been removed."

345 describeIssue Forward (AllPathsFailed p) = para $ "The path " <> (code . T.pack) p <> " has been removed."

@@ -436,10 +434,10 @@ tracedFragments mpi =

436 | (i, x) <- L.zip [0 ..] $ pathFragments $ extract mpi

434 | (i, x) <- L.zip [0 ..] $ pathFragments $ extract mpi

437 ]

435 ]

438

436

439−tracedMethod ::

437+tracedMethod

440− OperationMethod ->

438+ :: OperationMethod

441− Traced MatchedPathItem ->

439+ -> Traced MatchedPathItem

442− Maybe (Traced' MatchedOperation Operation)

440+ -> Maybe (Traced' MatchedOperation Operation)

443tracedMethod s mpi = env (ask mpi >>> step (OperationMethodStep s)) <$> (pathItemMethod s . pathItem . extract $ mpi)

441tracedMethod s mpi = env (ask mpi >>> step (OperationMethodStep s)) <$> (pathItemMethod s . pathItem . extract $ mpi)

444

442

445instance Issuable 'PathLevel where

443instance Issuable 'PathLevel where

@@ -487,10 +485,10 @@ instance Subtree MatchedPathItem where

487 checkSemanticCompatibility env beh prodCons = do

485 checkSemanticCompatibility env beh prodCons = do

488 let paramDefs = getH @(ProdCons (Traced (Definitions Param))) env

486 let paramDefs = getH @(ProdCons (Traced (Definitions Param))) env

489 pathTracedParams = getPathParams <$> paramDefs <*> prodCons

487 pathTracedParams = getPathParams <$> paramDefs <*> prodCons

490− getPathParams ::

488+ getPathParams

491− Traced (Definitions Param) ->

489+ :: Traced (Definitions Param)

492− Traced MatchedPathItem ->

490+ -> Traced MatchedPathItem

493− [Traced Param]

491+ -> [Traced Param]

494 getPathParams defs mpi = do

492 getPathParams defs mpi = do

495 paramRef <- tracedMatchedPathItemParameters mpi

493 paramRef <- tracedMatchedPathItemParameters mpi

496 pure $ dereference defs paramRef

494 pure $ dereference defs paramRef

src/Data/OpenApi/Compare/Validate/Param.hs+7−9

@@ -2,8 +2,8 @@

2{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

3

4module Data.OpenApi.Compare.Validate.Param

5− ( Behave (..),

5+ ( Behave (..)

6− Issue (..),

6+ , Issue (..)

7 )

8where

9

@@ -79,7 +79,7 @@ instance Issuable 'PathFragmentLevel where

79 describeIssue _ ParamPlaceIncompatible = para "Parameters in incompatible locations."

80 describeIssue _ ParamStyleMismatch = para "Different parameter styles (encodings)."

81 describeIssue _ ParamSchemaMismatch = para "Expected a schema, but didn't find one."

82− describeIssue ori (PathFragmentsDontMatch (orientProdCons ori -> ProdCons e a)) =

82+ describeIssue ori (PathFragmentsDontMatch (orientProdCons ori -> ProdCons e a)) =

83 para $ "Parameter changed from " <> code e <> " to " <> code a <> "."

84

85instance Behavable 'PathFragmentLevel 'SchemaLevel where

@@ -106,17 +106,15 @@ instance Subtree Param where

106 when (_paramName (extract p) /= _paramName (extract c)) $

107 issueAt beh ParamNameMismatch

108 when

109− ( (fromMaybe False . _paramRequired . extract $ c)

109+ ((fromMaybe False . _paramRequired . extract $ c)

110− && not (fromMaybe False . _paramRequired . extract $ p)

110+ && not (fromMaybe False . _paramRequired . extract $ p))

111− )

112 $ issueAt beh ParamRequired

111 $ issueAt beh ParamRequired

113 case (_paramIn . extract $ p, _paramIn . extract $ c) of

112 case (_paramIn . extract $ p, _paramIn . extract $ c) of

114 (ParamQuery, ParamQuery) -> do

113 (ParamQuery, ParamQuery) -> do

115 -- Emptiness is only for query params

114 -- Emptiness is only for query params

116 when

115 when

117− ( (fromMaybe False . _paramAllowEmptyValue . extract $ p)

116+ ((fromMaybe False . _paramAllowEmptyValue . extract $ p)

118− && not (fromMaybe False . _paramAllowEmptyValue . extract $ c)

117+ && not (fromMaybe False . _paramAllowEmptyValue . extract $ c))

119− )

120 $ issueAt beh ParamEmptinessIncompatible

118 $ issueAt beh ParamEmptinessIncompatible

121 (a, b) | a == b -> pure ()

119 (a, b) | a == b -> pure ()

122 _ -> issueAt beh ParamPlaceIncompatible

120 _ -> issueAt beh ParamPlaceIncompatible

src/Data/OpenApi/Compare/Validate/PathFragment.hs+4−3

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

1module Data.OpenApi.Compare.Validate.PathFragment

2− ( parsePath,

2+ ( parsePath

3− PathFragment (..),

3+ , PathFragment (..)

4− PathFragmentParam,

4+ , PathFragmentParam

5 )

6where

7

@@ -12,6 +12,7 @@ import Data.OpenApi.Compare.Subtree

12import Data.OpenApi.Compare.Validate.Param

13import Data.Text (Text)

14import qualified Data.Text as T

15+import Data.Typeable

15

16

16-- TODO: templates can be only part of the PathFragment. Currently only supports templates as full PathFragment.

17-- TODO: templates can be only part of the PathFragment. Currently only supports templates as full PathFragment.

17-- #23

18-- #23

src/Data/OpenApi/Compare/Validate/Products.hs+28−27

@@ -1,21 +1,21 @@

1−-- | Checks product-like entities. The key is some identificator for the product

1+{- | Checks product-like entities. The key is some identificator for the product

2−--element. Each element may be required or optional.

2+element. Each element may be required or optional.

3−--

3+

4−--One example of product is request parameters. There are optional and required

4+One example of product is request parameters. There are optional and required

5−--parameters. The client and server have possibly different set of

5+parameters. The client and server have possibly different set of

6−--parameters. What we must check is if server requires some request parameter,

6+parameters. What we must check is if server requires some request parameter,

7−--then this parameter must be presented by client and their schemas must match.

7+then this parameter must be presented by client and their schemas must match.

8−--

8+

9−--So when we checking products we are checking from the server's (consumer)

9+So when we checking products we are checking from the server's (consumer)

10−--perspective, ensuring that all parameters are provided by the client (producer)

10+perspective, ensuring that all parameters are provided by the client (producer)

11−--and their schemas match.

11+and their schemas match.

12−--

12+

13−--This module abstracts this logic for arbitrary elements

13+This module abstracts this logic for arbitrary elements -}

14+

14module Data.OpenApi.Compare.Validate.Products

15module Data.OpenApi.Compare.Validate.Products

15− ( checkProducts,

16+ ( checkProducts

16− ProductLike (..),

17+ , ProductLike(..)

17− )

18−where

18+ ) where

19

20import Data.Foldable

21import Data.Map.Strict (Map)

@@ -30,19 +30,20 @@ data ProductLike a = ProductLike

30 , required :: Bool

31 }

32

33−checkProducts ::

33+checkProducts

34− (Ord k, Issuable l) =>

34+ :: (Ord k, Issuable l)

35− Paths q r l ->

35+ => Paths q r l

36+ -> (k -> Issue l)

36− -- | No required element found

37+ -- ^ No required element found

37− (k -> Issue l) ->

38− (k -> ProdCons t -> CompatFormula' q AnIssue r ()) ->

38+ -> (k -> ProdCons t -> CompatFormula' q AnIssue r ())

39− ProdCons (Map k (ProductLike t)) ->

39+ -> ProdCons (Map k (ProductLike t))

40− CompatFormula' q AnIssue r ()

40+ -> CompatFormula' q AnIssue r ()

41checkProducts xs noElt check (ProdCons p c) = for_ (M.toList c) $ \(key, consElt) ->

42 case M.lookup key p of

43 Nothing -> case required consElt of

44− True -> issueAt xs $ noElt key

44+ True -> issueAt xs $ noElt key

45 False -> pure ()

46 Just prodElt -> do

47+ let

47− let elts = ProdCons prodElt consElt

48+ elts = ProdCons prodElt consElt

48 check key (productValue <$> elts)

49 check key (productValue <$> elts)

src/Data/OpenApi/Compare/Validate/RequestBody.hs+2−2

@@ -1,8 +1,8 @@

1{-# OPTIONS_GHC -Wno-orphans #-}

2

3module Data.OpenApi.Compare.Validate.RequestBody

4− ( Issue (..),

4+ ( Issue (..)

5− Behave (..),

5+ , Behave (..)

6 )

7where

8

src/Data/OpenApi/Compare/Validate/Responses.hs+1−1

@@ -2,7 +2,7 @@

2{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

3

4module Data.OpenApi.Compare.Validate.Responses

5− ( Behave (..),

5+ ( Behave (..)

6 )

7where

8

src/Data/OpenApi/Compare/Validate/Schema.hs+98−77

@@ -1,19 +1,18 @@

1{-# OPTIONS_GHC -Wno-orphans #-}

2−

3module Data.OpenApi.Compare.Validate.Schema

2module Data.OpenApi.Compare.Validate.Schema

4 (

3 (

5 )

4 )

6where

5where

7

6

8−import Control.Monad (when,unless)

7+import Control.Monad.Writer

9import qualified Data.Aeson as A

8import qualified Data.Aeson as A

10import Data.Coerce

9import Data.Coerce

11import Data.Foldable (for_, toList)

10import Data.Foldable (for_, toList)

12import Data.Functor

11import Data.Functor

13import Data.HList

12import Data.HList

14−import Data.List (genericIndex, genericLength, group)

15import qualified Data.List.NonEmpty as NE

13import qualified Data.List.NonEmpty as NE

16import qualified Data.Map as M

14import qualified Data.Map as M

15+import Data.List (group, genericLength, genericIndex)

17import Data.Maybe

16import Data.Maybe

18import Data.OpenApi

17import Data.OpenApi

19import Data.OpenApi.Compare.Behavior

18import Data.OpenApi.Compare.Behavior

@@ -23,24 +22,24 @@ import Data.OpenApi.Compare.Subtree

23import Data.OpenApi.Compare.Validate.Schema.DNF

22import Data.OpenApi.Compare.Validate.Schema.DNF

24import Data.OpenApi.Compare.Validate.Schema.Issues

23import Data.OpenApi.Compare.Validate.Schema.Issues

25import Data.OpenApi.Compare.Validate.Schema.JsonFormula

24import Data.OpenApi.Compare.Validate.Schema.JsonFormula

26−import Data.OpenApi.Compare.Validate.Schema.Partition

27−import Data.OpenApi.Compare.Validate.Schema.Process

28import Data.OpenApi.Compare.Validate.Schema.Traced

25import Data.OpenApi.Compare.Validate.Schema.Traced

29import Data.OpenApi.Compare.Validate.Schema.TypedJson

26import Data.OpenApi.Compare.Validate.Schema.TypedJson

27+import Data.OpenApi.Compare.Validate.Schema.Partition

28+import Data.OpenApi.Compare.Validate.Schema.Process

30import Data.Ord

29import Data.Ord

31import Data.Ratio

30import Data.Ratio

32import Data.Semigroup

31import Data.Semigroup

33import qualified Data.Set as S

32import qualified Data.Set as S

34import Data.Text (Text)

33import Data.Text (Text)

35

34

36−checkFormulas ::

35+checkFormulas

37− (ReassembleHList xs (CheckEnv (Referenced Schema))) =>

36+ :: (ReassembleHList xs (CheckEnv (Referenced Schema)))

38− HList xs ->

37+ => HList xs

39− Behavior 'SchemaLevel ->

38+ -> Behavior 'SchemaLevel

40− ProdCons (Trace Schema) ->

39+ -> ProdCons (Trace Schema)

41− ProdCons (Traced (Definitions Schema)) ->

40+ -> ProdCons (Traced (Definitions Schema))

42− ProdCons (ForeachType JsonFormula, P.PathsPrefixTree Behave AnIssue 'SchemaLevel) ->

41+ -> ProdCons (ForeachType JsonFormula, P.PathsPrefixTree Behave AnIssue 'SchemaLevel)

43− SemanticCompatFormula ()

42+ -> SemanticCompatFormula ()

44checkFormulas env beh trs defs (ProdCons (fp, ep) (fc, ec)) =

43checkFormulas env beh trs defs (ProdCons (fp, ep) (fc, ec)) =

45 case P.toList ep ++ P.toList ec of

44 case P.toList ep ++ P.toList ec of

46 issues@(_ : _) -> for_ issues $ embedFormula beh . anItem

45 issues@(_ : _) -> for_ issues $ embedFormula beh . anItem

@@ -145,21 +144,21 @@ checkFormulas env beh trs defs (ProdCons (fp, ep) (fc, ec)) =

145 EnumDoesntSatisfy $ untypeValue e -- what does this look like when partitioned?

144 EnumDoesntSatisfy $ untypeValue e -- what does this look like when partitioned?

146 issueFromDisjunct mPart ps = NoMatchingCondition mPart $ SomeCondition <$> S.toList ps

145 issueFromDisjunct mPart ps = NoMatchingCondition mPart $ SomeCondition <$> S.toList ps

147

146

148−checkContradiction ::

147+checkContradiction

149− Behavior 'TypedSchemaLevel ->

148+ :: Behavior 'TypedSchemaLevel

150− Maybe Partition ->

149+ -> Maybe Partition

151− S.Set (Condition t) ->

150+ -> S.Set (Condition t)

152− SemanticCompatFormula ()

151+ -> SemanticCompatFormula ()

153checkContradiction beh mPart _ = issueAt beh $ maybe TypeBecomesEmpty PartitionBecomesEmpty mPart -- TODO #70

152checkContradiction beh mPart _ = issueAt beh $ maybe TypeBecomesEmpty PartitionBecomesEmpty mPart -- TODO #70

154

153

155−checkImplication ::

154+checkImplication

156− (ReassembleHList xs (CheckEnv (Referenced Schema))) =>

155+ :: (ReassembleHList xs (CheckEnv (Referenced Schema)))

157− HList xs ->

156+ => HList xs

158− Behavior 'TypedSchemaLevel ->

157+ -> Behavior 'TypedSchemaLevel

159− ProdCons (Trace Schema) -> -- the traces of the root schemas used in this comparison

158+ -> ProdCons (Trace Schema) -- the traces of the root schemas used in this comparison

160− S.Set (Condition t) ->

159+ -> S.Set (Condition t)

161− Condition t ->

160+ -> Condition t

162− SemanticCompatFormula ()

161+ -> SemanticCompatFormula ()

163checkImplication env beh trs prods cons = case findExactly prods of

162checkImplication env beh trs prods cons = case findExactly prods of

164 Just e

163 Just e

165 | all (satisfiesTyped e) prods ->

164 | all (satisfiesTyped e) prods ->

@@ -167,104 +166,124 @@ checkImplication env beh trs prods cons = case findExactly prods of

167 then pure ()

166 then pure ()

168 else issueAt beh (EnumDoesntSatisfy $ untypeValue e)

167 else issueAt beh (EnumDoesntSatisfy $ untypeValue e)

169 | otherwise -> pure () -- vacuously true

168 | otherwise -> pure () -- vacuously true

169+

170 Nothing -> case cons of

171 -- the above code didn't catch it, so there's no Exactly condition on the lhs

172 Exactly e -> issueAt beh (NoMatchingEnum $ untypeValue e)

173+

173 Maximum m -> foldCheck min m NoMatchingMaximum MatchingMaximumWeak $ \case

174 Maximum m -> foldCheck min m NoMatchingMaximum MatchingMaximumWeak $ \case

174 Maximum m' -> Just m'

175 Maximum m' -> Just m'

175 _ -> Nothing

176 _ -> Nothing

177+

176 Minimum m -> foldCheck max m (NoMatchingMinimum . coerce) (MatchingMinimumWeak . coerce) $ \case

178 Minimum m -> foldCheck max m (NoMatchingMinimum . coerce) (MatchingMinimumWeak . coerce) $ \case

177 Minimum m' -> Just m'

179 Minimum m' -> Just m'

178 _ -> Nothing

180 _ -> Nothing

181+

179 MultipleOf m -> foldCheck lcmScientific m NoMatchingMultipleOf MatchingMultipleOfWeak $ \case

182 MultipleOf m -> foldCheck lcmScientific m NoMatchingMultipleOf MatchingMultipleOfWeak $ \case

180 MultipleOf m' -> Just m'

183 MultipleOf m' -> Just m'

181 _ -> Nothing

184 _ -> Nothing

185+

182 NumberFormat f -> case flip any prods $ \case

186 NumberFormat f -> case flip any prods $ \case

183− NumberFormat f' -> f == f'

187+ NumberFormat f' -> f == f'

184− _ -> False of

188+ _ -> False

189+ of

185 True -> pure ()

190 True -> pure ()

186 False -> issueAt beh (NoMatchingFormat f)

191 False -> issueAt beh (NoMatchingFormat f)

192+

187 MaxLength m -> foldCheck min m NoMatchingMaxLength MatchingMaxLengthWeak $ \case

193 MaxLength m -> foldCheck min m NoMatchingMaxLength MatchingMaxLengthWeak $ \case

188 MaxLength m' -> Just m'

194 MaxLength m' -> Just m'

189 _ -> Nothing

195 _ -> Nothing

196+

190 MinLength m -> foldCheck max m NoMatchingMinLength MatchingMinLengthWeak $ \case

197 MinLength m -> foldCheck max m NoMatchingMinLength MatchingMinLengthWeak $ \case

191 MinLength m' -> Just m'

198 MinLength m' -> Just m'

192 _ -> Nothing

199 _ -> Nothing

200+

193 Pattern p -> case flip any prods $ \case

201 Pattern p -> case flip any prods $ \case

194− Pattern p' -> p == p'

202+ Pattern p' -> p == p'

195− _ -> False of

203+ _ -> False

204+ of

196 True -> pure ()

205 True -> pure ()

197 False -> issueAt beh (NoMatchingPattern p) -- TODO: regex comparison #32

206 False -> issueAt beh (NoMatchingPattern p) -- TODO: regex comparison #32

207+

198 StringFormat f -> case flip any prods $ \case

208 StringFormat f -> case flip any prods $ \case

199− StringFormat f' -> f == f'

209+ StringFormat f' -> f == f'

200− _ -> False of

210+ _ -> False

211+ of

201 True -> pure ()

212 True -> pure ()

202 False -> issueAt beh (NoMatchingFormat f)

213 False -> issueAt beh (NoMatchingFormat f)

214+

203 Items _ cons' -> case foldSome (<>) prods $ \case

215 Items _ cons' -> case foldSome (<>) prods $ \case

204− Items _ rs -> Just (Just (rs NE.:| []), mempty)

216+ Items _ rs -> Just (Just (rs NE.:| []), mempty)

205− TupleItems (map snd -> fs) -> Just (mempty, Just (fs NE.:| []))

217+ TupleItems (map snd -> fs) -> Just (mempty, Just (fs NE.:| []))

206− _ -> Nothing of

218+ _ -> Nothing

219+ of

207 Just (mItems, Just pfs)

220 Just (mItems, Just pfs)

208 | not $ allSame (length <$> pfs) -> pure () -- vacuously

221 | not $ allSame (length <$> pfs) -> pure () -- vacuously

209− | let plen = genericLength (NE.head pfs) ->

222+ | let plen = genericLength (NE.head pfs)

210− clarifyIssue (AnItem beh (anIssue TupleToArray)) $

223+ -> clarifyIssue (AnItem beh (anIssue TupleToArray)) $ for_ [0 .. plen - 1] $ \i -> do

211− for_ [0 .. plen - 1] $ \i -> do

212− let prod' = tracedConjunct $ case mItems of

224+ let prod' = tracedConjunct $ case mItems of

213− Just prods' -> ((`genericIndex` i) <$> pfs) <> prods'

225+ Just prods' -> ((`genericIndex` i) <$> pfs) <> prods'

214− Nothing -> (`genericIndex` i) <$> pfs

226+ Nothing -> (`genericIndex` i) <$> pfs

215− checkCompatibility (beh >>> step (InItem i)) env $ ProdCons prod' cons'

227+ checkCompatibility (beh >>> step (InItem i)) env $ ProdCons prod' cons'

216 Just (Just prods', Nothing) -> do

228 Just (Just prods', Nothing) -> do

217 let prod' = tracedConjunct prods'

229 let prod' = tracedConjunct prods'

218 checkCompatibility (beh >>> step InItems) env $ ProdCons prod' cons'

230 checkCompatibility (beh >>> step InItems) env $ ProdCons prod' cons'

219 _ -> clarifyIssue (AnItem beh (anIssue NoMatchingItems)) $ do

231 _ -> clarifyIssue (AnItem beh (anIssue NoMatchingItems)) $ do

220 checkCompatibility (beh >>> step InItems) env $ ProdCons prodTopSchema cons'

232 checkCompatibility (beh >>> step InItems) env $ ProdCons prodTopSchema cons'

233+

221 TupleItems (map snd -> fs) -> case foldSome (<>) prods $ \case

234 TupleItems (map snd -> fs) -> case foldSome (<>) prods $ \case

222− TupleItems (map snd -> fs') -> Just (Just $ fs' NE.:| [], Just . Max $ genericLength fs', Just . Min $ genericLength fs', mempty)

235+ TupleItems (map snd -> fs') -> Just (Just $ fs' NE.:| [], Just . Max $ genericLength fs', Just . Min $ genericLength fs', mempty)

223− MinItems m' -> Just (mempty, Just . Max $ m', mempty, mempty)

236+ MinItems m' -> Just (mempty, Just . Max $ m', mempty, mempty)

224− MaxItems m' -> Just (mempty, mempty, Just . Min $ m', mempty)

237+ MaxItems m' -> Just (mempty, mempty, Just . Min $ m', mempty)

225− Items _ rs -> Just (mempty, mempty, mempty, Just (rs NE.:| []))

238+ Items _ rs -> Just (mempty, mempty, mempty, Just (rs NE.:| []))

226− _ -> Nothing of

239+ _ -> Nothing

240+ of

227− -- if the length constraints in the producer are contradictory:

241+ -- if the length constraints in the producer are contradictory:

228− Just (_, Just (Max lowest), Just (Min highest), _) | lowest > highest -> pure ()

242+ Just (_, Just (Max lowest), Just (Min highest), _) | lowest > highest -> pure ()

229− -- We have an explicit tuple items clause...

243+ -- We have an explicit tuple items clause...

230− Just (Just pfs, Just (Max plen), _, _)

244+ Just (Just pfs, Just (Max plen), _, _)

231− | plen /= genericLength fs -> -- ...of wrong length

245+ | plen /= genericLength fs -- ...of wrong length

232− issueAt beh (TupleItemsLengthChanged ProdCons {producer = plen, consumer = genericLength fs})

246+ -> issueAt beh (TupleItemsLengthChanged ProdCons {producer = plen, consumer = genericLength fs})

233− | otherwise ->

247+ | otherwise

234− for_ [0 .. plen - 1] $ \i -> do

248+ -> for_ [0 .. plen - 1] $ \i -> do

235 checkCompatibility (beh >>> step (InItem i)) env $ ProdCons (tracedConjunct $ (`genericIndex` i) <$> pfs) (fs `genericIndex` i)

249 checkCompatibility (beh >>> step (InItem i)) env $ ProdCons (tracedConjunct $ (`genericIndex` i) <$> pfs) (fs `genericIndex` i)

236− -- We have a fixed length array in the producer...

250+ -- We have a fixed length array in the producer...

237− Just (Nothing, Just (Max plen), Just (Min plen'), mProd)

251+ Just (Nothing, Just (Max plen), Just (Min plen'), mProd)

238− | plen == plen' ->

252+ | plen == plen'

239− clarifyIssue (AnItem beh (anIssue ArrayToTuple)) $ case mProd of

253+ -> clarifyIssue (AnItem beh (anIssue ArrayToTuple)) $ case mProd of

240− _

241− | plen /= genericLength fs -> -- ...of wrong length

254+ _ | plen /= genericLength fs -> -- ...of wrong length

242− issueAt beh (TupleItemsLengthChanged ProdCons {producer = plen, consumer = genericLength fs})

255+ issueAt beh (TupleItemsLengthChanged ProdCons {producer = plen, consumer = genericLength fs})

243 Just rs -> for_ [0 .. plen - 1] $ \i -> do

256 Just rs -> for_ [0 .. plen - 1] $ \i -> do

244 checkCompatibility (beh >>> step (InItem i)) env $ ProdCons (tracedConjunct rs) (fs `genericIndex` i)

257 checkCompatibility (beh >>> step (InItem i)) env $ ProdCons (tracedConjunct rs) (fs `genericIndex` i)

245 -- ...and no "items" schema

258 -- ...and no "items" schema

246 Nothing -> clarifyIssue (AnItem beh (anIssue NoMatchingTupleItems)) $ do

259 Nothing -> clarifyIssue (AnItem beh (anIssue NoMatchingTupleItems)) $ do

247 for_ [0 .. plen - 1] $ \i -> do

260 for_ [0 .. plen - 1] $ \i -> do

248 checkCompatibility (beh >>> step (InItem i)) env $ ProdCons prodTopSchema (fs `genericIndex` i)

261 checkCompatibility (beh >>> step (InItem i)) env $ ProdCons prodTopSchema (fs `genericIndex` i)

249− _ -> issueAt beh NoMatchingTupleItems

262+ _ -> issueAt beh NoMatchingTupleItems

263+

250 MaxItems m -> foldCheck min m NoMatchingMaxItems MatchingMaxItemsWeak $ \case

264 MaxItems m -> foldCheck min m NoMatchingMaxItems MatchingMaxItemsWeak $ \case

251 MaxItems m' -> Just m'

265 MaxItems m' -> Just m'

252 TupleItems fs -> Just $ toInteger $ length fs

266 TupleItems fs -> Just $ toInteger $ length fs

253 _ -> Nothing

267 _ -> Nothing

268+

254 MinItems m -> foldCheck max m NoMatchingMinItems MatchingMinItemsWeak $ \case

269 MinItems m -> foldCheck max m NoMatchingMinItems MatchingMinItemsWeak $ \case

255 MinItems m' -> Just m'

270 MinItems m' -> Just m'

256 TupleItems fs -> Just $ toInteger $ length fs

271 TupleItems fs -> Just $ toInteger $ length fs

257 _ -> Nothing

272 _ -> Nothing

273+

258 UniqueItems -> case flip any prods $ \case

274 UniqueItems -> case flip any prods $ \case

259− UniqueItems -> True

275+ UniqueItems -> True

260− MaxItems 1 -> True

276+ MaxItems 1 -> True

261− TupleItems fs | length fs == 1 -> True

277+ TupleItems fs | length fs == 1 -> True

262− _ -> False of

278+ _ -> False

279+ of

263 True -> pure ()

280 True -> pure ()

264 False -> issueAt beh NoMatchingUniqueItems

281 False -> issueAt beh NoMatchingUniqueItems

282+

265 Properties props _ madd -> case foldSome (<>) prods $ \case

283 Properties props _ madd -> case foldSome (<>) prods $ \case

266− Properties props' _ madd' -> Just $ (props', madd') NE.:| []

284+ Properties props' _ madd' -> Just $ (props', madd') NE.:| []

267− _ -> Nothing of

285+ _ -> Nothing

286+ of

268 Just pm ->

287 Just pm ->

269 anyOfAt beh NoMatchingProperties $ -- TODO: could first "concat" the lists

288 anyOfAt beh NoMatchingProperties $ -- TODO: could first "concat" the lists

270 NE.toList pm <&> \(props', madd') -> do

289 NE.toList pm <&> \(props', madd') -> do

@@ -295,9 +314,11 @@ checkImplication env beh trs prods cons = case findExactly prods of

295 (Just add', Just add) -> checkCompatibility (beh >>> step InAdditionalProperty) env (ProdCons add' add)

314 (Just add', Just add) -> checkCompatibility (beh >>> step InAdditionalProperty) env (ProdCons add' add)

296 pure ()

315 pure ()

297 Nothing -> issueAt beh NoMatchingProperties

316 Nothing -> issueAt beh NoMatchingProperties

317+

298 MaxProperties m -> foldCheck min m NoMatchingMaxProperties MatchingMaxPropertiesWeak $ \case

318 MaxProperties m -> foldCheck min m NoMatchingMaxProperties MatchingMaxPropertiesWeak $ \case

299 MaxProperties m' -> Just m'

319 MaxProperties m' -> Just m'

300 _ -> Nothing

320 _ -> Nothing

321+

301 MinProperties m -> foldCheck max m NoMatchingMinProperties MatchingMinPropertiesWeak $ \case

322 MinProperties m -> foldCheck max m NoMatchingMinProperties MatchingMinPropertiesWeak $ \case

302 MinProperties m' -> Just m'

323 MinProperties m' -> Just m'

303 _ -> Nothing

324 _ -> Nothing

@@ -305,14 +326,14 @@ checkImplication env beh trs prods cons = case findExactly prods of

305 lcmScientific (toRational -> a) (toRational -> b) =

326 lcmScientific (toRational -> a) (toRational -> b) =

306 fromRational $ lcm (numerator a) (numerator b) % gcd (denominator a) (denominator b)

327 fromRational $ lcm (numerator a) (numerator b) % gcd (denominator a) (denominator b)

307

328

308− foldCheck ::

329+ foldCheck

309− Eq a =>

330+ :: Eq a

310− (a -> a -> a) ->

331+ => (a -> a -> a)

311− a ->

332+ -> a

312− (a -> Issue 'TypedSchemaLevel) ->

333+ -> (a -> Issue 'TypedSchemaLevel)

313− (ProdCons a -> Issue 'TypedSchemaLevel) ->

334+ -> (ProdCons a -> Issue 'TypedSchemaLevel)

314− (forall t. Condition t -> Maybe a) ->

335+ -> (forall t. Condition t -> Maybe a)

315− SemanticCompatFormula ()

336+ -> SemanticCompatFormula ()

316 foldCheck f m missing weak extr = case foldSome f prods extr of

337 foldCheck f m missing weak extr = case foldSome f prods extr of

317 Just m'

338 Just m'

318 | f m' m == m' -> pure ()

339 | f m' m == m' -> pure ()

src/Data/OpenApi/Compare/Validate/Schema/DNF.hs+8−8

@@ -1,12 +1,12 @@

1module Data.OpenApi.Compare.Validate.Schema.DNF

2− ( DNF (..),

2+ ( DNF (..)

3− Disjunct (..),

3+ , Disjunct (..)

4− pattern SingleDisjunct,

4+ , pattern SingleDisjunct

5− pattern TopDNF,

5+ , pattern TopDNF

6− pattern BottomDNF,

6+ , pattern BottomDNF

7− pattern LiteralDNF,

7+ , pattern LiteralDNF

8− foldDNF,

8+ , foldDNF

9− forDNF,

9+ , forDNF

10 )

11where

12

src/Data/OpenApi/Compare/Validate/Schema/Issues.hs+51−53

@@ -1,8 +1,8 @@

1{-# OPTIONS_GHC -Wno-orphans #-}

2

3module Data.OpenApi.Compare.Validate.Schema.Issues

4− ( Issue (..),

4+ ( Issue (..)

5− Behave (..),

5+ , Behave (..)

6 )

7where

8

@@ -100,54 +100,53 @@ instance Issuable 'TypedSchemaLevel where

100 TypeBecomesEmpty -> ProbablyIssue -- TODO: #70

101 PartitionBecomesEmpty _ -> ProbablyIssue -- ditto

102 _ -> CertainIssue

103− relatedIssues =

103+ relatedIssues = (==) `withClass` \case

104− (==) `withClass` \case

105 EnumDoesntSatisfy v -> Just v

104 EnumDoesntSatisfy v -> Just v

106 NoMatchingEnum v -> Just v

105 NoMatchingEnum v -> Just v

107 _ -> Nothing

106 _ -> Nothing

108− `withClass` \case

107+ `withClass` \case

109− NoMatchingMaximum _ -> Just ()

108+ NoMatchingMaximum _ -> Just ()

110− MatchingMaximumWeak _ -> Just ()

109+ MatchingMaximumWeak _ -> Just ()

111− _ -> Nothing

110+ _ -> Nothing

112− `withClass` \case

111+ `withClass` \case

113− NoMatchingMinimum _ -> Just ()

112+ NoMatchingMinimum _ -> Just ()

114− MatchingMinimumWeak _ -> Just ()

113+ MatchingMinimumWeak _ -> Just ()

115− _ -> Nothing

114+ _ -> Nothing

116− `withClass` \case

115+ `withClass` \case

117− NoMatchingMultipleOf _ -> Just ()

116+ NoMatchingMultipleOf _ -> Just ()

118− MatchingMultipleOfWeak _ -> Just ()

117+ MatchingMultipleOfWeak _ -> Just ()

119− _ -> Nothing

118+ _ -> Nothing

120− `withClass` \case

119+ `withClass` \case

121− NoMatchingMaxLength _ -> Just ()

120+ NoMatchingMaxLength _ -> Just ()

122− MatchingMaxLengthWeak _ -> Just ()

121+ MatchingMaxLengthWeak _ -> Just ()

123− _ -> Nothing

122+ _ -> Nothing

124− `withClass` \case

123+ `withClass` \case

125− NoMatchingMinLength _ -> Just ()

124+ NoMatchingMinLength _ -> Just ()

126− MatchingMinLengthWeak _ -> Just ()

125+ MatchingMinLengthWeak _ -> Just ()

127− _ -> Nothing

126+ _ -> Nothing

128− `withClass` \case

127+ `withClass` \case

129− NoMatchingItems -> Just ()

128+ NoMatchingItems -> Just ()

130− ArrayToTuple -> Just ()

129+ ArrayToTuple -> Just ()

131− TupleToArray -> Just ()

130+ TupleToArray -> Just ()

132− NoMatchingTupleItems -> Just ()

131+ NoMatchingTupleItems -> Just ()

133− TupleItemsLengthChanged _ -> Just ()

132+ TupleItemsLengthChanged _ -> Just ()

134− _ -> Nothing

133+ _ -> Nothing

135− `withClass` \case

134+ `withClass` \case

136− NoMatchingMaxItems _ -> Just ()

135+ NoMatchingMaxItems _ -> Just ()

137− MatchingMaxItemsWeak _ -> Just ()

136+ MatchingMaxItemsWeak _ -> Just ()

138− _ -> Nothing

137+ _ -> Nothing

139− `withClass` \case

138+ `withClass` \case

140− NoMatchingMinItems _ -> Just ()

139+ NoMatchingMinItems _ -> Just ()

141− MatchingMinItemsWeak _ -> Just ()

140+ MatchingMinItemsWeak _ -> Just ()

142− _ -> Nothing

141+ _ -> Nothing

143− `withClass` \case

142+ `withClass` \case

144− NoMatchingMaxProperties _ -> Just ()

143+ NoMatchingMaxProperties _ -> Just ()

145− MatchingMaxPropertiesWeak _ -> Just ()

144+ MatchingMaxPropertiesWeak _ -> Just ()

146− _ -> Nothing

145+ _ -> Nothing

147− `withClass` \case

146+ `withClass` \case

148− NoMatchingMinProperties _ -> Just ()

147+ NoMatchingMinProperties _ -> Just ()

149− MatchingMinPropertiesWeak _ -> Just ()

148+ MatchingMinPropertiesWeak _ -> Just ()

150− _ -> Nothing

149+ _ -> Nothing

151 describeIssue Forward (EnumDoesntSatisfy v) = para "The following enum value was removed:" <> showJSONValue v

150 describeIssue Forward (EnumDoesntSatisfy v) = para "The following enum value was removed:" <> showJSONValue v

152 describeIssue Backward (EnumDoesntSatisfy v) = para "The following enum value was added:" <> showJSONValue v

151 describeIssue Backward (EnumDoesntSatisfy v) = para "The following enum value was added:" <> showJSONValue v

153 describeIssue Forward (NoMatchingEnum v) = para "The following enum value has been added:" <> showJSONValue v

152 describeIssue Forward (NoMatchingEnum v) = para "The following enum value has been added:" <> showJSONValue v

@@ -255,15 +254,14 @@ instance Issuable 'SchemaLevel where

255 PropertyToAdditional -> Comment

254 PropertyToAdditional -> Comment

256 TypesRestricted _ -> ProbablyIssue -- TODO: #70

255 TypesRestricted _ -> ProbablyIssue -- TODO: #70

257 _ -> CertainIssue

256 _ -> CertainIssue

258− relatedIssues =

257+ relatedIssues = (==) `withClass` \case

259− (==) `withClass` \case

260 AdditionalToProperty -> Just ()

258 AdditionalToProperty -> Just ()

261 PropertyToAdditional -> Just ()

259 PropertyToAdditional -> Just ()

262 _ -> Nothing

260 _ -> Nothing

263− `withClass` \case

261+ `withClass` \case

264− PropertyNowRequired -> Just ()

262+ PropertyNowRequired -> Just ()

265− UnexpectedProperty -> Just ()

263+ UnexpectedProperty -> Just ()

266− _ -> Nothing

264+ _ -> Nothing

267 describeIssue _ (NotSupported i) =

265 describeIssue _ (NotSupported i) =

268 para (emph "Encountered a feature that CompaREST does not support: " <> text i <> ".")

266 para (emph "Encountered a feature that CompaREST does not support: " <> text i <> ".")

269 describeIssue _ OneOfNotDisjoint =

267 describeIssue _ OneOfNotDisjoint =

src/Data/OpenApi/Compare/Validate/Schema/JsonFormula.hs+48−56

@@ -1,27 +1,26 @@

1module Data.OpenApi.Compare.Validate.Schema.JsonFormula

2− ( Bound (..),

2+ ( Bound (..)

3− showBound,

3+ , showBound

4− Property (..),

4+ , Property (..)

5− Condition (..),

5+ , Condition (..)

6− showCondition,

6+ , showCondition

7− satisfiesTyped,

7+ , satisfiesTyped

8− checkStringFormat,

8+ , checkStringFormat

9− checkNumberFormat,

9+ , checkNumberFormat

10− SomeCondition (..),

10+ , SomeCondition (..)

11− JsonFormula (..),

11+ , JsonFormula (..)

12− satisfiesFormula,

12+ , satisfiesFormula

13− satisfies,

13+ , satisfies

14− showJSONValue,

14+ , showJSONValue

15− showJSONValueInline,

15+ , showJSONValueInline

16 )

17where

18

19import Algebra.Lattice

20import qualified Data.Aeson as A

21−import qualified Data.Aeson.Key as Key

22−import qualified Data.Aeson.KeyMap as KeyMap

23import qualified Data.ByteString.Lazy as BSL

21import qualified Data.ByteString.Lazy as BSL

24import qualified Data.Foldable as F

22import qualified Data.Foldable as F

23+import qualified Data.HashMap.Strict as HM

25import Data.Functor

24import Data.Functor

26import Data.Int

25import Data.Int

27import Data.Kind

26import Data.Kind

@@ -40,7 +39,7 @@ import Data.Text (Text)

40import qualified Data.Text as T

39import qualified Data.Text as T

41import qualified Data.Text.Encoding as T

40import qualified Data.Text.Encoding as T

42import Data.Typeable

41import Data.Typeable

43−import Text.Pandoc.Builder hiding (Format)

42+import Text.Pandoc.Builder hiding (Format, Null)

44import Text.Regex.Pcre2

43import Text.Regex.Pcre2

45

44

46data Bound a = Exclusive !a | Inclusive !a

45data Bound a = Exclusive !a | Inclusive !a

@@ -68,33 +67,30 @@ data Property = Property

68data Condition :: JsonType -> Type where

67data Condition :: JsonType -> Type where

69 Exactly :: TypedValue t -> Condition t

68 Exactly :: TypedValue t -> Condition t

70 Maximum :: !(Bound Scientific) -> Condition 'Number

69 Maximum :: !(Bound Scientific) -> Condition 'Number

71− Minimum ::

70+ Minimum

72− !(Down (Bound (Down Scientific))) ->

71+ :: !(Down (Bound (Down Scientific)))

73− -- | this has the right Ord

72+ -> Condition 'Number -- ^ this has the right Ord

74− Condition 'Number

75 MultipleOf :: !Scientific -> Condition 'Number

73 MultipleOf :: !Scientific -> Condition 'Number

76 NumberFormat :: !Format -> Condition 'Number

74 NumberFormat :: !Format -> Condition 'Number

77 MaxLength :: !Integer -> Condition 'String

75 MaxLength :: !Integer -> Condition 'String

78 MinLength :: !Integer -> Condition 'String

76 MinLength :: !Integer -> Condition 'String

79 Pattern :: !Pattern -> Condition 'String

77 Pattern :: !Pattern -> Condition 'String

80 StringFormat :: !Format -> Condition 'String

78 StringFormat :: !Format -> Condition 'String

81− Items ::

79+ Items

82− !(ForeachType JsonFormula) ->

80+ :: !(ForeachType JsonFormula)

83− !(Traced (Referenced Schema)) ->

81+ -> !(Traced (Referenced Schema))

84− Condition 'Array

82+ -> Condition 'Array

85− TupleItems ::

83+ TupleItems

86− ![(ForeachType JsonFormula, Traced (Referenced Schema))] ->

84+ :: ![(ForeachType JsonFormula, Traced (Referenced Schema))]

87− Condition 'Array

85+ -> Condition 'Array

88 MaxItems :: !Integer -> Condition 'Array

86 MaxItems :: !Integer -> Condition 'Array

89 MinItems :: !Integer -> Condition 'Array

87 MinItems :: !Integer -> Condition 'Array

90 UniqueItems :: Condition 'Array

88 UniqueItems :: Condition 'Array

91− Properties ::

89+ Properties

92− !(M.Map Text Property) ->

90+ :: !(M.Map Text Property)

93− -- | formula for additional properties

91+ -> !(ForeachType JsonFormula) -- ^ formula for additional properties

94− !(ForeachType JsonFormula) ->

92+ -> !(Maybe (Traced (Referenced Schema))) -- ^ schema for additional properties, Nothing means bottom

95− -- | schema for additional properties, Nothing means bottom

93+ -> Condition 'Object

96− !(Maybe (Traced (Referenced Schema))) ->

97− Condition 'Object

98 MaxProperties :: !Integer -> Condition 'Object

94 MaxProperties :: !Integer -> Condition 'Object

99 MinProperties :: !Integer -> Condition 'Object

95 MinProperties :: !Integer -> Condition 'Object

100

96

@@ -122,15 +118,13 @@ showCondition = \case

122 UniqueItems -> para "The elements in the array should be unique."

118 UniqueItems -> para "The elements in the array should be unique."

123 (Properties props additional _) ->

119 (Properties props additional _) ->

124 bulletList $

120 bulletList $

125− ( M.toList props

121+ (M.toList props

126− <&> ( \(k, p) ->

122+ <&> (\(k, p) ->

127− para (code k)

123+ para (code k)

128− <> para (strong $ if propRequired p then "Required" else "Optional")

124+ <> para (strong $ if propRequired p then "Required" else "Optional")

129− <> showForEachJsonFormula (propFormula p)

125+ <> showForEachJsonFormula (propFormula p)))

130− )

131− )

132 <> [ para (emph "Additional properties")

126 <> [ para (emph "Additional properties")

133− <> showForEachJsonFormula additional

127+ <> showForEachJsonFormula additional

134 ]

128 ]

135 (MaxProperties n) -> para $ "The maximum number of fields should be " <> show' n <> "."

129 (MaxProperties n) -> para $ "The maximum number of fields should be " <> show' n <> "."

136 (MinProperties n) -> para $ "The minimum number of fields should be " <> show' n <> "."

130 (MinProperties n) -> para $ "The minimum number of fields should be " <> show' n <> "."

@@ -139,17 +133,15 @@ showCondition = \case

139 showForEachJsonFormula i =

133 showForEachJsonFormula i =

140 bulletList $

134 bulletList $

141 foldType

135 foldType

142− ( \t f -> case getJsonFormula $ f i of

136+ (\t f -> case getJsonFormula $ f i of

143− BottomDNF -> mempty

137+ BottomDNF -> mempty

144− (DNF conds) ->

138+ (DNF conds) ->

145 [ para (describeJSONType t)

139 [ para (describeJSONType t)

146 <> bulletList

140 <> bulletList

147− ( S.toList conds <&> \case

141+ (S.toList conds <&> \case

148− Disjunct (S.toList -> []) -> para "Empty"

142+ Disjunct (S.toList -> []) -> para "Empty"

149− Disjunct (S.toList -> cond) -> bulletList (showCondition <$> cond)

143+ Disjunct (S.toList -> cond) -> bulletList (showCondition <$> cond))

150− )

144+ ])

151− ]

152− )

153

145

154showJSONValue :: A.Value -> Blocks

146showJSONValue :: A.Value -> Blocks

155showJSONValue v = codeBlockWith ("", ["json"], mempty) (T.decodeUtf8 . BSL.toStrict . A.encode $ v)

147showJSONValue v = codeBlockWith ("", ["json"], mempty) (T.decodeUtf8 . BSL.toStrict . A.encode $ v)

@@ -178,10 +170,10 @@ satisfiesTyped (TArray a) (MaxItems m) = fromIntegral (F.length a) <= m

178satisfiesTyped (TArray a) (MinItems m) = fromIntegral (F.length a) >= m

170satisfiesTyped (TArray a) (MinItems m) = fromIntegral (F.length a) >= m

179satisfiesTyped (TArray a) UniqueItems = S.size (S.fromList $ F.toList a) == F.length a -- TODO: could be better #36

171satisfiesTyped (TArray a) UniqueItems = S.size (S.fromList $ F.toList a) == F.length a -- TODO: could be better #36

180satisfiesTyped (TObject o) (Properties props additional _) =

172satisfiesTyped (TObject o) (Properties props additional _) =

181− all (`KeyMap.member` o) (map Key.fromText $ M.keys (M.filter propRequired props))

173+ all (`HM.member` o) (M.keys (M.filter propRequired props))

182− && all (\(k, v) -> satisfies v $ maybe additional propFormula $ M.lookup (Key.toText k) props) (KeyMap.toList o)

174+ && all (\(k, v) -> satisfies v $ maybe additional propFormula $ M.lookup k props) (HM.toList o)

183−satisfiesTyped (TObject o) (MaxProperties m) = fromIntegral (KeyMap.size o) <= m

175+satisfiesTyped (TObject o) (MaxProperties m) = fromIntegral (HM.size o) <= m

184−satisfiesTyped (TObject o) (MinProperties m) = fromIntegral (KeyMap.size o) >= m

176+satisfiesTyped (TObject o) (MinProperties m) = fromIntegral (HM.size o) >= m

185

177

186checkNumberFormat :: Format -> Scientific -> Bool

178checkNumberFormat :: Format -> Scientific -> Bool

187checkNumberFormat "int32" (toRational -> n) =

179checkNumberFormat "int32" (toRational -> n) =

src/Data/OpenApi/Compare/Validate/Schema/Partition.hs+30−34

@@ -1,22 +1,21 @@

1module Data.OpenApi.Compare.Validate.Schema.Partition

2− ( partitionSchema,

2+ ( partitionSchema

3− partitionRefSchema,

3+ , partitionRefSchema

4− selectPartition,

4+ , selectPartition

5− runPartitionM,

5+ , runPartitionM

6− tryPartition,

6+ , tryPartition

7− showPartition,

7+ , showPartition

8− intersectSchema,

8+ , intersectSchema

9− intersectRefSchema,

9+ , intersectRefSchema

10− IntersectionResult (..),

10+ , IntersectionResult (..)

11− runIntersectionM,

11+ , runIntersectionM

12− Partition,

12+ , Partition

13 )

14where

15

16import Algebra.Lattice

17import Algebra.Lattice.Lifted

18import Control.Applicative

19−import Control.Monad (when)

20import Control.Monad.Reader hiding (ask)

19import Control.Monad.Reader hiding (ask)

21import qualified Control.Monad.Reader as R

20import qualified Control.Monad.Reader as R

22import Control.Monad.State

21import Control.Monad.State

@@ -32,7 +31,6 @@ import qualified Data.List as L

32import qualified Data.List.NonEmpty as NE

31import qualified Data.List.NonEmpty as NE

33import qualified Data.Map as M

32import qualified Data.Map as M

34import Data.Maybe

33import Data.Maybe

35−import Data.Monoid

36import Data.OpenApi

34import Data.OpenApi

37import Data.OpenApi.Compare.Memo

35import Data.OpenApi.Compare.Memo

38import Data.OpenApi.Compare.References

36import Data.OpenApi.Compare.References

@@ -45,8 +43,7 @@ import Data.Ord

45import qualified Data.Set as S

43import qualified Data.Set as S

46import Data.Text (Text)

44import Data.Text (Text)

47import qualified Data.Text as T

45import qualified Data.Text as T

48−import Data.Traversable (forM)

46+import Text.Pandoc.Builder hiding (Format, Null)

49−import Text.Pandoc.Builder hiding (Format)

50

47

51data PartitionData

48data PartitionData

52 = DByEnumValue (DNF (S.Set A.Value))

49 = DByEnumValue (DNF (S.Set A.Value))

@@ -146,11 +143,10 @@ partitionCondition = \case

146 Just _ -> top

143 Just _ -> top

147 Nothing ->

144 Nothing ->

148 singletonPart $

145 singletonPart $

149− DByProperties $

146+ DByProperties $ LiteralDNF

150− LiteralDNF

147+ ( M.keysSet $ M.filter (not . propRequired) props

151− ( M.keysSet $ M.filter (not . propRequired) props

148+ , M.keysSet $ M.filter propRequired props

152− , M.keysSet $ M.filter propRequired props

149+ )

153− )

154 inProps <- forM (M.toList $ M.filter propRequired props) $ \(k, prop) -> do

150 inProps <- forM (M.toList $ M.filter propRequired props) $ \(k, prop) -> do

155 f <- partitionRefSchema $ propRefSchema prop

151 f <- partitionRefSchema $ propRefSchema prop

156 pure $ fmap (\(Partitions m) -> Partitions $ M.mapKeysMonotonic (PInProperty k) m) f

152 pure $ fmap (\(Partitions m) -> Partitions $ M.mapKeysMonotonic (PInProperty k) m) f

@@ -160,10 +156,10 @@ partitionCondition = \case

160runPartitionM :: Traced (Definitions Schema) -> PartitionM a -> a

156runPartitionM :: Traced (Definitions Schema) -> PartitionM a -> a

161runPartitionM defs = runIdentity . runMemo () . (`runReaderT` defs)

157runPartitionM defs = runIdentity . runMemo () . (`runReaderT` defs)

162

158

163−partitionJsonFormulas ::

159+partitionJsonFormulas

164− ProdCons (Traced (Definitions Schema)) ->

160+ :: ProdCons (Traced (Definitions Schema))

165− ProdCons (JsonFormula t) ->

161+ -> ProdCons (JsonFormula t)

166− Lifted Partitions

162+ -> Lifted Partitions

167partitionJsonFormulas defs pc = producer pcPart \/ consumer pcPart

163partitionJsonFormulas defs pc = producer pcPart \/ consumer pcPart

168 where

164 where

169 pcPart = partitionFormula <$> defs <*> pc

165 pcPart = partitionFormula <$> defs <*> pc

@@ -215,11 +211,11 @@ runIntersectionM defs act = case runWriterT $ runReaderT act defs of

215 Just (x, Any False) -> Same x

211 Just (x, Any False) -> Same x

216 Just (x, Any True) -> New x

212 Just (x, Any True) -> New x

217

213

218−intersectSchema ::

214+intersectSchema

219− PartitionLocation ->

215+ :: PartitionLocation

220− PartitionChoice ->

216+ -> PartitionChoice

221− Traced Schema ->

217+ -> Traced Schema

222− IntersectionM Schema

218+ -> IntersectionM Schema

223intersectSchema loc part sch = do

219intersectSchema loc part sch = do

224 allOf' <- forM (tracedAllOf sch) $ \rss ->

220 allOf' <- forM (tracedAllOf sch) $ \rss ->

225 -- Assuming i ranges over a nonempty set (checked in processSchema)

221 -- Assuming i ranges over a nonempty set (checked in processSchema)

@@ -262,11 +258,11 @@ intersectSchema loc part sch = do

262 pure $ sch' {_schemaEnum = Just enum'}

258 pure $ sch' {_schemaEnum = Just enum'}

263 CByProperties {} -> error "CByProperties not implemented"

259 CByProperties {} -> error "CByProperties not implemented"

264

260

265−intersectRefSchema ::

261+intersectRefSchema

266− PartitionLocation ->

262+ :: PartitionLocation

267− PartitionChoice ->

263+ -> PartitionChoice

268− Traced (Referenced Schema) ->

264+ -> Traced (Referenced Schema)

269− IntersectionM (Referenced Schema)

265+ -> IntersectionM (Referenced Schema)

270intersectRefSchema loc part rs = do

266intersectRefSchema loc part rs = do

271 defs <- R.ask

267 defs <- R.ask

272 Inline <$> intersectSchema loc part (dereference defs rs)

268 Inline <$> intersectSchema loc part (dereference defs rs)

src/Data/OpenApi/Compare/Validate/Schema/Process.hs+48−47

@@ -1,11 +1,11 @@

1module Data.OpenApi.Compare.Validate.Schema.Process

2− ( schemaToFormula,

2+ ( schemaToFormula

3 )

4where

5

6import Algebra.Lattice

7−import Control.Monad.Reader hiding (ask)

8import qualified Control.Monad.Reader as R

7import qualified Control.Monad.Reader as R

8+import Control.Monad.Reader hiding (ask)

9import Control.Monad.State

10import Control.Monad.Writer

11import qualified Data.Aeson as A

@@ -13,7 +13,6 @@ import Data.Functor.Identity

13import qualified Data.HashMap.Strict.InsOrd as IOHM

14import qualified Data.Map as M

15import Data.Maybe

16−import Data.Monoid

17import Data.OpenApi hiding (get)

16import Data.OpenApi hiding (get)

18import Data.OpenApi.Compare.Behavior

17import Data.OpenApi.Compare.Behavior

19import Data.OpenApi.Compare.Memo

18import Data.OpenApi.Compare.Memo

@@ -29,7 +28,6 @@ import Data.OpenApi.Compare.Validate.Schema.Traced

29import Data.OpenApi.Compare.Validate.Schema.TypedJson

28import Data.OpenApi.Compare.Validate.Schema.TypedJson

30import Data.Ord

29import Data.Ord

31import qualified Data.Set as S

30import qualified Data.Set as S

32−import Data.Traversable (forM)

33

31

34-- | A fake writer monad that doesn't actually record anything and allows lazy recursion.

32-- | A fake writer monad that doesn't actually record anything and allows lazy recursion.

35newtype Silent w a = Silent {runSilent :: a}

33newtype Silent w a = Silent {runSilent :: a}

@@ -41,11 +39,15 @@ instance Monoid w => MonadWriter w (Silent w) where

41 listen (Silent x) = Silent (x, mempty)

39 listen (Silent x) = Silent (x, mempty)

42 pass (Silent (x, _)) = Silent x

40 pass (Silent (x, _)) = Silent x

43

41

42+instance MonadState (MemoState ()) (Silent w) where

43+ get = Silent $ runIdentity $ runMemo () get

44+ put _ = pure ()

45+

44type ProcessM = StateT (MemoState ()) (ReaderT (Traced (Definitions Schema)) (Writer (P.PathsPrefixTree Behave AnIssue 'SchemaLevel)))

46type ProcessM = StateT (MemoState ()) (ReaderT (Traced (Definitions Schema)) (Writer (P.PathsPrefixTree Behave AnIssue 'SchemaLevel)))

45

47

46−type SilentM = StateT (MemoState ()) (ReaderT (Traced (Definitions Schema)) (Silent (P.PathsPrefixTree Behave AnIssue 'SchemaLevel)))

48+type SilentM = ReaderT (Traced (Definitions Schema)) (Silent (P.PathsPrefixTree Behave AnIssue 'SchemaLevel))

47

49

48−-- Either ProcessM or SilentM

50+-- Either SilentM or ProcessM

49type MonadProcess m =

51type MonadProcess m =

50 ( MonadReader (Traced (Definitions Schema)) m

52 ( MonadReader (Traced (Definitions Schema)) m

51 , MonadWriter (P.PathsPrefixTree Behave AnIssue 'SchemaLevel) m

53 , MonadWriter (P.PathsPrefixTree Behave AnIssue 'SchemaLevel) m

@@ -55,11 +57,11 @@ type MonadProcess m =

55warn :: MonadProcess m => Issue 'SchemaLevel -> m ()

57warn :: MonadProcess m => Issue 'SchemaLevel -> m ()

56warn issue = tell $ P.singleton $ AnItem Root $ anIssue issue

58warn issue = tell $ P.singleton $ AnItem Root $ anIssue issue

57

59

58−-- Perform a computation lazily, ignoring the warnings and discarding memoization/loop detection information.

60+-- | Ignore warnings but allow a recursive loop that lazily computes a recursive 'Condition'.

59−lazily :: MonadProcess m => SilentM a -> m a

61+silently :: MonadProcess m => SilentM a -> m a

60−lazily m = do

62+silently m = do

61 defs <- R.ask

63 defs <- R.ask

62− pure $ runSilent $ runReaderT (runMemo () m) defs

64+ pure . runSilent $ runReaderT m defs

63

65

64warnKnot :: MonadProcess m => KnotTier (ForeachType JsonFormula) () m

66warnKnot :: MonadProcess m => KnotTier (ForeachType JsonFormula) () m

65warnKnot =

67warnKnot =

@@ -69,10 +71,10 @@ warnKnot =

69 , tieKnot = \_ -> pure

71 , tieKnot = \_ -> pure

70 }

72 }

71

73

72−processRefSchema ::

74+processRefSchema

73− MonadProcess m =>

75+ :: MonadProcess m

74− Traced (Referenced Schema) ->

76+ => Traced (Referenced Schema)

75− m (ForeachType JsonFormula)

77+ -> m (ForeachType JsonFormula)

76processRefSchema x = do

78processRefSchema x = do

77 defs <- R.ask

79 defs <- R.ask

78 memoWithKnot warnKnot (processSchema $ dereference defs x) (ask x)

80 memoWithKnot warnKnot (processSchema $ dereference defs x) (ask x)

@@ -80,10 +82,10 @@ processRefSchema x = do

80-- | Turn a schema into a tuple of 'JsonFormula's that describes the condition

82-- | Turn a schema into a tuple of 'JsonFormula's that describes the condition

81-- for every possible type of a JSON value. The conditions are independent, and

83-- for every possible type of a JSON value. The conditions are independent, and

82-- are thus checked independently.

84-- are thus checked independently.

83−processSchema ::

85+processSchema

84− MonadProcess m =>

86+ :: MonadProcess m

85− Traced Schema ->

87+ => Traced Schema

86− m (ForeachType JsonFormula)

88+ -> m (ForeachType JsonFormula)

87processSchema sch@(extract -> Schema {..}) = do

89processSchema sch@(extract -> Schema {..}) = do

88 let singletonFormula :: Condition t -> JsonFormula t

90 let singletonFormula :: Condition t -> JsonFormula t

89 singletonFormula = JsonFormula . LiteralDNF

91 singletonFormula = JsonFormula . LiteralDNF

@@ -241,11 +243,11 @@ processSchema sch@(extract -> Schema {..}) = do

241 itemsClause <- case tracedItems sch of

243 itemsClause <- case tracedItems sch of

242 Nothing -> pure top

244 Nothing -> pure top

243 Just (Left rs) -> do

245 Just (Left rs) -> do

244− f <- lazily $ processRefSchema rs

246+ f <- silently $ processRefSchema rs

245 pure top {forArray = singletonFormula $ Items f rs}

247 pure top {forArray = singletonFormula $ Items f rs}

246 Just (Right rss) -> do

248 Just (Right rss) -> do

247 fsrs <- forM rss $ \rs -> do

249 fsrs <- forM rss $ \rs -> do

248− f <- lazily $ processRefSchema rs

250+ f <- silently $ processRefSchema rs

249 pure (f, rs)

251 pure (f, rs)

250 pure top {forArray = singletonFormula $ TupleItems fsrs}

252 pure top {forArray = singletonFormula $ TupleItems fsrs}

251

253

@@ -271,12 +273,12 @@ processSchema sch@(extract -> Schema {..}) = do

271 _ -> top

273 _ -> top

272

274

273 (addProps, addPropSchema) <- case tracedAdditionalProperties sch of

275 (addProps, addPropSchema) <- case tracedAdditionalProperties sch of

274− Just (Right rs) -> (,Just rs) <$> lazily (processRefSchema rs)

276+ Just (Right rs) -> (,Just rs) <$> silently (processRefSchema rs)

275 Just (Left False) -> pure (bottom, Nothing)

277 Just (Left False) -> pure (bottom, Nothing)

276 _ -> pure (top, Just $ traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty)

278 _ -> pure (top, Just $ traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty)

277 propList <- forM (S.toList . S.fromList $ IOHM.keys _schemaProperties <> _schemaRequired) $ \k -> do

279 propList <- forM (S.toList . S.fromList $ IOHM.keys _schemaProperties <> _schemaRequired) $ \k -> do

278 (f, psch) <- case IOHM.lookup k $ tracedProperties sch of

280 (f, psch) <- case IOHM.lookup k $ tracedProperties sch of

279− Just rs -> (,rs) <$> lazily (processRefSchema rs)

281+ Just rs -> (,rs) <$> silently (processRefSchema rs)

280 Nothing ->

282 Nothing ->

281 let fakeSchema = traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty

283 let fakeSchema = traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty

282 in -- The mempty here is incorrect, but if addPropSchema was Nothing, then

284 in -- The mempty here is incorrect, but if addPropSchema was Nothing, then

@@ -329,27 +331,26 @@ processSchema sch@(extract -> Schema {..}) = do

329 pure $

331 pure $

330 nullableClause

332 nullableClause

331 \/ meets

333 \/ meets

332− ( allClauses

334+ (allClauses

333− <> [ anyClause

335+ <> [ anyClause

334− , oneClause

336+ , oneClause

335− , typeClause

337+ , typeClause

336− , enumClause

338+ , enumClause

337− , maximumClause

339+ , maximumClause

338− , minimumClause

340+ , minimumClause

339− , multipleOfClause

341+ , multipleOfClause

340− , formatClause

342+ , formatClause

341− , maxLengthClause

343+ , maxLengthClause

342− , minLengthClause

344+ , minLengthClause

343− , patternClause

345+ , patternClause

344− , itemsClause

346+ , itemsClause

345− , maxItemsClause

347+ , maxItemsClause

346− , minItemsClause

348+ , minItemsClause

347− , uniqueItemsClause

349+ , uniqueItemsClause

348− , propertiesClause

350+ , propertiesClause

349− , maxPropertiesClause

351+ , maxPropertiesClause

350− , minPropertiesClause

352+ , minPropertiesClause

351− ]

353+ ])

352− )

353

354

354{- TODO: ReadOnly/WriteOnly #68 -}

355{- TODO: ReadOnly/WriteOnly #68 -}

355

356

@@ -368,8 +369,8 @@ checkOneOfDisjoint schs = do

368runProcessM :: Traced (Definitions Schema) -> ProcessM a -> (a, P.PathsPrefixTree Behave AnIssue 'SchemaLevel)

369runProcessM :: Traced (Definitions Schema) -> ProcessM a -> (a, P.PathsPrefixTree Behave AnIssue 'SchemaLevel)

369runProcessM defs = runWriter . (`runReaderT` defs) . runMemo ()

370runProcessM defs = runWriter . (`runReaderT` defs) . runMemo ()

370

371

371−schemaToFormula ::

372+schemaToFormula

372− Traced (Definitions Schema) ->

373+ :: Traced (Definitions Schema)

373− Traced Schema ->

374+ -> Traced Schema

374− (ForeachType JsonFormula, P.PathsPrefixTree Behave AnIssue 'SchemaLevel)

375+ -> (ForeachType JsonFormula, P.PathsPrefixTree Behave AnIssue 'SchemaLevel)

375schemaToFormula defs rs = runProcessM defs $ processSchema rs

376schemaToFormula defs rs = runProcessM defs $ processSchema rs

src/Data/OpenApi/Compare/Validate/Schema/Traced.hs+12−12

@@ -1,18 +1,18 @@

1{-# OPTIONS_GHC -Wno-orphans #-}

2

3module Data.OpenApi.Compare.Validate.Schema.Traced

4− ( Step (..),

4+ ( Step (..)

5− tracedAllOf,

5+ , tracedAllOf

6− tracedAnyOf,

6+ , tracedAnyOf

7− tracedOneOf,

7+ , tracedOneOf

8− tracedItems,

8+ , tracedItems

9− tracedAdditionalProperties,

9+ , tracedAdditionalProperties

10− tracedDiscriminator,

10+ , tracedDiscriminator

11− tracedProperties,

11+ , tracedProperties

12− tracedConjunct,

12+ , tracedConjunct

13− PartitionLocation (..),

13+ , PartitionLocation (..)

14− PartitionChoice (..),

14+ , PartitionChoice (..)

15− Partition,

15+ , Partition

16 )

17where

18

src/Data/OpenApi/Compare/Validate/Schema/TypedJson.hs+23−25

@@ -1,11 +1,11 @@

1module Data.OpenApi.Compare.Validate.Schema.TypedJson

2− ( JsonType (..),

2+ ( JsonType (..)

3− describeJSONType,

3+ , describeJSONType

4− TypedValue (..),

4+ , TypedValue (..)

5− untypeValue,

5+ , untypeValue

6− ForeachType (..),

6+ , ForeachType (..)

7− foldType,

7+ , foldType

8− forType_,

8+ , forType_

9 )

10where

11

@@ -88,26 +88,24 @@ forType_ :: Applicative m => (forall x. Typeable x => JsonType -> (ForeachType f

88forType_ k = getAp $ foldType (\ty proj -> Ap $ k ty proj)

89

90broadcastType :: (forall x. Typeable x => f x) -> ForeachType f

91−broadcastType k =

91+broadcastType k = ForeachType

92− ForeachType

92+ { forNull = k

93− { forNull = k

93+ , forBoolean = k

94− , forBoolean = k

94+ , forNumber = k

95− , forNumber = k

95+ , forString = k

96− , forString = k

96+ , forArray = k

97− , forArray = k

97+ , forObject = k

98− , forObject = k

98+ }

99− }

100

99

101zipType :: (forall x. Typeable x => f x -> g x -> h x) -> ForeachType f -> ForeachType g -> ForeachType h

100zipType :: (forall x. Typeable x => f x -> g x -> h x) -> ForeachType f -> ForeachType g -> ForeachType h

102−zipType k f1 f2 =

101+zipType k f1 f2 = ForeachType

103− ForeachType

102+ { forNull = k (forNull f1) (forNull f2)

104− { forNull = k (forNull f1) (forNull f2)

103+ , forBoolean = k (forBoolean f1) (forBoolean f2)

105− , forBoolean = k (forBoolean f1) (forBoolean f2)

104+ , forNumber = k (forNumber f1) (forNumber f2)

106− , forNumber = k (forNumber f1) (forNumber f2)

105+ , forString = k (forString f1) (forString f2)

107− , forString = k (forString f1) (forString f2)

106+ , forArray = k (forArray f1) (forArray f2)

108− , forArray = k (forArray f1) (forArray f2)

107+ , forObject = k (forObject f1) (forObject f2)

109− , forObject = k (forObject f1) (forObject f2)

108+ }

110− }

111

109

112instance (forall x. Lattice (f x)) => Lattice (ForeachType f) where

110instance (forall x. Lattice (f x)) => Lattice (ForeachType f) where

113 (\/) = zipType (\/)

111 (\/) = zipType (\/)

src/Data/OpenApi/Compare/Validate/SecurityRequirement.hs+8−9

@@ -2,7 +2,7 @@

2{-# OPTIONS_GHC -Wno-orphans #-}

3

4module Data.OpenApi.Compare.Validate.SecurityRequirement

5− ( Issue (..),

5+ ( Issue (..)

6 )

7where

8

@@ -41,19 +41,18 @@ instance Subtree SecurityRequirement where

41 for (IOHM.toList $ getSecurityRequirement sec) $ \(key, scopes) ->

42 (,scopes) <$> lookupScheme key defs

43 structuralMaybeWith

44− ( \pc' -> do

44+ (\pc' -> do

45− let ProdCons pScopes cScopes = fmap snd <$> pc'

45+ let ProdCons pScopes cScopes = fmap snd <$> pc'

46− unless (pScopes == cScopes) structuralIssue

46+ unless (pScopes == cScopes) structuralIssue

47− structuralList env $ fmap fst <$> pc'

47+ structuralList env $ fmap fst <$> pc'

48− pure ()

48+ pure ())

49− )

50 normalized

49 normalized

51 pure ()

50 pure ()

52 checkSemanticCompatibility env bhv' pc = do

51 checkSemanticCompatibility env bhv' pc = do

53 let schemes = getH @(ProdCons (Traced (Definitions SecurityScheme))) env

52 let schemes = getH @(ProdCons (Traced (Definitions SecurityScheme))) env

54 ( ProdCons pErrs cErrs

53 ( ProdCons pErrs cErrs

55− , (ProdCons pSchemes cSchemes) ::

54+ , (ProdCons pSchemes cSchemes)

56− ProdCons [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]

55+ :: ProdCons [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]

57 ) =

56 ) =

58 NE.unzip $

57 NE.unzip $

59 partitionEithers <$> do

58 partitionEithers <$> do

src/Data/OpenApi/Compare/Validate/Server.hs+9−10

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

1{-# OPTIONS_GHC -Wno-orphans #-}

2

3module Data.OpenApi.Compare.Validate.Server

4− ( Issue (..),

4+ ( Issue (..)

5 )

6where

7

@@ -31,9 +31,9 @@ import Data.Traversable

31import Text.Pandoc.Builder

32import Prelude as P

33

34−tracedParsedServerUrlParts ::

34+tracedParsedServerUrlParts

35− Server ->

35+ :: Server

36− Either (Issue 'ServerLevel) ProcessedServer

36+ -> Either (Issue 'ServerLevel) ProcessedServer

37tracedParsedServerUrlParts s =

38 let parsedUrl = parseServerUrl $ _serverUrl s

39 lookupVar var = case IOHM.lookup var (_serverVariables s) of

@@ -63,12 +63,11 @@ instance Subtree [Server] where

63 pcServer

64 <&> partitionEithers

65 . fmap

66− ( \(Traced t s) ->

66+ (\(Traced t s) ->

67− let bhv = beh >>> step (InServer $ _serverUrl s)

67+ let bhv = beh >>> step (InServer $ _serverUrl s)

68− in case tracedParsedServerUrlParts s of

68+ in case tracedParsedServerUrlParts s of

69− Left e -> Left $ issueAt bhv e

69+ Left e -> Left $ issueAt bhv e

70− Right u -> Right (bhv, Traced (t >>> step (ServerStep $ _serverUrl s)) u)

70+ Right u -> Right (bhv, Traced (t >>> step (ServerStep $ _serverUrl s)) u))

71− )

72 . sequence

71 . sequence

73 sequenceA_ pErrs

72 sequenceA_ pErrs

74 sequenceA_ cErrs

73 sequenceA_ cErrs

src/Data/OpenApi/Compare/Validate/Sums.hs+11−12

@@ -1,25 +1,24 @@

1module Data.OpenApi.Compare.Validate.Sums

2− ( checkSums,

2+ ( checkSums

3− )

3+ ) where

4−where

5

4

6import Data.Foldable

5import Data.Foldable

7import Data.Map.Strict (Map)

6import Data.Map.Strict (Map)

8import qualified Data.Map.Strict as M

7import qualified Data.Map.Strict as M

9import Data.OpenApi.Compare.Behavior

8import Data.OpenApi.Compare.Behavior

10−import Data.OpenApi.Compare.Paths

11import Data.OpenApi.Compare.Subtree

9import Data.OpenApi.Compare.Subtree

10+import Data.OpenApi.Compare.Paths

12

11

13−checkSums ::

12+checkSums

14− (Ord k, Issuable l) =>

13+ :: (Ord k, Issuable l)

15− Paths q r l ->

14+ => Paths q r l

16− (k -> Issue l) ->

15+ -> (k -> Issue l)

17− (k -> ProdCons t -> CompatFormula' q AnIssue r ()) ->

16+ -> (k -> ProdCons t -> CompatFormula' q AnIssue r ())

18− ProdCons (Map k t) ->

17+ -> ProdCons (Map k t)

19− CompatFormula' q AnIssue r ()

18+ -> CompatFormula' q AnIssue r ()

20checkSums xs noElt check (ProdCons p c) = for_ (M.toList p) $ \(key, prodElt) ->

19checkSums xs noElt check (ProdCons p c) = for_ (M.toList p) $ \(key, prodElt) ->

21 case M.lookup key c of

20 case M.lookup key c of

22 Nothing -> issueAt xs $ noElt key

21 Nothing -> issueAt xs $ noElt key

23 Just consElt ->

22 Just consElt ->

24 let sumElts = ProdCons prodElt consElt

23 let sumElts = ProdCons prodElt consElt

25− in check key sumElts

24+ in check key sumElts

src/Data/OpenUnion/Extra.hs+5−5

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

1module Data.OpenUnion.Extra

2− ( (@@>),

2+ ( (@@>)

3− TryLiftUnion (..),

3+ , TryLiftUnion (..)

4− pattern SingletonUnion,

4+ , pattern SingletonUnion

5 )

6where

7

@@ -18,8 +18,8 @@ instance TryLiftUnion '[] where

18 tryLiftUnion _ = empty

19

20instance

21− (Typeable y, SubList ys (y : ys), TryLiftUnion ys) =>

21+ (Typeable y, SubList ys (y : ys), TryLiftUnion ys)

22− TryLiftUnion (y ': ys)

22+ => TryLiftUnion (y ': ys)

23 where

24 tryLiftUnion (x :: x) = case eqT @x @y of

25 Nothing -> reUnion <$> tryLiftUnion @ys x

stack.yaml+6−18

@@ -1,23 +1,11 @@

1−resolver: lts-22.34

1+resolver: lts-18.4

2−

3−packages:

4− - .

5

2

6extra-deps:

3extra-deps:

7− - base16-bytestring-1.0.2.0

8− - freer-simple-1.2.1.2

9− - generics-sop-0.5.1.4

10− - github-0.29

11− - http-link-header-1.2.1

12 - open-union-0.4.0.0

4 - open-union-0.4.0.0

13− - th-abstraction-0.7.0.0

14 - type-fun-0.1.3

5 - type-fun-0.1.3

15− - typerep-map-0.6.0.0

6+ - github-0.26

16−

7+ - base16-bytestring-0.1.1.7

17−# Required for freer-simple and typerep-map

8+ - http-link-header-1.0.3.1

18−allow-newer: true

19

9

20−nix:

10+apply-ghc-options: everything

21−# packages: [pkg-config yq zlib]

11+rebuild-ghc-options: true

22− shell-file: ./nix/shell.nix

23− pure: false

stack.yaml.lock+4−4

@@ -41,7 +41,7 @@ packages:

41 hackage: http-link-header-1.0.3.1

42snapshots:

43- completed:

44− size: 587393

44+ size: 585817

45− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/25.yaml

45+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/4.yaml

46− sha256: 1b74fb5e970497b5aefae56703f1bd44aa648bd1a5ef95c1eb8c29775087e2bf

46+ sha256: ea3a318eafa9e9cc56bfbe46099fd0d54d32641ab7bbe1d182ed8f5de39f804c

47− original: lts-18.25

47+ original: lts-18.4

test/Spec/Golden/Extra.hs+44−48

@@ -1,8 +1,8 @@

1module Spec.Golden.Extra

2− ( getGoldenInputs,

2+ ( getGoldenInputs

3− getGoldenInputsUniform,

3+ , getGoldenInputsUniform

4− goldenInputsTree,

4+ , goldenInputsTree

5− goldenInputsTreeUniform,

5+ , goldenInputsTreeUniform

6 )

7where

8

@@ -19,12 +19,12 @@ data TestInput t

19 | TestInputLeaf TestName t FilePath

20 deriving stock (Functor)

21

22−getGoldenInputs ::

22+getGoldenInputs

23− (Each s t (FilePath, FilePath -> IO a) a) =>

23+ :: (Each s t (FilePath, FilePath -> IO a) a)

24− TestName ->

24+ => TestName

25− FilePath ->

25+ -> FilePath

26− s ->

26+ -> s

27− IO (TestInput t)

27+ -> IO (TestInput t)

28getGoldenInputs name filepath inp = do

29 dirs' <- listDirectory filepath >>= filterM (doesDirectoryExist . (filepath </>))

30 case dirs' of

@@ -39,55 +39,51 @@ getGoldenInputs name filepath inp = do

39 TestInputNode name

40 <$> forM dirs (\dir -> getGoldenInputs dir (filepath </> dir) inp)

41

42−getGoldenInputsUniform ::

42+getGoldenInputsUniform

43− (Each t h (FilePath, FilePath -> IO a) a) =>

43+ :: (Each t h (FilePath, FilePath -> IO a) a)

44− (Each s t FilePath (FilePath, FilePath -> IO a)) =>

44+ => (Each s t FilePath (FilePath, FilePath -> IO a))

45− TestName ->

45+ => TestName

46− (FilePath -> IO a) ->

46+ -> (FilePath -> IO a)

47− FilePath ->

47+ -> FilePath

48− s ->

48+ -> s

49− IO (TestInput h)

49+ -> IO (TestInput h)

50getGoldenInputsUniform name f filepath inp = getGoldenInputs name filepath $ inp & each %~ (,f)

51

52−goldenInputsTree ::

52+goldenInputsTree

53− (Each s t (FilePath, FilePath -> IO a) a) =>

53+ :: (Each s t (FilePath, FilePath -> IO a) a)

54− TestName ->

54+ => TestName

55− -- | Root path

55+ -> FilePath -- ^ Root path

56− FilePath ->

56+ -> FilePath -- ^ Name of golden file

57− -- | Name of golden file

57+ -> s

58− FilePath ->

58+ -> (t -> IO BSL.ByteString)

59− s ->

59+ -> IO TestTree

60− (t -> IO BSL.ByteString) ->

60+goldenInputsTree name filepath golden inp f = do

61− IO TestTree

62−goldenInputsTree name filepath golden inp f =

63 runTestInputTree golden f <$> getGoldenInputs name filepath inp

61 runTestInputTree golden f <$> getGoldenInputs name filepath inp

64

62

65−runTestInputTree ::

63+runTestInputTree

66− FilePath ->

64+ :: FilePath

67− (t -> IO BSL.ByteString) ->

65+ -> (t -> IO BSL.ByteString)

68− TestInput t ->

66+ -> TestInput t

69− TestTree

67+ -> TestTree

70runTestInputTree golden f (TestInputNode name rest) =

68runTestInputTree golden f (TestInputNode name rest) =

71 testGroup name (runTestInputTree golden f <$> rest)

69 testGroup name (runTestInputTree golden f <$> rest)

72runTestInputTree golden f (TestInputLeaf name t path) =

70runTestInputTree golden f (TestInputLeaf name t path) =

73 goldenVsStringDiff

71 goldenVsStringDiff

74 name

72 name

75− (\ref new -> ["diff-yaml", ref, new])

73+ (\ref new -> ["diff", "-u", ref, new])

76 (path </> golden)

74 (path </> golden)

77 (f t)

75 (f t)

78

76

79−goldenInputsTreeUniform ::

77+goldenInputsTreeUniform

80− ( Each t h (FilePath, FilePath -> IO a) a

78+ :: ( Each t h (FilePath, FilePath -> IO a) a

81− , Each s t FilePath (FilePath, FilePath -> IO a)

79+ , Each s t FilePath (FilePath, FilePath -> IO a)

82− ) =>

80+ )

83− String ->

81+ => String

84− -- | Root path

82+ -> FilePath -- ^ Root path

85− FilePath ->

83+ -> FilePath -- ^ Name of golden file

86− -- | Name of golden file

84+ -> s

87− FilePath ->

85+ -> (FilePath -> IO a)

88− s ->

86+ -> (h -> IO BSL.ByteString)

89− (FilePath -> IO a) ->

87+ -> IO TestTree

90− (h -> IO BSL.ByteString) ->

91− IO TestTree

92goldenInputsTreeUniform name filepath golden inp h =

88goldenInputsTreeUniform name filepath golden inp h =

93 goldenInputsTree name filepath golden (inp & each %~ (,h))

89 goldenInputsTree name filepath golden (inp & each %~ (,h))

test/Spec/Golden/TraceTree.hs+2−2

@@ -25,7 +25,7 @@ tests = do

25 traceTreeTests <-

26 goldenInputsTreeUniform

27 "TraceTree"

28− "test/golden"

28+ "test/golden/common"

29 "trace-tree.yaml"

30 ("a.yaml", "b.yaml")

31 Yaml.decodeFileThrow

@@ -34,7 +34,7 @@ tests = do

34 reportTests <-

35 goldenInputsTreeUniform

36 "Report"

37− "test/golden"

37+ "test/golden/common"

38 "report.md"

39 ("a.yaml", "b.yaml")

40 Yaml.decodeFileThrow

test/golden/common/bad-oneof-unchanged/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes | [❓ Unsupported feature changes](#unsupported-changes) |

4−|---------------------|-------------------------|--------------------------------------------------------|

4+|--------------------|-------------------------|-------------------------------------------------------|

5−| 0 | 0 | 2 |

5+| 0 | 0 | 2 |

6

7# ❓ Unsupported feature changes

8

test/golden/common/enum-added/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 1 | 1 |

5+| 1 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/enum-anyof/report.md+2−2

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

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes |

4−|---------------------|-------------------------|

4+|--------------------|-------------------------|

5−| 0 | 0 |

5+| 0 | 0 |

test/golden/common/id/report.md+2−2

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

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes |

4−|---------------------|-------------------------|

4+|--------------------|-------------------------|

5−| 0 | 0 |

5+| 0 | 0 |

test/golden/common/json/recursive/report.md+2−2

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

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes |

4−|---------------------|-------------------------|

4+|--------------------|-------------------------|

5−| 0 | 0 |

5+| 0 | 0 |

test/golden/common/maximum-lowered/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 1 | 1 |

5+| 1 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/parameters/allowEmptyValue/reset/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 1 | 0 |

5+| 1 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/parameters/allowEmptyValue/set/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|---------------------|--------------------------------------------------|

4+|--------------------|--------------------------------------------------|

5−| 0 | 1 |

5+| 0 | 1 |

6

7# ⚠️ Non-breaking changes

8

test/golden/common/pathItem/operation/parameters/change/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 1 | 1 |

5+| 1 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/parameters/required/false/add/report.md+2−2

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

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes |

4−|---------------------|-------------------------|

4+|--------------------|-------------------------|

5−| 0 | 0 |

5+| 0 | 0 |

test/golden/common/pathItem/operation/parameters/required/false/del/report.md+2−2

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

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes |

4−|---------------------|-------------------------|

4+|--------------------|-------------------------|

5−| 0 | 0 |

5+| 0 | 0 |

test/golden/common/pathItem/operation/parameters/required/reset/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|---------------------|--------------------------------------------------|

4+|--------------------|--------------------------------------------------|

5−| 0 | 1 |

5+| 0 | 1 |

6

7# ⚠️ Non-breaking changes

8

test/golden/common/pathItem/operation/parameters/required/set/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 1 | 0 |

5+| 1 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/parameters/required/true/add/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 1 | 0 |

5+| 1 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/parameters/required/true/del/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|---------------------|--------------------------------------------------|

4+|--------------------|--------------------------------------------------|

5−| 0 | 1 |

5+| 0 | 1 |

6

7# ⚠️ Non-breaking changes

8

test/golden/common/pathItem/operation/requestBody/mediaTypeObject/add/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|---------------------|--------------------------------------------------|

4+|--------------------|--------------------------------------------------|

5−| 0 | 1 |

5+| 0 | 1 |

6

7# ⚠️ Non-breaking changes

8

test/golden/common/pathItem/operation/requestBody/mediaTypeObject/change/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 1 | 1 |

5+| 1 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/requestBody/mediaTypeObject/del/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 1 | 0 |

5+| 1 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/requestBody/required/reset/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|---------------------|--------------------------------------------------|

4+|--------------------|--------------------------------------------------|

5−| 0 | 1 |

5+| 0 | 1 |

6

7# ⚠️ Non-breaking changes

8

test/golden/common/pathItem/operation/requestBody/required/set/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 1 | 0 |

5+| 1 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/responses/add/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 1 | 0 |

5+| 1 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/responses/change/headers/mandatory/add/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|---------------------|--------------------------------------------------|

4+|--------------------|--------------------------------------------------|

5−| 0 | 1 |

5+| 0 | 1 |

6

7# ⚠️ Non-breaking changes

8

test/golden/common/pathItem/operation/responses/change/headers/mandatory/del/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 1 | 0 |

5+| 1 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/responses/change/headers/optional/add/report.md+2−2

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

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes |

4−|---------------------|-------------------------|

4+|--------------------|-------------------------|

5−| 0 | 0 |

5+| 0 | 0 |

test/golden/common/pathItem/operation/responses/change/headers/optional/del/report.md+2−2

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

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes |

4−|---------------------|-------------------------|

4+|--------------------|-------------------------|

5−| 0 | 0 |

5+| 0 | 0 |

test/golden/common/pathItem/operation/responses/change/mediaTypeObject/add/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 1 | 0 |

5+| 1 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/responses/change/mediaTypeObject/change/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 1 | 1 |

5+| 1 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/pathItem/operation/responses/change/mediaTypeObject/del/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|---------------------|--------------------------------------------------|

4+|--------------------|--------------------------------------------------|

5−| 0 | 1 |

5+| 0 | 1 |

6

7# ⚠️ Non-breaking changes

8

test/golden/common/pathItem/operation/responses/del/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|---------------------|--------------------------------------------------|

4+|--------------------|--------------------------------------------------|

5−| 0 | 1 |

5+| 0 | 1 |

6

7# ⚠️ Non-breaking changes

8

test/golden/common/property-removed-additional/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 3 | 3 |

5+| 3 | 3 |

6

7# ❌ Breaking changes

8

test/golden/common/property-removed/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 2 | 0 |

5+| 2 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/property-required/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 1 | 1 |

5+| 1 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/random-example/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 5 | 6 |

5+| 5 | 6 |

6

7# ❌ Breaking changes

8

test/golden/common/random-example/trace-tree.yaml+4−4

@@ -23,10 +23,6 @@ forwardChanges:

23backwardChanges:

24 AtPath "/pets":

25 InOperation GetMethod:

26− InParam "limit":

27− InParamSchema:

28− OfType Number: MatchingMaximumWeak (ProdCons {producer = Inclusive 30.0,

29− consumer = Inclusive 20.0})

30 WithStatusCode 200:

26 WithStatusCode 200:

31 ResponsePayload:

27 ResponsePayload:

32 PayloadSchema:

28 PayloadSchema:

@@ -37,6 +33,10 @@ backwardChanges:

37 - TypesRestricted [Number]

33 - TypesRestricted [Number]

38 - AdditionalToProperty

34 - AdditionalToProperty

39 - OfType Number: NoMatchingMultipleOf 1.0

35 - OfType Number: NoMatchingMultipleOf 1.0

36+ InParam "limit":

37+ InParamSchema:

38+ OfType Number: MatchingMaximumWeak (ProdCons {producer = Inclusive 30.0,

39+ consumer = Inclusive 20.0})

40 InOperation PostMethod:

41 InRequest:

42 InPayload:

test/golden/common/recursive/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 1 | 1 |

5+| 1 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/security-scheme/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 2 | 1 |

5+| 2 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/servers/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 3 | 1 |

5+| 3 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/tuple-items/heterogeneous-component-mismatch/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 2 | 2 |

5+| 2 | 2 |

6

7# ❌ Breaking changes

8

test/golden/common/tuple-items/heterogeneous-length-mismatch/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | ⚠️ Non-breaking changes |

4−|------------------------------------------|-------------------------|

4+|-----------------------------------------|-------------------------|

5−| 2 | 0 |

5+| 2 | 0 |

6

7# ❌ Breaking changes

8

test/golden/common/tuple-items/homogeneous-component-mismatch/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 4 | 2 |

5+| 4 | 2 |

6

7# ❌ Breaking changes

8

test/golden/common/tuple-items/homogeneous-length-mismatch/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 5 | 5 |

5+| 5 | 5 |

6

7# ❌ Breaking changes

8

test/golden/common/tuple-items/homogeneous-vector/report.md+2−2

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

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes |

4−|---------------------|-------------------------|

4+|--------------------|-------------------------|

5−| 0 | 0 |

5+| 0 | 0 |

test/golden/common/type-changing/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 6 | 6 |

5+| 6 | 6 |

6

7# ❌ Breaking changes

8

test/golden/common/unguarded-recursive/basic/a.yaml → test/golden/common/unguarded-recursive/a.yamlrenamed

The content is the same.

test/golden/common/unguarded-recursive/basic/b.yaml → test/golden/common/unguarded-recursive/b.yamlrenamed

The content is the same.

test/golden/common/unguarded-recursive/basic/report.md → test/golden/common/unguarded-recursive/report.mdrenamed+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| ❌ Breaking changes | ⚠️ Non-breaking changes | [❓ Unsupported feature changes](#unsupported-changes) |

4−|---------------------|-------------------------|--------------------------------------------------------|

4+|--------------------|-------------------------|-------------------------------------------------------|

5−| 0 | 0 | 1 |

5+| 0 | 0 | 1 |

6

7# ❓ Unsupported feature changes

8

test/golden/common/unguarded-recursive/silent/a.yamldeleted−25

@@ -1,25 +0,0 @@

1−components:

2− schemas:

3− A:

4− type: object

5− properties:

6− bar:

7− $ref: "#/components/schemas/B"

8− B:

9− anyOf:

10− - $ref: "#/components/schemas/B"

11− type: object

12−openapi: 3.0.0

13−info:

14− version: ""

15− title: ""

16−paths:

17− /foo:

18− get:

19− responses:

20− "200":

21− content:

22− application/json;charset=utf-8:

23− schema:

24− $ref: "#/components/schemas/A"

25− description: ""

test/golden/common/unguarded-recursive/silent/b.yamldeleted−19

@@ -1,19 +0,0 @@

1−components:

2− schemas: {}

3−openapi: 3.0.0

4−info:

5− version: ""

6− title: ""

7−paths:

8− /foo:

9− get:

10− responses:

11− "200":

12− content:

13− application/json;charset=utf-8:

14− schema:

15− type: object

16− properties:

17− bar:

18− type: object

19− description: ""

test/golden/common/unguarded-recursive/silent/report.mddeleted−15

@@ -1,15 +0,0 @@

1−# Summary

2−

3−| ❌ Breaking changes | ⚠️ Non-breaking changes | [❓ Unsupported feature changes](#unsupported-changes) |

4−|---------------------|-------------------------|--------------------------------------------------------|

5−| 0 | 0 | 1 |

6−

7−# ❓ Unsupported feature changes

8−

9−## **GET** /foo

10−

11−### ⬅️☁️ JSON Response – 200

12−

13−#### `$.bar`

14−

15−Encountered recursion that is too complex for CompaREST to untangle.

test/golden/common/unguarded-recursive/silent/trace-tree.yamldeleted−16

@@ -1,16 +0,0 @@

1−forwardChanges:

2− AtPath "/foo":

3− InOperation GetMethod:

4− WithStatusCode 200:

5− ResponsePayload:

6− PayloadSchema:

7− OfType Object:

8− InProperty "bar": UnguardedRecursion

9−backwardChanges:

10− AtPath "/foo":

11− InOperation GetMethod:

12− WithStatusCode 200:

13− ResponsePayload:

14− PayloadSchema:

15− OfType Object:

16− InProperty "bar": UnguardedRecursion

test/golden/common/unguarded-recursive/basic/trace-tree.yaml → test/golden/common/unguarded-recursive/trace-tree.yamlrenamed

The content is the same.

test/golden/common/variant-added/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 1 | 1 |

5+| 1 | 1 |

6

7# ❌ Breaking changes

8

test/golden/common/variant-changed/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 2 | 2 |

5+| 2 | 2 |

6

7# ❌ Breaking changes

8

test/golden/common/variant-deep-changed/report.md+2−2

@@ -1,8 +1,8 @@

1# Summary

2

3| [❌ Breaking changes](#breaking-changes) | [⚠️ Non-breaking changes](#non-breaking-changes) |

4−|------------------------------------------|--------------------------------------------------|

4+|-----------------------------------------|--------------------------------------------------|

5−| 2 | 2 |

5+| 2 | 2 |

6

7# ❌ Breaking changes

8