git.iko.soy/typeable/compaREST
on master help sign in
Added foldable tree report (#91)
62a321aiko
app/FormatHeuristic.hs+56−53
compare with master
unifiedsplit
@@ -18,26 +18,26 @@ import System.FilePath (takeExtension)
18import Text.DocTemplates.Internal
18import Text.DocTemplates.Internal
19import Text.Pandoc
19import Text.Pandoc
20
20
21−formatFromFilePath :: forall m. PandocMonad m => FilePath -> Maybe (Pandoc -> m ByteString)
21+formatFromFilePath :: forall m. PandocMonad m => FilePath -> Maybe (Pandoc -> m ByteString, FilePath)
22formatFromFilePath x =
22formatFromFilePath x =
23 case takeExtension (map toLower x) of
23 case takeExtension (map toLower x) of
24− ".adoc" -> f "asciidoc" def
24+ ".adoc" -> fWithDefaultFile "asciidoc" def
25− ".asciidoc" -> f "asciidoc" def
25+ ".asciidoc" -> fWithDefaultFile "asciidoc" def
26− ".context" -> f "context" def
26+ ".context" -> fWithDefaultFile "context" def
27− ".ctx" -> f "context" def
27+ ".ctx" -> fWithDefaultFile "context" def
28− ".db" -> f "docbook" def
28+ ".db" -> fWithDefaultFile "docbook" def
29− ".doc" -> f "doc" def -- so we get an "unknown reader" error
29+ ".doc" -> fWithDefaultFile "doc" def -- so we get an "unknown reader" error
30− ".docx" -> f "docx" def
30+ ".docx" -> fWithDefaultFile "docx" def
31− ".dokuwiki" -> f "dokuwiki" def
31+ ".dokuwiki" -> fWithDefaultFile "dokuwiki" def
32− ".epub" -> f "epub" def
32+ ".epub" -> fWithDefaultFile "epub" def
33− ".fb2" -> f "fb2" def
33+ ".fb2" -> fWithDefaultFile "fb2" def
34− ".htm" -> html
34+ ".htm" -> fWithDefaultFile "html" def
35− ".html" -> html
35+ ".html" -> fWithDefaultFile "html" def
36− ".icml" -> f "icml" def
36+ ".icml" -> fWithDefaultFile "icml" def
37− ".json" -> f "json" def
37+ ".json" -> fWithDefaultFile "json" def
38− ".latex" -> f "latex" def
38+ ".latex" -> fWithDefaultFile "latex" def
39− ".lhs" -> f "markdown+lhs" def
39+ ".lhs" -> fWithDefaultFile "markdown+lhs" def
40− ".ltx" -> f "latex" def
40+ ".ltx" -> fWithDefaultFile "latex" def
41 ".markdown" -> markdown
41 ".markdown" -> markdown
42 ".mkdn" -> markdown
42 ".mkdn" -> markdown
43 ".mkd" -> markdown
43 ".mkd" -> markdown
@@ -45,47 +45,50 @@ formatFromFilePath x =
45 ".mdown" -> markdown
45 ".mdown" -> markdown
46 ".Rmd" -> markdown
46 ".Rmd" -> markdown
47 ".md" -> markdown
47 ".md" -> markdown
48− ".ms" -> f "ms" def
48+ ".ms" -> fWithDefaultFile "ms" def
49− ".muse" -> f "muse" def
49+ ".muse" -> fWithDefaultFile "muse" def
50− ".native" -> f "native" def
50+ ".native" -> fWithDefaultFile "native" def
51− ".odt" -> f "odt" def
51+ ".odt" -> fWithDefaultFile "odt" def
52− ".opml" -> f "opml" def
52+ ".opml" -> fWithDefaultFile "opml" def
53− ".org" -> f "org" def
53+ ".org" -> fWithDefaultFile "org" def
54 -- so we get an "unknown reader" error
54 -- so we get an "unknown reader" error
55− ".pdf" -> f "pdf" def
55+ ".pdf" -> fWithDefaultFile "pdf" def
56− ".pptx" -> f "pptx" def
56+ ".pptx" -> fWithDefaultFile "pptx" def
57− ".roff" -> f "ms" def
57+ ".roff" -> fWithDefaultFile "ms" def
58− ".rst" -> f "rst" def
58+ ".rst" -> fWithDefaultFile "rst" def
59− ".rtf" -> f "rtf" def
59+ ".rtf" -> fWithDefaultFile "rtf" def
60− ".s5" -> f "s5" def
60+ ".s5" -> fWithDefaultFile "s5" def
61− ".t2t" -> f "t2t" def
61+ ".t2t" -> fWithDefaultFile "t2t" def
62− ".tei" -> f "tei" def
62+ ".tei" -> fWithDefaultFile "tei" def
63− ".tei.xml" -> f "tei" def
63+ ".tei.xml" -> fWithDefaultFile "tei" def
64− ".tex" -> f "latex" def
64+ ".tex" -> fWithDefaultFile "latex" def
65− ".texi" -> f "texinfo" def
65+ ".texi" -> fWithDefaultFile "texinfo" def
66− ".texinfo" -> f "texinfo" def
66+ ".texinfo" -> fWithDefaultFile "texinfo" def
67 ".text" -> markdown
67 ".text" -> markdown
68− ".textile" -> f "textile" def
68+ ".textile" -> fWithDefaultFile "textile" def
69 ".txt" -> markdown
69 ".txt" -> markdown
70− ".wiki" -> f "mediawiki" def
70+ ".wiki" -> fWithDefaultFile "mediawiki" def
71− ".xhtml" -> f "html" def
71+ ".xhtml" -> fWithDefaultFile "html" def
72− ".ipynb" -> f "ipynb" def
72+ ".ipynb" -> fWithDefaultFile "ipynb" def
73− ".csv" -> f "csv" def
73+ ".csv" -> fWithDefaultFile "csv" def
74− ".bib" -> f "biblatex" def
74+ ".bib" -> fWithDefaultFile "biblatex" def
75− ['.', y] | y `elem` ['1' .. '9'] -> f "man" def
75+ ['.', y] | y `elem` ['1' .. '9'] -> fWithDefaultFile "man" def
76+ "" ->
77+ (,x <> ".html")
78+ <$> f
79+ "html"
80+ def
81+ { writerTemplate = Just Html.template
82+ , -- Not actually used. Needed to silence warning.
83+ writerVariables = Context $ M.fromList [("pagetitle", toVal ("OpenApi Diff" :: Text))]
84+ }
76 _ -> Nothing
85 _ -> Nothing
77 where
86 where
78− markdown, html :: Maybe (Pandoc -> m ByteString)
87+ markdown :: Maybe (Pandoc -> m ByteString, FilePath)
79− markdown = f "markdown" markdownOpt
88+ markdown = fWithDefaultFile "markdown" markdownOpt
80− html =
89+
81− f
82− "html"
83− def
84− { writerTemplate = Just Html.template
85− , -- Not actually used. Needed to silence warning.
86− writerVariables = Context $ M.fromList [("pagetitle", toVal ("OpenApi Diff" :: Text))]
87− }
88 markdownOpt = def {writerExtensions = githubMarkdownExtensions}
90 markdownOpt = def {writerExtensions = githubMarkdownExtensions}
91+ fWithDefaultFile k opt = (,x) <$> f k opt
89 f k opt =
92 f k opt =
90 lookup k writers <&> \case
93 lookup k writers <&> \case
91 TextWriter g -> fmap (TL.encodeUtf8 . TL.fromStrict) . g opt
94 TextWriter g -> fmap (TL.encodeUtf8 . TL.fromStrict) . g opt
app/Main.hs+2−2
@@ -38,8 +38,8 @@ main = do
38 StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown options
38 StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown options
39 FileMode f -> case formatFromFilePath f of
39 FileMode f -> case formatFromFilePath f of
40 Nothing -> \_ -> throwError UnknownOutputFormat
40 Nothing -> \_ -> throwError UnknownOutputFormat
41− Just writer -> lift . BSL.writeFile f <=< runPandocIO . writer
41+ Just (writer, f') -> lift . BSL.writeFile f' <=< runPandocIO . writer
42− (report, status) = runReport (a, b)
42+ (report, status) = runReport (reportConfig opts) (a, b)
43 either handler pure <=< runExceptT $ write report
43 either handler pure <=< runExceptT $ write report
44 case status of
44 case status of
45 NoBreakingChanges -> exitSuccess
45 NoBreakingChanges -> exitSuccess
app/OpenAPI/Checker/Options.hs+25−6
@@ -8,6 +8,7 @@ module OpenAPI.Checker.Options
8where
8where
9
9
10import GHC.Generics (Generic)
10import GHC.Generics (Generic)
11+import OpenAPI.Checker.Report
11import Options.Applicative
12import Options.Applicative
12
13
13data Options = Options
14data Options = Options
@@ -15,6 +16,7 @@ data Options = Options
15 , serverFile :: FilePath
16 , serverFile :: FilePath
16 , mode :: Mode
17 , mode :: Mode
17 , outputMode :: OutputMode
18 , outputMode :: OutputMode
19+ , reportConfig :: ReportConfig
18 }
20 }
19 deriving stock (Generic)
21 deriving stock (Generic)
20
22
@@ -56,10 +58,27 @@ optionsParser =
56 "Report both incompatible and compatible changes. \
58 "Report both incompatible and compatible changes. \
57 \Compatible changes will not trigger a failure exit code.")
59 \Compatible changes will not trigger a failure exit code.")
58 <|> pure All)
60 <|> pure All)
59− <*> (pure StdoutMode
60− <|> (FileMode
61+ <*> ((FileMode
61− <$> strOption
62+ <$> strOption
62− (short 'o' <> long "output"
63+ (short 'o' <> long "output"
64+ <> help
65+ "The file path where the output should be writtrn. \
66+ \Leave blank to output result to stdout."))
67+ <|> pure StdoutMode)
68+ <*> (ReportConfig
69+ <$> (flag'
70+ FoldingBlockquotesTreeStyle
71+ (long "folding-block-quotes-style"
72+ <> help
73+ "The report tree is structured using \
74+ \summary/detail HTML elements and indented using \
75+ \block quotes. This style renders well on GitHub.\
76+ \Intended for HTML output format. Markdown has rendering \
77+ \bugs on GitHub.")
78+ <|> flag'
79+ HeadersTreeStyle
80+ (long "header-style"
63 <> help
81 <> help
64− "The file path where the output should be writtrn. \
82+ "The report tree is structured using \
65− \Leave blank to output result to stdout.")))
83+ \increasing levels of headers.")
84+ <|> pure HeadersTreeStyle))
openapi-diff.cabal+1
@@ -108,6 +108,7 @@ library
108 , generic-data
108 , generic-data
109 , doctemplates
109 , doctemplates
110 , file-embed
110 , file-embed
111+ , data-default
111 hs-source-dirs: src
112 hs-source-dirs: src
112 exposed-modules: Data.HList
113 exposed-modules: Data.HList
113 , OpenAPI.Checker.Behavior
114 , OpenAPI.Checker.Behavior
src/OpenAPI/Checker/Report.hs+67−29
@@ -3,6 +3,8 @@ module OpenAPI.Checker.Report
3 , ReportInput (..)
3 , ReportInput (..)
4 , ReportStatus (..)
4 , ReportStatus (..)
5 , Pandoc
5 , Pandoc
6+ , ReportConfig (..)
7+ , ReportTreeStyle (..)
6 )
8 )
7where
9where
8
10
@@ -10,6 +12,7 @@ import Control.Monad.Free hiding (unfoldM)
10import Control.Monad.Reader
12import Control.Monad.Reader
11import Control.Monad.Writer
13import Control.Monad.Writer
12import Data.Aeson (ToJSON)
14import Data.Aeson (ToJSON)
15+import Data.Default
13import Data.Either
16import Data.Either
14import Data.Foldable
17import Data.Foldable
15import Data.Function
18import Data.Function
@@ -54,8 +57,20 @@ data ReportStatus
54 -- there actually are any breaking changes.
57 -- there actually are any breaking changes.
55 OnlyUnsupportedChanges
58 OnlyUnsupportedChanges
56
59
60+data ReportConfig = ReportConfig
61+ { treeStyle :: ReportTreeStyle
62+ }
63+
64+instance Default ReportConfig where
65+ def =
66+ ReportConfig
67+ { treeStyle = HeadersTreeStyle
68+ }
69+
70+data ReportTreeStyle = HeadersTreeStyle | FoldingBlockquotesTreeStyle
71+
57−generateReport :: ReportInput -> (Pandoc, ReportStatus)
72+generateReport :: ReportConfig -> ReportInput -> (Pandoc, ReportStatus)
58−generateReport inp =
73+generateReport cfg inp =
59 let partitionUnsupported = P.partition (\(AnIssue _ i) -> issueIsUnsupported i)
74 let partitionUnsupported = P.partition (\(AnIssue _ i) -> issueIsUnsupported i)
60 (bUnsupported, breaking) = partitionUnsupported $ breakingChanges inp
75 (bUnsupported, breaking) = partitionUnsupported $ breakingChanges inp
61 (nbUnsupported, invertIssueOrientationP -> nonBreaking) = partitionUnsupported $ nonBreakingChanges inp
76 (nbUnsupported, invertIssueOrientationP -> nonBreaking) = partitionUnsupported $ nonBreakingChanges inp
@@ -64,8 +79,8 @@ generateReport inp =
64 nonBreakingChangesPresent = not $ P.null nonBreaking
79 nonBreakingChangesPresent = not $ P.null nonBreaking
65 unsupportedChangesPresent = not $ P.null unsupported
80 unsupportedChangesPresent = not $ P.null unsupported
66 report = doc $
81 report = doc $
67− runReportMonad jets $ do
82+ runReportMonad cfg jets $ do
68− smartHeader "Summary"
83+ tell $ header 1 "Summary"
69 tell $
84 tell $
70 simpleTable
85 simpleTable
71 (para
86 (para
@@ -75,13 +90,13 @@ generateReport inp =
75 ])
90 ])
76 [para . show' <$> [P.size breaking, P.size nonBreaking, P.size unsupported]]
91 [para . show' <$> [P.size breaking, P.size nonBreaking, P.size unsupported]]
77 when breakingChangesPresent $ do
92 when breakingChangesPresent $ do
78− smartHeader $ anchor breakingChangesId <> "⚠️ Breaking changes"
93+ tell $ header 1 $ anchor breakingChangesId <> "⚠️ Breaking changes"
79 incrementHeaders $ showErrs breaking
94 incrementHeaders $ showErrs breaking
80 when nonBreakingChangesPresent $ do
95 when nonBreakingChangesPresent $ do
81− smartHeader $ anchor nonBreakingChangesId <> "🙆 Non-breaking changes"
96+ tell $ header 1 $ anchor nonBreakingChangesId <> "🙆 Non-breaking changes"
82 incrementHeaders $ showErrs nonBreaking
97 incrementHeaders $ showErrs nonBreaking
83 when unsupportedChangesPresent $ do
98 when unsupportedChangesPresent $ do
84− smartHeader $ anchor unsupportedChangesId <> "🤷 Unsupported feature changes"
99+ tell $ header 1 $ anchor unsupportedChangesId <> "🤷 Unsupported feature changes"
85 incrementHeaders $ showErrs unsupported
100 incrementHeaders $ showErrs unsupported
86 status =
101 status =
87 if
102 if
@@ -105,24 +120,45 @@ generateReport inp =
105data ReportState = ReportState
120data ReportState = ReportState
106 { sourceJets :: [ReportJet' Behave Inlines]
121 { sourceJets :: [ReportJet' Behave Inlines]
107 , headerLevel :: Int
122 , headerLevel :: Int
123+ , headerHandle :: Inlines -> ReportMonad () -> ReportMonad ()
124+ , incrementHeadersHandle :: ReportState -> ReportState
108 }
125 }
109
126
110type ReportMonad = ReaderT ReportState (Writer Blocks)
127type ReportMonad = ReaderT ReportState (Writer Blocks)
111
128
112−runReportMonad :: [ReportJet' Behave Inlines] -> ReportMonad () -> Blocks
129+runReportMonad :: ReportConfig -> [ReportJet' Behave Inlines] -> ReportMonad () -> Blocks
113−runReportMonad jts =
130+runReportMonad cfg jts =
114 execWriter
131 execWriter
115 . flip
132 . flip
116 runReaderT
133 runReaderT
117 ReportState
134 ReportState
118 { sourceJets = jts
135 { sourceJets = jts
119 , headerLevel = 1
136 , headerLevel = 1
137+ , headerHandle =
138+ case treeStyle cfg of
139+ HeadersTreeStyle -> \i body -> do
140+ h <- asks headerLevel
141+ tell $ header h i
142+ body
143+ FoldingBlockquotesTreeStyle -> \i body -> do
144+ tell $
145+ rawHtml "<details>"
146+ <> rawHtml "<summary>"
147+ <> plain i
148+ <> rawHtml "</summary>"
149+ (mapReaderT . mapWriterT . fmap . fmap) blockQuote $ body
150+ tell $ rawHtml "</details>"
151+ where
152+ rawHtml = rawBlock "html"
153+ , incrementHeadersHandle = case treeStyle cfg of
154+ HeadersTreeStyle -> \l -> l {headerLevel = headerLevel l + 1}
155+ FoldingBlockquotesTreeStyle -> id
120 }
156 }
121
157
122−smartHeader :: Inlines -> ReportMonad ()
158+smartHeader :: Inlines -> ReportMonad () -> ReportMonad ()
123−smartHeader i = do
159+smartHeader i body = do
124− h <- asks headerLevel
160+ f <- asks headerHandle
125− tell $ header h i
161+ f i body
126
162
127showErrs :: forall a. Typeable a => P.PathsPrefixTree Behave AnIssue a -> ReportMonad ()
163showErrs :: forall a. Typeable a => P.PathsPrefixTree Behave AnIssue a -> ReportMonad ()
128showErrs x@(P.PathsPrefixNode currentIssues _) = do
164showErrs x@(P.PathsPrefixNode currentIssues _) = do
@@ -141,24 +177,27 @@ showErrs x@(P.PathsPrefixNode currentIssues _) = do
141 in (Just (ori, p'), o)
177 in (Just (ori, p'), o)
142 _ -> (Nothing, currentIssues)
178 _ -> (Nothing, currentIssues)
143 jts <- asks sourceJets
179 jts <- asks sourceJets
180+ tell $ case S.toList otherIssues of
181+ [AnIssue ori i] -> describeIssue ori i
144− for_ otherIssues $ \(AnIssue ori i) -> tell . describeIssue ori $ i
182+ ii -> orderedList $ ii <&> (\(AnIssue ori i) -> describeIssue ori i)
145 case removedPaths of
183 case removedPaths of
146 Just (ori, paths) -> do
184 Just (ori, paths) -> do
147− smartHeader $ case ori of
185+ smartHeader
186+ (case ori of
148− Forward -> "Removed paths"
187+ Forward -> "Removed paths"
149− Backward -> "Added paths"
188+ Backward -> "Added paths")
150− tell $
189+ $ tell $
151− bulletList $
190+ bulletList $
152− paths <&> \case
191+ paths <&> \case
153− (NoPathsMatched p) -> para . code $ T.pack p
192+ (NoPathsMatched p) -> para . code $ T.pack p
154− (AllPathsFailed p) -> para . code $ T.pack p
193+ (AllPathsFailed p) -> para . code $ T.pack p
155 Nothing -> pure ()
194 Nothing -> pure ()
156 unfoldM x (observeJetShowErrs <$> jts) $ \(P.PathsPrefixNode _ subIssues) -> do
195 unfoldM x (observeJetShowErrs <$> jts) $ \(P.PathsPrefixNode _ subIssues) -> do
157 for_ subIssues $ \(WrapTypeable (AStep m)) ->
196 for_ subIssues $ \(WrapTypeable (AStep m)) ->
158 for_ (M.toList m) $ \(bhv, subErrors) -> do
197 for_ (M.toList m) $ \(bhv, subErrors) -> do
159− unless (P.null subErrors) $ do
198+ unless (P.null subErrors) $
160− smartHeader $ describeBehaviour bhv
199+ smartHeader (describeBehaviour bhv) $
161− incrementHeaders $ showErrs subErrors
200+ incrementHeaders $ showErrs subErrors
162
201
163unfoldM :: Monad m => a -> [a -> m a] -> (a -> m ()) -> m ()
202unfoldM :: Monad m => a -> [a -> m a] -> (a -> m ()) -> m ()
164unfoldM a [] g = g a
203unfoldM a [] g = g a
@@ -168,8 +207,8 @@ unfoldM a (f : ff) g = do
168
207
169incrementHeaders :: ReportMonad x -> ReportMonad x
208incrementHeaders :: ReportMonad x -> ReportMonad x
170incrementHeaders m = do
209incrementHeaders m = do
171− l <- asks headerLevel
210+ f <- asks incrementHeadersHandle
172− local (\x -> x {headerLevel = l + 1}) m
211+ local f m
173
212
174jets :: [ReportJet' Behave Inlines]
213jets :: [ReportJet' Behave Inlines]
175jets =
214jets =
@@ -241,8 +280,7 @@ observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues)
241 Free jet' -> fmap (embed $ step bhv) <$> observeJetShowErrs' jet' subErrs
280 Free jet' -> fmap (embed $ step bhv) <$> observeJetShowErrs' jet' subErrs
242 Pure h -> Just $ do
281 Pure h -> Just $ do
243 unless (P.null subErrs) $ do
282 unless (P.null subErrs) $ do
244− smartHeader h
245− incrementHeaders $ showErrs subErrs
283+ smartHeader h $ incrementHeaders $ showErrs subErrs
246 return mempty)
284 return mempty)
247 in (fmap . fmap) (PathsPrefixNode currentIssues mempty <>) $
285 in (fmap . fmap) (PathsPrefixNode currentIssues mempty <>) $
248 if any isRight results
286 if any isRight results
src/OpenAPI/Checker/Run.hs+2−2
@@ -26,5 +26,5 @@ runChecker (client, server) =
26 }
26 }
27 run p c = either id mempty . runCompatFormula . checkCompatibility Root HNil $ toPC p c
27 run p c = either id mempty . runCompatFormula . checkCompatibility Root HNil $ toPC p c
28
28
29−runReport :: (OpenApi, OpenApi) -> (Pandoc, ReportStatus)
29+runReport :: ReportConfig -> (OpenApi, OpenApi) -> (Pandoc, ReportStatus)
30−runReport = generateReport . runChecker
30+runReport cfg = generateReport cfg . runChecker
test/Spec/Golden/TraceTree.hs+1−1
@@ -37,7 +37,7 @@ tests = do
37 "report.md"
37 "report.md"
38 ("a.yaml", "b.yaml")
38 ("a.yaml", "b.yaml")
39 Yaml.decodeFileThrow
39 Yaml.decodeFileThrow
40− (runPandoc . writeMarkdown def {writerExtensions = githubMarkdownExtensions} . fst . runReport)
40+ (runPandoc . writeMarkdown def {writerExtensions = githubMarkdownExtensions} . fst . runReport def)
41
41
42 return $ testGroup "Golden tests" [traceTreeTests, reportTests]
42 return $ testGroup "Golden tests" [traceTreeTests, reportTests]
43
43
test/golden/common/servers/report.md+2−2
@@ -14,9 +14,9 @@ The server was removed.
14
14
15### Server `http://{x}variable.path/{y}/{openVariable1}/{openVariable2}`
15### Server `http://{x}variable.path/{y}/{openVariable1}/{openVariable2}`
16
16
17−Enum value `a` has been removed.
17+1. Enum value `a` has been removed.
18
18
19−A variable has been changed from being open to being closed.
19+2. A variable has been changed from being open to being closed.
20
20
21# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
21# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
22
22