Added support for modes (#101)

app/Main.hs

@@ -5,6 +5,7 @@ import Control.Monad.Except
 import Data.Aeson
 import qualified Data.ByteString.Lazy as BSL
 import Data.Default
+import Data.Maybe
 import qualified Data.Text.IO as T
 import qualified Data.Yaml as Yaml
 import FormatHeuristic
@@ -39,8 +40,15 @@ main = do
         FileMode f -> case formatFromFilePath f of
           Nothing -> \_ -> throwError UnknownOutputFormat
           Just (writer, f') -> lift . BSL.writeFile f' <=< runPandocIO . writer
-      (report, status) = runReport (reportConfig opts) (a, b)
-  either handler pure <=< runExceptT $ write report
+      reportConfig =
+        ReportConfig
+          { treeStyle = reportTreeStyle opts
+          , reportMode = fromMaybe All $ mode opts
+          }
+      (report, status) = runReport reportConfig (a, b)
+  case mode opts of
+    Just _ -> either handler pure <=< runExceptT $ write report
+    Nothing -> pure ()
   case status of
     NoBreakingChanges -> exitSuccess
     BreakingChanges -> exitWith $ ExitFailure 1

app/OpenAPI/Checker/Options.hs

@@ -1,6 +1,5 @@
 module OpenAPI.Checker.Options
   ( Options (..)
-  , Mode (..)
   , OutputMode (..)
   , optionsParserInfo
   , execParser
@@ -14,14 +13,13 @@ import Options.Applicative
 data Options = Options
   { clientFile :: FilePath
   , serverFile :: FilePath
-  , mode :: Mode
+  , -- | 'Nothing' means "don't produce any output"
+    mode :: Maybe ReportMode
   , outputMode :: OutputMode
-  , reportConfig :: ReportConfig
+  , reportTreeStyle :: ReportTreeStyle
   }
   deriving stock (Generic)
 
-data Mode = Silent | OnlyErrors | All
-
 data OutputMode = StdoutMode | FileMode FilePath
 
 optionsParserInfo :: ParserInfo Options
@@ -44,20 +42,20 @@ optionsParser =
          <> long "server"
          <> help "The specification that will be used for the server of the API.")
     <*> (flag'
-           Silent
+           Nothing
            (long "silent"
               <> help "Silence all output.")
            <|> flag'
-             OnlyErrors
+             (Just OnlyErrors)
              (long "only-errors"
                 <> help "Only report incompatibility errors in the output.")
            <|> flag'
-             All
+             (Just All)
              (long "all"
                 <> help
                   "Report both incompatible and compatible changes. \
                   \Compatible changes will not trigger a failure exit code.")
-           <|> pure All)
+           <|> pure (Just All))
     <*> ((FileMode
             <$> strOption
               (short 'o' <> long "output"
@@ -65,20 +63,19 @@ optionsParser =
                    "The file path where the output should be writtrn. \
                    \Leave blank to output result to stdout."))
            <|> pure StdoutMode)
-    <*> (ReportConfig
-           <$> (flag'
-                  FoldingBlockquotesTreeStyle
-                  (long "folding-block-quotes-style"
-                     <> help
-                       "The report tree is structured using \
-                       \summary/detail HTML elements and indented using \
-                       \block quotes. This style renders well on GitHub.\
-                       \Intended for HTML output format. Markdown has rendering \
-                       \bugs on GitHub.")
-                  <|> flag'
-                    HeadersTreeStyle
-                    (long "header-style"
-                       <> help
-                         "The report tree is structured using \
-                         \increasing levels of headers.")
-                  <|> pure HeadersTreeStyle))
+    <*> (flag'
+           FoldingBlockquotesTreeStyle
+           (long "folding-block-quotes-style"
+              <> help
+                "The report tree is structured using \
+                \summary/detail HTML elements and indented using \
+                \block quotes. This style renders well on GitHub.\
+                \Intended for HTML output format. Markdown has rendering \
+                \bugs on GitHub.")
+           <|> flag'
+             HeadersTreeStyle
+             (long "header-style"
+                <> help
+                  "The report tree is structured using \
+                  \increasing levels of headers.")
+           <|> pure HeadersTreeStyle)

src/OpenAPI/Checker/Report.hs

@@ -5,6 +5,7 @@ module OpenAPI.Checker.Report
   , Pandoc
   , ReportConfig (..)
   , ReportTreeStyle (..)
+  , ReportMode (..)
   )
 where
 
@@ -56,18 +57,26 @@ data ReportStatus
     -- there actually are any breaking changes.
     OnlyUnsupportedChanges
 
+data ReportMode = OnlyErrors | All
+  deriving stock (Eq)
+
 data ReportConfig = ReportConfig
   { treeStyle :: ReportTreeStyle
+  , reportMode :: ReportMode
   }
 
 instance Default ReportConfig where
   def =
     ReportConfig
       { treeStyle = HeadersTreeStyle
+      , reportMode = All
       }
 
 data ReportTreeStyle = HeadersTreeStyle | FoldingBlockquotesTreeStyle
 
+twoRowTable :: [(Inlines, Inlines)] -> Blocks
+twoRowTable x = simpleTable (para . fst <$> x) [para . snd <$> x]
+
 generateReport :: ReportConfig -> ReportInput -> (Pandoc, ReportStatus)
 generateReport cfg inp =
   let partitionUnsupported = P.partition (\(AnIssue _ i) -> issueIsUnsupported i)
@@ -77,23 +86,34 @@ generateReport cfg inp =
       breakingChangesPresent = not $ P.null breaking
       nonBreakingChangesPresent = not $ P.null nonBreaking
       unsupportedChangesPresent = not $ P.null unsupported
+      nonBreakingChangesShown = case reportMode cfg of
+        All -> True
+        OnlyErrors -> False
       builder = buildReport cfg
       report =
         doc $
           header 1 "Summary"
-            <> simpleTable
-              (para
-                 <$> [ refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
-                     , refOpt nonBreakingChangesPresent nonBreakingChangesId "🙆 Non-breaking changes"
-                     , refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
-                     ])
-              [para . show' <$> [P.size breaking, P.size nonBreaking, P.size unsupported]]
+            <> twoRowTable
+              ([ ( refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
+                 , show' $ P.size breaking
+                 )
+               ]
+                 ++ when'
+                   nonBreakingChangesShown
+                   [ ( refOpt nonBreakingChangesPresent nonBreakingChangesId "🙆 Non-breaking changes"
+                     , show' $ P.size nonBreaking
+                     )
+                   ]
+                 ++ [ ( refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
+                      , show' $ P.size unsupported
+                      )
+                    ])
             <> when'
               breakingChangesPresent
               (header 1 (anchor breakingChangesId <> "⚠️ Breaking changes")
                  <> builder (showErrs breaking))
             <> when'
-              nonBreakingChangesPresent
+              (nonBreakingChangesPresent && nonBreakingChangesShown)
               (header 1 (anchor nonBreakingChangesId <> "🙆 Non-breaking changes")
                  <> builder (showErrs nonBreaking))
             <> when'