Merge pull request #44 from serokell/martoon/smart-progress-option

Disable progress bar in CI automatically

Author: Martoon-00

CHANGES.md

@@ -7,6 +7,13 @@
 Unreleased
 ==========
 
+0.1.2
+=======
+
+* [#44](https://github.com/serokell/xrefcheck/pull/44)
+  + Decide whether to show progress bar by default depending on `CI` env variable.
+  + Added `--progress` option.
+
 0.1.1.2
 =======
 

exec/Main.hs

@@ -16,6 +16,7 @@ import Xrefcheck.Config
 import Xrefcheck.Progress
 import Xrefcheck.Scan
 import Xrefcheck.Scanners
+import Xrefcheck.System
 import Xrefcheck.Verify
 
 formats :: FormatsSupport
@@ -39,14 +40,17 @@ defaultAction Options{..} = do
       Just configPath -> do
         readConfig configPath
 
-    repoInfo <- allowRewrite oShowProgressBar $ \rw -> do
+    withinCI <- askWithinCI
+    let showProgressBar = oShowProgressBar ?: not withinCI
+
+    repoInfo <- allowRewrite showProgressBar $ \rw -> do
         let fullConfig = addTraversalOptions (cTraversal config) oTraversalOptions
         gatherRepoInfo rw formats fullConfig root
 
     when oVerbose $
         fmtLn $ "=== Repository data ===\n\n" <> indentF 2 (build repoInfo)
 
-    verifyRes <- allowRewrite oShowProgressBar $ \rw ->
+    verifyRes <- allowRewrite showProgressBar $ \rw ->
         verifyRepo rw (cVerification config) oMode root repoInfo
     case verifyErrors verifyRes of
         Nothing ->

package.yaml

@@ -5,7 +5,7 @@
 spec-version: 0.31.0
 
 name:                xrefcheck
-version:             0.1.1.2
+version:             0.1.2
 github:              serokell/xrefcheck
 license:             MPL-2.0
 license-file:        LICENSE

src/Xrefcheck/CLI.hs

@@ -18,7 +18,7 @@ module Xrefcheck.CLI
     ) where
 
 import Data.Version (showVersion)
-import Options.Applicative (Parser, ReadM, command, eitherReader, execParser, fullDesc, help,
+import Options.Applicative (Parser, ReadM, command, eitherReader, execParser, flag', fullDesc, help,
                             helper, hsubparser, info, infoOption, long, metavar, option, progDesc,
                             short, strOption, switch, value)
 import Paths_xrefcheck (version)
@@ -50,7 +50,7 @@ data Options = Options
     , oRoot             :: FilePath
     , oMode             :: VerifyMode
     , oVerbose          :: Bool
-    , oShowProgressBar  :: Bool
+    , oShowProgressBar  :: Maybe Bool
     , oTraversalOptions :: TraversalOptions
     }
 
@@ -99,9 +99,16 @@ optionsParser = do
         short 'v' <>
         long "verbose" <>
         help "Report repository scan and verification details."
-    oShowProgressBar <- fmap not . switch $
-        long "no-progress" <>
-        help "Do not display progress bar during verification."
+    oShowProgressBar <- asum
+        [ flag' (Just True) $
+            long "progress" <>
+            help "Display progress bar during verification. \
+                 \This is enabled by default unless `CI` env var is set to true."
+        , flag' (Just False) $
+            long "no-progress" <>
+            help "Do not display progress bar during verification."
+        , pure Nothing
+        ]
     oTraversalOptions <- traversalOptionsParser
     return Options{..}
 

src/Xrefcheck/System.hs

@@ -5,13 +5,16 @@
 
 module Xrefcheck.System
     ( readingSystem
+    , askWithinCI
     , RelGlobPattern (..)
     , bindGlobPattern
     ) where
 
 import Data.Aeson (FromJSON (..), withText)
+import qualified Data.Char as C
 import GHC.IO.Unsafe (unsafePerformIO)
 import System.Directory (canonicalizePath)
+import System.Environment (lookupEnv)
 import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
 
@@ -20,6 +23,14 @@ import qualified System.FilePath.Glob as Glob
 readingSystem :: IO a -> a
 readingSystem = unsafePerformIO
 
+-- | Heuristics to check whether we are running within CI.
+-- Check the respective env variable which is usually set in all CIs.
+askWithinCI :: IO Bool
+askWithinCI = lookupEnv "CI" <&> \case
+  Just "1"                       -> True
+  Just (map C.toLower -> "true") -> True
+  _                              -> False
+
 -- | Glob pattern relative to repository root.
 newtype RelGlobPattern = RelGlobPattern FilePath