Less verbose stack setup on Windows (fixes #1212)

commercialhaskell · Mar 20, 2019 · ae06651 · ae06651
1 parent a3761bc
commit ae06651
Show file tree

Hide file tree

Showing 2 changed files with 19 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
@@ -35,6 +35,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(..))
@@ -43,12 +44,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
@@ -1497,7 +1497,21 @@ setup7z si = do
                         , "-y"
                         , toFilePath archive
                         ]
-                ec <- proc cmd args runProcess
+                ec <- proc cmd args $ \pc ->
+                      withProcess (setStdout createSource pc) $ \p -> do
+                        total <- runConduit
+                            $ getStdout p
+                           .| filterCE (== 10) -- newline characters
+                           .| foldMC
+                                (\count bs -> do
+                                    let count' = count + S.length bs
+                                    when (count' `div` 100 > count `div` 100)
+                                      $ logInfo $ "Extracted " <> RIO.display count' <> " files"
+                                    pure count'
+                                )
+                                0
+                        logInfo $ "Extracted total of " <> RIO.display total <> " files"
+                        waitExitCode p
                 when (ec /= ExitSuccess)
                     $ liftIO $ throwM (ProblemWhileDecompressing archive)
         _ -> throwM SetupInfoMissingSevenz