@@ -1,6 +1,8 @@
1module OpenAPI.Checker.Report
1module OpenAPI.Checker.Report
2 ( generateReport
2 ( generateReport
3 , ReportInput (..)
4 , ReportInput (..)
4 , ReportStatus (..)
6 , ReportStatus (..)
6 , ReportConfig (..)
8 , ReportConfig (..)
@@ -43,14 +45,38 @@ import Text.Pandoc.Builder
44type Changes = P.PathsPrefixTree Behave AnIssue 'APILevel
46type Changes = P.PathsPrefixTree Behave AnIssue 'APILevel
48+data CheckerOutput = CheckerOutput
49+ { forwardChanges :: Changes
50+ , backwardChanges :: Changes
52+ deriving stock (Generic)
53+ deriving (Semigroup, Monoid) via (Generically CheckerOutput)
54+ deriving anyclass (ToJSON)
46data ReportInput = ReportInput
56data ReportInput = ReportInput
47− { breakingChanges :: Changes
57+ { breakingChanges :: Changes -- ^ forward 'CertainIssue', 'ProbablyIssue' and 'Comment'
48− , nonBreakingChanges :: Changes
58+ , nonBreakingChanges :: Changes -- ^ backward 'CertainIssue', 'ProbablyIssue' and 'Comment', except those shadowed by 'relatedIssues'
59+ , unsupportedChanges :: Changes -- ^ forward and backward 'Unsupported' (assumed to be the same anyway)
60+ , schemaIssues :: Changes -- ^ forward and backward 'SchemaInvalid' (assumed to be the same anyway)
50 deriving stock (Generic)
62 deriving stock (Generic)
51 deriving (Semigroup, Monoid) via (Generically ReportInput)
63 deriving (Semigroup, Monoid) via (Generically ReportInput)
52 deriving anyclass (ToJSON)
64 deriving anyclass (ToJSON)
66+segregateIssues :: CheckerOutput -> ReportInput
67+segregateIssues CheckerOutput {forwardChanges = fwd, backwardChanges = bck} = ReportInput
68+ { breakingChanges = P.filter isBreaking fwd
69+ , nonBreakingChanges = invertIssueOrientationP $ P.filterWithKey isNonBreaking bck
70+ , unsupportedChanges = P.filter isUnsupported fwd <> P.filter isUnsupported bck
71+ , schemaIssues = P.filter isSchemaIssue fwd <> P.filter isSchemaIssue bck
74+ isBreaking i = anIssueKind i `elem` [CertainIssue, ProbablyIssue, Comment]
75+ isNonBreaking :: Paths Behave 'APILevel a -> AnIssue a -> Bool
76+ isNonBreaking xs i = isBreaking i && all (\j -> not $ relatedAnIssues i j) (P.lookup xs fwd)
77+ isUnsupported i = anIssueKind i == Unsupported
78+ isSchemaIssue i = anIssueKind i == SchemaInvalid
54data ReportStatus
80data ReportStatus
55 = BreakingChanges
81 = BreakingChanges
56 | NoBreakingChanges
82 | NoBreakingChanges
@@ -80,13 +106,11 @@ twoRowTable x = simpleTable (para . fst <$> x) [para . snd <$> x]
81generateReport :: ReportConfig -> ReportInput -> (Pandoc, ReportStatus)
107generateReport :: ReportConfig -> ReportInput -> (Pandoc, ReportStatus)
82generateReport cfg inp =
108generateReport cfg inp =
83− let partitionUnsupported = P.partition (\(AnIssue _ i) -> issueIsUnsupported i)
109+ let
84− (bUnsupported, breaking) = partitionUnsupported $ breakingChanges inp
110+ schemaIssuesPresent = not $ P.null $ schemaIssues inp
85− (nbUnsupported, invertIssueOrientationP -> nonBreaking) = partitionUnsupported $ nonBreakingChanges inp
111+ breakingChangesPresent = not $ P.null $ breakingChanges inp
86− unsupported = bUnsupported <> nbUnsupported
87− breakingChangesPresent = not $ P.null breaking
88− nonBreakingChangesPresent = not $ P.null nonBreaking
112+ nonBreakingChangesPresent = not $ P.null $ nonBreakingChanges inp
89− unsupportedChangesPresent = not $ P.null unsupported
113+ unsupportedChangesPresent = not $ P.null $ unsupportedChanges inp
90 nonBreakingChangesShown = case reportMode cfg of
114 nonBreakingChangesShown = case reportMode cfg of
91 All -> True
115 All -> True
92 OnlyErrors -> False
116 OnlyErrors -> False
@@ -95,32 +119,43 @@ generateReport cfg inp =
96 header 1 "Summary"
120 header 1 "Summary"
97 <> twoRowTable
121 <> twoRowTable
124+ [ ( refOpt schemaIssuesPresent schemaIssuesId "❌ Schema issues"
125+ , show' $ P.size $ schemaIssues inp
98− ([ ( refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
129+ [ ( refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
99− , show' $ P.size breaking
130+ , show' $ P.size $ breakingChanges inp
103 nonBreakingChangesShown
134 nonBreakingChangesShown
104 [ ( refOpt nonBreakingChangesPresent nonBreakingChangesId "🙆 Non-breaking changes"
135 [ ( refOpt nonBreakingChangesPresent nonBreakingChangesId "🙆 Non-breaking changes"
105− , show' $ P.size nonBreaking
136+ , show' $ P.size $ nonBreakingChanges inp
108 ++ [ ( refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
139 ++ [ ( refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
109− , show' $ P.size unsupported
140+ , show' $ P.size $ unsupportedChanges inp
145+ (header 1 (anchor schemaIssuesId <> "❌ Schema issues")
146+ <> builder (showErrs $ schemaIssues inp))
113 breakingChangesPresent
148 breakingChangesPresent
114 (header 1 (anchor breakingChangesId <> "⚠️ Breaking changes")
149 (header 1 (anchor breakingChangesId <> "⚠️ Breaking changes")
115− <> builder (showErrs breaking))
150+ <> builder (showErrs $ breakingChanges inp))
117 (nonBreakingChangesPresent && nonBreakingChangesShown)
152 (nonBreakingChangesPresent && nonBreakingChangesShown)
118 (header 1 (anchor nonBreakingChangesId <> "🙆 Non-breaking changes")
153 (header 1 (anchor nonBreakingChangesId <> "🙆 Non-breaking changes")
119− <> builder (showErrs nonBreaking))
154+ <> builder (showErrs $ nonBreakingChanges inp))
121 unsupportedChangesPresent
156 unsupportedChangesPresent
122 (header 1 (anchor unsupportedChangesId <> "🤷 Unsupported feature changes")
157 (header 1 (anchor unsupportedChangesId <> "🤷 Unsupported feature changes")
123− <> builder (showErrs unsupported))
158+ <> builder (showErrs $ unsupportedChanges inp))
126 | breakingChangesPresent -> BreakingChanges
161 | breakingChangesPresent -> BreakingChanges
@@ -135,10 +170,11 @@ generateReport cfg inp =
135 refOpt False _ i = i
170 refOpt False _ i = i
136 refOpt True a i = link ("#" <> a) "" i
171 refOpt True a i = link ("#" <> a) "" i
138− breakingChangesId, nonBreakingChangesId, unsupportedChangesId :: Text
173+ breakingChangesId, nonBreakingChangesId, unsupportedChangesId, schemaIssuesId :: Text
139 breakingChangesId = "breaking-changes"
174 breakingChangesId = "breaking-changes"
140 unsupportedChangesId = "unsupported-changes"
175 unsupportedChangesId = "unsupported-changes"
141 nonBreakingChangesId = "non-breaking-changes"
176 nonBreakingChangesId = "non-breaking-changes"
177+ schemaIssuesId = "schema-issues"
143 when' :: Monoid m => Bool -> m -> m
179 when' :: Monoid m => Bool -> m -> m
144 when' True m = m
180 when' True m = m
@@ -180,7 +216,7 @@ showErrs x@(P.PathsPrefixNode currentIssues _) =
180 flip foldMap (M.toList m) $ \(bhv, subErrors) ->
216 flip foldMap (M.toList m) $ \(bhv, subErrors) ->
181 if P.null subErrors
217 if P.null subErrors
182 then mempty
218 then mempty
183− else singletonHeader (describeBehaviour bhv) $ showErrs subErrors
219+ else singletonHeader (describeBehavior bhv) $ showErrs subErrors
184 in issues <> paths <> rest
220 in issues <> paths <> rest
186unfoldFunctions :: forall m a. (Monoid m, Eq a) => a -> [a -> (m, a)] -> (a -> m) -> m
222unfoldFunctions :: forall m a. (Monoid m, Eq a) => a -> [a -> (m, a)] -> (a -> m) -> m
@@ -198,11 +234,11 @@ jets =
198 unwrapReportJetResult
234 unwrapReportJetResult
199 <$> [ constructReportJet $
235 <$> [ constructReportJet $
200 curry $ \case
236 curry $ \case
201− (OfType Object, p@(InPartition _)) -> Just $ describeBehaviour p :: Maybe Inlines
237+ (OfType Object, p@(InPartition _)) -> Just $ describeBehavior p :: Maybe Inlines
202 _ -> Nothing
238 _ -> Nothing
203 , constructReportJet jsonPathJet
239 , constructReportJet jsonPathJet
204 , constructReportJet $ \p@(AtPath _) op@(InOperation _) ->
240 , constructReportJet $ \p@(AtPath _) op@(InOperation _) ->
205− strong (describeBehaviour op) <> " " <> describeBehaviour p :: Inlines
241+ strong (describeBehavior op) <> " " <> describeBehavior p :: Inlines
206 , constructReportJet $ \(WithStatusCode c) ResponsePayload PayloadSchema ->
242 , constructReportJet $ \(WithStatusCode c) ResponsePayload PayloadSchema ->
207 "📱⬅️ JSON Response – " <> str (T.pack . show $ c) :: Inlines
243 "📱⬅️ JSON Response – " <> str (T.pack . show $ c) :: Inlines
208 , constructReportJet $ \InRequest InPayload PayloadSchema -> "📱➡️ JSON Request" :: Inlines
244 , constructReportJet $ \InRequest InPayload PayloadSchema -> "📱➡️ JSON Request" :: Inlines