db716ee · typeable/compaREST

compaREST.cabal+1−1

compare with master

unifiedsplit

@@ -14,7 +14,7 @@ extra-doc-files: README.md

14 CHANGELOG.md

15tested-with: GHC == 8.10.4

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

17−data-files:

17+extra-source-files:

18 test/golden/**/*.yaml

19 test/golden/**/*.md

20

src/Data/OpenApi/Compare/Validate/Schema/Process.hs+10−14

@@ -39,15 +39,11 @@ instance Monoid w => MonadWriter w (Silent w) where

39 listen (Silent x) = Silent (x, mempty)

40 pass (Silent (x, _)) = Silent x

41

42−instance MonadState (MemoState ()) (Silent w) where

43− get = Silent $ runIdentity $ runMemo () get

44− put _ = pure ()

45−

46type ProcessM = StateT (MemoState ()) (ReaderT (Traced (Definitions Schema)) (Writer (P.PathsPrefixTree Behave AnIssue 'SchemaLevel)))

42type ProcessM = StateT (MemoState ()) (ReaderT (Traced (Definitions Schema)) (Writer (P.PathsPrefixTree Behave AnIssue 'SchemaLevel)))

47

43

48−type SilentM = ReaderT (Traced (Definitions Schema)) (Silent (P.PathsPrefixTree Behave AnIssue 'SchemaLevel))

44+type SilentM = StateT (MemoState ()) (ReaderT (Traced (Definitions Schema)) (Silent (P.PathsPrefixTree Behave AnIssue 'SchemaLevel)))

49

45

50−-- Either SilentM or ProcessM

46+-- Either ProcessM or SilentM

51type MonadProcess m =

47type MonadProcess m =

52 ( MonadReader (Traced (Definitions Schema)) m

48 ( MonadReader (Traced (Definitions Schema)) m

53 , MonadWriter (P.PathsPrefixTree Behave AnIssue 'SchemaLevel) m

49 , MonadWriter (P.PathsPrefixTree Behave AnIssue 'SchemaLevel) m

@@ -57,11 +53,11 @@ type MonadProcess m =

57warn :: MonadProcess m => Issue 'SchemaLevel -> m ()

53warn :: MonadProcess m => Issue 'SchemaLevel -> m ()

58warn issue = tell $ P.singleton $ AnItem Root $ anIssue issue

54warn issue = tell $ P.singleton $ AnItem Root $ anIssue issue

59

55

60−-- | Ignore warnings but allow a recursive loop that lazily computes a recursive 'Condition'.

56+-- Perform a computation lazily, ignoring the warnings and discarding memoization/loop detection information.

61−silently :: MonadProcess m => SilentM a -> m a

57+lazily :: MonadProcess m => SilentM a -> m a

62−silently m = do

58+lazily m = do

63 defs <- R.ask

59 defs <- R.ask

64− pure . runSilent $ runReaderT m defs

60+ pure $ runSilent $ runReaderT (runMemo () m) defs

65

61

66warnKnot :: MonadProcess m => KnotTier (ForeachType JsonFormula) () m

62warnKnot :: MonadProcess m => KnotTier (ForeachType JsonFormula) () m

67warnKnot =

63warnKnot =

@@ -243,11 +239,11 @@ processSchema sch@(extract -> Schema {..}) = do

243 itemsClause <- case tracedItems sch of

239 itemsClause <- case tracedItems sch of

244 Nothing -> pure top

240 Nothing -> pure top

245 Just (Left rs) -> do

241 Just (Left rs) -> do

246− f <- silently $ processRefSchema rs

242+ f <- lazily $ processRefSchema rs

247 pure top {forArray = singletonFormula $ Items f rs}

243 pure top {forArray = singletonFormula $ Items f rs}

248 Just (Right rss) -> do

244 Just (Right rss) -> do

249 fsrs <- forM rss $ \rs -> do

245 fsrs <- forM rss $ \rs -> do

250− f <- silently $ processRefSchema rs

246+ f <- lazily $ processRefSchema rs

251 pure (f, rs)

247 pure (f, rs)

252 pure top {forArray = singletonFormula $ TupleItems fsrs}

248 pure top {forArray = singletonFormula $ TupleItems fsrs}

253

249

@@ -273,12 +269,12 @@ processSchema sch@(extract -> Schema {..}) = do

273 _ -> top

269 _ -> top

274

270

275 (addProps, addPropSchema) <- case tracedAdditionalProperties sch of

271 (addProps, addPropSchema) <- case tracedAdditionalProperties sch of

276− Just (Right rs) -> (,Just rs) <$> silently (processRefSchema rs)

272+ Just (Right rs) -> (,Just rs) <$> lazily (processRefSchema rs)

277 Just (Left False) -> pure (bottom, Nothing)

273 Just (Left False) -> pure (bottom, Nothing)

278 _ -> pure (top, Just $ traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty)

274 _ -> pure (top, Just $ traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty)

279 propList <- forM (S.toList . S.fromList $ IOHM.keys _schemaProperties <> _schemaRequired) $ \k -> do

275 propList <- forM (S.toList . S.fromList $ IOHM.keys _schemaProperties <> _schemaRequired) $ \k -> do

280 (f, psch) <- case IOHM.lookup k $ tracedProperties sch of

276 (f, psch) <- case IOHM.lookup k $ tracedProperties sch of

281− Just rs -> (,rs) <$> silently (processRefSchema rs)

277+ Just rs -> (,rs) <$> lazily (processRefSchema rs)

282 Nothing ->

278 Nothing ->

283 let fakeSchema = traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty

279 let fakeSchema = traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty

284 in -- The mempty here is incorrect, but if addPropSchema was Nothing, then

280 in -- The mempty here is incorrect, but if addPropSchema was Nothing, then

test/Spec/Golden/TraceTree.hs+2−4

@@ -12,7 +12,6 @@ import Data.OpenApi.Compare.Validate.OpenApi ()

12import Data.Text (Text)

13import qualified Data.Text.Encoding as T

14import qualified Data.Yaml as Yaml

15−import Paths_compaREST

16import Spec.Golden.Extra

15import Spec.Golden.Extra

17import Test.Tasty (TestTree, testGroup)

16import Test.Tasty (TestTree, testGroup)

18import Text.Pandoc.Builder

17import Text.Pandoc.Builder

@@ -23,11 +22,10 @@ import Prelude hiding (id, (.))

23

22

24tests :: IO TestTree

23tests :: IO TestTree

25tests = do

24tests = do

26− dir <- getDataDir

27 traceTreeTests <-

25 traceTreeTests <-

28 goldenInputsTreeUniform

26 goldenInputsTreeUniform

29 "TraceTree"

27 "TraceTree"

30− dir

28+ "test/golden"

31 "trace-tree.yaml"

29 "trace-tree.yaml"

32 ("a.yaml", "b.yaml")

30 ("a.yaml", "b.yaml")

33 Yaml.decodeFileThrow

31 Yaml.decodeFileThrow

@@ -36,7 +34,7 @@ tests = do

36 reportTests <-

34 reportTests <-

37 goldenInputsTreeUniform

35 goldenInputsTreeUniform

38 "Report"

36 "Report"

39− dir

37+ "test/golden"

40 "report.md"

38 "report.md"

41 ("a.yaml", "b.yaml")

39 ("a.yaml", "b.yaml")

42 Yaml.decodeFileThrow

40 Yaml.decodeFileThrow

test/golden/common/unguarded-recursive/a.yaml → test/golden/common/unguarded-recursive/basic/a.yamlrenamed

The content is the same.

test/golden/common/unguarded-recursive/b.yaml → test/golden/common/unguarded-recursive/basic/b.yamlrenamed

The content is the same.

test/golden/common/unguarded-recursive/report.md → test/golden/common/unguarded-recursive/basic/report.mdrenamed

The content is the same.

test/golden/common/unguarded-recursive/trace-tree.yaml → test/golden/common/unguarded-recursive/basic/trace-tree.yamlrenamed

The content is the same.

test/golden/common/unguarded-recursive/silent/a.yamlnew file+25

@@ -0,0 +1,25 @@

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.yamlnew file+19

@@ -0,0 +1,19 @@

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.mdnew file+15

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

1+# Summary

2+

3+| ❌ Breaking changes | ⚠️ Non-breaking changes | [❓ Unsupported feature changes](#unsupported-changes) |

4+|---------------------|-------------------------|--------------------------------------------------------|

5+| 0 | 0 | 1 |

6+

7+# <span id="unsupported-changes"></span>❓ 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.yamlnew file+16

@@ -0,0 +1,16 @@

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