From ae066514af6448de3b583cdfb65b67b09f5faef8 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 20 Mar 2019 10:21:33 +0200 Subject: [PATCH] Less verbose stack setup on Windows (fixes #1212) --- ChangeLog.md | 2 ++ src/Stack/Setup.hs | 20 +++++++++++++++++--- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 3cb5da8d95..4639ea0e4b 100644 --- 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 index 6e66064545..8b174ea659 100644 --- 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