Merge pull request #4643 from commercialhaskell/1212-quieter-setup-wi…

…ndows Less verbose stack setup on Windows (fixes #1212)
commercialhaskell · Mar 22, 2019 · 3609850 · 3609850
2 parents b69c6f1 + 496ff9b
commit 3609850
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 3 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -127,6 +127,8 @@ Other enhancements:
 * Both `stack dot` and `stack ls dependencies` accept a
   `--global-hints` flag to bypass the need for an installed GHC. See
   [#4390](https://github.com/commercialhaskell/stack/issues/4390).
+* Less verbose output from `stack setup` on Windows. See
+  [#1212](https://github.com/commercialhaskell/stack/issues/1212).
 
 Bug fixes:
 

diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs
@@ -38,6 +38,7 @@ module Stack.Setup
   ) where
 
 import qualified    Codec.Archive.Tar as Tar
+import              Conduit
 import              Control.Applicative (empty)
 import              Control.Monad.State (get, put, modify)
 import "cryptonite" Crypto.Hash (SHA1(..), SHA256(..))
@@ -46,12 +47,11 @@ import qualified    Data.ByteString as S
 import qualified    Data.ByteString.Lazy as LBS
 import qualified    Data.ByteString.Lazy.Char8 as BL8
 import              Data.Char (isSpace)
-import              Data.Conduit (await, yield, awaitForever)
 import qualified    Data.Conduit.Binary as CB
 import              Data.Conduit.Lazy (lazyConsume)
 import              Data.Conduit.Lift (evalStateC)
 import qualified    Data.Conduit.List as CL
-import              Data.Conduit.Process.Typed (eceStderr)
+import              Data.Conduit.Process.Typed (eceStderr, createSource)
 import              Data.Conduit.Zlib          (ungzip)
 import              Data.Foldable (maximumBy)
 import qualified    Data.HashMap.Strict as HashMap
@@ -1531,7 +1531,32 @@ setup7z si = do
                         , "-y"
                         , toFilePath archive
                         ]
-                ec <- proc cmd args runProcess
+                let archiveDisplay = fromString $ FP.takeFileName $ toFilePath archive
+                    isExtract = FP.takeExtension (toFilePath archive) == ".tar"
+                logInfo $
+                  (if isExtract then "Extracting " else "Decompressing ") <>
+                  archiveDisplay <> "..."
+                ec <-
+                  proc cmd args $ \pc ->
+                  if isExtract
+                    then withProcess (setStdout createSource pc) $ \p -> do
+                        total <- runConduit
+                            $ getStdout p
+                           .| filterCE (== 10) -- newline characters
+                           .| foldMC
+                                (\count bs -> do
+                                    let count' = count + S.length bs
+                                    logSticky $ "Extracted " <> RIO.display count' <> " files"
+                                    pure count'
+                                )
+                                0
+                        logStickyDone $
+                          "Extracted total of " <>
+                          RIO.display total <>
+                          " files from " <>
+                          archiveDisplay
+                        waitExitCode p
+                    else runProcess pc
                 when (ec /= ExitSuccess)
                     $ liftIO $ throwM (ProblemWhileDecompressing archive)
         _ -> throwM SetupInfoMissingSevenz