@@ -1,15 +1,20 @@
1module OpenAPI.Checker.Report
1module OpenAPI.Checker.Report
2 ( generateReport
2 ( generateReport
6import Control.Monad.Free hiding (unfoldM)
9import Control.Monad.Free hiding (unfoldM)
7import Control.Monad.Reader
10import Control.Monad.Reader
8import Control.Monad.Writer
11import Control.Monad.Writer
12+import Data.Aeson (ToJSON)
9import Data.Either
13import Data.Either
10import Data.Foldable
14import Data.Foldable
11import Data.Function
15import Data.Function
12import Data.Functor
16import Data.Functor
17+import Data.Functor.Const
13import Data.List.NonEmpty
18import Data.List.NonEmpty
14import qualified Data.List.NonEmpty as NE
19import qualified Data.List.NonEmpty as NE
15import qualified Data.Map as M
20import qualified Data.Map as M
@@ -22,6 +27,7 @@ import Data.Text (Text)
22import qualified Data.Text as T
27import qualified Data.Text as T
23import Data.TypeRepMap hiding (empty)
28import Data.TypeRepMap hiding (empty)
24import Data.Typeable
29import Data.Typeable
25import OpenAPI.Checker.Behavior
31import OpenAPI.Checker.Behavior
26import OpenAPI.Checker.Paths
32import OpenAPI.Checker.Paths
27import OpenAPI.Checker.PathsPrefixTree hiding (empty)
33import OpenAPI.Checker.PathsPrefixTree hiding (empty)
@@ -31,27 +37,79 @@ import OpenAPI.Checker.Validate.OpenApi
31import OpenAPI.Checker.Validate.Schema
37import OpenAPI.Checker.Validate.Schema
32import Text.Pandoc.Builder
38import Text.Pandoc.Builder
34−generateReport :: Either (P.PathsPrefixTree Behave AnIssue 'APILevel) () -> Pandoc
40+type Changes = P.PathsPrefixTree Behave AnIssue 'APILevel
35−generateReport (Right ()) = doc $ header 1 "No breaking changes found ✨"
41+
42+type ProcessedChanges a = P.PathsPrefixTree Behave (FunctorTuple (Const Orientation) AnIssue) a
44+data FunctorTuple f g a = FunctorTuple (f a) (g a)
45+ deriving stock (Eq, Ord)
47+data ReportInput = ReportInput
48+ { breakingChanges :: Changes
49+ , nonBreakingChanges :: Changes
51+ deriving stock (Generic)
52+ deriving (Semigroup, Monoid) via (Generically ReportInput)
53+ deriving anyclass (ToJSON)
58+ | -- | All changes that could be breaking are unsupported – we don't know if
59+ -- there actually are any breaking changes.
60+ OnlyUnsupportedChanges
62+preprocessChanges :: Orientation -> Changes -> ProcessedChanges 'APILevel
63+preprocessChanges initialO = P.fromList . fmap process . P.toList
65+ process :: AnItem Behave AnIssue 'APILevel -> AnItem Behave (FunctorTuple (Const Orientation) AnIssue) 'APILevel
66+ process (AnItem paths issue) = AnItem paths $ FunctorTuple (Const $ toggle initialO) issue
68+ (Endo toggle) = togglePaths paths
70+ togglePaths :: Paths Behave a c -> Endo Orientation
71+ togglePaths Root = mempty
72+ togglePaths (rest `Snoc` (_ :: Behave b c)) = case eqT @c @'ResponseLevel of
73+ Just Refl -> Endo toggleOrientation <> togglePaths rest
74+ Nothing -> togglePaths rest
76+generateReport :: ReportInput -> (Pandoc, ReportStatus)
36−generateReport (Left errs) = doc $
77+generateReport inp =
37− runReportMonad jets $ do
38− let (unsupported, breaking) = P.partition (\(AnIssue i) -> issueIsUnsupported i) errs
78+ let partitionUnsupported = P.partition (\(AnIssue i) -> issueIsUnsupported i)
79+ (bUnsupported, preprocessChanges Forward -> breaking) =
80+ partitionUnsupported $ breakingChanges inp
81+ (nbUnsupported, preprocessChanges Backward -> nonBreaking) =
82+ partitionUnsupported $ nonBreakingChanges inp
83+ unsupported = preprocessChanges Forward $ bUnsupported <> nbUnsupported
39− breakingChangesPresent = not $ P.null breaking
84+ breakingChangesPresent = not $ P.null breaking
85+ nonBreakingChangesPresent = not $ P.null nonBreaking
40− unsupportedChangesPresent = not $ P.null unsupported
86+ unsupportedChangesPresent = not $ P.null unsupported
88+ runReportMonad jets $ do
41− smartHeader "Summary"
89+ smartHeader "Summary"
43− simpleTable
91+ simpleTable
45− <$> [ refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
93+ <$> [ refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
94+ , refOpt nonBreakingChangesPresent nonBreakingChangesId "🙆 Non-breaking changes"
46− , refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
95+ , refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
48− [para . show' <$> [P.size breaking, P.size unsupported]]
97+ [para . show' <$> [P.size breaking, P.size nonBreaking, P.size unsupported]]
49− when breakingChangesPresent $ do
98+ when breakingChangesPresent $ do
50− smartHeader $ anchor breakingChangesId <> "⚠️ Breaking changes"
99+ smartHeader $ anchor breakingChangesId <> "⚠️ Breaking changes"
51− incrementHeaders $ showErrs breaking
100+ incrementHeaders $ showErrs breaking
101+ when nonBreakingChangesPresent $ do
102+ smartHeader $ anchor nonBreakingChangesId <> "🙆 Non-breaking changes"
103+ incrementHeaders $ showErrs nonBreaking
52− when unsupportedChangesPresent $ do
104+ when unsupportedChangesPresent $ do
53− smartHeader $ anchor unsupportedChangesId <> "🤷 Unsupported feature changes"
105+ smartHeader $ anchor unsupportedChangesId <> "🤷 Unsupported feature changes"
54− incrementHeaders $ showErrs unsupported
106+ incrementHeaders $ showErrs unsupported
109+ | breakingChangesPresent -> BreakingChanges
110+ | unsupportedChangesPresent -> OnlyUnsupportedChanges
111+ | otherwise -> NoBreakingChanges
56 anchor :: Text -> Inlines
114 anchor :: Text -> Inlines
57 anchor a = spanWith (a, [], []) mempty
115 anchor a = spanWith (a, [], []) mempty
@@ -60,11 +118,10 @@ generateReport (Left errs) = doc $
60 refOpt False _ i = i
118 refOpt False _ i = i
61 refOpt True a i = link ("#" <> a) "" i
119 refOpt True a i = link ("#" <> a) "" i
63− breakingChangesId :: Text
121+ breakingChangesId, nonBreakingChangesId, unsupportedChangesId :: Text
64 breakingChangesId = "breaking-changes"
122 breakingChangesId = "breaking-changes"
66− unsupportedChangesId :: Text
67 unsupportedChangesId = "unsupported-changes"
123 unsupportedChangesId = "unsupported-changes"
124+ nonBreakingChangesId = "non-breaking-changes"
69data ReportState = ReportState
126data ReportState = ReportState
70 { sourceJets :: [ReportJet' Behave Inlines]
127 { sourceJets :: [ReportJet' Behave Inlines]
@@ -88,22 +145,24 @@ smartHeader i = do
88 h <- asks headerLevel
145 h <- asks headerLevel
89 tell $ header h i
146 tell $ header h i
91−showErrs :: forall a. Typeable a => P.PathsPrefixTree Behave AnIssue a -> ReportMonad ()
148+showErrs :: forall a. Typeable a => ProcessedChanges a -> ReportMonad ()
92showErrs x@(P.PathsPrefixNode currentIssues _) = do
149showErrs x@(P.PathsPrefixNode currentIssues _) = do
93 let -- Extract this pattern if more cases like this arise
150 let -- Extract this pattern if more cases like this arise
94− (removedPaths :: [Issue 'APILevel], otherIssues :: Set (AnIssue a)) = case eqT @a @'APILevel of
151+ ( removedPaths :: [Issue 'APILevel]
152+ , otherIssues :: Set (FunctorTuple (Const Orientation) AnIssue a)
153+ ) = case eqT @a @'APILevel of
95− Just Refl ->
154+ Just Refl ->
96− let (p, o) =
155+ let (p, o) =
97− S.partition
156+ S.partition
98− (\(AnIssue u) -> case u of
157+ (\(FunctorTuple _ (AnIssue u)) -> case u of
99− NoPathsMatched {} -> True
158+ NoPathsMatched {} -> True
100− AllPathsFailed {} -> True)
159+ AllPathsFailed {} -> True)
101− currentIssues
160+ currentIssues
102− p' = S.toList p <&> (\(AnIssue i) -> i)
161+ p' = S.toList p <&> (\(FunctorTuple _ (AnIssue i)) -> i)
103− in (p', o)
162+ in (p', o)
104− Nothing -> (mempty, currentIssues)
163+ Nothing -> (mempty, currentIssues)
105 jts <- asks sourceJets
164 jts <- asks sourceJets
106− for_ otherIssues $ \(AnIssue i) -> tell . describeIssue $ i
165+ for_ otherIssues $ \(FunctorTuple (Const ori) (AnIssue i)) -> tell . describeIssue ori $ i
107 unless ([] == removedPaths) $ do
166 unless ([] == removedPaths) $ do
108 smartHeader "Removed paths"
167 smartHeader "Removed paths"
@@ -135,9 +194,9 @@ jets =
135 <$> [ constructReportJet jsonPathJet
194 <$> [ constructReportJet jsonPathJet
136 , constructReportJet $ \p@(AtPath _) op@(InOperation _) ->
195 , constructReportJet $ \p@(AtPath _) op@(InOperation _) ->
137 strong (describeBehaviour op) <> " " <> describeBehaviour p :: Inlines
196 strong (describeBehaviour op) <> " " <> describeBehaviour p :: Inlines
138− , constructReportJet $ \InRequest InPayload PayloadSchema -> "JSON Request" :: Inlines
197+ , constructReportJet $ \InRequest InPayload PayloadSchema -> "📱➡️ JSON Request" :: Inlines
139 , constructReportJet $ \(WithStatusCode c) ResponsePayload PayloadSchema ->
198 , constructReportJet $ \(WithStatusCode c) ResponsePayload PayloadSchema ->
140− "JSON Response – " <> str (T.pack . show $ c) :: Inlines
199+ "📱⬅️ JSON Response – " <> str (T.pack . show $ c) :: Inlines
143 unwrapReportJetResult :: ReportJetResult Behave x -> ReportJet' Behave x
202 unwrapReportJetResult :: ReportJetResult Behave x -> ReportJet' Behave x
@@ -177,8 +236,8 @@ jets =
178observeJetShowErrs
237observeJetShowErrs
179 :: ReportJet' Behave Inlines
238 :: ReportJet' Behave Inlines
180− -> P.PathsPrefixTree Behave AnIssue a
239+ -> ProcessedChanges a
181− -> ReportMonad (P.PathsPrefixTree Behave AnIssue a)
240+ -> ReportMonad (ProcessedChanges a)
182observeJetShowErrs jet p = case observeJetShowErrs' jet p of
241observeJetShowErrs jet p = case observeJetShowErrs' jet p of
183 Just m -> m
242 Just m -> m
184 Nothing -> pure p
243 Nothing -> pure p
@@ -186,8 +245,8 @@ observeJetShowErrs jet p = case observeJetShowErrs' jet p of
186observeJetShowErrs'
245observeJetShowErrs'
187 :: forall a.
246 :: forall a.
188 ReportJet' Behave Inlines
247 ReportJet' Behave Inlines
189− -> P.PathsPrefixTree Behave AnIssue a
248+ -> ProcessedChanges a
190− -> Maybe (ReportMonad (P.PathsPrefixTree Behave AnIssue a))
249+ -> Maybe (ReportMonad (ProcessedChanges a))
191observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues) =
250observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues) =
192 let results =
251 let results =
193 subIssues >>= \(WrapTypeable (AStep m)) ->
252 subIssues >>= \(WrapTypeable (AStep m)) ->